AnalyseAnnos.hs revision 6cc0d8b77759c557e7d9459cd2734625a4db78b9
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachModule : $Header$
8267b99c0d7a187abe6f87ad50530dc08f5d1cdcAndy GimblettDescription : analyse annotations and add them to global ones
e071fb22ea9923a2a4ff41184d80ca46b55ee932Till MossakowskiCopyright : (c) Christian Maeder, Klaus Luettich and Uni Bremen 2002-2003
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachMaintainer : Christian.Maeder@dfki.de
b4fbc96e05117839ca409f5f20f97b3ac872d1edTill MossakowskiStability : provisional
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachPortability : portable
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachSome functions for building and accessing the datastructures of
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maeder GlobalAnnotations
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbachmodule Common.AnalyseAnnos (addGlobalAnnos, store_literal_map) where
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reillyimport qualified Common.Lib.Rel as Rel
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reillyimport qualified Data.Map as Map
fd8af3ecf2dff782cb2496c1c9bf9d0a76faa98bLiam O'Reillyimport Data.Maybe (fromMaybe)
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reillyimport Data.List (partition)
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly-- | add global annotations
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'ReillyaddGlobalAnnos :: GlobalAnnos -> [Annotation] -> Result GlobalAnnos
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian MaederaddGlobalAnnos ga all_annos = do
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder let (annos, rest_annos) = partition ( \ a -> case a of
90047eafd2de482c67bcd13103c6064e9b0cb254Andy Gimblett Label _ _ -> False
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Semantic_anno _ _ -> False
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly Unparsed_anno _ _ _ -> False
d04c328b10f17ec78001a94d694f7188ebd8c03cAndy Gimblett -- line and group and comments will be ignored
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly _ -> True) all_annos
90047eafd2de482c67bcd13103c6064e9b0cb254Andy Gimblett appendDiags $ map (mkDiag Hint "no analysis of") rest_annos
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly n_prec_annos <- store_prec_annos (prec_annos ga) annos
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly n_assoc_annos <- store_assoc_annos (assoc_annos ga) annos
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly n_display_annos <- store_display_annos (display_annos ga) annos
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly n_literal_annos <- store_literal_annos (literal_annos ga) annos
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly n_literal_map <- store_literal_map (literal_map ga) annos
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly { prec_annos = n_prec_annos
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly , assoc_annos = n_assoc_annos
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly , display_annos = n_display_annos
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly , literal_annos = n_literal_annos
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly , literal_map = n_literal_map }
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly-- | add precedences
842ae753ab848a8508c4832ab64296b929167a97Christian Maederstore_prec_annos :: PrecedenceGraph -> [Annotation] -> Result PrecedenceGraph
842ae753ab848a8508c4832ab64296b929167a97Christian Maederstore_prec_annos pgr =
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder let showRel = showSepList (showString "\n") showIdPair . Rel.toList in
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder fmap Rel.transClosure . foldM ( \ p0 an -> case an of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Prec_anno prc lIds hIds _ -> foldM (\ p1 li ->
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly foldM ( \ p2 hi -> if li == hi
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly then Result [mkDiag Error "prec_anno with equal id" hi] $ Just p2
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly err rel = Result [mkDiag Error
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly ("prec_anno conflict: " ++ showId li rel ++ showId hi "\n"
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder ++ showRel p2 "") hi] $ Just p2
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly in case prc of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Lower -> if Rel.path hi li p2
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder then err " < "
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder else return (Rel.insert li hi p2)
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder BothDirections -> if Rel.path hi li p2 == Rel.path li hi p2
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder then return (Rel.insert hi li (Rel.insert li hi p2))
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly else err " <> "
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly _ -> err " > ") p1 hIds) p0 lIds
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder _ -> return p0) pgr
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder-- | add associative ids
842ae753ab848a8508c4832ab64296b929167a97Christian Maederstore_assoc_annos :: AssocMap -> [Annotation] -> Result AssocMap
842ae753ab848a8508c4832ab64296b929167a97Christian Maederstore_assoc_annos = foldM $ \ am0 an -> case an of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Assoc_anno as is _ -> foldM ( \ am1 i ->
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly let v = Map.lookup i am1 in case v of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Nothing -> return $ Map.insert i as am1
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Just os -> Result
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly [ if as == os
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder then mkDiag Hint "repeated associative identifier" i
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder else mkDiag Error "identifier has already other associativity" i ]
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder $ Just am1 ) am0 is
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly _ -> return am0
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly-- | add display annotations
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reillystore_display_annos :: DisplayMap -> [Annotation] -> Result DisplayMap
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblettstore_display_annos = foldM $ \ m an -> case an of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly Display_anno i sxs _ -> do
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly dm <- foldM ( \ table (df, str) -> do
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett let Result ds mres = parse_display_str an str
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett toks = fromMaybe [] mres
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly oldToks = Map.findWithDefault toks df table
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder [ mkDiag Error
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly ("Number of places in identifier \"" ++ showId i
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly " \" does not meet number of places in display string \""
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder ++ str ++ "\"") an
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly | placeCount i /= placeCount (mkId toks) ]
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly appendDiags ds
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly if oldToks == toks then do
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly appendDiags checkToks
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder return $ Map.insert df toks table
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett appendDiags [mkDiag Error ("conflict: " ++ showDoc an "") an]
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett return table) t sxs
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett return $ Map.insert i dm m
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder _ -> return m
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett-- | add literal annotation to 'LiteralMap'
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett-- and check for overlapping ids
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblettstore_literal_map :: LiteralMap -> [Annotation] -> Result LiteralMap
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblettstore_literal_map = foldM $ \ m a -> case a of
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder Number_anno id1 _ ->
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder let oc = Map.findWithDefault Number id1 m in
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett if oc == Number -- repeated or new
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett then return $ Map.insert id1 Number m
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett else Result [mkDiag Error ("conflict: " ++ showDoc a "") id1] $ Just m
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett String_anno id1 id2 _ ->
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder let c = StringCons id1
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett on = Map.findWithDefault StringNull id1 m
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett in if oc == c && on == StringNull
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder then return $ Map.insert id1 StringNull $ Map.insert id2 c m
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett else Result [mkDiag Error ("conflict: " ++ showDoc a "") id1] $ Just m
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder Float_anno id1 id2 _ ->
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly let oc = Map.findWithDefault Fraction id1 m
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly on = Map.findWithDefault Floating id2 m
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett in if oc == Fraction && on == Floating
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett then return $ Map.insert id2 Floating $ Map.insert id1 Fraction m
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett else Result [mkDiag Error ("conflict: " ++ showDoc a "") id1] $ Just m
e771539425f4a0abef9f94cf4b63690f3603f682Andy Gimblett List_anno id1 id2 id3 _ ->
e54c5af823b9775dd2c058185ea5bdf7593950faAndy Gimblett let c = ListCons id1 id2
d326dac41dadbe2b84bb7021cbfd91f4dd4a19bcAndy Gimblett n = ListNull id1
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder in if c == oc && n == on
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly then return $ Map.insert id2 n $ Map.insert id3 c m
16e124196c6b204769042028c74f533509c9b5d3Christian Maeder else Result [mkDiag Error ("conflict: " ++ showDoc a "") id1] $ Just m
56899f6457976a2ee20f6a23f088cb5655b15715Liam O'Reilly-- | add literal annotation to 'LiteralAnnos'
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder-- and check for contradictions
67e234eb781dd16dfd269486befd2b5781075079Christian Maederstore_literal_annos :: LiteralAnnos -> [Annotation] -> Result LiteralAnnos
67e234eb781dd16dfd269486befd2b5781075079Christian Maederstore_literal_annos la ans = do
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly n_string_lit <- setStringLit (string_lit la) ans
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder n_list_lit <- setListLit (list_lit la) ans
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder n_number_lit <- setNumberLit (number_lit la) ans
e54c5af823b9775dd2c058185ea5bdf7593950faAndy Gimblett n_float_lit <- setFloatLit (float_lit la) ans
fd8af3ecf2dff782cb2496c1c9bf9d0a76faa98bLiam O'Reilly { string_lit = n_string_lit
cdf1545bdcd39a9d53c00761ffa42e7b1174b91eLiam O'Reilly , list_lit = n_list_lit
cdf1545bdcd39a9d53c00761ffa42e7b1174b91eLiam O'Reilly , number_lit = n_number_lit
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly , float_lit = n_float_lit }
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian Maeder-- | shortcut to show errors in 'setStringLit' and 'setFloatLit'
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'ReillyshowIdPair :: (Id, Id) -> ShowS
afd6ed16928bbd774b6c6c5b3f440a917dd638a1Andy GimblettshowIdPair (i1, i2) = showId i1 . showString "," . showId i2
e54c5af823b9775dd2c058185ea5bdf7593950faAndy Gimblett-- | add (and check for uniqueness) string annotations
afd6ed16928bbd774b6c6c5b3f440a917dd638a1Andy GimblettsetStringLit :: Maybe (Id,Id) -> [Annotation] -> Result (Maybe (Id,Id))
afd6ed16928bbd774b6c6c5b3f440a917dd638a1Andy GimblettsetStringLit = foldM $ \ m a -> case a of
e54c5af823b9775dd2c058185ea5bdf7593950faAndy Gimblett String_anno id1 id2 _ -> let q = (id1, id2) in case m of
e54c5af823b9775dd2c058185ea5bdf7593950faAndy Gimblett Nothing -> return $ Just q
afd6ed16928bbd774b6c6c5b3f440a917dd638a1Andy Gimblett Just p -> if q == p then return m
d297a45fc73aa6c4a1f9d073c3170611415f324bAndy Gimblett else Result [mkDiag Error
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian Maeder ("conflict %string " ++ showIdPair q " and " ++ showIdPair p "") id1]
afd6ed16928bbd774b6c6c5b3f440a917dd638a1Andy Gimblett _ -> return m
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly-- | add (and check for uniqueness) floating annotations
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'ReillysetFloatLit :: Maybe (Id,Id) -> [Annotation] -> Result (Maybe (Id,Id))
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'ReillysetFloatLit = foldM $ \ m a -> case a of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly Float_anno id1 id2 _ -> let q = (id1, id2) in case m of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly Nothing -> return $ Just q
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder Just p -> if q == p then return m
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder else Result [mkDiag Error
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly ("conflict %floating " ++ showIdPair q " and " ++ showIdPair p "") id1]
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder _ -> return m
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder-- | add (and check for uniqueness) number annotations
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'ReillysetNumberLit :: Maybe Id -> [Annotation] -> Result (Maybe Id)
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'ReillysetNumberLit = foldM $ \ m a -> case a of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly Number_anno id1 _ -> case m of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Nothing -> return $ Just id1
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Just id2 -> if id1 == id2 then return m
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder else Result [mkDiag Error
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder ("conflict %number " ++ showId id1 " and " ++ showId id2 "") id1]
f08f7774e4c47012f3c349205310750198cdc434Liam O'Reilly _ -> return m
7dc79552823b00bdd0dd75fcd2ab9af541c71650Christian Maeder-- | add (and check for consistency) (possibly several) list annotations
842ae753ab848a8508c4832ab64296b929167a97Christian MaedersetListLit :: Map.Map Id (Id,Id) -> [Annotation] -> Result (Map.Map Id (Id,Id))
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian Maeder let showListAnno i1 (i2, i3) =
56899f6457976a2ee20f6a23f088cb5655b15715Liam O'Reilly " %list " ++ showId i1 "," ++ showId i2 "," ++ showId i3 ""
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly in foldM $ \ m a -> case a of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly List_anno id1 id2 id3 _ ->
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder -- equal keys with different values conflict
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly let nv = (id2, id3)
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder in case Map.lookup id1 m of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Nothing -> return $ Map.insert id1 nv m
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Just v -> if nv == v then return m
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder else Result [mkDiag Error
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder ("conflict" ++ showListAnno id1 nv ++ " and"
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder ++ showListAnno id1 v) id1] $ Just m
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder _ -> return m
56899f6457976a2ee20f6a23f088cb5655b15715Liam O'Reillyparse_display_str :: Annotation -> String -> Result [Token]
842ae753ab848a8508c4832ab64296b929167a97Christian Maederparse_display_str an str =
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly case parse tokenL "-- internal parse --" str of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Left err -> let
f08f7774e4c47012f3c349205310750198cdc434Liam O'Reilly err' = "could not parse display string: using \""
eaf34cf96fbfcdcce7f3bdb322c4ea7ebd1fd220Liam O'Reilly ++ str ++ "\" as display token!\n" ++ show err
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly ++ "\nin:\n" ++ showDoc an ""
816c50f9135a598dfdcfb2af8a80390bc42a9b24Liam O'Reilly in warning [mkSimpleId str] err' nullRange
816c50f9135a598dfdcfb2af8a80390bc42a9b24Liam O'Reilly Right i' -> return i'
842ae753ab848a8508c4832ab64296b929167a97Christian MaedertokenL :: CharParser st [Token]
842ae753ab848a8508c4832ab64296b929167a97Christian MaedertokenL = many1 $ placeT
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder <|> fmap mkSimpleId
816c50f9135a598dfdcfb2af8a80390bc42a9b24Liam O'Reilly (anyChar <:> manyTill anyChar (lookAhead $ forget placeT <|> eof))