MixfixParser.hs revision 6eed7cde6b75d63ec6b8f7e31caac6919558a676
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
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederimport Graph (empty)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maederimport Lexer (caslChar)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maederimport ParsecPrim
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maederimport qualified Char as C
70ca840c8a6cf3591d5f9aa9a3de6fae42d696e8Christian 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(__+__)%"]
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaederlistAnnos = "%list([__], [], ::)%"
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder-- don't put in list ids twice!
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
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder , matchList :: Bool -- usually False
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder , matchPlace :: Maybe Bool -- no "__" encountered yet,
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder -- or true (literal match of place)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder -- or false (treat as non-terminal)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder , arglist :: [State] -- currently collected arguments
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder -- in reverse order
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder , dotPos :: [Token]
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder , rulePos :: Int
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder } deriving (Eq, Ord)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedershortShowState:: State -> ShowS
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedershortShowState s = showId $ rule s
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederinstance Show State where
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder showsPrec _ (State r l b a d p) = showChar '{' . showListTag l
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . showSepList (showString "") showTok first
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . showChar '.'
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . showSepList (showString "") showTok d
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . showParen True (showMatch b)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . showSepList (showChar ',') shortShowState a
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder . shows p . showChar '}'
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder where first = take (length v - length d) v
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder v = getTokenList r
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder showMatch Nothing = showString ""
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder showMatch (Just x) = showString $ if x then place else "TERM"
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder showListTag l = if l then showString "L " else showString ""
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederinstance (Show a) => Show (Set a) where
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder showsPrec _ = shows . setToList
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maederprefix :: Id -> Bool
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maederprefix (Id ts _ _) = if null ts then False else not $ isPlace $ head ts
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 "[" :
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder concat (intersperse [mkSimpleId ","]
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder (map getTokenList cs)) ++ [mkSimpleId "]"]
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder in reverse toks ++ cts ++ reverse pls
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedermkState :: Int -> Id -> State
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian MaedermkState n ide = State ide False Nothing [] (getTokenList ide) n
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maedertype Chart = FiniteMap Int (Set State)
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaederinitialState :: Set Id -> GlobalAnnos -> Int -> Set State
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaederinitialState is g i = mapSet (mkState i) is `union` listStates g i
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaederlistStates :: GlobalAnnos -> Int -> Set State
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaederlistStates g i = case list_lit (literal_annos g) of
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder Nothing -> emptySet
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder Just (Id b _ _, c, f) ->
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder let (b1, rest) = break isPlace b
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder b2 = if null rest then []
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder else filter (not . isPlace) rest
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder s1 = State c True (Just False) [] (b1++b2) i
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder in mkSet [ s1
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder , State f True (Just False) []
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder (b1 ++ [mkSimpleId place] ++ b2) i
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder , State f True (Just False) []
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder (b1 ++ [mkSimpleId place, mkSimpleId ","]
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaederdontMatchPlace, doMatchPlace, mayMatchNT :: Maybe Bool -> Bool
70ca840c8a6cf3591d5f9aa9a3de6fae42d696e8Christian MaederdontMatchPlace Nothing = False
70ca840c8a6cf3591d5f9aa9a3de6fae42d696e8Christian MaederdontMatchPlace (Just x) = not x
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaederdoMatchPlace Nothing = False
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaederdoMatchPlace (Just x) = x
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedermayMatchNT = not . doMatchPlace
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederscan :: Token -> Int -> Chart -> Chart
70ca840c8a6cf3591d5f9aa9a3de6fae42d696e8Christian Maeder addToFM m (i+1) (mkSet $
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder foldr (\ (State o z b a ts k) l ->
70ca840c8a6cf3591d5f9aa9a3de6fae42d696e8Christian Maeder if null ts || head ts /= t || isPlace t && dontMatchPlace b then l
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder else if z && t == mkSimpleId "," then
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder (State o z b a (mkSimpleId place : ts) k)
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder : (State o z b a (mkSimpleId place : tail ts) k) : l
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder else (State o z (if isPlace t then Just True else b)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder 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)
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder $ filter (\ (State _ _ _ _ ts _) -> null ts) l
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedercollectArg :: GlobalAnnos -> Chart -> State -> [State]
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder-- pre: finished rule
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian MaedercollectArg g m s@(State _ _ _ _ _ k) =
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder map (\ (State o z _ a ts k1) ->
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder State o z (Just False) (s:a) (tail ts) k1)
e69bfc714e534d71322f504dde433941142e1c05Christian Maeder $ filter (filterByPrec g s)
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder $ filter (\ (State _ _ b _ ts _) -> not (null ts)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder && isPlace (head ts) && mayMatchNT b)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder $ setToList $ lookUp m k
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaederfilterByPrec :: GlobalAnnos -> State -> State -> Bool
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaederfilterByPrec g (State argIde zArg _ _ _ _) (State opIde zOp _ args _ _) =
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder if zArg || zOp then True
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder let n = length args in
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder if isLeftArg opIde n then
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder if isPostfix opIde && not (isPostfix argIde) then False
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder else checkArg g ALeft opIde argIde
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder else if isRightArg opIde n then
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder if isPrefix opIde && isMixfix argIde then False
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder else checkArg g ARight opIde argIde
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian 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
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maederpredict ms g i m = if any (\ (State _ _ b _ ts _) -> not (null ts)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder && isPlace (head ts) && mayMatchNT 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
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian MaedersucChart m = any (\ (State _ _ _ _ ts k) -> null ts && k == 0) $
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder setToList $ lookUp m $ sizeFM m - 1
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedergetAppls :: Chart -> [TERM]
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder map stateToAppl $
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder filter (\ (State _ _ _ _ ts k) -> null ts && k == 0) $
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder setToList $ lookUp m $ sizeFM m - 1
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaederstateToAppl :: State -> TERM
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian MaederstateToAppl (State i _ _ a _ _) = Application (Op_name i)
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder (reverse (map stateToAppl a)) []
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
e69bfc714e534d71322f504dde433941142e1c05Christian Maeder (map (mkSimpleId . (: [])) t)
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian MaedermyAppls g r t = map (printText g)
6eed7cde6b75d63ec6b8f7e31caac6919558a676Christian Maeder $ getAppls (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)