MixfixParser.hs revision 7bdf8f2044ee1bb844ec460e7d96fbdee69feda4
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maedermodule MixfixParser where
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maederimport AS_Basic_CASL
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maederimport GlobalAnnotations
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maederimport Lexer (caslChar)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maederimport ParsecPrim
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maederimport qualified Char as C
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder-- convert LiteralAnnos from Ids to OpItems
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maederdata LiteralOpItems = LitItem
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder { emptyString :: Maybe OpItem
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder , consString :: Maybe OpItem
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder , emptyList :: Maybe OpItem
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder , consList :: Maybe OpItem
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder , listBrackets :: ([Token],[Token])
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder , numberLit :: Maybe OpItem
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder , decimalOp :: Maybe OpItem
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder , exponentOp :: Maybe OpItem
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder , negExponent :: Maybe OpItem
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder } deriving (Show)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian MaederconvertLitAnnos is la =
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder LitItem {emptyString = case string_lit la of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Nothing -> Nothing
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Just (c, _) -> case lookupId is 0 c of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder [ci] -> Just ci
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder ,consString = case string_lit la of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Nothing -> Nothing
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Just (_, f) -> case lookupId is 2 f of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder [fi] -> Just fi
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder ,emptyList = case list_lit la of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Nothing -> Nothing
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Just (_, c, _) -> case lookupId is 0 c of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder [ci] -> Just ci
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder ,consList = case list_lit la of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Nothing -> Nothing
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Just (_, _, f) -> case lookupId is 2 f of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder [fi] -> Just fi
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder ,listBrackets = case list_lit la of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Nothing -> ([], [])
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Just(Id bs _ _, _, _) ->
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder let (b1, rt) = span (not . isPlace) bs
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder in if null rt || any isPlace (tail rt)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder then ([], [])
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder else (b1, tail rt)
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder ,numberLit = case number_lit la of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Nothing -> Nothing
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Just f -> case lookupId is 2 f of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder [fi] -> Just fi
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder ,decimalOp = case float_lit la of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Nothing -> Nothing
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Just (f, _) -> case lookupId is 2 f of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder [fi] -> Just fi
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder ,exponentOp = case float_lit la of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Nothing -> Nothing
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Just (_, g) -> case lookupId is 2 g of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder [gi] -> Just gi
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder ,negExponent = case lookupId is 1 (Id [Token "-" nullPos] [] []) of
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder [fi] -> Just fi
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder-- only check for the correct number of arguments
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian MaederlookupId :: [OpItem] -> Int -> Id -> [OpItem]
fd40e201b7277427113c89724d8a2389c18e9cbdChristian MaederlookupId is args i =
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder filter (\x -> opId x == i && args == length(opArgs(opType x))) is
fd40e201b7277427113c89724d8a2389c18e9cbdChristian MaederisChar :: Token -> Bool
fd40e201b7277427113c89724d8a2389c18e9cbdChristian MaederisChar t = head (tokStr t) == '\''
fd40e201b7277427113c89724d8a2389c18e9cbdChristian MaederisString t = head (tokStr t) == '\"'
fd40e201b7277427113c89724d8a2389c18e9cbdChristian MaederisNumber t = C.isDigit $ head (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"
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian MaedermakeStringTerm :: LiteralOpItems -> [OpItem] -> Token -> ([Diagnosis], [TERM])
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian MaedermakeStringTerm ga is tok =
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder let p = tokPos tok in
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder case emptyString ga of
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder Nothing -> ([Error "no proper %string annotation" p], [])
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder Just x -> let l = init (tail (tokStr tok))
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder y = asAppl x []
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder in if null l then ([], [y])
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder else case consString ga of
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder ([Error "no %string constructor" p], [])
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder let (errs, term) = makeStrTerm is y
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder (asAppl f) p l
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder in (errs, [term])
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian MaedermakeStrTerm :: [OpItem] -> TERM -> ([TERM] -> TERM)
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder -> Pos -> [Char] -> ([Diagnosis], TERM)
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian MaedermakeStrTerm is x f p l =
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder if null l then ([], x)
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder else let (hd, tl) = split caslChar l
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder incr (line, column) = (line, column+1)
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder (errs, rest) = makeStrTerm is x f (incr p) tl
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder real = "'" ++ hd ++ "'"
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder in case lookupId is 0 (Id [Token real nullPos] [] []) of
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder [c] -> (errs, f [asAppl c [], rest])
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder _ -> (Error ("missing or ambiguous definition for character "
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder ++ real) p : errs, rest)
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder-- convert OpItem's OpType to OP_TYPE
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian MaederoldOpType :: OpItem -> OP_TYPE
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder let t = opType f in
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder (case opKind t of
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder Total -> Total_op_type
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian Maeder Partial -> Partial_op_type) (opArgs t) (opRes t) []
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian MaederasAppl :: OpItem -> [TERM] -> TERM
7bdf8f2044ee1bb844ec460e7d96fbdee69feda4Christian MaederasAppl f args = Application (Qual_op_name (opId f) (oldOpType f) []) args []
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder-- analyse Mixfix_token
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder{-convertMixfixToken:: GlobalAnnos -> [varDecl] -> [OpItem] -> Token
fd40e201b7277427113c89724d8a2389c18e9cbdChristian Maeder -> ([Diagnosis], [TERM])
d697755cce49a436e1170e8e158c19f79b0389b8Christian MaederconvertMixfixToken ga vs is t =
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder if isPlace t then ([], [Mixfix_token t])
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder else if isString t then
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder case string_lit $ literal_annos ga of
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder Nothing -> ([Error "missing %string annotation" (tokPos t)], [])
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder Just (c, f) -> makeStringTerm is c f t
d697755cce49a436e1170e8e158c19f79b0389b8Christian Maeder else error "not implemented yet"