X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=spl.icl;h=383b84e6371cf9c0dde2e0ba01a364738ff87284;hb=3e6f3b020114be9550bb5893874fdb40b86fa2de;hp=f398f902e33e858b60fc79b4ca70c26e1ba784f5;hpb=fc38bf6ef5716c685ac316fdf3c42e7afce327eb;p=cc1516.git diff --git a/spl.icl b/spl.icl index f398f90..383b84e 100644 --- a/spl.icl +++ b/spl.icl @@ -12,11 +12,14 @@ import Data.Maybe import Data.Func import System.CommandLine import GenPrint -from Text import class Text(concat), instance Text String +import Data.Map +from Text import class Text(concat,join), instance Text String import parse import lex +import sem import AST +import gen from yard import :: Error, instance toString Error :: Opts = { @@ -24,11 +27,23 @@ from yard import :: Error, instance toString Error program :: String, lex :: Bool, parse :: Bool, + sem :: Bool, + gen :: Bool, fp :: Maybe String, help :: Bool} derive gPrint TokenValue +preamble :: AST -> AST +preamble (AST fd) = AST (pre ++ fd) + where + pre = [ + FunDecl zero "1printstr" ["x"] Nothing [] [ + IfStmt (FunExpr zero "isEmpty" [VarExpr zero (VarDef "x" [])] []) + [] + [FunStmt "1printchar" [VarExpr zero (VarDef "x" [FieldHd])] [] + ,FunStmt "1printstr" [VarExpr zero (VarDef "x" [FieldTl])] []]]] + Start :: *World -> *World Start w # (args, w) = parseArgs w @@ -48,28 +63,44 @@ Start w <<< " --help Show this help\n" <<< " --version Show the version\n" <<< " --[no-]lex Lexer output(default: disabled)\n" - <<< " --[no-]parse Parser output(default: enabled)\n" + <<< " --[no-]parse Parser output(default: disabled)\n" + <<< " --[no-]sem Semantic analysis output(default: disabled)\n" + <<< " --[no-]code Code generation output(default: enabled)\n" = snd $ fclose stdin w # (contents, stdin, w) = readFileOrStdin stdin args.fp w = case contents of (Left cs) = snd $ fclose (stdin <<< cs) w - (Right cs) - # lexOut = lexer cs - # stdin = if (not args.lex) stdin (case lexOut of - (Right toks) = - stdin <<< "//LEXER\n" <<< printTokens toks <<< "//LEXER\n" - _ = stdin) - # parseOut = parser lexOut - # stdin = if (not args.parse) stdin (case parser lexOut of - (Right ast) = - stdin <<< "//PARSER\n" <<< toString ast <<< "//PARSER\n" - (Left parse) = stdin <<< toString parse) - = snd $ fclose stdin w + (Right cs) = case lexer cs of + (Left e) = snd $ fclose (stdin <<< toString e <<< "\n") w + (Right lexOut) + # stdin = if (not args.lex) stdin ( + stdin <<< "//LEXER\n" <<< printTokens lexOut <<< "//LEXER\n") + = case parser lexOut of + (Left e) = snd $ fclose (stdin <<< toString e <<< "\n") w + (Right parseOut) + # stdin = if (not args.parse) stdin ( + stdin <<< "//PARSER\n" <<< toString parseOut <<< "//PARSER\n") + = case sem (preamble parseOut) of + (Left e) = snd $ fclose (stdin <<< join "\n" (map toString e) <<< "\n") w + (Right ast) + # stdin = if (not args.sem) stdin (stdin + <<< "//SEM G\n" <<< toString ast <<< "//SEMA\n") + = case gen ast of + (Left e) = snd $ fclose (stdin <<< e) w + (Right asm) + # stdin = if (not args.gen) stdin (stdin + <<< ";CODE GEN\n" <<< asm <<< "\n;CODE GEN\n") + = snd $ fclose (stdin <<< "\n") w where + printConstraints :: Constraints -> String + printConstraints [] = "" + printConstraints [(t1, t2):ts] = concat [ + "(", toString t1, ",", toString t2, ")"] +++ printConstraints ts + printTokens :: [Token] -> String printTokens ts = concat $ flatten $ map pt ts where - pt ({line,col},token) = [toString line, ":", + pt ({line,col},token) = [toString line, ":", toString col, ": ", printToString token, "\n"] parseArgs :: *World -> (Opts, *World) @@ -79,7 +110,9 @@ parseArgs w program=p, version=False, lex=False, - parse=True, + parse=False, + sem=False, + gen=True, fp=Nothing, help=False}, w) where @@ -91,6 +124,10 @@ where pa ["--no-lex":r] o = pa r {o & lex=False} pa ["--parse":r] o = pa r {o & parse=True} pa ["--no-parse":r] o = pa r {o & parse=False} + pa ["--sem":r] o = pa r {o & sem=True} + pa ["--no-sem":r] o = pa r {o & sem=False} + pa ["--code":r] o = pa r {o & gen=True} + pa ["--no-code":r] o = pa r {o & gen=False} pa [x:r] o = pa r {o & fp=Just x} readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World)