From: Mart Lubbers Date: Fri, 12 Feb 2016 12:05:45 +0000 (+0100) Subject: lexing and printing is working X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=8de73bb36ae068011c2c1b1fc9b3c9091a897997;p=cc1516.git lexing and printing is working --- diff --git a/lex.dcl b/lex.dcl index 56c3765..46a3ab8 100644 --- a/lex.dcl +++ b/lex.dcl @@ -5,7 +5,7 @@ import Data.Either :: Token //Value tokens = IdentToken [Char] // Identifier - | NumberToken Int // Integer + | NumberToken [Char]// Integer | CharToken Char // Character literal //Keyword tokens | VarToken // var keyword @@ -44,6 +44,7 @@ import Data.Either | AmpersandsToken // && | PipesToken // || | ArrowToken // -> + | EndOfFileToken // EOF :: LexerOutput :== Either String [Token] diff --git a/lex.icl b/lex.icl index aa80f70..a1912bf 100644 --- a/lex.icl +++ b/lex.icl @@ -6,6 +6,7 @@ import StdString import System.CommandLine import StdFile import StdMisc +import StdBool from StdFunc import id, const import Data.Maybe import Control.Applicative @@ -16,266 +17,133 @@ from Data.Func import $ from Text import class Text, instance Text String import qualified Text +Start :: *World -> *World +Start w +# (args, w) = getCommandLine w // We lezen nu nog standaard van stdin +# (out, w) = stdio w +# (toparse, out) = readEntireFile out +# out = out <<< print (lexer toparse) +# (b, w) = fclose out w +| not b = setReturnCode 1 w += w + where + readEntireFile :: *File -> *([Char], *File) + readEntireFile f + # (b, c, f) = freadc f + | not b = ([], f) + # (cs, f) = readEntireFile f + = ([c:cs], f) + lexer :: [Char] -> LexerOutput -lexer _ = undef +lexer [] = Right [] +lexer x = case lex x of + (Right t, rest) = lexer rest >>= \ts.Right [t:ts] + (Left e, _) = Left e -instance toString LexerOutput where - toString (Left l) = "Error: " +++ l - toString (Right x) = 'Text'.concat (print 0 x) +print :: LexerOutput -> String +print (Left l) = "Error: " +++ l +print (Right x) = 'Text'.concat (print` 0 x) where - print :: Int [Token] -> [String] - print _ [] = [] - print i [(IdentToken l):rest] = [toString l:print i rest] - print i [(NumberToken j):rest] = [toString j:print i rest] - print i [(CharToken c):rest] = ["'":toString c:"'":print i rest] - print i [VarToken:rest] = ["var":print i rest] - print i [VoidToken:rest] = ["Void":print i rest] - print i [ReturnToken:rest] = ["return":print i rest] - print i [IfToken:rest] = ["if":print i rest] - print i [ElseToken:rest] = ["else":print i rest] - print i [WhileToken:rest] = ["while":print i rest] - print i [TrueToken:rest] = ["True":print i rest] - print i [FalseToken:rest] = ["False":print i rest] - print i [BraceOpenToken:rest] = ["(":print i rest] - print i [BraceCloseToken:rest] = [")":print i rest] - print i [CBraceOpenToken:rest] = ["{\n":tab (i+1):print (i+1) rest] - print i [CBraceCloseToken:rest] = ["}\n":tab (i-1):print (i-1) rest] - print i [SquareOpenToken:rest] = ["[":print i rest] - print i [SquareCloseToken:rest] = ["]":print i rest] - print i [CommaToken:rest] = [", ":print i rest] - print i [ColonToken:rest] = [":":print i rest] - print i [SColonToken:rest] = [";\n":tab i:print i rest] - print i [DotToken:rest] = [".":print i rest] - print i [PlusToken:rest] = [" + ":print i rest] - print i [DashToken:rest] = [" - ":print i rest] - print i [StarToken:rest] = [" * ":print i rest] - print i [SlashToken:rest] = [" / ":print i rest] - print i [PercentToken:rest] = [" % ":print i rest] - print i [AssignmentToken:rest] = [" = ":print i rest] - print i [LesserToken:rest] = [" < ":print i rest] - print i [BiggerToken:rest] = [" > ":print i rest] - print i [ExclamationToken:rest] = ["!":print i rest] - print i [DoubleColonToken:rest] = [" :: ":print i rest] - print i [LesserEqToken:rest] = [" <= ":print i rest] - print i [GreaterEqToken:rest] = [" >= ":print i rest] - print i [EqualsToken:rest] = [" == ":print i rest] - print i [AmpersandsToken:rest] = [" && ":print i rest] - print i [PipesToken:rest] = [" || ":print i rest] - print i [ArrowToken:rest] = [" -> ":print i rest] + print` :: Int [Token] -> [String] + print` _ [] = [] + print` i [(IdentToken l):rest] = [toString l:print` i rest] + print` i [(NumberToken j):rest] = [toString j:print` i rest] + print` i [(CharToken c):rest] = ["'":toString c:"'":print` i rest] + print` i [VarToken:rest] = ["var ":print` i rest] + print` i [VoidToken:rest] = ["Void":print` i rest] + print` i [ReturnToken:rest] = ["return":print` i rest] + print` i [IfToken:rest] = ["if":print` i rest] + print` i [ElseToken:rest] = ["else":print` i rest] + print` i [WhileToken:rest] = ["while":print` i rest] + print` i [TrueToken:rest] = ["True":print` i rest] + print` i [FalseToken:rest] = ["False":print` i rest] + print` i [BraceOpenToken:rest] = ["(":print` i rest] + print` i [BraceCloseToken:rest] = [")":print` i rest] + print` i [CBraceOpenToken:rest] = ["{\n":tab (i+1):print` (i+1) rest] + print` i [CBraceCloseToken:rest] = ["}\n":tab i:print` i rest] + print` i [SquareOpenToken:rest] = ["[":print` i rest] + print` i [SquareCloseToken:rest] = ["]":print` i rest] + print` i [CommaToken:rest] = [", ":print` i rest] + print` i [ColonToken:rest] = [":":print` i rest] + print` i [SColonToken:CBraceCloseToken:rest] = + [";\n":tab (i-1):"}\n":print` (i-1) rest] + print` i [SColonToken:rest] = [";\n":tab i:print` i rest] + print` i [DotToken:rest] = [".":print` i rest] + print` i [PlusToken:rest] = [" + ":print` i rest] + print` i [DashToken:rest] = [" - ":print` i rest] + print` i [StarToken:rest] = [" * ":print` i rest] + print` i [SlashToken:rest] = [" / ":print` i rest] + print` i [PercentToken:rest] = [" % ":print` i rest] + print` i [AssignmentToken:rest] = [" = ":print` i rest] + print` i [LesserToken:rest] = [" < ":print` i rest] + print` i [BiggerToken:rest] = [" > ":print` i rest] + print` i [ExclamationToken:rest] = ["!":print` i rest] + print` i [DoubleColonToken:rest] = [" :: ":print` i rest] + print` i [LesserEqToken:rest] = [" <= ":print` i rest] + print` i [GreaterEqToken:rest] = [" >= ":print` i rest] + print` i [EqualsToken:rest] = [" == ":print` i rest] + print` i [AmpersandsToken:rest] = [" && ":print` i rest] + print` i [PipesToken:rest] = [" || ":print` i rest] + print` i [ArrowToken:rest] = [" -> ":print` i rest] + print` i [EndOfFileToken:rest] = ["\n":print` i rest] tab :: Int -> String tab 0 = "" tab i = "\t" +++ tab (i-1) -lex :: [Char] -> LexerOutput -lex ['v':'a':'r':rest] = undef -lex ['V':'o':'i':'d':rest] = undef -lex ['r':'e':'t':'u':'r':'n':rest] = undef -lex ['i':'f':rest] = undef -lex ['e':'l':'s':'e':rest] = undef -lex ['w':'h':'i':'l':'e':rest] = undef -lex ['T':'r':'u':'e':rest] = undef -lex ['F':'a':'l':'s':'e':rest] = undef -lex [':':':':rest] = undef -lex ['<':'=':rest] = undef -lex ['>':'=':rest] = undef -lex ['=':'=':rest] = undef -lex ['&':'&':rest] = undef -lex ['|':'|':rest] = undef -lex ['-':'>':rest] = undef -lex ['(':rest] = undef -lex [')':rest] = undef -lex ['{':rest] = undef -lex ['{':rest] = undef -lex ['[':rest] = undef -lex [':rest]':rest] = undef -lex [',':rest] = undef -lex [':':rest] = undef -lex [';':rest] = undef -lex ['.':rest] = undef -lex ['+':rest] = undef -lex ['-':rest] = undef -lex ['*':rest] = undef -lex ['/':rest] = undef -lex ['%':rest] = undef -lex ['=':rest] = undef -lex ['<':rest] = undef -lex ['>':rest] = undef -lex ['!':rest] = undef + +lex :: [Char] -> (Either String Token, [Char]) +lex [] = (Right EndOfFileToken, []) +lex ['v':'a':'r':rest] = (Right VarToken, rest) +lex ['V':'o':'i':'d':rest] = (Right VoidToken, rest) +lex ['r':'e':'t':'u':'r':'n':rest] = (Right ReturnToken, rest) +lex ['i':'f':rest] = (Right IfToken, rest) +lex ['e':'l':'s':'e':rest] = (Right ElseToken, rest) +lex ['w':'h':'i':'l':'e':rest] = (Right WhileToken, rest) +lex ['T':'r':'u':'e':rest] = (Right TrueToken, rest) +lex ['F':'a':'l':'s':'e':rest] = (Right FalseToken, rest) lex ['\'':'\\':x:'\'':rest] = case x of - 'a' = undef // (CharToken '\a') - 'b' = undef // (CharToken '\b') - 'f' = undef // (CharToken '\f') - 'n' = undef // (CharToken '\n') - 'r' = undef // (CharToken '\r') - 't' = undef // (CharToken '\t') - 'v' = undef // (CharToken '\v') - _ = Left ("Illegal escape: \\" +++ toString x) -lex ['\'':x:'\'':rest] = undef + 'a' = (Right (CharToken (toChar 7)), rest) //Alarm + 'b' = (Right (CharToken '\b'), rest) //Backspace + 'f' = (Right (CharToken '\f'), rest) //Formfeed + 'n' = (Right (CharToken '\n'), rest) //Newline + 'r' = (Right (CharToken '\r'), rest) //Carriage Return + 't' = (Right (CharToken '\t'), rest) //Horizontal tab + 'v' = (Right (CharToken '\v'), rest) //Vertical tab + _ = (Left ("Unknown escape: \\" +++ toString x), rest) +lex ['\'':x:'\'':rest] = (Right (CharToken x), rest) +lex [':':':':rest] = (Right DoubleColonToken, rest) +lex ['<':'=':rest] = (Right LesserEqToken, rest) +lex ['>':'=':rest] = (Right GreaterEqToken, rest) +lex ['=':'=':rest] = (Right EqualsToken, rest) +lex ['&':'&':rest] = (Right AmpersandsToken, rest) +lex ['|':'|':rest] = (Right PipesToken, rest) +lex ['-':'>':rest] = (Right ArrowToken, rest) +lex ['(':rest] = (Right BraceOpenToken, rest) +lex [')':rest] = (Right BraceCloseToken, rest) +lex ['{':rest] = (Right CBraceOpenToken, rest) +lex ['}':rest] = (Right CBraceCloseToken, rest) +lex ['[':rest] = (Right SquareOpenToken, rest) +lex [']':rest] = (Right SquareCloseToken, rest) +lex [',':rest] = (Right CommaToken, rest) +lex [':':rest] = (Right ColonToken, rest) +lex [';':rest] = (Right SColonToken, rest) +lex ['.':rest] = (Right DotToken, rest) +lex ['+':rest] = (Right PlusToken, rest) +lex ['-':rest] = (Right DashToken, rest) +lex ['*':rest] = (Right StarToken, rest) +lex ['/':rest] = (Right SlashToken, rest) +lex ['%':rest] = (Right PercentToken, rest) +lex ['=':rest] = (Right AssignmentToken, rest) +lex ['<':rest] = (Right LesserToken, rest) +lex ['>':rest] = (Right BiggerToken, rest) +lex ['!':rest] = (Right ExclamationToken, rest) lex [x:xs] | isSpace x = lex xs -| isDigit x = undef //Parse Int -| isAlpha x = undef //Parse ident -| otherwise = Left ("Unexpected character: " +++ toString x) - -:: LexerOutput :== Either String [Token] - -Start = toString sp - where - sp :: LexerOutput - sp = Right [ - WhileToken, - BraceOpenToken, - TrueToken, - BraceCloseToken, - CBraceOpenToken, - VarToken, - IdentToken ['x'], - AssignmentToken, - IdentToken ['x'], - PlusToken, - NumberToken 5, - SColonToken, - CBraceCloseToken] - -//:: LexerOutput a :== Either String a -// -// -//runParser :: (Parser a) [Char] -> (LexerOutput a, [Char]) -//runParser (Parser p) s = p s -// -//lexer :: [Char] -> LexerOutput [Token] -// -////lexer functions -//identT = alpha >>= \a -> many (char '_' <|> alphaNum) >>= \as -> return $ IdentToken [a:as] -//numberT = optional (char '-') >>= \sign -> (some digit) >>= \n -> case sign of -// Nothing -> return $ NumberToken $ 5 //fromString n -// _ -> return $ NumberToken $ -5 //(fromString n) * -1 -//charLT = CharToken <$> (char '\'' *> item <* char '\'') -//char2T = item >>= \c1 -> case c1 of -// ':' = char ':' >>| return DoubleColonToken -// '<' = char '=' >>| return LesserEqToken -// '>' = char '=' >>| return GreaterEqToken -// '=' = char '=' >>| return EqualsToken -// '&' = char '&' >>| return AmpersandsToken -// '|' = char '|' >>| return PipesToken -// '-' = char '>' >>| return ArrowToken -// _ = zero -//char1T = item >>= \c1 -> findT c1 charTokenMap -//varT = string (fromString "var") >>| return VarToken -//voidT = string (fromString "Void") >>| return VoidToken -//returnT = string (fromString "return") >>| return ReturnToken -//ifT = string (fromString "if") >>| return IfToken -//elseT = string (fromString "else") >>| return ElseToken -//whileT = string (fromString "while") >>| return WhileToken -//trueT = string (fromString "True") >>| return TrueToken -//falseT = string (fromString "False") >>| return FalseToken -////note, for the anyToken parser the order matters! -//anyT = char2T <|> char1T <|> varT <|> voidT <|> returnT <|> ifT <|> elseT <|> whileT <|> -// trueT <|> falseT <|> numberT <|> identT <|> charLT -// -//Start :: *World -> *World -//Start w -//# (args, w) = getCommandLine w // We lezen nu nog standaard van stdin -//# (out, w) = stdio w -//# (toparse, out) = readEntireFile out -//# out = out <<< toString (lexer toparse) -//# (b, w) = fclose out w -//| not b = setReturnCode 1 w -//= w -// where -// readEntireFile :: *File -> *([Char], *File) -// readEntireFile f -// # (b, c, f) = freadc f -// | not b = ([], f) -// # (cs, f) = readEntireFile f -// = ([c:cs], f) -// -// -// -//charTokenMap = [('(', BraceOpenToken) -// ,(')', BraceCloseToken) -// ,('{', CBraceOpenToken) -// ,('}', CBraceCloseToken) -// ,('[', SquareOpenToken) -// ,(']', SquareCloseToken) -// ,(',', CommaToken) -// ,(':', ColonToken) -// ,(';', SColonToken) -// ,('.', DotToken) -// ,('+', PlusToken) -// ,('-', DashToken) -// ,('*', StarToken) -// ,('/', SlashToken) -// ,('%', PercentToken) -// ,('=', AssignmentToken) -// ,('<', LesserToken) -// ,('>', BiggerToken) -// ,('!', ExclamationToken)] -//findT c [] = fail "Unrecognized character" -//findT c [(k,v):xs] = if (c==k) (return v) (findT c xs) -// -// -//// Clean adaption of Yard, a parsec like parser combinator -//:: Parser a = Parser ([Char] -> (LexerOutput a, [Char])) -// -//runParser :: (Parser a) [Char] -> (LexerOutput a, [Char]) -//runParser (Parser p) s = p s -// -//instance Functor Parser where -// fmap f s = liftM f s -// -//instance Applicative Parser where -// pure a = Parser $ \s -> (Right a, s) -// (<*>) sf s = ap sf s -// -//instance Monad Parser where -// bind p f = Parser $ \s -> let (out, rest) = runParser p s in case out of -// Left e = (Left e, rest) -// Right t = runParser (f t) rest -// -////gives us some, many and optional -//instance Alternative Parser where -// empty = zero -// (<|>) p1 p2 = Parser $ \s -> let (out, rest) = runParser p1 s in case out of -// Left e = runParser p2 s -// Right t = (Right t, rest) -// -////parser that fails with error -//fail :: String -> Parser a -//fail e = Parser $ \s -> (Left e, s) -// -////parser that always fails -//zero :: Parser a -//zero = fail "Zero parser" -// -////matches exactly one Char -//item :: Parser Char -//item = Parser $ \s -> case s of -// [] = (Left "Unexpected empty input", s) -// [x:xs] = (Right x, xs) -// -////matches any char which satisfies f -//satisfy :: (Char -> Bool) -> Parser Char -//satisfy f = item >>= (\r -> if (f r) (return r) zero) -// -////tries a parser, if it fails returns a default value -//optionalDef :: a (Parser a) -> Parser a -//optionalDef def p = p <|> return def -// -////matched given char -//char :: Char -> Parser Char -//char c = satisfy (\i -> c==i) //I hate that we can't do: satisfy (==c) -// -//alpha :: Parser Char -//alpha = satisfy isAlpha -// -//digit :: Parser Char -//digit = satisfy isDigit -// -//alphaNum :: Parser Char -//alphaNum = alpha <|> digit -// -////matches a given String -//string :: [Char] -> Parser [Char] -//string s = mapM_ char s >>| return s +| isDigit x + # (is, rest) = span isDigit xs + = (Right (NumberToken [x:is]), rest) +| isAlpha x + # (is, rest) = span (\c.isAlphanum c || c == '_') xs + = (Right (IdentToken [x:is]), rest) +| otherwise = (Left ("Unexpected character: " +++ toString x), [])