Merge remote-tracking branch 'origin/task-3' into llvm-code-gen

lib/StdLib.hs

@@ -5,8 +5,6 @@ module StdLib
   ( TypedStdDeclaration,
     typedStdDeclarations,
     stdDeclarations,
-    binOpIdentifier,
-    unOpIdentifier,
   )
 where
 
@@ -23,17 +21,7 @@ typedStdDeclarations = [notDecl, printBoolDecl, printIntDecl]
 
 -- | The list of standard declarations.
 stdDeclarations :: [Identifier]
-stdDeclarations = (mapper <$> typedStdDeclarations) <> operatorDecls
-  where
-    mapper (name, _) = name
-
-    operatorDecls = (binOpIdentifier <$> binOps) <> (unOpIdentifier <$> unaryOps)
-
-    binOps =
-      (BoolOp <$> [minBound .. maxBound])
-        <> (ArithOp <$> [minBound .. maxBound])
-        <> (CompOp <$> [minBound .. maxBound])
-    unaryOps = [minBound .. maxBound]
+stdDeclarations = fst <$> typedStdDeclarations
 
 -- ** Function Declarations
 
@@ -49,25 +37,6 @@ printBoolDecl = ("print_bool", TFun TBool TUnit)
 printIntDecl :: TypedStdDeclaration
 printIntDecl = ("print_int", TFun TInt TUnit)
 
--- ** Operator Declarations
-
-binOpIdentifier :: BinaryOperator -> Identifier
-binOpIdentifier (BoolOp AndOp) = "(&&)"
-binOpIdentifier (BoolOp OrOp) = "(||)"
-binOpIdentifier (ArithOp PlusOp) = "(+)"
-binOpIdentifier (ArithOp MinusOp) = "(-)"
-binOpIdentifier (ArithOp MulOp) = "(*)"
-binOpIdentifier (ArithOp DivOp) = "(/)"
-binOpIdentifier (CompOp EqOp) = "(=)"
-binOpIdentifier (CompOp NeOp) = "(<>)"
-binOpIdentifier (CompOp LtOp) = "(<)"
-binOpIdentifier (CompOp LeOp) = "(<=)"
-binOpIdentifier (CompOp GtOp) = "(>)"
-binOpIdentifier (CompOp GeOp) = "(>=)"
-
-unOpIdentifier :: UnaryOperator -> Identifier
-unOpIdentifier UnMinusOp = "(~-)"
-
 data StdLibDecl
   = And
   | Or

lib/Transformations/Anf/AnfGen.hs

@@ -5,6 +5,7 @@ module Transformations.Anf.AnfGen (astToAnf) where
 import Control.Monad.Cont (ContT, mapContT)
 import Control.Monad.State (MonadTrans (lift), State, evalState, get, modify)
 import Control.Monad.Trans.Cont (evalContT)
+import Data.Text (pack)
 import qualified Parser.Ast as Ast
 import qualified Transformations.Anf.Anf as Anf
 import Transformations.Cc.Cc (ccAst)
@@ -83,4 +84,4 @@ genName :: CntState Common.Identifier'
 genName = do
   cnt <- get
   modify (+ 1)
-  return $ Common.Gen cnt
+  return $ Common.Gen cnt $ pack "anf"

lib/Transformations/Anf/PrettyPrinter.hs

@@ -1,44 +1,85 @@
+{-# LANGUAGE LambdaCase #-}
+
 module Transformations.Anf.PrettyPrinter (prettyPrint) where
 
+import Control.Monad.State (MonadState (get), State, evalState, modify)
 import Data.Text (unpack)
-import StdLib (binOpIdentifier, unOpIdentifier)
 import Transformations.Anf.Anf
-import Trees.Common (Identifier' (Gen, Txt))
+import Trees.Common
 
 prettyPrint :: Program -> String
-prettyPrint (Program stmts) = prettyPrint' stmts
+prettyPrint (Program decls) = unlines $ prettyDecl <$> decls
+
+type IndentState = State IndentLevel
 
-prettyPrint' :: [GlobalDeclaration] -> String
-prettyPrint' stmts = unlines $ map prettyStmt stmts
+type IndentLevel = Int
 
-prettyStmt :: GlobalDeclaration -> String
-prettyStmt (GlobVarDecl name value) = doubleSemicolon $ unwords ["let", prettyId name, "=", prettyExpr value]
-prettyStmt (GlobFunDecl name params body) = doubleSemicolon $ unwords ["let", prettyId name, unwords (prettyId <$> params), "=", prettyExpr body]
+prettyDecl :: GlobalDeclaration -> String
+prettyDecl decl = evalState (prettyDecl' decl) 0 <> ";;"
+  where
+    prettyDecl' :: GlobalDeclaration -> IndentState String
+    prettyDecl' (GlobVarDecl name value) = do
+      val' <- prettyExpr value
+      return $ unwords ["let", prettyId name, "=", val']
+    prettyDecl' (GlobFunDecl name params body) = do
+      val' <- prettyExpr body
+      return $ unwords ["let", prettyId name, unwords (prettyId <$> params), "=", val']
 
-prettyExpr :: Expression -> String
-prettyExpr (ExprAtom aexpr) = prettyAtomic aexpr
+prettyExpr :: Expression -> IndentState String
+prettyExpr (ExprAtom aexpr) = return $ prettyAtomic aexpr
 prettyExpr (ExprComp cexpr) = prettyComplex cexpr
-prettyExpr (ExprLetIn (ident, val) expr) = unwords ["let", prettyId ident, "=", prettyExpr val, "in", prettyExpr expr]
+prettyExpr (ExprLetIn (ident, val) expr) = do
+  modify (+ 2)
+  indent <- get
+  val' <- prettyExpr val
+  expr' <- prettyExpr expr
+  let declText = createIndent indent <> "let " <> prettyId ident <> " = " <> val'
+  let exprText = createIndent indent <> "in " <> expr'
+  modify $ \x -> x - 2
+  return $ declText <> exprText
+
+prettyComplex :: ComplexExpression -> IndentState String
+prettyComplex = \case
+  CompApp f arg -> return $ parens $ prettyAtomic f <> " " <> prettyAtomic arg
+  CompIte c t e -> do
+    indent <- get
+    let cText = createIndent (indent + 2) <> "if " <> prettyAtomic c
+    let tText = createIndent (indent + 4) <> "then " <> prettyAtomic t
+    let eText = createIndent (indent + 4) <> "else " <> prettyAtomic e
+    return $ cText <> tText <> eText
 
 prettyAtomic :: AtomicExpression -> String
-prettyAtomic aexpr = case aexpr of
+prettyAtomic = \case
   AtomId name -> prettyId name
   AtomBool value -> if value then "true" else "false"
   AtomInt value -> show value
-  AtomBinOp op lhs rhs -> parens (unwords [unpack $ binOpIdentifier op, prettyAtomic lhs, prettyAtomic rhs])
-  AtomUnOp op x -> parens (unwords [unpack $ unOpIdentifier op, prettyAtomic x])
-
-prettyComplex :: ComplexExpression -> String
-prettyComplex cexpr = case cexpr of
-  CompApp f arg -> parens $ prettyAtomic f <> " " <> prettyAtomic arg
-  CompIte c t e -> unwords ["if", prettyAtomic c, "then", prettyAtomic t, "else", prettyAtomic e]
+  AtomBinOp op lhs rhs -> parens (unwords [prettyAtomic lhs, prettyBinOp op, prettyAtomic rhs])
+  AtomUnOp op x -> parens $ prettyUnOp op <> prettyAtomic x
 
 prettyId :: Identifier' -> String
-prettyId (Txt n) = "`" <> unpack n <> "`"
-prettyId (Gen n) = "`$" <> show n <> "`"
+prettyId (Txt n) = unpack n
+prettyId (Gen n ident) = unpack ident <> "'" <> show n
+
+prettyBinOp :: BinaryOperator -> String
+prettyBinOp = \case
+  BoolOp AndOp -> "&&"
+  BoolOp OrOp -> "||"
+  ArithOp PlusOp -> "+"
+  ArithOp MinusOp -> "-"
+  ArithOp MulOp -> "*"
+  ArithOp DivOp -> "/"
+  CompOp EqOp -> "="
+  CompOp NeOp -> "<>"
+  CompOp LtOp -> "<"
+  CompOp LeOp -> "<="
+  CompOp GtOp -> ">"
+  CompOp GeOp -> ">="
+
+prettyUnOp :: UnaryOperator -> String
+prettyUnOp UnMinusOp = "-"
+
+createIndent :: Int -> String
+createIndent indent = "\n" <> replicate indent ' '
 
 parens :: String -> String
 parens val = "(" <> val <> ")"
-
-doubleSemicolon :: String -> String
-doubleSemicolon val = val <> ";;"

lib/Transformations/Ll/Ll.hs

@@ -4,6 +4,7 @@ module Transformations.Ll.Ll (llAst) where
 
 import Control.Monad.State (State, get, modify, runState)
 import qualified Data.List.NonEmpty as NE
+import Data.Text (pack)
 import qualified Transformations.Ll.Lfr as Lfr
 import qualified Transformations.Simplification.SimplifiedAst as Ast
 import qualified Trees.Common as Common
@@ -61,7 +62,7 @@ genName :: LlState Common.Identifier'
 genName = do
   Env _ cnt <- get
   modify $ \env -> env {idCnt = cnt + 1}
-  return $ Common.Gen cnt
+  return $ Common.Gen cnt $ pack "ll"
 
 -- Utils
 

lib/Transformations/Relabeler/RelabelVars.hs

@@ -85,9 +85,12 @@ findLabel name = do
 pushScope :: Ast.Identifier' -> RelabelerState ()
 pushScope name = modify $ \(Env scs cnt) ->
   Env
-    { scopes = (name, Ast.Gen cnt) : scs,
+    { scopes = (name, Ast.Gen cnt (getIdentName name)) : scs,
       idCnt = cnt + 1
     }
+  where
+    getIdentName (Ast.Gen _ ident) = ident
+    getIdentName (Ast.Txt ident) = ident
 
 popScope :: RelabelerState ()
 popScope = modify $ \env@(Env scs _) -> env {scopes = tail scs}

lib/Transformations/Simplification/SimplifyAst.hs

@@ -3,6 +3,7 @@
 module Transformations.Simplification.SimplifyAst (simplifyAst) where
 
 import Control.Monad.State (State, get, modify, runState)
+import Data.Text (pack)
 import qualified Parser.Ast as Ast
 import qualified Transformations.Simplification.SimplifiedAst as SAst
 import qualified Trees.Common as Common
@@ -50,7 +51,7 @@ genName :: SimplifierState Common.Identifier'
 genName = do
   cnt <- get
   modify (+ 1)
-  return $ Common.Gen cnt
+  return $ Common.Gen cnt $ pack "simp"
 
 -- Utils
 

lib/Trees/Common.hs

@@ -10,7 +10,7 @@ type Identifier = Text
 
 data Identifier'
   = Txt Identifier
-  | Gen IdCnt
+  | Gen IdCnt Identifier
   deriving (Show, Eq, Ord)
 
 type IdCnt = Int

test/Sample/Anf/DuplicateDeclaration.anf

@@ -1,7 +1,7 @@
-let `$3` = 5;;
-let `$5` `$4` = ((*) `$4` `$3`);;
-let `$6` = (`$5` `$3`);;
-let `$7` = true;;
-let `$8` = (`$5` `$7`);;
-let `$10` `$9` = ((*) `$9` `$7`);;
-let `$11` = (`$10` 5);;
+let x'3 = 5;;
+let f'5 a'4 = (a'4 * x'3);;
+let simp'6 = (f'5 x'3);;
+let x'7 = true;;
+let simp'8 = (f'5 x'7);;
+let f'10 a'9 = (a'9 * x'7);;
+let simp'11 = (f'10 5);;

test/Sample/Anf/HardTest.anf

@@ -1,6 +1,40 @@
-let `$1` `$2` `$3` = let `$16` = let `$15` = (`$1` ((-) `$2` 1)) in (`$15` ((+) `$3` 5)) in if ((||) ((=) `$2` 0) ((=) `$3` 1)) then true else `$16`;;
-let `$4` `$5` `$6` `$7` = let `$8` = ((+) `$6` `$7`) in let `$19` = let `$18` = let `$17` = (`$4` 0) in (`$17` 0) in (`$18` `$7`) in let `$21` = let `$20` = (`$1` `$8`) in (`$20` `$6`) in if ((=) `$8` 1) then `$19` else `$21`;;
-let `$9` = let `$23` = let `$22` = (`$1` 0) in (`$22` 2) in let `$26` = let `$25` = let `$24` = (`$4` 2) in (`$24` 2) in (`$25` 2) in ((+) `$23` `$26`);;
-let `$11` `$10` = ((+) `$10` 1);;
-let `$13` `$12` = let `$27` = (`$11` `$12`) in ((+) `$27` 2);;
-let `$14` = (`$13` 5);;
+let g'1 a'2 b'3 = 
+  let anf'16 = 
+    let anf'15 = (g'1 (a'2 - 1))
+    in (anf'15 (b'3 + 5))
+  in 
+    if ((a'2 = 0) || (b'3 = 1))
+      then true
+      else anf'16;;
+let h'4 m'5 p'6 z'7 = 
+  let m'8 = (p'6 + z'7)
+  in 
+    let anf'19 = 
+      let anf'18 = 
+        let anf'17 = (h'4 0)
+        in (anf'17 0)
+      in (anf'18 z'7)
+    in 
+      let anf'21 = 
+        let anf'20 = (g'1 m'8)
+        in (anf'20 p'6)
+      in 
+        if (m'8 = 1)
+          then anf'19
+          else anf'21;;
+let g'9 = 
+  let anf'23 = 
+    let anf'22 = (g'1 0)
+    in (anf'22 2)
+  in 
+    let anf'26 = 
+      let anf'25 = 
+        let anf'24 = (h'4 2)
+        in (anf'24 2)
+      in (anf'25 2)
+    in (anf'23 + anf'26);;
+let g'11 a'10 = (a'10 + 1);;
+let g'13 b'12 = 
+  let anf'27 = (g'11 b'12)
+  in (anf'27 + 2);;
+let simp'14 = (g'13 5);;

test/Sample/Anf/SimpleTest.anf

@@ -1,3 +1,10 @@
-let `$1` `$2` = let `$6` = (`$1` ((+) `$2` 1)) in if ((<) `$2` 0) then 0 else `$6`;;
-let `$4` `$3` = let `$7` = (`$1` ((~-) 5)) in ((+) `$7` `$3`);;
-let `$5` = (`$4` 3);;
+let g'1 x'2 = 
+  let anf'6 = (g'1 (x'2 + 1))
+  in 
+    if (x'2 < 0)
+      then 0
+      else anf'6;;
+let g'4 x'3 = 
+  let anf'7 = (g'1 (-5))
+  in (anf'7 + x'3);;
+let simp'5 = (g'4 3);;

test/Sample/Factorial/FacRec.anf

@@ -1 +1,8 @@
-let `$0` `$1` = let `$3` = let `$2` = (`$0` ((-) `$1` 1)) in ((*) `$1` `$2`) in if ((<=) `$1` 0) then 1 else `$3`;;
+let factorial'0 n'1 = 
+  let anf'3 = 
+    let anf'2 = (factorial'0 (n'1 - 1))
+    in (n'1 * anf'2)
+  in 
+    if (n'1 <= 0)
+      then 1
+      else anf'3;;

test/Sample/Factorial/FacRecCps.anf

@@ -1,4 +1,21 @@
-let `$1` `$0` = `$0`;;
-let `$8` `$3` `$4` `$5` = (`$4` ((*) `$3` `$5`));;
-let `$2` `$3` `$4` = let `$9` = (`$4` 1) in let `$14` = let `$10` = (`$2` ((-) `$3` 1)) in let `$13` = let `$12` = let `$11` = (`$8` `$3`) in (`$11` `$4`) in (`$12` `$5`) in (`$10` `$13`) in if ((=) `$3` 0) then `$9` else `$14`;;
-let `$7` `$6` = let `$15` = (`$2` `$6`) in (`$15` `$1`);;
+let id'1 x'0 = x'0;;
+let ll'8 n'3 k'4 result'5 = (k'4 (n'3 * result'5));;
+let cps_factorial'2 n'3 k'4 = 
+  let anf'9 = (k'4 1)
+  in 
+    let anf'14 = 
+      let anf'10 = (cps_factorial'2 (n'3 - 1))
+      in 
+        let anf'13 = 
+          let anf'12 = 
+            let anf'11 = (ll'8 n'3)
+            in (anf'11 k'4)
+          in (anf'12 result'5)
+        in (anf'10 anf'13)
+    in 
+      if (n'3 = 0)
+        then anf'9
+        else anf'14;;
+let factorial'7 n'6 = 
+  let anf'15 = (cps_factorial'2 n'6)
+  in (anf'15 id'1);;

test/Sample/Factorial/FacRecLoop.anf

@@ -1,2 +1,13 @@
-let `$1` `$0` `$2` `$3` = let `$6` = let `$5` = (`$1` ((+) `$2` 1)) in (`$5` ((*) `$3` `$2`)) in if ((>) `$2` `$0`) then `$3` else `$6`;;
-let `$4` `$0` = let `$8` = let `$7` = (`$1` `$0`) in (`$7` 1) in (`$8` 1);;
+let loop'1 n'0 i'2 accum'3 = 
+  let anf'6 = 
+    let anf'5 = (loop'1 (i'2 + 1))
+    in (anf'5 (accum'3 * i'2))
+  in 
+    if (i'2 > n'0)
+      then accum'3
+      else anf'6;;
+let factorial'4 n'0 = 
+  let anf'8 = 
+    let anf'7 = (loop'1 n'0)
+    in (anf'7 1)
+  in (anf'8 1);;