add to default addressbook'

[cc1516.git] / spl.icl

diff --git a/spl.icl b/spl.icl
index 1690d71..383b84e 100644 (file)
--- a/spl.icl
+++ b/spl.icl
@@ -12,12 +12,14 @@ import Data.Maybe
 import Data.Func
 import System.CommandLine
 import GenPrint
 import Data.Func
 import System.CommandLine
 import GenPrint

+import Data.Map

 from Text import class Text(concat,join), instance Text String
 
 import parse
 import lex
 import sem
 import AST
 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 = {
 from yard import :: Error, instance toString Error
 
 :: Opts = {


@@ -26,11 +28,22 @@ from yard import :: Error, instance toString Error
        lex :: Bool,
        parse :: Bool,
        sem :: Bool,
        lex :: Bool,
        parse :: Bool,
        sem :: Bool,

+    gen :: Bool,

        fp :: Maybe String,
        help :: Bool}
 
 derive gPrint TokenValue
 
        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
 Start :: *World -> *World
 Start w
 # (args, w) = parseArgs w


@@ -50,28 +63,40 @@ Start w
                <<< "  --help             Show this help\n"
                <<< "  --version          Show the version\n"
                <<< "  --[no-]lex         Lexer output(default: disabled)\n"
                <<< "  --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) = case lexer cs of
        = snd $ fclose stdin w
 # (contents, stdin, w) = readFileOrStdin stdin args.fp w
 = case contents of
        (Left cs) = snd $ fclose (stdin <<< cs) w
        (Right cs) = case lexer cs of

-               (Left e) = snd $ fclose (stdin <<< toString e) w
+               (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
                (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) w
+                       (Left e) = snd $ fclose (stdin <<< toString e <<< "\n") w

                        (Right parseOut)
                        # stdin = if (not args.parse) stdin (
                                stdin <<<  "//PARSER\n" <<< toString parseOut <<< "//PARSER\n")
                        (Right parseOut)
                        # stdin = if (not args.parse) stdin (
                                stdin <<<  "//PARSER\n" <<< toString parseOut <<< "//PARSER\n")

-                       = case sem parseOut of
-                               (Left e) = snd $ fclose (stdin <<< join "\n" (map toString e)) w
-                               (Right semOut)
-                               # stdin = if (not args.sem) stdin (
-                                       stdin <<<  "//SEM\n" <<< toString semOut <<< "//SEM\n")
-                               = snd $ fclose stdin w
+                       = 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
                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
                        printTokens :: [Token] -> String
                        printTokens ts = concat $ flatten $ map pt ts
                                where


@@ -86,7 +111,8 @@ parseArgs w
        version=False,
        lex=False,
        parse=False,
        version=False,
        lex=False,
        parse=False,

-       sem=True,
+       sem=False,
+    gen=True,

        fp=Nothing,
        help=False}, w)
 where
        fp=Nothing,
        help=False}, w)
 where


@@ -100,6 +126,8 @@ where
        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 ["--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)
        pa [x:r] o = pa r {o & fp=Just x}
 
 readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World)