From 8789e58ffd30bae4181069aed5c30b82959961aa Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Fri, 12 Feb 2016 10:52:54 +0100 Subject: [PATCH] pretty printing en dingen --- lex.icl | 375 ++++++++++++++++++++++++++++++++++++-------------------- lex.prj | 47 ++++--- 2 files changed, 270 insertions(+), 152 deletions(-) diff --git a/lex.icl b/lex.icl index cbdcd65..75fab23 100644 --- a/lex.icl +++ b/lex.icl @@ -13,146 +13,251 @@ import Control.Monad import Control.Monad.State import Data.Functor from Data.Func import $ - -// Misschien moeten we hier continuation style van maken -instance toString lexerOutput where - toString l = "dit is een lexer output, danwel error\n" +from Text import class Text, instance Text String +import qualified Text lexer :: [Char] -> LexerOutput [Token] -lexer i = let (out, rest) = runParser (many anyT) i in case rest of - [] = out - _ = Left "Unexpected input after last 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 +lexer _ = undef -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 +// Misschien moeten we hier continuation style van maken +instance toString (LexerOutput [Token]) where + toString (Left l) = "Error: " +++ l + toString (Right x) = 'Text'.concat (print 0 x) -//matched given char -char :: Char -> Parser Char -char c = satisfy (\i -> c==i) //I hate that we can't do: satisfy (==c) +print :: Int [Token] -> [String] +print i [(IdentToken l):rest] = [tab i:toString l:print i rest] +print i [(NumberToken j):rest] = [tab i:toString j:print i rest] +print i [(CharToken c):rest] = [tab i:"'":toString c:"'":print i rest] +print i [VarToken:rest] = [tab i:"var":print i rest] +print i [VoidToken:rest] = [tab i:"Void":print i rest] +print i [ReturnToken:rest] = [tab i:"return":print i rest] +print i [IfToken:rest] = [tab i:"if":print i rest] +print i [ElseToken:rest] = [tab i:"else":print i rest] +print i [WhileToken:rest] = [tab i:"while":print i rest] +print i [TrueToken:rest] = [tab i:"True":print i rest] +print i [FalseToken:rest] = [tab i:"False":print i rest] +print i [BraceOpenToken:rest] = [tab i:"(":print i rest] +print i [BraceCloseToken:rest] = [tab i:")":print i rest] +print i [CBraceOpenToken:rest] = [tab i:"{\n":print (i+1) rest] +print i [CBraceCloseToken:rest] = [tab i:"}\n":print (i-1) rest] +print i [SquareOpenToken:rest] = [tab i:"[":print i rest] +print i [SquareCloseToken:rest] = [tab i:"]":print i rest] +print i [CommaToken:rest] = [tab i:", ":print i rest] +print i [ColonToken:rest] = [tab i:":":print i rest] +print i [SColonToken:rest] = [tab i:";\n":print i rest] +print i [DotToken:rest] = [tab i:".":print i rest] +print i [PlusToken:rest] = [tab i:" + ":print i rest] +print i [DashToken:rest] = [tab i:" - ":print i rest] +print i [StarToken:rest] = [tab i:" * ":print i rest] +print i [SlashToken:rest] = [tab i:" / ":print i rest] +print i [PercentToken:rest] = [tab i:" % ":print i rest] +print i [AssignmentToken:rest] = [tab i:" = ":print i rest] +print i [LesserToken:rest] = [tab i:" < ":print i rest] +print i [BiggerToken:rest] = [tab i:" > ":print i rest] +print i [ExclamationToken:rest] = [tab i:"!":print i rest] +print i [DoubleColonToken:rest] = [tab i:" :: ":print i rest] +print i [LesserEqToken:rest] = [tab i:" <= ":print i rest] +print i [GreaterEqToken:rest] = [tab i:" >= ":print i rest] +print i [EqualsToken:rest] = [tab i:" == ":print i rest] +print i [AmpersandsToken:rest] = [tab i:" && ":print i rest] +print i [PipesToken:rest] = [tab i:" || ":print i rest] +print i [ArrowToken:rest] = [tab i:" -> ":print i rest] -alpha :: Parser Char -alpha = satisfy isAlpha +tab :: Int -> String +tab 0 = "" +tab i = "\t" +++ tab (i-1) -digit :: Parser Char -digit = satisfy isDigit +lex :: [Char] -> LexerOutput [Token] +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 ['\'':'\\':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: \\" +++ x) +lex ['\'':x:'\'':rest] = undef +lex [x:xs] +| isSpace x = lex xs +| isDigit x = undef //Parse Int +| isAlpha x = undef //Parse ident +| otherwise = Left ("Unexpected character: " +++ toString x) -alphaNum :: Parser Char -alphaNum = alpha <|> digit +Start = "Hi" -//matches a given String -string :: [Char] -> Parser [Char] -string s = mapM_ char s >>| return s \ No newline at end of file +//:: 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 diff --git a/lex.prj b/lex.prj index 15b5f46..35240fc 100644 --- a/lex.prj +++ b/lex.prj @@ -31,7 +31,6 @@ Global Link LinkMethod: Static GenerateRelocations: False - GenerateSymbolTable: False GenerateLinkMap: False LinkResources: False ResourceSource: @@ -324,7 +323,7 @@ OtherModules Fusion: False Module Name: Control.Applicative - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -338,7 +337,7 @@ OtherModules Fusion: False Module Name: Control.Monad - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -352,7 +351,7 @@ OtherModules Fusion: False Module Name: Control.Monad.State - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -366,7 +365,7 @@ OtherModules Fusion: False Module Name: Control.Monad.Trans - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -380,7 +379,7 @@ OtherModules Fusion: False Module Name: Data.Either - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -394,7 +393,7 @@ OtherModules Fusion: False Module Name: Data.Func - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -408,7 +407,7 @@ OtherModules Fusion: False Module Name: Data.Functor - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -422,7 +421,7 @@ OtherModules Fusion: False Module Name: Data.Functor.Identity - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -436,7 +435,7 @@ OtherModules Fusion: False Module Name: Data.List - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -450,7 +449,7 @@ OtherModules Fusion: False Module Name: Data.Maybe - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -464,7 +463,7 @@ OtherModules Fusion: False Module Name: Data.Monoid - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -478,7 +477,7 @@ OtherModules Fusion: False Module Name: Data.Void - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -492,7 +491,7 @@ OtherModules Fusion: False Module Name: System.CommandLine - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -506,7 +505,7 @@ OtherModules Fusion: False Module Name: System.IO - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -520,7 +519,21 @@ OtherModules Fusion: False Module Name: System._Pointer - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Independent + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + Module + Name: Text + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent Compiler NeverMemoryProfile: False NeverTimeProfile: False @@ -534,7 +547,7 @@ OtherModules Fusion: False Module Name: System.OS - Dir: {Application}/lib/iTasks-SDK/Dependencies/clean-platform/src/libraries/OS-Mac + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Linux-64 Compiler NeverMemoryProfile: False NeverTimeProfile: False -- 2.20.1