ParseType.hs revision d046de48e620a7233d0dc2a687fc84b82c089887
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbachmodule ParseType where
e071fb22ea9923a2a4ff41184d80ca46b55ee932Till Mossakowskiimport Id (Token(Token), Id(Id), showTok)
e85b224577b78d08ba5c39fe9dcc2e53995454a2Christian Maederimport Lexer ((<++>), (<<), keySign, keyWord, signChars, checkWith)
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbachimport Token (skipChar, makeToken, parseId)
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachoParen = skipChar '('
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachcParen = skipChar ')'
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachseparatedBy :: (Token -> Parser a) -> Parser Token
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach -> Token -> Parser [(Token, a)]
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachseparatedBy p s t = do { r <- p t
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach ; l <- option [] (s >>= separatedBy p s)
1df33829303cbf924aa018ac5ce9a28e69c17d22Till Mossakowski ; return ((t, r) : l)
1df33829303cbf924aa018ac5ce9a28e69c17d22Till MossakowskitoKey s = makeToken (let p = string s in
e85b224577b78d08ba5c39fe9dcc2e53995454a2Christian Maeder if last s `elem` signChars then keySign p
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach else keyWord p)
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachlessSign = toKey lessStr
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachisMixIdOrCross (Id ts cs) =
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach not (null (tail ts)) ||
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach show ts `elem` [lessStr, productSign, altProductSign]
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachsortId = parseId `checkWith` (not . isMixIdOrCross)
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachtypeId _ = do { i <- sortId
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach ; return (Type i [])
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachprimType :: Token -> Parser Type
1538a6e8d77301d6de757616ffc69ee61f1482e4Andy GimblettprimType c = typeId c
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach <|> (do { o <- oParen
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach ; (cParen >> return (crossProduct []))
1538a6e8d77301d6de757616ffc69ee61f1482e4Andy Gimblett <|> (funType o << cParen)
0ea916d1e6aea10fd7b84f802fb5148a79d8c20aAndy Gimblettcross = toKey productSign <|> toKey altProductSign <?> "cross"
567db7182e691cce5816365d8c912d09ffe92f86Andy GimbletttoId :: Token -> Id
0ea916d1e6aea10fd7b84f802fb5148a79d8c20aAndy GimbletttoId i = Id [i] []
0ea916d1e6aea10fd7b84f802fb5148a79d8c20aAndy GimblettproductType :: Token -> Parser Type
1538a6e8d77301d6de757616ffc69ee61f1482e4Andy GimblettproductType c = fmap makeProduct (separatedBy primType cross c)
c4b2418421546a337f83332fe0db04742dcd735dAndy Gimblett where makeProduct [(c, x)] = x
9f6c50e7b48ca79fc104275f9b1ea091a1359f89Andy Gimblett makeProduct [(_, x), (c, y)] = Type (toId c) [x, y]
9f6c50e7b48ca79fc104275f9b1ea091a1359f89Andy Gimblett makeProduct ((_, x) : l@(_ : _)) =
167414650dc57c11c13ba85253f0211b3de0ecc5Christian Maeder let Type c m = makeProduct l in Type c (x:m)
04ceed96d1528b939f2e592d0656290d81d1c045Andy Gimblettarrow = makeToken (keySign (string totalFunArrow
167414650dc57c11c13ba85253f0211b3de0ecc5Christian Maeder <++> option "" (string partialSuffix)))
1df33829303cbf924aa018ac5ce9a28e69c17d22Till MossakowskifunType :: Token -> Parser Type
1df33829303cbf924aa018ac5ce9a28e69c17d22Till MossakowskifunType c = fmap makeFuns (separatedBy productType arrow c)
04ceed96d1528b939f2e592d0656290d81d1c045Andy Gimblett where makeFuns [(_, x)] = x
04ceed96d1528b939f2e592d0656290d81d1c045Andy Gimblett makeFuns ((_, x) : s@((c, _):_)) =
1538a6e8d77301d6de757616ffc69ee61f1482e4Andy Gimblett let t = makeFuns s in Type (toId c) [x, t]
567db7182e691cce5816365d8c912d09ffe92f86Andy GimblettparseType = funType (Token [colonChar] nullPos)