Id.hs revision b4fbc96e05117839ca409f5f20f97b3ac872d1ed
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maeder{- |
c3d42e13d2a7c3749229498658aec34e7e4fd0a0Christian MaederModule : $Header$
c3d42e13d2a7c3749229498658aec34e7e4fd0a0Christian MaederCopyright : (c) Klaus L�ttich and Christian Maeder and Uni Bremen 2002-2003
cd7372fc7e6e43c389619f63daa6eb872d9d5b16Christian MaederLicence : similar to LGPL, see HetCATS/LICENCE.txt or LIZENZ.txt
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian Maeder
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian MaederMaintainer : maeder@tzi.de
c3d42e13d2a7c3749229498658aec34e7e4fd0a0Christian MaederStability : provisional
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian MaederPortability : portable
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maeder
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maeder
99c923311eab71a85f1dcc4785d349609c828da4Christian MaederThis module supplies positions, simple and mixfix identifiers.
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian MaederA simple identifier is a lexical token given by a string and a start position.
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maeder
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder- A 'place' is a special token within mixfix identifiers.
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maeder- A mixfix identifier may have a compound list.
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maeder This compound list follows the last non-place token!
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maeder
ce31795240d8fb340bc984b8b35147c955e29afaChristian Maeder- Identifiers fixed for all logics
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maeder-}
ce31795240d8fb340bc984b8b35147c955e29afaChristian Maeder
ce31795240d8fb340bc984b8b35147c955e29afaChristian Maedermodule Common.Id where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrinidata Pos = SourcePos { sourceName :: String
ce31795240d8fb340bc984b8b35147c955e29afaChristian Maeder , sourceLine :: !Int
ce31795240d8fb340bc984b8b35147c955e29afaChristian Maeder , sourceColumn :: !Int }
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance Show Pos where
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder showsPrec _ = showPos
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance Eq Pos where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini _ == _ = True
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance Ord Pos where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini compare _ _ = EQ
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinicomparePos :: Pos -> Pos -> Ordering
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinicomparePos (SourcePos s1 l1 c1) (SourcePos s2 l2 c2) =
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini compare (s1, l1, c1) (s2, l2, c2)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | construct a new position
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrininewPos :: String -> Int -> Int -> Pos
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrininewPos = SourcePos
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | increment the column counter
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniincSourceColumn :: Pos -> Int -> Pos
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniincSourceColumn (SourcePos s l c) i = SourcePos s l (c + i)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | show a position
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinishowPos :: Pos -> ShowS
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinishowPos p = let name = sourceName p
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini line = sourceLine p
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini column = sourceColumn p
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini in noShow (null name) (showString name . showChar ':') .
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini noShow (line == 0 && column == 0)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini (shows line . showChar '.' . shows column)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- * Tokens as 'String's with positions that are ignored for 'Eq' and 'Ord'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | tokens as supplied by the scanner
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrinidata Token = Token { tokStr :: String
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini , tokPos :: [Pos]
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini } --deriving (Show)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance Show Token where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini show = tokStr
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | simple ids are just tokens
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrinitype SIMPLE_ID = Token
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | a 'Token' with 'nullPos'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinimkSimpleId :: String -> Token
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinimkSimpleId s = Token s []
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniextSimpleId :: String -> SIMPLE_ID -> SIMPLE_ID
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniextSimpleId s sid = sid {tokStr = tokStr sid ++ s}
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini-- | show the plain string
38f8320f50c5f63965ba42e4e48f38be07c823cfChristian MaedershowTok :: Token -> ShowS
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo TorrinishowTok = showString . tokStr
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | ignore 'tokPos'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance Eq Token where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini Token s1 _ == Token s2 _ = s1 == s2
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | ignore 'tokPos'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance Ord Token where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini Token s1 _ <= Token s2 _ = s1 <= s2
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder-- | collect positions
99c923311eab71a85f1dcc4785d349609c828da4Christian MaedercatPos :: [Token] -> [Pos]
99c923311eab71a85f1dcc4785d349609c828da4Christian MaedercatPos = concatMap tokPos
99c923311eab71a85f1dcc4785d349609c828da4Christian Maeder
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | shortcut to get positions of surrounding and interspersed tokens
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinitoPos :: Token -> [Token] -> Token -> [Pos]
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinitoPos o l c = catPos $ o:l++[c]
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- * placeholder stuff
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | the special 'place'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniplace :: String
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniplace = "__"
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | is a 'place' token
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniisPlace :: Token -> Bool
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniisPlace (Token t _) = t == place
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- * identifiers with positions (usually ignored) of compound lists
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | mixfix and compound identifiers
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrinidata Id = Id [Token] [Id] [Pos]
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini -- pos of square brackets and commas of a compound list
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini --deriving Show
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance Show Id where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini showsPrec _ = showId
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | construct an 'Id' from a token list
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinimkId :: [Token] -> Id
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinimkId toks = Id toks [] []
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- ignore positions
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance Eq Id where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini Id tops1 ids1 _ == Id tops2 ids2 _ = (tops1, ids1) == (tops2, ids2)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- ignore positions
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance Ord Id where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini Id tops1 ids1 _ <= Id tops2 ids2 _ = (tops1, ids1) <= (tops2, ids2)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- ** show stuff
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | shortcut to suppress output for input condition
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrininoShow :: Bool -> ShowS -> ShowS
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrininoShow b s = if b then id else s
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | intersperse seperators
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinishowSepList :: ShowS -> (a -> ShowS) -> [a] -> ShowS
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaedershowSepList _ _ [] = id
99c923311eab71a85f1dcc4785d349609c828da4Christian MaedershowSepList _ f [x] = f x
99c923311eab71a85f1dcc4785d349609c828da4Christian MaedershowSepList s f (x:r) = f x . s . showSepList s f r
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | shows a compound list
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinishowIds :: [Id] -> ShowS
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinishowIds is = noShow (null is) $ showString "["
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini . showSepList (showString ",") showId is
d4e8d3a0ddb1a63754edc3571b6a3a54a7b62d04Paolo Torrini . showString "]"
d4e8d3a0ddb1a63754edc3571b6a3a54a7b62d04Paolo Torrini
d4e8d3a0ddb1a63754edc3571b6a3a54a7b62d04Paolo Torrini-- | shows an 'Id', puts final places behind a compound list
99c923311eab71a85f1dcc4785d349609c828da4Christian MaedershowId :: Id -> ShowS
99c923311eab71a85f1dcc4785d349609c828da4Christian MaedershowId (Id ts is _) =
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder let (toks, places) = splitMixToken ts
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini showToks = showSepList id showTok
ce31795240d8fb340bc984b8b35147c955e29afaChristian Maeder in showToks toks . showIds is . showToks places
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- for pretty printing see PrettyPrint.hs
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- ** splitting identifiers
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | splits off the front and final places
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinisplitMixToken :: [Token] -> ([Token],[Token])
ce31795240d8fb340bc984b8b35147c955e29afaChristian MaedersplitMixToken [] = ([], [])
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinisplitMixToken (h:l) =
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini let (toks, pls) = splitMixToken l
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini in if isPlace h && null toks
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini then (toks, h:pls)
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini else (h:toks, pls)
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini-- | return open and closing list bracket and a compound list
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini-- from a bracket 'Id' (parsed by 'caslListBrackets')
c730c28919b53f940ed319ebb42780244c528e29Paolo TorrinigetListBrackets :: Id -> ([Token], [Token], [Id])
c730c28919b53f940ed319ebb42780244c528e29Paolo TorrinigetListBrackets (Id b cs _) =
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini let (b1, rest) = break isPlace b
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini b2 = if null rest then []
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini else filter (not . isPlace) rest
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini in (b1, b2, cs)
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini-- ** reconstructing token lists
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini-- | reconstruct a list with surrounding strings and interspersed commas
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini-- with proper position information
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini-- that should be preserved by the input function
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo TorriniexpandPos :: (Token -> a) -> (String, String) -> [a] -> [Pos] -> [a]
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- expandPos f ("{", "}") [a,b] [(1,1), (1,3), 1,5)] =
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- [ t"{" , a , t"," , b , t"}" ] where t = f . Token (and proper positions)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniexpandPos f (o, c) ts ps =
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini if null ts then if null ps then map (f . mkSimpleId) [o, c]
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini else map f (zipWith Token [o, c] [[head ps] , [last ps]])
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini else let n = length ts + 1
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini diff = n - length ps
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini commas j = if j == 2 then [c] else "," : commas (j - 1)
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini ocs = o : commas n
38f8320f50c5f63965ba42e4e48f38be07c823cfChristian Maeder seps = map f (if diff == 0 then
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini zipWith ( \ s p -> Token s [p])
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini ocs ps else map mkSimpleId ocs)
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini in head seps : concat (zipWith (\ t s -> [t,s]) ts (tail seps))
c730c28919b53f940ed319ebb42780244c528e29Paolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | reconstruct the token list of an 'Id'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- including square brackets and commas of (nested) compound lists.
ce31795240d8fb340bc984b8b35147c955e29afaChristian MaedergetPlainTokenList :: Id -> [Token]
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinigetPlainTokenList (Id ts cs ps) =
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini if null cs then ts else
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini let (toks, pls) = splitMixToken ts in
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini toks ++ getCompoundTokenList cs ps ++ pls
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini-- | reconstruct tokens of compound list
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo TorrinigetCompoundTokenList :: [Id] -> [Pos] -> [Token]
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo TorrinigetCompoundTokenList cs ps = concat $ expandPos (:[]) ("[", "]")
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini -- although positions will be replaced (by scan)
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini (map getPlainTokenList cs) ps
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini-- ** conversion from 'SIMPLE_ID'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | a 'SIMPLE_ID' as 'Id'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinisimpleIdToId :: SIMPLE_ID -> Id
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorrinisimpleIdToId sid = Id [sid] [] []
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | efficiently test for a singleton list
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniisSingle :: [a] -> Bool
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniisSingle [_] = True
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniisSingle _ = False
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | test for a 'SIMPLE_ID'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniisSimpleId :: Id -> Bool
ce31795240d8fb340bc984b8b35147c955e29afaChristian MaederisSimpleId (Id ts cs _) = null cs && isSingle ts
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- ** fixity stuff
ce31795240d8fb340bc984b8b35147c955e29afaChristian Maeder
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder-- | number of 'place' in 'Id'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
ce31795240d8fb340bc984b8b35147c955e29afaChristian MaederplaceCount :: Id -> Int
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniplaceCount (Id tops _ _) = length $ filter isPlace tops
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
ce31795240d8fb340bc984b8b35147c955e29afaChristian Maeder-- | has no (toplevel) 'place'
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisOrdAppl :: Id -> Bool
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisOrdAppl = not . isMixfix
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder-- | has a 'place'
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniisMixfix :: Id -> Bool
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniisMixfix (Id tops _ _) = any isPlace tops
603e326e7b189de8c1e4ea8c89470b3a61154019Christian Maeder
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder-- | ends with a 'place'
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisPrefix :: Id -> Bool
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisPrefix (Id tops _ _) = not (null tops) && not (isPlace (head tops))
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder && isPlace (last tops)
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder-- | starts with a 'place'
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisPostfix :: Id -> Bool
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisPostfix (Id tops _ _) = not (null tops) && isPlace (head tops)
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder && not (isPlace (last tops))
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder-- | is a classical infix 'Id' with three tokens,
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder-- the middle one is a non-'place'
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisInfix2 :: Id -> Bool
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniisInfix2 (Id ts _ _) =
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini case ts of
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder [e1, e2, e3] -> isPlace e1 && not (isPlace e2)
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder && isPlace e3
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder _ -> False
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder-- | starts and ends with a 'place'
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisInfix :: Id -> Bool
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisInfix (Id tops _ _) = not (null tops) && isPlace (head tops)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini && isPlace (last tops)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- | has a 'place' but neither starts nor ends with one
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisSurround :: Id -> Bool
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisSurround i@(Id tops _ _) = not (null tops) && (isMixfix i)
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini && not (isPlace (head tops))
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder && not (isPlace (last tops))
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder
62dd3cd58cda003c32ac69ff12dc82b0a6f5d9d3Christian Maeder-- | has no compound list
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisNonCompound :: Id -> Bool
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederisNonCompound (Id _ cs _) = null cs
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder-- * position stuff
aa436590b8c7f5035f5cf657d6de163046bc23eaPaolo Torrini
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaedernullPos :: [Pos]
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaedernullPos = []
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder-- | compute a meaningful single position from an 'Id' for diagnostics
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo TorriniposOfId :: Id -> [Pos]
120c9bff9059626735fc12b0399dcc9e5a62c345Christian MaederposOfId (Id ts _ ps) = let l = filter (not . isPlace) ts
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder in (if null l then
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini -- for invisible "__ __" (only places)
120c9bff9059626735fc12b0399dcc9e5a62c345Christian Maeder catPos ts
99c923311eab71a85f1dcc4785d349609c828da4Christian Maeder else catPos l) ++ ps
74e146c7cfad97817d7e065dcd937cada89b257dChristian Maeder
74e146c7cfad97817d7e065dcd937cada89b257dChristian Maeder-- | get a reasonable position for a list
74e146c7cfad97817d7e065dcd937cada89b257dChristian MaederposOf :: PosItem a => [a] -> [Pos]
99c923311eab71a85f1dcc4785d349609c828da4Christian MaederposOf = concatMap get_pos
74e146c7cfad97817d7e065dcd937cada89b257dChristian Maeder
a2e8cca8a8217b158b0b7a760e8234c03186456dChristian Maeder
74e146c7cfad97817d7e065dcd937cada89b257dChristian Maeder-- | get a reasonable position for a list with an additional position list
99c923311eab71a85f1dcc4785d349609c828da4Christian MaederfirstPos :: PosItem a => [a] -> [Pos] -> [Pos]
74e146c7cfad97817d7e065dcd937cada89b257dChristian MaederfirstPos l ps = posOf l ++ ps
74e146c7cfad97817d7e065dcd937cada89b257dChristian Maeder
74e146c7cfad97817d7e065dcd937cada89b257dChristian Maeder---- helper class -------------------------------------------------------
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini{- | This class is derivable with DrIFT.
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini Its main purpose is to have a function that operates on
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini constructors with a 'Pos' or list of 'Pos' field. During parsing, mixfix
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini analysis and ATermConversion this function might be very useful.
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-}
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniclass PosItem a where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini get_pos :: a -> [Pos]
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini get_pos _ = []
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- a Pos list should not contain nullPos
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- handcoded instance
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance PosItem Token where
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maeder get_pos (Token _ p) = p
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maeder
13ed13e06a5dd4aad12044ed7e7503cbe7f62990Christian Maeder-- handcoded instance
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torriniinstance PosItem Id where
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini get_pos = posOfId
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini
1b0778e21d9b3e71a684ad6e901e8a0e7d57ee1cPaolo Torrini-- handcoded instance
d5ef5a29a89fa5548f81fcd49fcf0ffda69d45b0Christian Maederinstance PosItem ()
13ed13e06a5dd4aad12044ed7e7503cbe7f62990Christian Maeder -- default is ok
13ed13e06a5dd4aad12044ed7e7503cbe7f62990Christian Maeder