MixfixParser.hs revision e4eed2389ec1b1bfa03c662c71e8165e93df43c4
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
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maederimport List(intersperse, partition)
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder-- Earley Algorithm
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder-- the single non-terminal (forall terms) will be "()"
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian MaedernT = Token "()" nullPos
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian MaederisNT (Token s _) = s == "()"
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder-- all ids are duplicate replacing "__" with "()"
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maederdata State = State { rule :: Id
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder , dotPos :: [Token]
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder , rulePos :: Int
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder } deriving (Eq, Ord)
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maederprefix :: Id -> Bool
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maederprefix (Id ts _ _) = if null ts then False else not $ isPlace $ head ts
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian MaederplaceToNT :: Id -> Id
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian MaederplaceToNT (Id ts cs ps) = Id (map (\t -> if isPlace t then nT else t) ts) cs ps
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian MaederinitialState :: Set Id -> (Set Id, FiniteMap Int (Set State))
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian MaederinitialState is = let (ps, ms) = partition prefix $ setToList is
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder mis = map placeToNT ms
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder pis = map placeToNT ps
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder states = map (\i -> State i (getTokenList i) 0) mis
e4eed2389ec1b1bfa03c662c71e8165e93df43c4Christian Maeder in (mkSet $ ps ++ pis ++ ms ++ mis, unitFM 0 (mkSet states))
93fa7e4374de6e37328e752991a698bf03032c75Christian MaedergetTokenList :: Id -> [Token]
93fa7e4374de6e37328e752991a698bf03032c75Christian MaedergetTokenList (Id ts cs _) =
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder let (pls, toks) = span isPlace (reverse ts)
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder cts = if null cs then [] else (Token "[" nullPos) :
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder concat (intersperse [Token "," nullPos]
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder (map getTokenList cs)) ++ [Token "]" nullPos]
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder in reverse toks ++ cts ++ reverse pls
93fa7e4374de6e37328e752991a698bf03032c75Christian Maederpredict :: [Id] -> State -> [State]
93fa7e4374de6e37328e752991a698bf03032c75Christian Maederpredict is (State ts d p _) =
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder if isPlace (ts !! d) then
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder map (\i -> State (getTokenList i) 0 p p)
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder (filter prefix is)
93fa7e4374de6e37328e752991a698bf03032c75Christian Maederscan :: Token -> State -> [State]
93fa7e4374de6e37328e752991a698bf03032c75Christian Maederscan i (State ts d p k) =
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder if ts !! d == i then [State ts (d+1) (p+1) k] else []
93fa7e4374de6e37328e752991a698bf03032c75Christian Maedercomplete :: State -> State -> [State]
93fa7e4374de6e37328e752991a698bf03032c75Christian Maedercomplete (State ts1 d1 p1 _) (State ts2 d2 p2 k2) =
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder if d1 >= length ts1 && isPlace (ts2 !! d2) && p2 <= p1
93fa7e4374de6e37328e752991a698bf03032c75Christian Maeder then [State ts2 (d2+1) p1 k2] else []
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)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maedersplit :: GenParser Char () String -> String -> (String, String)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maedersplit p s = let ph = do hd <- p;
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder tl <- getInput;
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder return (hd, tl)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder in case parse ph "" s of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Left _ -> error"split"
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)