Earley.hs revision eed6203a39f88e398d86431a66d367036a3d17ba
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederModule : $Header$
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederCopyright : Christian Maeder and Uni Bremen 2003
1549f3abf73c1122acff724f718b615c82fa3648Till MossakowskiLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederMaintainer : maeder@tzi.de
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederStability : experimental
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederPortability : portable
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maedergeneric mixfix analysis
1549f3abf73c1122acff724f718b615c82fa3648Till Mossakowski -- * special tokens for special ids
1549f3abf73c1122acff724f718b615c82fa3648Till Mossakowski , varTok, exprTok, typeTok
1549f3abf73c1122acff724f718b615c82fa3648Till Mossakowski , applId, parenId, typeId, exprId, varId
1549f3abf73c1122acff724f718b615c82fa3648Till Mossakowski , tupleId, unitId, unknownId, isUnknownId, unToken
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder , Knowns, protect, listRules, mixRule
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder , getTokenPlaceList
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder , endPlace, begPlace
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder -- * resolution chart
f8b715ab2993083761c0aedb78f1819bcf67b6ccChristian Maeder , Chart, mixDiags, ToExpr
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder , initChart, nextChart, getResolved)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiimport qualified Common.Lib.Set as Set
0c2a90cbfb63865ff485c3fbe20a14589a5914beTill Mossakowskiimport qualified Common.Lib.Map as Map
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | reconstruct the token list of an 'Id'.
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- Replace top-level places with the input String
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedergetTokenList :: String -> Id -> [Token]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedergetTokenList placeStr (Id ts cs ps) =
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski let convert = map (\ t -> if isPlace t then t {tokStr = placeStr} else t)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski in if null cs then convert ts else
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski let (toks, pls) = splitMixToken ts in
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski convert toks ++ getCompoundTokenList cs ps ++ convert pls
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | update token positions.
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- return remaining positions
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskisetToksPos :: [Token] -> Range -> ([Token], Range)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskisetToksPos (h:ts) (Range (p:ps)) =
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski let (rt, rp) = setToksPos ts (Range ps)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski in (h {tokPos = Range [p]} : rt, rp)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskisetToksPos ts ps = (ts, ps)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | update positions in 'Id'.
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- return remaining positions
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedersetPlainIdePos :: Id -> Range -> (Id, Range)
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedersetPlainIdePos (Id ts cs _) ps =
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder if null cs then
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder let (newTs, restPs) = setToksPos ts ps
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski in (Id newTs cs nullRange, restPs)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski else let (toks, pls) = splitMixToken ts
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski (front, ps2) = setToksPos toks ps
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder ps2PL = rangeToList ps2
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder (newCs, ps3, ps4) = if isNullRange ps2 then error "setPlainIdePos2"
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder else foldl ( \ (prevCs, seps, restPs) a ->
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski let (c1, qs) = setPlainIdePos a restPs
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski qsPL = rangeToList qs
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski in if isNullRange qs then error "setPlainIdePos1"
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder else (c1: prevCs, Range (head qsPL : rangeToList seps), Range (tail qsPL)))
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder ([], Range [head ps2PL], Range (tail ps2PL)) cs
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder (newPls, ps7) = setToksPos pls ps4
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder in (Id (front ++ newPls) (reverse newCs) (reverseRange ps3), ps7)
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till Mossakowski-- | a special index type for more type safety
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maedernewtype Index = Index Int deriving (Eq, Ord, Show)
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian Maeder-- deriving Num is also possible
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian Maeder-- but the following functions are sufficient
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | the initial index
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederstartIndex :: Index
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian MaederstartIndex = Index 0
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederincrIndex :: Index -> Index
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederincrIndex (Index i) = Index (i + 1)
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maederdata Item a = Item
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder { rule :: Id -- the rule to match
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder , info :: Int -- additional precedence info for 'rule'
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder , lWeight :: Id -- weights for lower precedence pre- and postfixes
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder , rWeight :: Id -- given by the 'Id's itself
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder , posList :: Range -- positions of Id tokens
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski , args :: [a] -- currently collected arguments
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski -- both in reverse order
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski , ambigArgs :: [[a]] -- field for ambiguities
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder , ambigs :: [[a]] -- field for ambiguities
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder , rest :: [Token] -- part of the rule after the "dot"
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder , index :: Index -- index into the Table/input string
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maederinstance Show (Item a) where
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder showsPrec _ p =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder let d = rest p
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder v = getPlainTokenList (rule p)
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder first = take (length v - length d) v
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder showToks = showSepList id showTok
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder Index i = index p
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder in showChar '['. showToks first
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder . showChar '.'
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski . showString ", "
10a2cf8d9887524acde19d4ea59f8fea3a7f3258Till Mossakowski . shows i . showChar ']'
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | the non-terminal
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskitermStr :: String
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian MaedertermStr = "(__)"
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder-- | builtin terminals
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian MaedercommaTok, termTok, oParenTok, cParenTok, placeTok :: Token
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedercommaTok = mkSimpleId "," -- for list elements
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedertermTok = mkSimpleId termStr
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederplaceTok = mkSimpleId place
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederoParenTok = mkSimpleId "("
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaedercParenTok = mkSimpleId ")"
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederlistTok :: Token
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederlistTok = mkSimpleId "[]" -- impossible token
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederprotectTok :: Token
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederprotectTok = mkSimpleId "()" -- impossible token
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | token for type annotations
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskitypeTok :: Token
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskitypeTok = mkSimpleId ":"
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till Mossakowski-- | token for a fixed (or recursively resolved) operator expression
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskiexprTok :: Token
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskiexprTok = mkSimpleId "(op )"
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till Mossakowski-- | token for a fixed (or recursively resolved) argument expression
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskivarTok :: Token
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskivarTok = mkSimpleId "(var )"
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till Mossakowski-- | token for an unknown variable (within patterns)
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskiunknownTok :: Token
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskiunknownTok = mkSimpleId "(?)"
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | the invisible application rule with two places
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederapplId = mkId [placeTok, placeTok]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | parenthesis around one place
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederparenId = mkId [oParenTok, placeTok, cParenTok]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | id for tuples with at least two arguments
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedertupleId = mkId [oParenTok, placeTok, commaTok, placeTok, cParenTok]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | id for the emtpy tuple
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederunitId = mkId [oParenTok, cParenTok]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | see 'typeTok'
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedertypeId = mkId [placeTok, typeTok]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | see 'exprTok'
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederexprId = mkId [exprTok]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | see 'varTok'
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedervarId = mkId [varTok]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | see 'unknownTok'
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederunknownId :: Id
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederunknownId = mkId [unknownTok]
612749008484b6773aedf4d6bbc85b8d074d15c6Christian MaederlistId :: (Id, Id) -> Id
612749008484b6773aedf4d6bbc85b8d074d15c6Christian MaederlistId (f,c) = Id [listTok] [f,c] nullRange
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian MaederisListId :: Id -> Bool
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederisListId (Id ts cs _) = not (null ts) && head ts == listTok
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till Mossakowski && assert (length cs == 2) True
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder-- | interpret placeholders as literal places
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maederprotect :: Id -> Id
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maederprotect i = Id [protectTok] [i] nullRange
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederunProtect :: Id -> Id
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederunProtect (Id _ [i] _) = i
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederunProtect _ = error "unProtect"
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederisProtected :: Id -> Bool
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiisProtected (Id ts cs _) = not (null ts) && head ts == protectTok
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski && isSingle cs
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | test if an 'unknownId' was matched
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederisUnknownId :: Id -> Bool
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiisUnknownId (Id ts _ _) = not (null ts) && head ts == unknownTok
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | get unknown token from an 'unknownId'
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiunToken :: Id -> Token
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiunToken (Id [_,t] _ _) = t
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiunToken _ = error "unToken"
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskitype Rule = (Id, Int, [Token])
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskimkItem :: Index -> Rule -> Item a
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskimkItem ind (ide, inf, toks) =
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski Item { rule = ide
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski , lWeight = ide
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski , rWeight = ide
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski , posList = nullRange
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski , ambigArgs = []
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder , ambigs = []
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder , rest = toks
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder , index = ind }
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | extract tokens with the non-terminal for places
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedergetTokenPlaceList :: Id -> [Token]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskigetTokenPlaceList = getTokenList termStr
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | construct a rule for a mixfix
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskimixRule :: Int -> Id -> Rule
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskimixRule b i = (i, b, getTokenPlaceList i)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiasListAppl :: ToExpr a -> Id -> [a] -> Range -> a
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiasListAppl toExpr i ra br =
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski if isListId i then
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski let Id _ [f, c] _ = i
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski mkList [] ps = toExpr c [] ps
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski mkList (hd:tl) ps = toExpr f [hd, mkList tl ps] ps
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski in mkList ra br
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski else if i == typeId
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski || i == exprId
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski || i == parenId
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski || i == varId
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski then assert (isSingle ra) $ head ra
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski else toExpr i ra br
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | construct the list rules
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskilistRules :: Int -> GlobalAnnos -> [Rule]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskilistRules inf g =
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski let lists = list_lit $ literal_annos g
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski listRule co toks = (listId co, inf, toks)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski in concatMap ( \ (bs, (n, c)) ->
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski let (b1, b2, cs) = getListBrackets bs
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski e = Id (b1 ++ b2) cs nullRange in
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski (if e == n then [] -- add b1 ++ b2 if its not yet included by n
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski else [listRule (c, n) $ getPlainTokenList e])
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski ++ [listRule (c, n) (b1 ++ [termTok] ++ b2),
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski listRule (c, n) (b1 ++ [termTok, commaTok, termTok] ++ b2)]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskitype Table a = Map.Map Index [Item a]
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederlookUp :: Table a -> Index -> [Item a]
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederlookUp ce k = Map.findWithDefault [] k ce
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder-- | a set of strings that do not match a 'unknownTok'
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskitype Knowns = Set.Set String
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | recognize next token (possible introduce new tuple variable)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiscanItem :: (a -> a -> a) -> Knowns -> (a, Token) -> Item a -> [Item a]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiscanItem addType ks (trm, t) p =
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski let ts = rest p
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski q = p { posList = tokPos t `appRange` posList p }
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder in if null ts then [] else
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski let tt = tail ts
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski r = q { rest = tt }
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder if head ts == t then
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder if t == commaTok then
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski assert (not $ null tt) $
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder if head tt == termTok then
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder -- tuple or list elements separator
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski [ r, q { rest = termTok : ts } ]
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder else if t == exprTok || t == varTok then
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder [r { args = trm : args p }]
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder else if t == typeTok then
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski assert (null tt && isSingle as) $
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder [q { rest = [], args = [addType trm $ head as] }]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski else if Set.null ks then []
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder else if isUnknownId ide
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder && not (tokStr t `Set.member` ks) then
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder [r { rule = mkId [unknownTok, t]}]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiscan :: (a -> a -> a) -> Knowns -> (a, Token) -> [Item a] -> [Item a]
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maederscan f ks term = concatMap (scanItem f ks term)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskimkAmbigs :: ToExpr a -> Item a -> [a]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskimkAmbigs toExpr p =
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder let l = args p in
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski map ( \ as -> fst $
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski mkExpr toExpr
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder p { args = take (length l - length as) l ++ as
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder } ) $ ambigArgs p
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian MaederaddArg :: GlobalAnnos -> ToExpr a -> Item a -> Item a -> Item a
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederaddArg ga toExpr argItem p =
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder let (arg, q) = mkExpr toExpr argItem
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder ams = ambigs argItem
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder newAms = mkAmbigs toExpr argItem
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder in assert (not $ null $ rest p) $
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder p { rest = tail $ rest p
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , lWeight = getNewWeight ALeft ga argItem p
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , rWeight = getNewWeight ARight ga argItem p
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , posList = q `appRange` posList p
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , args = arg : args p
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , ambigs = (if null newAms then ams else newAms : ams)
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder ++ ambigs p }
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- | shortcut for a function that constructs an expression
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maedertype ToExpr a = Id -> [a] -> Range -> a
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedermkExpr :: ToExpr a -> Item a -> (a, Range)
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedermkExpr toExpr itm =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder let orig = rule itm
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder ps = posList itm
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder rs = reverseRange ps
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder (ide, qs) = if isListId orig then (orig, rs) else
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski if isProtected orig then
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder setPlainIdePos (unProtect orig) rs
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder else setPlainIdePos orig rs
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder as = reverse $ args itm
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder in (asListAppl toExpr ide as qs, rs)
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maederreduce :: GlobalAnnos -> Table a -> ToExpr a -> Item a -> [Item a]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maederreduce ga table toExpr itm =
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till Mossakowski map (addArg ga toExpr itm)
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till Mossakowski $ filter ( \ oi -> let ts = rest oi in
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder if null ts then False
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder else if head ts == termTok
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski then checkPrecs ga itm oi
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder $ lookUp table $ index itm
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- | 'Id' starts with a 'place'
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederbegPlace :: Id -> Bool
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederbegPlace (Id toks _ _) = not (null toks) && isPlace (head toks)
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till Mossakowski-- | 'Id' ends with a 'place'
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederendPlace :: Id -> Bool
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederendPlace (Id toks _ _) = not (null toks) && isPlace (last toks)
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- | check if a left argument will be added.
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- (The 'Int' is the number of current arguments.)
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederisLeftArg :: Id -> Int -> Bool
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederisLeftArg op num = begPlace op && num == 0
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- | check if a right argument will be added.
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaederisRightArg :: Id -> Int -> Bool
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till MossakowskiisRightArg op num = endPlace op && num + 1 == placeCount op
5e46b572ed576c0494768998b043d9d340594122Till MossakowskigetWeight :: AssocEither -> Item a -> Id
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian MaedergetWeight side = case side of
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski ALeft -> lWeight
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski ARight -> rWeight
5e46b572ed576c0494768998b043d9d340594122Till MossakowskijoinPlace :: AssocEither -> Id -> Bool
5e46b572ed576c0494768998b043d9d340594122Till MossakowskijoinPlace side = case side of
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski ALeft -> begPlace
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski ARight -> endPlace
5e46b572ed576c0494768998b043d9d340594122Till MossakowskiisJoinArg :: AssocEither -> Id -> Int -> Bool
5e46b572ed576c0494768998b043d9d340594122Till MossakowskiisJoinArg side = case side of
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski ALeft -> isLeftArg
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski ARight -> isRightArg
5e46b572ed576c0494768998b043d9d340594122Till MossakowskigetNewWeight :: AssocEither -> GlobalAnnos -> Item a -> Item a -> Id
5e46b572ed576c0494768998b043d9d340594122Till MossakowskigetNewWeight side ga argItem opItem =
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian Maeder let op = rule opItem
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski arg = getWeight side argItem
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski num = length $ args opItem in
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski if isJoinArg side op num then
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski if joinPlace side arg then
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski case precRel (prec_annos ga) op arg of
a938729e277da5c7742bb88946ab2c150416fd5dTill Mossakowski Higher -> arg
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski else getWeight side opItem
5e46b572ed576c0494768998b043d9d340594122Till MossakowskicheckArg :: AssocEither -> GlobalAnnos -> Item a -> Item a -> Bool
5e46b572ed576c0494768998b043d9d340594122Till MossakowskicheckArg side ga argItem opItem =
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski let op = rule opItem
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski opPrec = info opItem
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski arg = rule argItem
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski argPrec = info argItem
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski precs = prec_annos ga
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski assocs = assoc_annos ga
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski weight = getWeight side argItem
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski in if argPrec <= 0 then False
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski else case compare argPrec opPrec of
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski EQ -> if joinPlace side arg then
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski case precRel precs op weight of
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski Lower -> True
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski Higher -> False
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski BothDirections -> False
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski NoDirection ->
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski case (isInfix arg, joinPlace side op) of
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski (True, True) -> if arg == op
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian Maeder then not $ isAssoc side assocs op
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder (False, True) -> True
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski (True, False) -> False
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder _ -> side == ALeft
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- | check precedences of an argument and a top-level operator.
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- (The 'Int' is the number of current arguments of the operator.)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskicheckPrecs :: GlobalAnnos -> Item a -> Item a -> Bool
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskicheckPrecs ga argItem opItem =
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder let op = rule opItem
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder num = length $ args opItem
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder in if isLeftArg op num then
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder checkArg ARight ga argItem opItem
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder else if isRightArg op num then
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder checkArg ALeft ga argItem opItem
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederreduceCompleted :: GlobalAnnos -> Table a -> ToExpr a -> [Item a] -> [Item a]
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederreduceCompleted ga table toExpr =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder foldr mergeItems [] . map (reduce ga table toExpr) .
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder filter (null . rest)
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederrecReduce :: GlobalAnnos -> Table a -> ToExpr a -> [Item a] -> [Item a]
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederrecReduce ga table toExpr items =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder let reduced = reduceCompleted ga table toExpr items
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder in if null reduced then items
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder else recReduce ga table toExpr reduced `mergeItems` items
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maedercomplete :: ToExpr a -> GlobalAnnos -> Table a -> [Item a] -> [Item a]
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maedercomplete toExpr ga table items =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder let reducedItems = recReduce ga table toExpr $
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder reduceCompleted ga table toExpr items
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder in reducedItems
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maederpredict :: [Item a] -> [Item a] -> [Item a]
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maederpredict rs items =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder if any ( \ p -> let ts = rest p in
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski not (null ts) && head ts == termTok) items
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder then rs ++ items
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederordItem :: Item a -> Item a -> Ordering
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiordItem i1 i2 =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder compare (index i1, rest i1, rule i1)
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder (index i2, rest i2, rule i2)
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederambigItems :: Item a -> Item a -> Item a
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiambigItems i1 i2 = let as = ambigArgs i1 ++ ambigArgs i2 in
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder i1 { ambigArgs = if null as then
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder [args i1, args i2] else as }
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedermergeItems :: [Item a] -> [Item a] -> [Item a]
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedermergeItems [] i2 = i2
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskimergeItems i1 [] = i1
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedermergeItems (i1:r1) (i2:r2) =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder case ordItem i1 i2 of
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski LT -> i1 : mergeItems r1 (i2:r2)
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder EQ -> ambigItems i1 i2 : mergeItems r1 r2
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder GT -> i2 : mergeItems (i1:r1) r2
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | the whole state for mixfix resolution
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskidata Chart a = Chart { prevTable :: Table a
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski , currIndex :: Index
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski , currItems :: [Item a]
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski , rules :: [Rule]
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , knowns :: Knowns
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski , solveDiags :: [Diagnosis] }
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski deriving Show
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- | make one scan, complete, and predict step.
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- The first function adds a type to the result.
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski-- The second function filters based on argument and operator info.
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder-- If filtering yields 'Nothing' further filtering by precedence is applied.
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskinextChart :: (a -> a -> a) -> ToExpr a -> GlobalAnnos -> Chart a
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski -> (a, Token) -> Chart a
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedernextChart addType toExpr ga st term@(_, tok) =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder let table = prevTable st
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder idx = currIndex st
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski items = currItems st
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski rs = rules st
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski scannedItems = scan addType (knowns st) term items
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski nextTable = Map.insert idx items table
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder nextIdx = incrIndex idx
612749008484b6773aedf4d6bbc85b8d074d15c6Christian Maeder in if null items then st else
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski st { prevTable = nextTable
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian Maeder , currIndex = nextIdx
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian Maeder , currItems = predict (map (mkItem nextIdx) rs)
cdee35b1b16886e4f341e2a2a69fa0e6be30b3faTill Mossakowski $ complete toExpr ga nextTable
cdee35b1b16886e4f341e2a2a69fa0e6be30b3faTill Mossakowski $ sortBy ordItem scannedItems
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , solveDiags = (if null scannedItems then
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski [Diag Error ("unexpected mixfix token: " ++ tokStr tok)
cdee35b1b16886e4f341e2a2a69fa0e6be30b3faTill Mossakowski $ tokPos tok]
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder else []) ++ solveDiags st }
cdee35b1b16886e4f341e2a2a69fa0e6be30b3faTill Mossakowski-- | add intermediate diagnostic messages
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedermixDiags :: [Diagnosis] -> Chart a -> Chart a
1f086d5155f47fdad9a0de4e46bbebb2c4b33d30Christian MaedermixDiags ds st = st { solveDiags = ds ++ solveDiags st }
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- | create the initial chart
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederinitChart :: [Rule] -> Knowns -> Chart a
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaederinitChart ruleS knownS =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder Chart { prevTable = Map.empty
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , currIndex = startIndex
cdee35b1b16886e4f341e2a2a69fa0e6be30b3faTill Mossakowski , currItems = map (mkItem startIndex) ruleS
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , rules = ruleS
cdee35b1b16886e4f341e2a2a69fa0e6be30b3faTill Mossakowski , knowns = knownS
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder , solveDiags = [] }
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- | extract resolved result
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedergetResolved :: (a -> ShowS) -> Range -> ToExpr a -> Chart a -> Result a
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian MaedergetResolved pp p toExpr st =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder let items = filter ((currIndex st/=) . index) $ currItems st
cdee35b1b16886e4f341e2a2a69fa0e6be30b3faTill Mossakowski ds = solveDiags st
cdee35b1b16886e4f341e2a2a69fa0e6be30b3faTill Mossakowski in if null items
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder then Result ds Nothing
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder else let (finals, rest1) = partition ((startIndex==) . index) items
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder (result, rest2) = partition (null . rest) finals
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder in if null result then
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder let expected = if null rest2