Id.hs revision e6d40133bc9f858308654afb1262b8b483ec5922
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederModule : $Header$
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiDescription : positions, simple and mixfix identifiers
1549f3abf73c1122acff724f718b615c82fa3648Till MossakowskiCopyright : (c) Klaus L�ttich and Christian Maeder and Uni Bremen 2002-2003
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
b4fbc96e05117839ca409f5f20f97b3ac872d1edTill MossakowskiMaintainer : maeder@tzi.de
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederStability : provisional
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederPortability : portable
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiThis module supplies positions, simple and mixfix identifiers.
1549f3abf73c1122acff724f718b615c82fa3648Till MossakowskiA simple identifier is a lexical token given by a string and a start position.
1549f3abf73c1122acff724f718b615c82fa3648Till Mossakowski- A 'place' is a special token within mixfix identifiers.
1549f3abf73c1122acff724f718b615c82fa3648Till Mossakowski- A mixfix identifier may have a compound list.
1549f3abf73c1122acff724f718b615c82fa3648Till Mossakowski This compound list follows the last non-place token!
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder- Identifiers fixed for all logics
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder-- do use in data types that derive d directly
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maederdata Pos = SourcePos { sourceName :: String
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder , sourceLine :: !Int
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski , sourceColumn :: !Int } deriving (Eq, Ord)
23a00c966f2aa8da525d7a7c51933c99964426c0Christian Maederinstance Show Pos where
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder showsPrec _ = showPos
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder-- | position lists with trivial equality
db453fe9625a9dab5d108f7a5e464598814144b8Jian Chun Wangnewtype Range = Range [Pos]
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder-- let InlineAxioms recognize positions
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maederinstance Show Range where
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder show _ = "nullRange"
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- ignore all ranges in comparisons
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maederinstance Eq Range where
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder _ == _ = True
c438c79d00fc438f99627e612498744bdc0d0c89Christian Maeder-- Ord must be consistent with Eq
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus Luettichinstance Ord Range where
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus Luettich compare _ _ = EQ
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus LuettichrangeToList :: Range -> [Pos]
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus LuettichrangeToList (Range l) = l
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedernullRange :: Range
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskinullRange = Range []
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederisNullRange :: Range -> Bool
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederisNullRange (Range l) = null l
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederappRange :: Range -> Range -> Range
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskiappRange (Range l1) (Range l2) = Range (l1++l2)
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederreverseRange :: Range -> Range
8e80792f474d154ff11762fac081a422e34f1accChristian MaederreverseRange (Range l) = Range (reverse l)
26d11a256b1433604a3dbc69913b520fff7586acChristian MaederconcatMapRange :: (a -> Range) -> [a] -> Range
26d11a256b1433604a3dbc69913b520fff7586acChristian MaederconcatMapRange f = Range . concatMap (rangeToList . f)
26d11a256b1433604a3dbc69913b520fff7586acChristian MaedercomparePos :: Pos -> Pos -> Ordering
26d11a256b1433604a3dbc69913b520fff7586acChristian MaedercomparePos = compare
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | construct a new position
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian MaedernewPos :: String -> Int -> Int -> Pos
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian MaedernewPos = SourcePos
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder-- | increment the column counter
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederincSourceColumn :: Pos -> Int -> Pos
4fc727afa544a757d1959ce77c02208f8bf330dcChristian MaederincSourceColumn (SourcePos s l c) i = SourcePos s l (c + i)
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder-- | show a position
5e46b572ed576c0494768998b043d9d340594122Till MossakowskishowPos :: Pos -> ShowS
5e46b572ed576c0494768998b043d9d340594122Till MossakowskishowPos p = let name = sourceName p
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski line = sourceLine p
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder column = sourceColumn p
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder in noShow (null name) (showString name . showChar ':') .
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder noShow (line == 0 && column == 0)
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder (shows line . showChar '.' . shows column)
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- * Tokens as 'String's with positions that are ignored for 'Eq' and 'Ord'
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | tokens as supplied by the scanner
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maederdata Token = Token { tokStr :: String
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , tokPos :: Range
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski } deriving (Eq, Ord)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiinstance Show Token where
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski show = tokStr
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder-- | simple ids are just tokens
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maedertype SIMPLE_ID = Token
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder-- | construct a token without position from a string
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedermkSimpleId :: String -> Token
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedermkSimpleId s = Token s nullRange
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederextSimpleId :: String -> SIMPLE_ID -> SIMPLE_ID
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederextSimpleId s sid = sid {tokStr = tokStr sid ++ s}
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederisSimpleToken :: Token -> Bool
26d11a256b1433604a3dbc69913b520fff7586acChristian MaederisSimpleToken t = case tokStr t of
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder c : r -> isAlpha c || isDigit c && null r || c == '\''
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder-- | show the plain string
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian MaedershowTok :: Token -> ShowS
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaedershowTok = showString . tokStr
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | collect positions
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedercatPosAux :: [Token] -> [Pos]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedercatPosAux = concatMap (rangeToList . tokPos)
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedercatPos :: [Token] -> Range
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedercatPos = Range . catPosAux
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | shortcut to get positions of surrounding and interspersed tokens
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedertoPos :: Token -> [Token] -> Token -> Range
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedertoPos o l c = catPos $ o:l++[c]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedertoPosAux :: Token -> [Token] -> Token -> [Pos]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedertoPosAux o l c = catPosAux $ o:l++[c]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- * placeholder stuff
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | the special 'place'
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maederplace :: String
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | is a 'place' token
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederisPlace :: Token -> Bool
5e46b572ed576c0494768998b043d9d340594122Till MossakowskiisPlace (Token t _) = t == place
612749008484b6773aedf4d6bbc85b8d074d15c6Christian MaederplaceTok :: Token
5e46b572ed576c0494768998b043d9d340594122Till MossakowskiplaceTok = mkSimpleId place
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | also a definition indicator
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian MaederequalS :: String
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | token for type annotations
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian MaedertypeTok :: Token
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedertypeTok = mkSimpleId ":"
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- * identifiers with positions (usually ignored) of compound lists
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | mixfix and compound identifiers
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maederdata Id = Id [Token] [Id] Range
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski -- pos of square brackets and commas of a compound list
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski --deriving Show
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiinstance Show Id where
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder showsPrec _ = showId
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | construct an 'Id' from a token list
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskimkId :: [Token] -> Id
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskimkId toks = Id toks [] (Range [])
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedermkInfix :: String -> Id
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian MaedermkInfix s = mkId [placeTok, mkSimpleId s, placeTok]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- ignore positions
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiinstance Eq Id where
26d11a256b1433604a3dbc69913b520fff7586acChristian Maeder Id tops1 ids1 _ == Id tops2 ids2 _ = (tops1, ids1) == (tops2, ids2)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- ignore positions
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiinstance Ord Id where
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski Id tops1 ids1 _ <= Id tops2 ids2 _ = (tops1, ids1) <= (tops2, ids2)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | the postfix type identifier
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedertypeId = mkId [placeTok, typeTok]
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | the invisible application rule with two places
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiapplId = mkId [placeTok, placeTok]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | the infix equality identifier
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskieqId = mkInfix equalS
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder-- ** show stuff
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder-- | shortcut to suppress output for input condition
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedernoShow :: Bool -> ShowS -> ShowS
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian MaedernoShow b s = if b then id else s
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder-- | intersperse seperators
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskishowSepList :: ShowS -> (a -> ShowS) -> [a] -> ShowS
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskishowSepList _ _ [] = id
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedershowSepList _ f [x] = f x
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedershowSepList s f (x:r) = f x . s . showSepList s f r
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder-- | shows a compound list
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedershowIds :: [Id] -> ShowS
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian MaedershowIds is = noShow (null is) $ showString "["
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder . showSepList (showString ",") showId is
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder . showString "]"
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | shows an 'Id', puts final places behind a compound list
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedershowId :: Id -> ShowS
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian MaedershowId (Id ts is _) =
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder let (toks, places) = splitMixToken ts
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder showToks = showSepList id showTok
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder in showToks toks . showIds is . showToks places
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder-- ** splitting identifiers
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder-- | splits off the front and final places
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian MaedersplitMixToken :: [Token] -> ([Token],[Token])
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedersplitMixToken [] = ([], [])
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedersplitMixToken (h:l) =
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder let (toks, pls) = splitMixToken l
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder in if isPlace h && null toks
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski then (toks, h:pls)
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder else (h:toks, pls)
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder-- | return open and closing list bracket and a compound list
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder-- from a bracket 'Id' (parsed by 'Common.Anno_Parser.caslListBrackets')
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedergetListBrackets :: Id -> ([Token], [Token], [Id])
200849122a9c65773e5b2ba8084ac3490d0490b5Christian MaedergetListBrackets (Id b cs _) =
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder let (b1, rest) = break isPlace b
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder b2 = if null rest then []
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder else filter (not . isPlace) rest
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder in (b1, b2, cs)
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder-- ** reconstructing token lists
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder-- | reconstruct a list with surrounding strings and interspersed commas
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder-- with proper position information
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- that should be preserved by the input function
200849122a9c65773e5b2ba8084ac3490d0490b5Christian MaederexpandPos :: (Token -> a) -> (String, String) -> [a] -> Range -> [a]
0b6f6d3eeb7b3b36292e60f1b3da5a5ce42eef1aChristian Maeder-- expandPos f ("{", "}") [a,b] [(1,1), (1,3), 1,5)] =
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder-- [ t"{" , a , t"," , b , t"}" ] where t = f . Token (and proper positions)
200849122a9c65773e5b2ba8084ac3490d0490b5Christian MaederexpandPos f (o, c) ts (Range ps) =
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder if null ts then if null ps then map (f . mkSimpleId) [o, c]
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder else map f (zipWith Token [o, c] [Range [head ps] , Range [last ps]])
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder else let n = length ts + 1
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder diff = n - length ps
0b6f6d3eeb7b3b36292e60f1b3da5a5ce42eef1aChristian Maeder commas j = if j == 2 then [c] else "," : commas (j - 1)
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder ocs = o : commas n
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder seps = map f (if diff == 0 then
200849122a9c65773e5b2ba8084ac3490d0490b5Christian Maeder zipWith ( \ s p -> Token s (Range [p]))
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski ocs ps else map mkSimpleId ocs)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski in head seps : concat (zipWith (\ t s -> [t,s]) ts (tail seps))
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder-- | reconstruct the token list of an 'Id'
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder-- including square brackets and commas of (nested) compound lists.
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedergetPlainTokenList :: Id -> [Token]
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian MaedergetPlainTokenList (Id ts cs ps) =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder if null cs then ts else
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder let (toks, pls) = splitMixToken ts in
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder toks ++ getCompoundTokenList cs ps ++ pls
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- | reconstruct tokens of compound list
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedergetCompoundTokenList :: [Id] -> Range -> [Token]
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaedergetCompoundTokenList cs ps = concat $ expandPos (:[]) ("[", "]")
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder -- although positions will be replaced (by scan)
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder (map getPlainTokenList cs) ps
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | reconstruct the token list of an 'Id'.
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder-- Replace top-level places with the input String
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian MaedergetTokenList :: String -> Id -> [Token]
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedergetTokenList placeStr (Id ts cs ps) =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder let convert = map (\ t -> if isPlace t then t {tokStr = placeStr} else t)
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder in if null cs then convert ts else
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder let (toks, pls) = splitMixToken ts in
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder convert toks ++ getCompoundTokenList cs ps ++ convert pls
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- ** conversion from 'SIMPLE_ID'
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | a 'SIMPLE_ID' as 'Id'
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedersimpleIdToId :: SIMPLE_ID -> Id
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian MaedersimpleIdToId sid = Id [sid] [] (Range [])
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder-- | a string as 'Id'
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian MaederstringToId :: String -> Id
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian MaederstringToId sid = simpleIdToId $ mkSimpleId sid
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder-- | efficiently test for a singleton list
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian MaederisSingle :: [a] -> Bool
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskiisSingle [_] = True
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederisSingle _ = False
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski-- | test for a 'SIMPLE_ID'
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederisSimpleId :: Id -> Bool
578b677874296e4ba48e57b5e4b4b0270d995603Christian MaederisSimpleId (Id ts cs _) = null cs && case ts of
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder [t] -> isSimpleToken t
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-- ** fixity stuff
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder-- | number of 'place' in 'Id'
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederplaceCount :: Id -> Int
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian MaederplaceCount (Id tops _ _) = length $ filter isPlace tops
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | has no (toplevel) 'place'
4fc727afa544a757d1959ce77c02208f8bf330dcChristian MaederisOrdAppl :: Id -> Bool
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederisOrdAppl = not . isMixfix
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder-- | has a 'place'
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederisMixfix :: Id -> Bool
329d1810c6d5a5a0827e1d07503d94431578d176Christian MaederisMixfix (Id tops _ _) = any isPlace tops
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-- | 'Id' starts with a 'place'
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian MaederbegPlace :: Id -> Bool
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederbegPlace (Id toks _ _) = not (null toks) && isPlace (head toks)
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | 'Id' ends with a 'place'
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederendPlace :: Id -> Bool
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian MaederendPlace (Id toks _ _) = not (null toks) && isPlace (last toks)
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | ends with a 'place'
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederisPrefix :: Id -> Bool
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian MaederisPrefix (Id tops _ _) = not (null tops) && not (isPlace (head tops))
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder && isPlace (last tops)
4fc727afa544a757d1959ce77c02208f8bf330dcChristian Maeder-- | starts with a 'place'
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederisPostfix :: Id -> Bool
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederisPostfix (Id tops _ _) = not (null tops) && isPlace (head tops)
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder && not (isPlace (last tops))
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder-- | is a classical infix 'Id' with three tokens,
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder-- the middle one is a non-'place'
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederisInfix2 :: Id -> Bool
b1caf27fb0c879dd39600d09d501074a2dfd865aChristian MaederisInfix2 (Id ts _ _) =
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski [e1, e2, e3] -> isPlace e1 && not (isPlace e2)
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian Maeder && isPlace e3
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder-- | starts and ends with a 'place'
5e46b572ed576c0494768998b043d9d340594122Till MossakowskiisInfix :: Id -> Bool
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederisInfix (Id tops _ _) = not (null tops) && isPlace (head tops)
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski && isPlace (last tops)
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski-- | has a 'place' but neither starts nor ends with one
5e46b572ed576c0494768998b043d9d340594122Till MossakowskiisSurround :: Id -> Bool
5e46b572ed576c0494768998b043d9d340594122Till MossakowskiisSurround i@(Id tops _ _) = not (null tops) && (isMixfix i)
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder && not (isPlace (head tops))
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder && not (isPlace (last tops))
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski-- * position stuff
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski-- | compute a meaningful single position from an 'Id' for diagnostics
329d1810c6d5a5a0827e1d07503d94431578d176Christian MaederposOfId :: Id -> Range
329d1810c6d5a5a0827e1d07503d94431578d176Christian MaederposOfId (Id ts _ (Range ps)) =
329d1810c6d5a5a0827e1d07503d94431578d176Christian Maeder Range $ let l = filter (not . isPlace) ts
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder in (if null l then
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder -- for invisible "__ __" (only places)
329d1810c6d5a5a0827e1d07503d94431578d176Christian Maeder else catPosAux l) ++ ps
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder-- | get a reasonable position for a list
329d1810c6d5a5a0827e1d07503d94431578d176Christian MaederposOf :: PosItem a => [a] -> Range
329d1810c6d5a5a0827e1d07503d94431578d176Christian MaederposOf = Range . concatMap getPosList
329d1810c6d5a5a0827e1d07503d94431578d176Christian Maeder-- | get a reasonable position for a list with an additional position list
329d1810c6d5a5a0827e1d07503d94431578d176Christian MaederfirstPos :: PosItem a => [a] -> Range -> Range
329d1810c6d5a5a0827e1d07503d94431578d176Christian MaederfirstPos l (Range ps) = Range (rangeToList (posOf l) ++ ps)
329d1810c6d5a5a0827e1d07503d94431578d176Christian Maeder---- helper class -------------------------------------------------------
c438c79d00fc438f99627e612498744bdc0d0c89Christian Maeder{- | This class is derivable with DrIFT.
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder Its main purpose is to have a function that operates on
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder constructors with a 'Pos' or list of 'Pos' field. During parsing, mixfix
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder analysis and ATermConversion this function might be very useful.
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiclass PosItem a where
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder getRange :: a -> Range
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder getRange _ = nullRange -- default implementation
746440cc1b984a852f5864235b8fa3930963a081Christian MaedergetPosList :: PosItem a => a -> [Pos]
746440cc1b984a852f5864235b8fa3930963a081Christian MaedergetPosList = rangeToList . getRange
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- handcoded instance
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maederinstance PosItem Token where
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder getRange (Token _ p) = p
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-- handcoded instance
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maederinstance PosItem Id where
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder getRange = posOfId
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-- handcoded instance
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maederinstance PosItem ()
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder -- default is ok