From 9b257f4008624c0bdbb9821291f46e553e2f0f91 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Sat, 27 Feb 2016 14:14:25 +0100 Subject: [PATCH] working main program and part of parser --- src/main.icl | 73 +++++++++++++++++++++++++++++++++++++++++++---- src/main.prj | 42 +++++++++++++++++++++++++++ src/parse.dcl | 5 +++- src/parse.icl | 79 ++++++++++++++++++++++++++++++++++++++++++++++----- 4 files changed, 186 insertions(+), 13 deletions(-) diff --git a/src/main.icl b/src/main.icl index 9bc8d20..4739c35 100644 --- a/src/main.icl +++ b/src/main.icl @@ -2,16 +2,67 @@ module main import StdFile import StdBool +import StdMisc +import StdFunc +import StdList +import StdString +import Data.Either +import Data.Maybe +import System.CommandLine import parse import lex -Start :: *World -> (LexerOutput, ParserOutput, *World) +:: Opts = { + program :: String, + lex :: Bool, + parse :: Bool, + fp :: Maybe String, + help :: Bool} + +:: *StartType :== (LexerOutput, ParserOutput, *World) + +parseArgs :: *World -> (Opts, *World) +parseArgs w +# ([p:args], w) = getCommandLine w += (pa args {program=p, lex=False, parse=False, fp=Nothing, help=False}, w) +where + pa :: [String] -> (Opts -> Opts) + pa [] = id + pa ["--help":r] = \o.pa r {o & help=True} + pa ["--lex":r] = \o.pa r {o & lex=True, parse=False} + pa ["--parse":r] = \o.pa r {o & lex=False, parse=True} + pa [x:r] = \o.pa r {o & fp=Just x} + +//Start :: *World -> (LexerOutput, ParserOutput, *World) +//Start w +//# (args, w) = getCommandLine w +//# (toparse, out) = readEntireFile out +//= (lexer toparse, parse (lexer toparse), w) + +Start :: *World -> *StartType Start w -# (out, w) = stdio w -# (toparse, out) = readEntireFile out -# (_, w) = fclose out w -= (lexer toparse, parse (lexer toparse), w) +# (args, w) = parseArgs w +| args.help = help args.program w +# (stdin, w) = stdio w +# (contents, stdin, w) = readFileOrStdin stdin args.fp w +| args.lex = case contents of + (Right cs) = (lexer cs, Left "Parsing Disabled", w) + (Left e) = (Left e, Left "Parsing disabled", w) += case contents of + (Left e) = (Left e, Left "", w) + (Right cs) = let lexOut = lexer cs in (lexOut, parser lexOut, w) + +readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World) +readFileOrStdin stdin Nothing w +# (cs, stdin) = readEntireFile stdin += (Right cs, stdin, w) +readFileOrStdin stdin (Just fp) w +# (b, fin, w) = fopen fp FReadText w +| not b = (Left "Unable to open file", stdin, w) +# (cs, fin) = readEntireFile fin +# (_, w) = fclose fin w += (Right cs, stdin, w) readEntireFile :: *File -> *([Char], *File) readEntireFile f @@ -19,3 +70,15 @@ readEntireFile f | not b = ([], f) # (cs, f) = readEntireFile f = ([c:cs], f) + +help :: String *World -> *StartType +help p w +# (out, w) = stdio w +# out = out <<< "\nUsage: " <<< p <<< " [opts] [FILENAME]\n" + <<< "\t--help Show this help\n" + <<< "\t--lex Lex only, is mutually exclusive with --parse\n" + <<< "\t--parse Lex & Parse only\n\n" + <<< "\tFILENAME File to parse, when unspecified stdin is parsed\n" +# (_, w) = fclose out w += (Left "", Left "", w) + diff --git a/src/main.prj b/src/main.prj index 870e822..177aab2 100644 --- a/src/main.prj +++ b/src/main.prj @@ -601,6 +601,20 @@ OtherModules ReadableABC: False ReuseUniqueNodes: True Fusion: False + Module + Name: System.CommandLine + 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: System.IO Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent @@ -615,6 +629,20 @@ OtherModules ReadableABC: False ReuseUniqueNodes: True Fusion: False + Module + Name: System._Pointer + 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 @@ -657,6 +685,20 @@ OtherModules ReadableABC: False ReuseUniqueNodes: True Fusion: False + Module + Name: System.OS + Dir: {Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Linux-64 + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False Module Name: _SystemDynamic Dir: {Application}/lib/iTasks-SDK/Patches/Dynamics diff --git a/src/parse.dcl b/src/parse.dcl index 3f42eda..e7d2a25 100644 --- a/src/parse.dcl +++ b/src/parse.dcl @@ -25,6 +25,7 @@ import lex | IntExpr Int | CharExpr Char | BoolExpr Bool + | FunExpr String [Expr] | EmptyListExpr | TupleExpr Expr Expr @@ -37,4 +38,6 @@ import lex :: FunDecl = Stub -parse :: LexerOutput -> ParserOutput +instance toString AST + +parser :: LexerOutput -> ParserOutput diff --git a/src/parse.icl b/src/parse.icl index fdcb9e3..620e39a 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -5,24 +5,28 @@ import StdTuple import StdList from StdFunc import const import Data.Either +import Data.Functor +import Data.Maybe import Control.Monad import Control.Applicative import Data.Func +from Text import class Text(concat), instance Text String import yard import lex -parse :: LexerOutput -> ParserOutput -parse (Left e) = Left $ toString $ LexError e -parse (Right r) = case runParser parseProgram r of +parser :: LexerOutput -> ParserOutput +parser (Left e) = Left $ toString $ LexError e +parser (Right r) = case runParser parseProgram r of (Right p, _) = Right p (Left e, _) = Left $ toString e parseProgram :: Parser Token AST -parseProgram = parseVar >>= \t.pure $ AST [t] [] +parseProgram = parseVarDecl >>= \t.pure $ AST [t] [] -parseVar :: Parser Token VarDecl -parseVar = parseType +parseVarDecl :: Parser Token VarDecl +parseVarDecl = + (parseType <|> trans1 VarToken VarType ) >>= \t->parseIdent <* satTok AssignmentToken >>= \i->parseExpr <* satTok SColonToken >>= \e->pure $ VarDecl i t e @@ -30,7 +34,6 @@ parseVar = parseType parseType :: Parser Token Type parseType = trans1 IntTypeToken IntType <|> - trans1 VarToken VarType <|> trans1 CharTypeToken CharType <|> trans1 BoolTypeToken BoolType <|> (satTok SquareOpenToken *> parseType <* satTok SquareCloseToken @@ -53,7 +56,20 @@ parseExpr = trans2 (NumberToken zero) (\(NumberToken i)->IntExpr i) <|> trans2 (CharToken zero) (\(CharToken c)->CharExpr c) <|> (parseOp1 >>= \o->parseExpr >>= \e.pure $ Op1Expr o e) <|> + (parseIdent <* satTok BraceOpenToken + >>= \i->parseActArgs <* satTok BraceCloseToken + >>= \es->pure $ FunExpr i es) <|> (parseIdent >>= \i. parseFieldSelector >>= \f.pure $ VarExpr i f) + //TODO Parse Binary operators + +parseActArgs :: Parser Token [Expr] +parseActArgs = + //One argument + (some (parseExpr <* satTok CommaToken) >>= \es->parseExpr >>= \e.pure [e:es]) <|> + //Two or more arguments + (parseExpr >>= \e->pure [e]) <|> + //Zero arguments, dit moet nog mooier kunnen + empty parseOp1 :: Parser Token Op1 parseOp1 = trans1 DashToken UnMinus <|> @@ -86,3 +102,52 @@ satTok t = satisfy ((===) t) parseIdent :: Parser Token String parseIdent = trans2 (IdentToken []) (\(IdentToken e).toString e) + +instance toString AST where + toString (AST v f) = concat (print v ++ ["\n":print f]) + +class print a :: a -> [String] + +instance print [a] | print a where + print [] = ["\n"] + print [v:vs] = print v ++ ["\n":print vs] + +instance print VarDecl where + print (VarDecl i t e) = print t ++ [" ":i:"=":print e] ++ [";"] +instance print FunDecl where + print _ = ["Function printing not yet implemented"] + +instance print Type where + print (TupleType t1 t2) = ["(":print t1] ++ [", ":print t2] ++ [")"] + print (ListType t) = ["[":print t] ++ ["]"] + print (IdType s) = [s] + print IntType = ["Int"] + print BoolType = ["Bool"] + print CharType = ["Char"] + print VarType = ["var"] + +instance print Expr where + print (VarExpr i Nothing) = [i] + print (VarExpr i (Just mf)) = [i, case mf of + FieldHd = ".hd"; FieldTl = ".tl" + FieldSnd = ".snd"; FieldFst = ".fst"] + print (Op2Expr e1 o e2) = print e1 ++ [case o of + BiPlus = "+"; BiMinus = "-"; BiTimes = "*"; BiDivide = "/" + BiMod = "%"; BiEquals = "="; BiLesser = "<"; BiGreater = ">" + BiLesserEq = "<="; BiGreaterEq = ">="; BiUnEqual = "!="; + BiAnd = "&&"; BiOr = "||"; BiCons = ":" + :print e2] + print (Op1Expr o e) = [case o of + UnNegation = "!"; UnMinus = "-" + :print e] + print (IntExpr i) = [toString i] + print (CharExpr c) = ["\'", case c of + '\b' = "\\b"; '\f' = "\\f"; '\n' = "\\n" + '\r' = "\\r"; '\t' = "\\t"; '\v' = "\\v" + c = if (c == toChar 7) "\\a" (toString c) + ,"\'"] + print (BoolExpr b) = [toString b] + print (FunExpr i es) = pe ++ flatten [[",":x]\\x<-tl pes] + where [pe:pes] = map print es + print EmptyListExpr = ["[]"] + print (TupleExpr e1 e2) = ["(":print e1] ++ [",":print e2] ++ [")"] -- 2.20.1