Add for loops

diff --git a/AST.hs b/AST.hs
index 99b6d42a23b9af254c8767ac969accc8248f03bb..e5ea72ad3e059e33b71cb387b82a100b4c207a3a 100644 (file)
--- a/AST.hs
+++ b/AST.hs
@@ -2,7 +2,7 @@ module AST where
 
 import Data.Char
 import Text.Read
-import Text.ParserCombinators.ReadP hiding ((+++), choice)
+import Text.ParserCombinators.ReadP hiding ((+++), (<++), choice)
 
 newtype Program = Program [AST]
   deriving Show
@@ -26,6 +26,7 @@ data Expr = Num Double
           | Var String
           | Call String [Expr]
           | If Expr Expr Expr
+          | For String Expr Expr (Maybe Expr) Expr
   deriving Show
 data BinOpType = Add | Sub | Mul | Cmp Ordering
   deriving Show
@@ -52,6 +53,7 @@ instance Read Expr where
                     , parseVar
                     , parseCall
                     , parseIf
+                    , parseFor
                     , parseBinOp "+" Add
                     , parseBinOp "-" Sub
                     , parseBinOp "*" Mul
@@ -92,3 +94,18 @@ instance Read Expr where
               skipSpaces
             elseE <- step readPrec
             return (If cond thenE elseE)
+          parseFor = do
+            lift $ do
+              string "for"
+              skipSpaces
+            identifier <- lift (munch1 isAlpha)
+            lift $ skipSpaces >> char '=' >> skipSpaces
+            start <- step readPrec
+            lift $ skipSpaces >> char ',' >> skipSpaces
+            cond <- step readPrec
+            step' <- (do
+              lift $ skipSpaces >> char ',' >> skipSpaces
+              Just <$> step readPrec) <++ pure Nothing
+            lift $ skipSpaces >> string "in" >> skipSpaces
+            body <- step readPrec
+            return (For identifier start cond step' body)

diff --git a/Main.hs b/Main.hs
index f096ea6fa5177b8deb5671c570cb97ba79f37192..7fa4499024c94db07b3264d0a08964af7b194c67 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -44,14 +44,14 @@ main = do
     Left err -> die err
     Right mdl' -> withContext $ \ctx ->
       withHostTargetMachine $ \tm -> do
-        -- hPutStrLn stderr "Before optimisation:"
-        -- Text.hPutStrLn stderr (ppllvm mdl')
+        hPutStrLn stderr "Before optimisation:"
+        Text.hPutStrLn stderr (ppllvm mdl')
 
         withModuleFromAST ctx mdl' $ \mdl -> do
           let spec = defaultCuratedPassSetSpec { optLevel = Just 3 }
           withPassManager spec $ flip runPassManager mdl
-          -- hPutStrLn stderr "After optimisation:"
-          -- Text.hPutStrLn stderr . ppllvm =<< moduleAST mdl
+          hPutStrLn stderr "After optimisation:"
+          Text.hPutStrLn stderr . ppllvm =<< moduleAST mdl
           jit tm mdl >>= print
 
 jit :: TargetMachine -> Module -> IO Double
@@ -153,3 +153,33 @@ buildExpr binds (AST.If cond thenE elseE) = mdo
 
   mergeB <- block `named` "ifcont"
   phi [(thenOp, thenB), (elseOp, elseB)]
+
+buildExpr binds (AST.For ident start cond mStep body) = mdo
+  startV <- buildExpr binds start
+
+  preheaderB <- block `named` "preheader"
+
+  br loopB
+
+  loopB <- block `named` "loop"
+
+  i <- phi [(startV, preheaderB), (nextVar, loopB)] `named` "i"
+
+  let newBinds = Map.insert ident i binds
+
+  buildExpr newBinds body `named` "body"
+
+  stepV <- case mStep of
+    Just step -> buildExpr newBinds step
+    Nothing -> pure $ ConstantOperand (Float (Double 1))
+
+  nextVar <- fadd i stepV `named` "nextvar"
+
+  condV <- buildExpr newBinds cond `named` "cond"
+
+  condBr condV loopB afterB
+
+  afterB <- block `named` "after"
+
+  return (ConstantOperand (Float (Double 0)))
+

diff --git a/test.ks b/test.ks
index c18328bc30c77dbf7d5536ac5cc8e5d44ebf7c15..ed421756a4fd2b9aa6d791ae7386a6f1b0beb246 100644 (file)
--- a/test.ks
+++ b/test.ks
@@ -1,3 +1,7 @@
-def foo(x y) if x > y then x + y else x - y;
-extern putchard(x);
+extern putchard(char);
+
+def printstar(n)
+       for i = 0, i < n, 1.0 in
                putchard(42);
+
+printstar(100);