MixfixParser.hs revision 9987d35a267440c71e1e8b21c2ee6081a6390643
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder Author: Christian Maeder
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder Mixfix analysis of terms
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maedermodule MixfixParser where
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maederimport AS_Basic_CASL
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maederimport GlobalAnnotations
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maederimport FiniteMap
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maederimport Lexer (caslChar)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maederimport ParsecPrim
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maederimport qualified Char as C
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maederimport List(intersperse)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder-- for testing
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederimport PrettyPrint
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederimport Print_AS_Basic
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederimport GlobalAnnotationsFunctions
e69bfc714e534d71322f504dde433941142e1c05Christian Maederimport Anno_Parser
e69bfc714e534d71322f504dde433941142e1c05Christian Maeder-- precedence graph stuff
e69bfc714e534d71322f504dde433941142e1c05Christian MaederprecAnnos = [ "%prec({__+__} < {__*__})%", "%prec({__*__} < {__^__})%" ]
e69bfc714e534d71322f504dde433941142e1c05Christian MaederassocAnnos = ["%left_assoc(__+__)%"]
9987d35a267440c71e1e8b21c2ee6081a6390643Christian MaederlistAnnos = "%list([__], [], __::__)%"
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder-- don't put in list ids twice! (no danger!)
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedertestAnnos = addGlobalAnnos emptyGlobalAnnos
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder $ map (parseString annotationL)
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder (listAnnos:precAnnos ++ assocAnnos)
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedercheckArg :: GlobalAnnos -> AssocEither -> Id -> Id -> Bool
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedercheckArg g dir op arg =
b26211de8c1e50efbabbb95497e7508c4d852634Christian Maeder then isAssoc dir (assoc_annos g) op
b26211de8c1e50efbabbb95497e7508c4d852634Christian Maeder case precRel (prec_annos g) op arg of
b26211de8c1e50efbabbb95497e7508c4d852634Christian Maeder Lower -> True
b26211de8c1e50efbabbb95497e7508c4d852634Christian Maeder Higher -> False
b26211de8c1e50efbabbb95497e7508c4d852634Christian Maeder ExplGroup BothDirections -> False
b26211de8c1e50efbabbb95497e7508c4d852634Christian Maeder ExplGroup NoDirection -> not $ isInfix arg
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedercheckAnyArg :: GlobalAnnos -> Id -> Id -> Bool
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedercheckAnyArg g op arg =
b26211de8c1e50efbabbb95497e7508c4d852634Christian Maeder case precRel (prec_annos g) op arg of
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder ExplGroup BothDirections -> isInfix op && op == arg
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder-- Earley Algorithm
70ca840c8a6cf3591d5f9aa9a3de6fae42d696e8Christian Maeder-- after matching one place literally all places must match literally
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder-- and arguments must follow in parenthesis
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maederdata State = State { rule :: Id
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder , matchTerm ::Bool -- false (literally match place)
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder -- or false (treat as non-terminal)
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder , arglist :: [TERM] -- currently collected arguments
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder -- in reverse order
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder , dotPos :: [Token]
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder , rulePos :: Int
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maederinstance Eq State where
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder State r1 b1 _ t1 p1 == State r2 b2 _ t2 p2 =
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder r1 == r2 && t1 == t2 && p1 == p2 && b1 == b2
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maederinstance Ord State where
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder State r1 b1 _ t1 p1 <= State r2 b2 _ t2 p2 =
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder if r1 == r2 then
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder if t1 == t2 then
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder if p1 == p2 then b1 <= b2
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder else p1 <= p2
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder else t1 <= t2
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder else r1 <= r2
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederinstance Show State where
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder showsPrec _ (State r b _ d p) = showChar '{'
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . showSepList (showString "") showTok first
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . showChar '.'
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . showSepList (showString "") showTok d
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . showParen True (showMatch b)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . shows p . showChar '}'
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder where first = take (length v - length d) v
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder v = getTokenList r
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder showMatch x = showString $ if x then "" else place
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederinstance (Show a) => Show (Set a) where
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder showsPrec _ = shows . setToList
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaedercommaTok, placeTok, openParenTok, closeParenTok :: Token
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaedercommaTok = mkSimpleId ","
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaederplaceTok = mkSimpleId place
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaederopenParenTok = mkSimpleId "("
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaedercloseParenTok = mkSimpleId ")"
93fa7e4374de6e37328e752991a698bf03032c75Christian MaedergetTokenList :: Id -> [Token]
93fa7e4374de6e37328e752991a698bf03032c75Christian MaedergetTokenList (Id ts cs _) =
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder let (pls, toks) = span isPlace (reverse ts)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder cts = if null cs then [] else mkSimpleId "[" :
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder concat (intersperse [commaTok]
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder (map getTokenList cs)) ++ [mkSimpleId "]"]
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder in reverse toks ++ cts ++ reverse pls
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedermkState :: Int -> Id -> State
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaedermkState n ide = State ide True [] (getTokenList ide) n
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaederbracketToks :: [Token]
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaederbracketToks = [openParenTok, closeParenTok]
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaedermkApplState :: Int -> Id -> State
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaedermkApplState n ide = State ide False []
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder (getTokenList ide ++ bracketToks) n
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maedertype Chart = FiniteMap Int (Set State)
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaederinitialState :: Set Id -> GlobalAnnos -> Int -> Set State
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaederinitialState is g i =
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder mapSet (mkApplState i) is `union`
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder mapSet (mkState i) is `union`
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder listStates g i `addToSet`
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder bracketTerm i
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder-- qualified names not handled yet
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaederbracketTerm :: Int -> State
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaederbracketTerm i = let v = Id bracketToks [] []
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder in State v True [] (getTokenList v) i
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder-- unique id (usually "[]" yield two tokens)
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaederlistId = Id [mkSimpleId "[]"] [] []
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaederlistStates :: GlobalAnnos -> Int -> Set State
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaederlistStates g i = case list_lit (literal_annos g) of
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder Nothing -> emptySet
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder Just (Id b _ _, _, _) ->
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder let (b1, rest) = break isPlace b
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder b2 = if null rest then []
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder else filter (not . isPlace) rest
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder in mkSet [ State listId True [] (b1++b2) i
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder , State listId True []
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder (b1 ++ [placeTok] ++ b2) i
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder , State listId True []
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder (b1 ++ [placeTok, commaTok]
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederscan :: Token -> Int -> Chart -> Chart
70ca840c8a6cf3591d5f9aa9a3de6fae42d696e8Christian Maeder addToFM m (i+1) (mkSet $
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder foldr (\ (State o b a ts k) l ->
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder if null ts || head ts /= t
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder || isPlace t && b then l
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder else if t == commaTok || t == openParenTok then
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder (State o True a
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder (placeTok : commaTok : tail ts) k)
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder : (State o True a (placeTok : tail ts) k) : l
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder else (State o b a (tail ts) k) : l) []
70ca840c8a6cf3591d5f9aa9a3de6fae42d696e8Christian Maeder (setToList $ lookUp m i))
70ca840c8a6cf3591d5f9aa9a3de6fae42d696e8Christian MaederlookUp :: (Ord key) => FiniteMap key (Set a) -> key -> Set a
70ca840c8a6cf3591d5f9aa9a3de6fae42d696e8Christian MaederlookUp m i = lookupWithDefaultFM m emptySet i
b26211de8c1e50efbabbb95497e7508c4d852634Christian Maedercompl :: GlobalAnnos -> Chart -> [State] -> [State]
e69bfc714e534d71322f504dde433941142e1c05Christian Maeder concat $ map (collectArg g m)
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder $ filter (\ (State _ _ _ ts _) -> null ts) l
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedercollectArg :: GlobalAnnos -> Chart -> State -> [State]
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder-- pre: finished rule
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaedercollectArg g m s@(State _ _ _ _ k) =
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder map (\ (State o _ a ts k1) ->
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder State o True (asListAppl g s : a)
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder (tail ts) k1)
e69bfc714e534d71322f504dde433941142e1c05Christian Maeder $ filter (filterByPrec g s)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder $ setToList $ lookUp m k
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaederfilterByPrec :: GlobalAnnos -> State -> State -> Bool
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaederfilterByPrec _ _ (State _ _ _ [] _) = False
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaederfilterByPrec g (State argIde _ _ _ _) (State opIde b args (hd:ts) _) =
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder if isPlace hd && b then
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder if opIde == listId || argIde == listId then True
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder else if not (null ts) && (head ts == commaTok
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder || head ts == closeParenTok) then True
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder else let n = length args in
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder if isLeftArg opIde n then
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder if isPostfix opIde && not (isPostfix argIde) then False
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder else checkArg g ALeft opIde argIde
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder else if isRightArg opIde n then
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder if isPrefix opIde && isMixfix argIde then False
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder else checkArg g ARight opIde argIde
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder else checkAnyArg g opIde argIde
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian MaederisLeftArg, isRightArg :: Id -> Int -> Bool
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian MaederisLeftArg (Id ts _ _) n = n + 1 == (length $ takeWhile isPlace ts)
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian MaederisRightArg (Id ts _ _) n = n == (length $ filter isPlace ts) -
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder (length $ takeWhile isPlace (reverse ts))
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedercomplRec :: GlobalAnnos -> Chart -> [State] -> [State]
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedercomplRec g m l = let l1 = compl g m l in
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder if null l1 then l else complRec g m l1 ++ l
b26211de8c1e50efbabbb95497e7508c4d852634Christian Maedercomplete :: GlobalAnnos -> Int -> Chart -> Chart
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maedercomplete g i m = addToFM m i $ mkSet $ complRec g m $ setToList $ lookUp m i
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maederpredict :: Set Id -> GlobalAnnos -> Int -> Chart -> Chart
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maederpredict ms g i m = if any (\ (State _ b _ ts _) -> not (null ts)
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder && isPlace (head ts) && b)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder (setToList $ lookUp m i)
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder then addToFM_C union m i (initialState ms g i)
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedernextState :: Set Id -> GlobalAnnos -> [Token] -> Int -> Chart -> Chart
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedernextState rules pG toks pos chart =
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder if null toks then chart
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder else let c1 = predict rules pG pos chart
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder c2 = scan (head toks) pos c1
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder in if isEmptySet $ lookUp c2 (pos + 1) then c2
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder else nextState rules pG (tail toks) (pos + 1)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder (complete pG (pos + 1) c2)
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaedermkChart :: Set Id -> GlobalAnnos -> [Token] -> Chart
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaedermkChart rules g toks = nextState rules g toks 0
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder (unitFM 0 $ initialState rules g 0)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedersucChart :: Chart -> Bool
6fb319833285f714693d58e9620d67ab21ddebe4Christian MaedersucChart m = any (\ (State _ _ _ ts k) -> null ts && k == 0) $
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder setToList $ lookUp m $ sizeFM m - 1
9987d35a267440c71e1e8b21c2ee6081a6390643Christian MaedergetAppls :: GlobalAnnos -> Chart -> [TERM]
9987d35a267440c71e1e8b21c2ee6081a6390643Christian MaedergetAppls g m =
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder map (asListAppl g) $
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder filter (\ (State _ _ _ ts k) -> null ts && k == 0) $
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder setToList $ lookUp m $ sizeFM m - 1
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaederstateToAppl :: State -> TERM
9987d35a267440c71e1e8b21c2ee6081a6390643Christian MaederstateToAppl (State i _ a _ _) = asAppl i (reverse a) nullPos
9987d35a267440c71e1e8b21c2ee6081a6390643Christian MaederasListAppl :: GlobalAnnos -> State -> TERM
9987d35a267440c71e1e8b21c2ee6081a6390643Christian MaederasListAppl g s@(State i _ a _ _) =
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder case list_lit $ literal_annos g of
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder Nothing -> stateToAppl s
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder Just (_, c, f) ->
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder if i == listId then mkList (reverse a)
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder else stateToAppl s
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder where mkList [] = asAppl c [] nullPos
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder mkList (hd:tl) = asAppl f [hd, mkList tl] nullPos
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder-- start testing
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaedermyRules = ["__^__", "__*__", "__+__", "[__]",
e69bfc714e534d71322f504dde433941142e1c05Christian Maeder "x", "0", "1", "2", "3", "4", "5", "a", "b"]
e69bfc714e534d71322f504dde433941142e1c05Christian MaedermyTokens = "4*x^4+3*x^3+2*x^2+1*x^1+0*x^0"
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaedermyChart g r t = mkChart (mkSet $ map (parseString parseId) r) g
6fb319833285f714693d58e9620d67ab21ddebe4Christian Maeder (map (\ c -> mkSimpleId $ if c == '_' then place
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaedermyAppls g r t = map (printText g)
9987d35a267440c71e1e8b21c2ee6081a6390643Christian Maeder $ getAppls g (myChart g r t)
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaedertestAppls = myAppls testAnnos myRules myTokens
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder-- ---------------------------------------------------------------
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder-- convert literals
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder-- ---------------------------------------------------------------
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder-- isChar :: Token -> Bool
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder-- isChar t = head (tokStr t) == '\''
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaederisString :: Token -> Bool
fd40e201b7277427113c89724d8a2389c18e9cbdChristian MaederisString t = head (tokStr t) == '\"'
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaederisNumber :: Token -> Bool
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaederisNumber t = let s = tokStr t in length s > 1 && C.isDigit (head s)
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaederisFloating :: Token -> Bool
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder-- precondition: isNumber
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaederisFloating t = any (\c -> c == '.' || c == 'E') (tokStr t)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaederparseString :: Parser a -> String -> a
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaederparseString p s = case parse p "" s of
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder Left _ -> error "parseString"
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maedersplit :: Parser a -> String -> (a, String)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maedersplit p s = let ph = do hd <- p;
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder tl <- getInput;
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder return (hd, tl)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder in parseString ph s
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaedermakeStringTerm :: Id -> Id -> Token -> TERM
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaedermakeStringTerm c f tok =
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder makeStrTerm (line, colm + 1) str
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder (line, colm) = tokPos tok
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder str = init (tail (tokStr tok))
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder makeStrTerm p@(lin, col) l =
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder if null l then asAppl c [] p
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder else let (hd, tl) = split caslChar l
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder real = if hd == "'" then "'\\''" else "'" ++ hd ++ "'"
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder -- convert "'" to "\'" and lookup character '\''
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder in asAppl f [asAppl (Id [Token real p] [] []) [] p,
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder makeStrTerm (lin, col + length hd) tl] p
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaedermakeNumberTerm :: Id -> Token -> TERM
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaedermakeNumberTerm f t@(Token n p@(lin, col)) =
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder [] -> error "makeNumberTerm"
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder [_] -> asAppl (Id [t] [] []) [] p
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder hd:tl -> asAppl f [asAppl (Id [Token [hd] p] [] []) [] p,
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder makeNumberTerm f (Token tl (lin, col+1))] p
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaedermakeFraction :: Id -> Id -> Token -> TERM
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaedermakeFraction f d t@(Token s p@(lin, col)) =
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder let (n, r) = span (\c -> c /= '.') s
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder dotcol = col + length n
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder in if null r then makeNumberTerm f t
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder else asAppl d [makeNumberTerm f (Token n p),
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder makeNumberTerm f (Token (tail r) (lin, dotcol + 1))]
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder (lin, dotcol)
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaedermakeSignedNumber :: Id -> Token -> TERM
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaedermakeSignedNumber f t@(Token n p@(lin, col)) =
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder [] -> error "makeSignedNumber"
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder if hd == '-' || hd == '+' then
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder asAppl (Id [Token [hd] p] [] [])
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder [makeNumberTerm f (Token tl (lin, col+1))] p
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder else makeNumberTerm f t
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaedermakeFloatTerm :: Id -> Id -> Id -> Token -> TERM
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaedermakeFloatTerm f d e t@(Token s p@(lin, col)) =
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder let (m, r) = span (\c -> c /= 'E') s
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder ecol = col + length m
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder in if null r then makeFraction f d t
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder else asAppl e [makeFraction f d (Token m p),
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder makeSignedNumber f (Token (tail r) (lin, ecol + 1))]
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaederasAppl :: Id -> [TERM] -> Pos -> TERM
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaederasAppl f args p = let pos = if null args then [] else [p]
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder in Application (Op_name f) args pos
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder-- analyse Mixfix_token
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaederconvertMixfixToken:: LiteralAnnos -> Token -> Result TERM
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian MaederconvertMixfixToken ga t =
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder if isString t then
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder case string_lit ga of
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder Nothing -> err "string"
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder Just (c, f) -> erg $ makeStringTerm c f t
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder-- else if isChar t then erg $ asAppl (Id [t] [] []) [] (tokPos t)
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder else if isNumber t then
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder case number_lit ga of
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder Nothing -> err "number"
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder Just f -> if isFloating t then
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder case float_lit ga of
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder Nothing -> err "floating"
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder Just (d, e) -> erg $ makeFloatTerm f d e t
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder else erg $ makeNumberTerm f t
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder else erg $ Mixfix_token t
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder where err s = Result([Error ("missing %" ++ s ++ " annotation") (tokPos t)],
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder Just (Mixfix_token t))
e31c7e91ecb4b23aac070f64fa1b099c05aadd0dChristian Maeder erg r = Result([], Just r)