From: Mart Lubbers Date: Mon, 29 Feb 2016 12:15:05 +0000 (+0100) Subject: sattok mooier X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=4932517e2d12cd55922231175bf2f0a06f5b85d6;p=cc1516.git sattok mooier --- diff --git a/src/lex.dcl b/src/lex.dcl index 0b064b4..2c6f0aa 100644 --- a/src/lex.dcl +++ b/src/lex.dcl @@ -55,6 +55,4 @@ from Data.Either import :: Either :: LexerOutput :== Either String [Token] -(===) :: TokenValue Token -> Bool - lexer :: [Char] -> LexerOutput diff --git a/src/lex.icl b/src/lex.icl index cbeaf76..32ac048 100644 --- a/src/lex.icl +++ b/src/lex.icl @@ -75,12 +75,3 @@ lex t=:[x:xs] = case get x SingleCharTokens of | isAlpha x = let (v, r) = span isIdent t in ret (IdentToken v) r with isIdent c = isAlphanum c || c == '_' | otherwise = err ("Unexpected character: " +++ toString x) - - -derive gEq TokenValue - -(===) :: TokenValue Token -> Bool -(===) (IdentToken _) (_, IdentToken _) = True -(===) (NumberToken _) (_, NumberToken _) = True -(===) (CharToken _) (_, CharToken _) = True -(===) x (_, y) = gEq {|*|} x y diff --git a/src/parse.icl b/src/parse.icl index f1c7620..e60ad17 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -172,8 +172,14 @@ trans2 t f = satTok t >>= \(_, r).pure (f r) trans1 :: TokenValue a -> Parser Token a trans1 t r = trans2 t $ const r +derive gEq TokenValue satTok :: TokenValue -> Parser Token Token -satTok t = satisfy ((===) t) +satTok t = satisfy $ eq t + where + eq (IdentToken _) (_, IdentToken _) = True + eq (NumberToken _) (_, NumberToken _) = True + eq (CharToken _) (_, CharToken _) = True + eq x (_, y) = gEq {|*|} x y parseSepList :: TokenValue (Parser Token a) -> Parser Token [a] parseSepList sep p =