printBool
authorMart Lubbers <mart@martlubbers.net>
Fri, 20 May 2016 17:15:28 +0000 (19:15 +0200)
committerMart Lubbers <mart@martlubbers.net>
Fri, 20 May 2016 17:15:28 +0000 (19:15 +0200)
gen.icl
sem.icl
spl.icl

diff --git a/gen.icl b/gen.icl
index 082c34d..53a1de7 100644 (file)
--- a/gen.icl
+++ b/gen.icl
@@ -160,11 +160,14 @@ instance g Expr where
     g (VarExpr _ (VarDef k fs)) = getAdressbook >>= \ab->case 'Map'.get k ab of
                Just (ADDR t) = tell [Instr "ldl" [Lit t] ""] >>| mapM_ g fs >>| pure ()
                _ = liftT (Left $ Error "Higher order functions not implemented")
-    g (FunExpr _ k es fs) = 
-               mapM_ g es
-               >>| jump "bsr" k
-        >>| mapM_ (const $ tell [Instr "ajs" [Lit -1] ""]) es //clean up args
-               >>| tell [Instr "ldr" [Raw "RR"] ""]
+    g (FunExpr _ k es fs) = getAdressbook >>= \ab->case 'Map'.get k ab of
+               Just (LAB l arity) = if (arity <> (length es))
+                       (liftT $ Left $ Error "Higher order functions not implemented")
+                       (       mapM_ g es
+                               >>| jump "bsr" k
+                       >>| mapM_ (const $ tell [Instr "ajs" [Lit -1] ""]) es //clean up args
+                               >>| tell [Instr "ldr" [Raw "RR"] ""])
+               _ = liftT (Left $ Error "Funcall to variable?")
 
 jump :: String String -> Gen ()
 jump instr k = getAdressbook >>= \ab->case 'Map'.get k ab of
diff --git a/sem.icl b/sem.icl
index 5ebbc48..9eafed1 100644 (file)
--- a/sem.icl
+++ b/sem.icl
@@ -52,6 +52,9 @@ defaultGamma :: Gamma //includes all default functions
 defaultGamma = extend "print" (Forall ["a"] ((IdType "a") ->> VoidType))
                 $ extend "isEmpty" (Forall ["a"] ((ListType (IdType "a")) ->> BoolType))
                 $ extend "read" (Forall [] (FuncType CharType))
+                $ extend "1printchar" (Forall [] (CharType ->> VoidType))
+                $ extend "1printint" (Forall [] (IntType ->> VoidType))
+                $ extend "1printbool" (Forall [] (BoolType ->> VoidType))
                 zero
 
 sem :: AST -> Either [SemError] AST
diff --git a/spl.icl b/spl.icl
index c877bd0..9976cc1 100644 (file)
--- a/spl.icl
+++ b/spl.icl
@@ -37,12 +37,22 @@ 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])] []]]]
+               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])] []]]
+                       ,
+                       FunDecl zero "1printbool" ["x"] Nothing [] [
+                               IfStmt (VarExpr zero (VarDef "x" []))
+                                       [FunStmt "1printstr" [strOp2 $ fromString "True"] []]
+                                       [FunStmt "1printstr" [strOp2 $ fromString "False"] []]
+                       ]] 
+
+               strOp2 :: [Char] -> Expr
+               strOp2 [] = EmptyListExpr zero
+               strOp2 [x:xs] = Op2Expr zero (CharExpr zero x) BiCons (strOp2 xs)
 
 Start :: *World -> *World
 Start w