From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 20 May 2016 17:15:28 +0000 (+0200)
Subject: printBool
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=9b3178a764a615a753b43ee00c01336578303864;p=cc1516.git

printBool
---

diff --git a/gen.icl b/gen.icl
index 082c34d..53a1de7 100644
--- 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
--- 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
--- 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