MixfixParser.hs revision c8bf82bdb27dfa58f7f05045c639c14276be3333
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(__+__)%"]
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedertestAnnos = addGlobalAnnos emptyGlobalAnnos
b26211de8c1e50efbabbb95497e7508c4d852634Christian Maeder $ map (parseString annotationL) (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
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder showsPrec _ (State r l b a d p) = showChar '{' . showList 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"
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maeder showList 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)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaederinitialState :: Set Id -> Chart
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaederinitialState is = unitFM 0 (mapSet (mkState 0) is)
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
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian 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
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian MaederfilterByPrec g (State argIde _ _ _ _ _) (State opIde _ _ args _ _) =
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
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maederpredict :: Set Id -> Int -> Chart -> Chart
c8bf82bdb27dfa58f7f05045c639c14276be3333Christian Maederpredict ms i m = if any (\ (State _ _ b _ ts _) -> not (null ts)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder && isPlace (head ts) && mayMatchNT b)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder (setToList $ lookUp m i)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder then addToFM_C union m i (mapSet (mkState i) ms)
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedernextState :: Set Id -> GlobalAnnos -> [Token] -> Int -> Chart -> Chart
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedernextState rules pG toks pos chart =
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder if null toks then chart
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian Maeder else let c1 = predict rules 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)
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedermkChart :: Set Id -> [Token] -> Chart
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedermkChart rules toks = nextState rules testAnnos toks 0 (initialState rules)
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
e69bfc714e534d71322f504dde433941142e1c05Christian 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"
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedertestChart = myChart myRules myTokens
3f0cd3e73a8aa47bb586b69fe5f7fa450000ecfdChristian MaedermyChart r t = mkChart (mkSet $ map (parseString parseId) r)
e69bfc714e534d71322f504dde433941142e1c05Christian Maeder (map (mkSimpleId . (: [])) t)
b26211de8c1e50efbabbb95497e7508c4d852634Christian MaedertestAppls = map (printText testAnnos)
e69bfc714e534d71322f504dde433941142e1c05Christian Maeder $ getAppls testChart
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)