8a77240a809197c92c0736c431b4b88947a7bac1Christian Maeder{- |

d9a45a35cd696085be1a038b2cc67bee6819c574cmaederModule : $Header$

8a77240a809197c92c0736c431b4b88947a7bac1Christian MaederDescription : generic mixfix analysis, using an Earley parser

adea2e45fa61f1097aadc490a0aeaf4831b729ccChristian MaederCopyright : Christian Maeder and Uni Bremen 2003-2005

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiMaintainer : Christian.Maeder@dfki.de

98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuStability : experimental

2eeec5240b424984e3ee26296da1eeab6c6d739eChristian MaederPortability : portable

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiGeneric mixfix analysis, using an Earley parser

f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederThe grammer has a single non-terminal for terms (the double

0095c7efbddd0ffeed6aaf8ec015346be161d819Till Mossakowskiunderscore). A rule of the grammer carries an identifier, a precedence

adea2e45fa61f1097aadc490a0aeaf4831b729ccChristian Maedernumber, and the actual token list of the identifier to match against

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskithe input token list..

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederThe parser can be instantiated for any term type. A

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maederfunction parameter determines how applications from identifiers and

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederarguments are constructed.

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-}

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maedermodule Common.Earley

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski ( Rule

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , Rules

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , partitionRules

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski -- * special tokens for special ids

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , varTok

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , exprTok

1a38107941725211e7c3f051f7a8f5e12199f03acmaeder , parenId

1a38107941725211e7c3f051f7a8f5e12199f03acmaeder , exprId

ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder , varId

1a38107941725211e7c3f051f7a8f5e12199f03acmaeder , tupleId

d9a45a35cd696085be1a038b2cc67bee6819c574cmaeder , unitId

1a38107941725211e7c3f051f7a8f5e12199f03acmaeder , protect

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , listRules

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , mixRule

d3c9318c22fcf44d9135a3b2c64f880b9a785babChristian Maeder , getTokenPlaceList

d9a45a35cd696085be1a038b2cc67bee6819c574cmaeder , getPlainPolyTokenList

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , getPolyTokenList

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski -- * resolution chart

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , Chart

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , mixDiags

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , ToExpr

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , rules

adea2e45fa61f1097aadc490a0aeaf4831b729ccChristian Maeder , addRules

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , initChart

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , nextChart

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder , getResolved

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder ) where

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederimport Common.Id

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederimport Common.Result

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederimport Common.GlobalAnnotations

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederimport Common.AS_Annotation

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederimport Common.Prec

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederimport qualified Data.Map as Map

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiimport Data.List

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederimport Control.Exception

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- | take the difference of the two input lists take (length l2 - length l1) l2

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskitakeDiff :: [a] -> [b] -> [b]

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskitakeDiff l1 l2 = zipWith const l2 $ dropPrefix l1 l2

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- | update token positions.

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- return remaining positions

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedersetToksPos :: [Token] -> Range -> ([Token], Range)

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedersetToksPos (h:ts) (Range (p:ps)) =

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder let (rt, rp) = setToksPos ts (Range ps)

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder in (h {tokPos = Range [p]} : rt, rp)

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedersetToksPos ts ps = (ts, ps)

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederreverseRange :: Range -> Range

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederreverseRange = Range . reverse . rangeToList

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- | update positions in 'Id'.

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- return remaining positions

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskisetPlainIdePos :: Id -> Range -> (Id, Range)

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskisetPlainIdePos (Id ts cs _) ps =

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder if null cs then

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder let (newTs, restPs) = setToksPos ts ps

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder in (Id newTs cs nullRange, restPs)

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder else let (toks, pls) = splitMixToken ts

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski (front, ps2) = setToksPos toks ps

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski ps2PL = rangeToList ps2

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder (newCs, ps3, ps4) =

adea2e45fa61f1097aadc490a0aeaf4831b729ccChristian Maeder if isNullRange ps2 then error "setPlainIdePos2"

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder else foldl ( \ (prevCs, seps, restPs) a ->

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski let (c1, qs) = setPlainIdePos a restPs

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski qsPL = rangeToList qs

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski in if isNullRange qs then error "setPlainIdePos1"

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder else (c1: prevCs,

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski Range (head qsPL : rangeToList seps),

4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder Range (tail qsPL)))

4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder ([], Range [head ps2PL], Range (tail ps2PL)) cs

4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder (newPls, ps7) = setToksPos pls ps4

e7d2b3903c7b44db432538b0d720c21062c24823Christian Maeder in (Id (front ++ newPls) (reverse newCs) (reverseRange ps3), ps7)

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- no special index type anymore (assuming not much more development)

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- the info Int denotes fast precedence

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskidata Item a = Item

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski { rule :: Id -- the rule to match

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , info :: Int -- additional precedence info for 'rule'

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , lWeight :: Id -- weights for lower precedence pre- and postfixes

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , rWeight :: Id -- given by the 'Id's itself

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , posList :: Range -- positions of Id tokens

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , args :: [a] -- currently collected arguments

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski -- both in reverse order

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , ambigArgs :: [[a]] -- field for ambiguities

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , ambigs :: [[a]] -- field for ambiguities

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , rest :: [Token] -- part of the rule after the "dot"

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , index :: Int -- index into the Table/input string

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder }

a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu

a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu-- | the non-terminal

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskitermStr :: String

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskitermStr = "(__)"

e7d2b3903c7b44db432538b0d720c21062c24823Christian Maeder-- | builtin terminals

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedercommaTok, termTok, oParenTok, cParenTok :: Token

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskicommaTok = mkSimpleId "," -- for list elements

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskitermTok = mkSimpleId termStr

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskioParenTok = mkSimpleId "("

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaedercParenTok = mkSimpleId ")"

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskilistTok :: Token

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskilistTok = mkSimpleId "[]" -- impossible token

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprotectTok :: Token

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprotectTok = mkSimpleId "()" -- impossible token

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- | token for a fixed (or recursively resolved) operator expression

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiexprTok :: Token

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederexprTok = mkSimpleId "(op )"

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- | token for a fixed (or recursively resolved) argument expression

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskivarTok :: Token

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskivarTok = mkSimpleId "(var )"

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski

df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- | parenthesis around one place

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederparenId :: Id

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederparenId = mkId [oParenTok, placeTok, cParenTok]

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- | id for tuples with at least two arguments

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedertupleId :: Id

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedertupleId = mkId [oParenTok, placeTok, commaTok, placeTok, cParenTok]

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- | id for the emtpy tuple

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederunitId :: Id

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederunitId = mkId [oParenTok, cParenTok]

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- | see 'exprTok'

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederexprId :: Id

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederexprId = mkId [exprTok]

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- | see 'varTok'

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedervarId :: Id

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedervarId = mkId [varTok]

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederlistId :: (Id, Id) -> Id

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederlistId (f,c) = Id [listTok] [f,c] nullRange

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederisListId :: Id -> Bool

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederisListId (Id ts _ _) = not (null ts) && head ts == listTok

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- | interpret placeholders as literal places

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederprotect :: Id -> Id

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederprotect i = Id [protectTok] [i] nullRange

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederunProtect :: Id -> Maybe Id

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederunProtect (Id ts cs _) = case cs of

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder [i] -> case ts of

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder [tok] | tok == protectTok -> Just i

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder _ -> Nothing

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder _ -> Nothing

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- | get the token list for a mixfix rule

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetPolyTokenList :: Id -> [Token]

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetPolyTokenList = getGenPolyTokenList termStr

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- | get the plain token list for prefix applications

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetPlainPolyTokenList :: Id -> [Token]

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetPlainPolyTokenList = getGenPolyTokenList place

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

a65c6747c9acbbebc93baba7bae94d2e3d8cdafbTill Mossakowskitype Rule = (Id, Int, [Token])

4d7d53fec6b551333c79da6ae3b8ca2af0a741abChristian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedermkItem :: Int -> Rule -> Item a

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian MaedermkItem ind (ide, inf, toks) =

d9a45a35cd696085be1a038b2cc67bee6819c574cmaeder Item { rule = ide

d9a45a35cd696085be1a038b2cc67bee6819c574cmaeder , info = inf

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , lWeight = ide

d9a45a35cd696085be1a038b2cc67bee6819c574cmaeder , rWeight = ide

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , posList = nullRange

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , args = []

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , ambigArgs = []

d9a45a35cd696085be1a038b2cc67bee6819c574cmaeder , ambigs = []

cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich , rest = toks

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , index = ind }

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- | extract tokens with the non-terminal for places

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedergetTokenPlaceList :: Id -> [Token]

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedergetTokenPlaceList = getTokenList termStr

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- | construct a rule for a mixfix

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedermixRule :: Int -> Id -> Rule

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedermixRule b i = (i, b, getTokenPlaceList i)

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

e7d2b3903c7b44db432538b0d720c21062c24823Christian MaederasListAppl :: ToExpr a -> Id -> [a] -> Range -> a

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederasListAppl toExpr i ra br =

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder if isListId i then

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder let Id _ [f, c] _ = i

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder mkList [] ps = toExpr c [] ps

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder mkList (hd:tl) ps = toExpr f [hd, mkList tl ps] ps

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder in mkList ra br

e8eb2b9d68adc3024eb1aa9899b902ed5a3fb460Christian Maeder else if i == typeId

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder || i == exprId

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder || i == parenId

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder || i == varId

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder then case ra of

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder [arg] -> arg

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder _ -> error "asListAppl"

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder else toExpr i ra br

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- | construct the list rules

cd6e5706893519bfcf24539afa252fcbed5097ddKlaus LuettichlistRules :: Int -> GlobalAnnos -> [Rule]

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederlistRules inf g =

e7d2b3903c7b44db432538b0d720c21062c24823Christian Maeder let lists = list_lit $ literal_annos g

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder listRule co toks = (listId co, inf, toks)

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder in concatMap ( \ (bs, (n, c)) ->

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder let (b1, b2, cs) = getListBrackets bs

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder e = Id (b1 ++ b2) cs nullRange in

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder (if e == n then [] -- add b1 ++ b2 if its not yet included by n

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder else [listRule (c, n) $ getPlainTokenList e])

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder ++ [listRule (c, n) (b1 ++ [termTok] ++ b2),

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder listRule (c, n) (b1 ++ [termTok, commaTok, termTok] ++ b2)]

a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder ) $ Map.toList lists

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maedertype Table a = Map.Map Int [Item a]

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederlookUp :: Table a -> Int -> [Item a]

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederlookUp ce k = Map.findWithDefault [] k ce

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- | recognize next token (possible introduce new tuple variable)

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederscanItem :: (a -> a -> a) -> (a, Token) -> Item a -> [Item a]

8c7aa750542dcadb94b971be712564a9a8f1d189Christian MaederscanItem addType (trm, t)

8c7aa750542dcadb94b971be712564a9a8f1d189Christian Maeder p@Item{ rest = ts, args = pArgs, posList = pRange } =

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder let q = p { posList = appRange (tokPos t) pRange }

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder in case ts of

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder [] -> []

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder hd : tt -> let r = q { rest = tt } in

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder if hd == t || t == exprTok && hd == varTok then

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder if t == commaTok then

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder case tt of

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder sd : _ | sd == termTok ->

a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu -- tuple or list elements separator

a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu [ r, q { rest = termTok : ts } ]

a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu _ -> [r]

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder else if elem t [exprTok, varTok, typeInstTok] then

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder [r { args = trm : pArgs }]

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder else if t == typeTok then

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder case (tt, pArgs) of

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder ([], [arg]) -> [q { rest = [], args = [addType trm arg] }]

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder _ -> error "scanItem: typeTok"

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder else [r]

a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu else []

a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maederscan :: (a -> a -> a) -> (a, Token) -> [Item a] -> [Item a]

a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescuscan f term = concatMap (scanItem f term)

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedermkAmbigs :: ToExpr a -> Item a -> [a]

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedermkAmbigs toExpr p@Item{ args = l, ambigArgs = aArgs } =

e7d2b3903c7b44db432538b0d720c21062c24823Christian Maeder map ( \ aas -> fst $

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder mkExpr toExpr

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder p { args = takeDiff aas l ++ aas

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder } ) aArgs

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian MaederaddArg :: GlobalAnnos -> ToExpr a -> Item a -> Item a -> Item a

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian MaederaddArg ga toExpr argItem@Item { ambigs = ams } p@Item{ args = pArgs,

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder rule = op, posList = pRange, ambigs = pAmbs, rest = pRest} =

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder let (arg, ps) = mkExpr toExpr argItem

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder newAms = mkAmbigs toExpr argItem

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder q = case pRest of

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder _ : tl ->

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder p { rest = tl

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder , posList = ps `appRange` pRange

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , args = arg : pArgs

4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder , ambigs = (if null newAms then ams else newAms : ams)

c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder ++ pAmbs }

4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder _ -> error "addArg"

4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder in if isLeftArg op pArgs then

4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder q { lWeight = getNewWeight ALeft ga argItem op }

4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder else if isRightArg op pArgs then

4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder q { rWeight = getNewWeight ARight ga argItem op }

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder else q

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- | shortcut for a function that constructs an expression

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maedertype ToExpr a = Id -> [a] -> Range -> a

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedermkExpr :: ToExpr a -> Item a -> (a, Range)

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedermkExpr toExpr Item { rule = orig, posList = ps, args = iArgs } =

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder let rs = reverseRange ps

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder (ide, qs) = if isListId orig then (orig, rs) else

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder setPlainIdePos (maybe orig id $ unProtect orig) rs

e8eb2b9d68adc3024eb1aa9899b902ed5a3fb460Christian Maeder in (asListAppl toExpr ide (reverse iArgs) qs, rs)

e8eb2b9d68adc3024eb1aa9899b902ed5a3fb460Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maederreduce :: GlobalAnnos -> Table a -> ToExpr a -> Item a -> [Item a]

e8eb2b9d68adc3024eb1aa9899b902ed5a3fb460Christian Maederreduce ga table toExpr itm =

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder map (addArg ga toExpr itm)

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder $ filter (checkPrecs ga itm)

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder $ lookUp table $ index itm

09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder

09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetWeight :: AssocEither -> Item a -> Id

cd6e5706893519bfcf24539afa252fcbed5097ddKlaus LuettichgetWeight side = case side of

cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich ALeft -> lWeight

c40a1fdc8ec6978bd27240d6780d0e0a7b6b0056Dominik Luecke ARight -> rWeight

cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaedergetNewWeight :: AssocEither -> GlobalAnnos -> Item a -> Id -> Id

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaedergetNewWeight side ga argItem = nextWeight side ga $ getWeight side argItem

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder-- | check precedences of an argument and a top-level operator.

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaedercheckPrecs :: GlobalAnnos -> Item a -> Item a -> Bool

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaedercheckPrecs ga argItem@Item { rule = arg, info = argPrec }

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder Item { rule = op, info = opPrec, args = oArgs } =

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder checkPrec ga (op, opPrec) (arg, argPrec) oArgs $ flip getWeight argItem

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederreduceCompleted :: GlobalAnnos -> Table a -> ToExpr a -> [Item a] -> [Item a]

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederreduceCompleted ga table toExpr =

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder foldr mergeItems [] . map (reduce ga table toExpr) .

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder filter (null . rest)

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederrecReduce :: GlobalAnnos -> Table a -> ToExpr a -> [Item a] -> [Item a]

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederrecReduce ga table toExpr items =

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder let reduced = reduceCompleted ga table toExpr items

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder in if null reduced then items

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder else recReduce ga table toExpr reduced `mergeItems` items

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maedercomplete :: ToExpr a -> GlobalAnnos -> Table a -> [Item a] -> [Item a]

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maedercomplete toExpr ga table items =

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder let reducedItems = recReduce ga table toExpr $

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder reduceCompleted ga table toExpr items

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder in reducedItems ++ items

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederdoPredict :: [Item a] -> ([Item a], [Item a])

556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederdoPredict items = partition ( \ Item{ rest = ts } ->

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder not (null ts) && head ts == termTok) items

556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder

ordItem :: Item a -> Item a -> Ordering

ordItem Item{ index = i1, rest = r1, rule = n1 }

Item{ index = i2, rest = r2, rule = n2 } =

compare (i1, r1, n1) (i2, r2, n2)

ambigItems :: Item a -> Item a -> Item a

ambigItems i1@Item{ ambigArgs = ams1, args = as1 }

Item{ ambigArgs = ams2, args = as2 } =

i1 { ambigArgs = case ams1 ++ ams2 of

[] -> [as1, as2]

ams -> ams }

mergeItems :: [Item a] -> [Item a] -> [Item a]

mergeItems [] i2 = i2

mergeItems i1 [] = i1

mergeItems (i1:r1) (i2:r2) =

case ordItem i1 i2 of

LT -> i1 : mergeItems r1 (i2:r2)

EQ -> ambigItems i1 i2 : mergeItems r1 r2

GT -> i2 : mergeItems (i1:r1) r2

-- | the whole state for mixfix resolution

data Chart a = Chart { prevTable :: Table a

, currIndex :: Int

, currItems :: ([Item a], [Item a])

, rules :: ([Rule], [Rule])

, addRules :: Token -> [Rule]

, solveDiags :: [Diagnosis] }

-- | make one scan, complete, and predict step.

-- The first function adds a type to the result.

-- The second function filters based on argument and operator info.

-- If filtering yields 'Nothing' further filtering by precedence is applied.

nextChart :: (a -> a -> a) -> ToExpr a -> GlobalAnnos

-> Chart a -> (a, Token) -> Chart a

nextChart addType toExpr ga st term@(_, tok) =

let table = prevTable st

idx = currIndex st

igz = idx > 0

(cItems, sItems) = currItems st

(cRules, sRules) = rules st

pItems = if null cItems && igz then sItems else

map (mkItem idx) (addRules st tok ++ sRules) ++ sItems

scannedItems = scan addType term pItems

nextTable = if null cItems && igz then table

else Map.insert idx (map (mkItem idx) cRules ++ cItems)

table

completedItems = complete toExpr ga nextTable

$ sortBy ordItem $ scannedItems

nextIdx = idx + 1

in if null pItems && igz then st else

st { prevTable = nextTable

, currIndex = nextIdx

, currItems = doPredict completedItems

, solveDiags = (if null scannedItems then

[Diag Error ("unexpected mixfix token: " ++ tokStr tok)

$ tokPos tok]

else []) ++ solveDiags st }

-- | add intermediate diagnostic messages

mixDiags :: [Diagnosis] -> Chart a -> Chart a

mixDiags ds st = st { solveDiags = ds ++ solveDiags st }

type Rules = ([Rule], [Rule]) -- postfix and prefix rules

-- | presort rules

partitionRules :: [Rule] -> Rules

partitionRules = partition ( \ (_, _, t : _) -> t == termTok)

-- | create the initial chart

initChart :: (Token -> [Rule]) -> Rules -> Chart a

initChart adder ruleS =

Chart { prevTable = Map.empty

, currIndex = 0

, currItems = ([], [])

, rules = ruleS

, addRules = adder

, solveDiags = [] }

-- | extract resolved result

getResolved :: (a -> ShowS) -> Range -> ToExpr a -> Chart a -> Result a

getResolved pp p toExpr st =

let (predicted, items') = currItems st

ds = solveDiags st

items = if null items' && null ds then predicted else items'

in case items of

[] -> assert (not $ null ds) $ Result ds Nothing

_ -> let (finals, rest1) = partition ((0 ==) . index) items

(result, rest2) = partition (null . rest) finals

in case result of

[] -> let expected = if null rest2

then filter (not . null . rest) rest1

else rest2

withpos = filter (not . isNullRange . posList)

expected

(q, errs) = if null withpos then (p, expected)

else (concatMapRange

(reverseRange . posList)

withpos, withpos)

in Result (Diag Error

("expected further mixfix token: "

++ show (take 5 $ nub

$ map (tokStr . head . rest)

errs)) q : ds) Nothing

[har] -> case ambigs har of

[] -> case mkAmbigs toExpr har of

[] -> Result ds $ Just $ fst $ mkExpr toExpr har

ambAs -> Result ((showAmbigs pp p $

take 5 ambAs) : ds) Nothing

ams -> Result ((map (showAmbigs pp p) $

take 5 ams) ++ ds) Nothing

_ -> Result ((showAmbigs pp p $

map (fst . mkExpr toExpr) result) : ds) Nothing

showAmbigs :: (a -> ShowS) -> Range -> [a] -> Diagnosis

showAmbigs pp p as =

Diag Error ("ambiguous mixfix term\n " ++

showSepList (showString "\n ") pp

(take 5 as) "") p