HToken.hs revision c87b89ba43e53ae18d4cd69daa30cfc7532ec73f
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maeder Authors: Christian Maeder
3f69b6948966979163bdfe8331c38833d5d90ecdChristian Maeder parser for HasCASL IDs
7abd0c58a5ce51db13f93de82407b2188d55d298Christian Maeder adapted from HetCATS/CASL/Token.hs, v 1.9
35597678f1c9da703de8d0b6b66ea63247ebe884Christian Maedermodule HToken where
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport Keywords
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder-- ----------------------------------------------
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maeder-- further hascasl keyword
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder-- ----------------------------------------------
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian MaederassignS = ":="
4ef2a978e66e2246ff0b7f00c77deb7aabb28b8eChristian MaederpFun = funS ++ quMark
8197d0be8b81692f311ad5ca34e125e2cf9eecb8Christian MaedercontFun = minusS ++ funS
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian MaederpContFun = minusS ++ pFun
72b9099aeec0762bae4546db3bc4b48721027bf4Christian MaederclassS = "class"
ccf3de3d66b521a260e5c22d335c64a48e3f0195Christian MaederprogramS = "program"
72b9099aeec0762bae4546db3bc4b48721027bf4Christian MaederinstanceS = "instance"
74a946e10a4b324c10d7a59f84298afbcae9b3cfChristian MaedercaseS = "case"
878ac75d7acbbb06412e82a4c95356ce60f942deChristian MaederwhereS = "where"
35597678f1c9da703de8d0b6b66ea63247ebe884Christian Maeder-- ----------------------------------------------
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder-- hascasl keyword handling
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder-- ----------------------------------------------
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maederhascasl_reserved_ops = [asP, assignS, lamS] ++ casl_reserved_ops
6b1153c560b677f9f5da2a60ee8a10de75ff90c5Christian Maederhascasl_type_ops = [funS, pFun, contFun, pContFun, prodS, timesS, quMark,
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maederhascasl_reserved_words = [classS, instanceS, programS, caseS, ofS, whereS]
35597678f1c9da703de8d0b6b66ea63247ebe884Christian Maeder ++ formula_words ++ casl_reserved_words
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian MaederscanWords = reserved hascasl_reserved_words scanAnyWords
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder-- ----------------------------------------------
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder-- bracket-token (for ids)
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder-- ----------------------------------------------
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder-- simple id (but more than only words)
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maedersid l = pToken (scanQuotedChar <|> scanDotWords
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder <|> scanDigit <|> reserved l scanAnySigns
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder <|> scanWords <?> "simple-id")
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder-- balanced mixfix-components {...}, [...]
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maederbraced l = begDoEnd oBraceT (innerList l) cBraceT
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian MaedernoComp l = begDoEnd oBracketT (innerList l) cBracketT
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder-- alternating sid and other mixfix components (including places)
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder-- no two sid stand side by side
ce7653c9c71e23bf04a5ec0ca5cb600c3738a909Christian MaederinnerMix1 l = sid l <:> option [] (innerMix2 l)
2ac1742771a267119f1d839054b5e45d0a468085Christian MaederinnerMix2 l = flat (many1 (braced l <|> noComp l<|> many1 placeT))
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder <++> option [] (innerMix1 l)
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder-- ingredients starting either with an sid or brackets, braces or place
b1bd8688a1ce545444792a307412711c2c61df5fChristian MaederinnerList l = option [] (innerMix1 l <|> innerMix2 l <?> "token")
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder-- a mixfix component starting with an sid (outside innerList)
b1bd8688a1ce545444792a307412711c2c61df5fChristian MaedertopMix1 l = sid l <:> option [] (topMix2 l)
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder-- following an sid only braced mixfix-components are acceptable
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder-- square brackets after an sid will be taken as compound part
74a946e10a4b324c10d7a59f84298afbcae9b3cfChristian MaedertopMix2 l = flat (many1 (braced l)) <++> option [] (topMix1 l)
74a946e10a4b324c10d7a59f84298afbcae9b3cfChristian Maeder-- square brackets (as mixfix component) are ok following a place
74a946e10a4b324c10d7a59f84298afbcae9b3cfChristian MaedertopMix3 l = noComp l <++> flat (many (braced l)) <++> option [] (topMix1 l)
74a946e10a4b324c10d7a59f84298afbcae9b3cfChristian MaederafterPlace l = topMix1 l <|> topMix2 l<|> topMix3 l
74a946e10a4b324c10d7a59f84298afbcae9b3cfChristian Maeder-- places and something balanced possibly including places as well
74a946e10a4b324c10d7a59f84298afbcae9b3cfChristian Maedermiddle l = many1 placeT <++> option [] (afterPlace l)
74a946e10a4b324c10d7a59f84298afbcae9b3cfChristian Maeder-- balanced stuff interspersed with places
b1bd8688a1ce545444792a307412711c2c61df5fChristian MaedertokStart l = afterPlace l <++> flat (many (middle l))
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder-- at least two places on its own or a non-place possibly preceded by places
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maederstart l = tokStart l <|> placeT <:> (tokStart l <|>
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder many1 placeT <++> option [] (tokStart l))
ce7653c9c71e23bf04a5ec0ca5cb600c3738a909Christian Maeder-- ----------------------------------------------
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder-- non-compound mixfix ids (variables)
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maeder-- ----------------------------------------------
2ac1742771a267119f1d839054b5e45d0a468085Christian Maedervar :: GenParser Char st Id
2ac1742771a267119f1d839054b5e45d0a468085Christian Maedervar = fmap (\l -> Id l [] []) (start hascasl_reserved_ops)
7c35990c03276d1e675ea6f4ba38f47081620d77Christian Maeder-- ----------------------------------------------
4aad9879e208b4ebc32b47b551a94a5e13e4f716Christian Maeder-- ----------------------------------------------
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian MaederbracketParser :: GenParser Char st a -> GenParser Char st Token
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maeder -> GenParser Char st Token -> GenParser Char st Token
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder -> ([a] -> [Pos] -> b) -> GenParser Char st b
36c6cc568751e4235502cfee00ba7b597dae78dcChristian MaederbracketParser parser op cl sep k =
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder (ts, ps) <- option ([], [])
840b2a6f37ec58f3281da16fafbc4121462c856aChristian Maeder (parser `separatedBy` sep)
5ba383b1607c20c57e14324e72cee2c789436d5fChristian Maeder return (k ts (map tokPos (o:ps++[c])))
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maederbrackets parser k = bracketParser parser oBracketT cBracketT commaT k
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder-- ----------------------------------------------
5ba383b1607c20c57e14324e72cee2c789436d5fChristian Maeder-- mixfix and compound ids
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder-- ----------------------------------------------
72909c6c1cfe9702f5910d0a135c8b55729c7917Christian Maeder-- a compound list
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maedercomps :: GenParser Char st ([Id], [Pos])
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maedercomps = brackets uninstOpName (,)
72909c6c1cfe9702f5910d0a135c8b55729c7917Christian Maeder <?> "[<id>,...,<id>]"
d5b008ac61f0f3d99f41ad3476f945e2b65bd3c0Christian Maeder-- a compound list does not follow a place
d5b008ac61f0f3d99f41ad3476f945e2b65bd3c0Christian Maeder-- but after a compound list further places may follow
d5b008ac61f0f3d99f41ad3476f945e2b65bd3c0Christian MaedermixId :: [String] -> GenParser Char st Id
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian MaedermixId keys = do { l <- start keys
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder ; if isPlace (last l) then return (Id l [] [])
2118d66b6aa3c90458925019c9b2fb986e2b2aabChristian Maeder else (do { (c, p) <- option ([], []) comps
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder ; u <- many placeT
35597678f1c9da703de8d0b6b66ea63247ebe884Christian Maeder ; return (Id (l++u) c p)
d5b008ac61f0f3d99f41ad3476f945e2b65bd3c0Christian MaederuninstOpName = mixId hascasl_reserved_ops
d5b008ac61f0f3d99f41ad3476f945e2b65bd3c0Christian MaedertypeName = mixId (hascasl_type_ops ++ hascasl_reserved_ops)
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maeder-- ----------------------------------------------
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maeder-- TYPE-VAR Ids
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maeder-- ----------------------------------------------
d5b008ac61f0f3d99f41ad3476f945e2b65bd3c0Christian Maeder-- no compound ids (just a word)
4805aaef9706fd26f102ffd712b99cb8778ba3c1Christian MaedertypeVar :: GenParser Char st Token
4805aaef9706fd26f102ffd712b99cb8778ba3c1Christian MaedertypeVar = pToken scanWords
35597678f1c9da703de8d0b6b66ea63247ebe884Christian MaederclassName = typeVar