From 98e238b8dd8c07705ab9681ff07c85e10eda9397 Mon Sep 17 00:00:00 2001
From: Michael Andreen <harv@ruin.nu>
Date: Wed, 1 Mar 2006 14:18:38 +0000
Subject: [PATCH] adding compiler

---
 Compile.hs  | 41 +++++++++++++++++++++++++++++++++++
 Compiler.hs | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 Makefile    |  5 ++++-
 3 files changed, 106 insertions(+), 1 deletion(-)
 create mode 100644 Compile.hs
 create mode 100644 Compiler.hs

diff --git a/Compile.hs b/Compile.hs
new file mode 100644
index 0000000..c3e93f9
--- /dev/null
+++ b/Compile.hs
@@ -0,0 +1,41 @@
+module Compile (compileExp, compileStm) where
+
+import Abssyntax
+import Prelude hiding (lookup)
+
+compileExp :: Exp -> String
+compileExp (EBool True) = "1";
+compileExp (EBool False) = "0";
+compileExp (EInt n) = show n
+compileExp (EVar (Ident i)) = i
+compileExp (EAss (Ident i) e) = i++"="++compileExp e
+compileExp EDefault = error "EDefault called from an illegal place"
+compileExp (BiOpExp e o e') = "("++compileExp e++")"++op o++"("++compileExp e'++")"
+compileExp (ENeg e) = "-("++compileExp e++")"
+compileExp (ENot e) ="!("++compileExp e++")" 
+compileExp (EPost (Ident i) Plus) = i++"++"
+compileExp (EPost (Ident i) Minus) = i++"--"
+compileExp EReadI = "read()"
+compileExp EReadB = "read()"
+
+op :: Op -> String
+op Eq = "=="
+op NEq = "!="
+op Plus = "+"
+op Minus = "-"
+op Times = "*" 
+op Div = "/" 
+op Lt = "<"
+op ELt = "<="
+op Gt = ">"
+op EGt = ">="
+
+compileStm :: Stm -> String
+compileStm (SNoop) = ";\n"
+compileStm (SExp e) = compileExp e++";\n"
+compileStm (SIf b s s') = "if("++compileExp b++")"++compileStm s++" \nelse "++compileStm s'
+compileStm (SPrint e) = "printf(\"%d\\n\","++compileExp e++");\n"
+compileStm (SBlock ss) = "{\n"++concat (map (("\t"++).compileStm) ss)++"\n}\n"
+compileStm (SWhile e s) = "while("++compileExp e++")"++compileStm s
+compileStm (SDecl t (Ident i) EDefault) = "int "++i++"=0;\n"
+compileStm (SDecl t (Ident i) e) = "int "++i++"="++compileExp e++";\n"
diff --git a/Compiler.hs b/Compiler.hs
new file mode 100644
index 0000000..2f1f31b
--- /dev/null
+++ b/Compiler.hs
@@ -0,0 +1,61 @@
+-- automatically generated by BNF Converter
+module Main where
+
+
+import IO ( stdin, hGetContents )
+import System ( getArgs, getProgName )
+
+import Lexsyntax
+import Parsyntax
+import Skelsyntax
+import Printsyntax
+import Abssyntax
+
+import Typecheck
+import Compile
+import Control.Monad.State
+import Data.Map as Map hiding (showTree,map)
+
+import ErrM
+
+type ParseFun a = [Token] -> Err a
+
+myLLexer = myLexer
+
+type Verbosity = Int
+
+putStrV :: Verbosity -> String -> IO ()
+putStrV v s = if v > 1 then putStrLn s else return ()
+
+runFile :: Verbosity -> ParseFun Stms -> FilePath -> IO ()
+runFile v p f = readFile f >>= run v p
+
+run :: Verbosity -> ParseFun Stms -> String -> IO ()
+run v p s = let ts = myLLexer s in case p ts of
+	Bad s    -> do
+		putStrLn "\nParse              Failed...\n"
+		putStrV v "Tokens:"
+		putStrV v $ show ts
+		putStrLn s
+	Ok (Program s) -> do
+		runStateT (mapM typeCheckStm s) [empty]
+		putStr $ concat (map compileStm s) 
+		return ()
+
+showTree :: (Show a, Print a) => Int -> a -> IO ()
+showTree v tree
+ = do
+      putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
+      putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree
+
+main :: IO ()
+main = do args <- getArgs
+          case args of
+            [] -> hGetContents stdin >>= run 2 pStms
+            "-s":fs -> mapM_ (runFile 0 pStms) fs
+            fs -> mapM_ (runFile 2 pStms) fs
+
+
+
+
+
diff --git a/Makefile b/Makefile
index f662112..24f8a62 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-all: Typechecker Interpreter
+all: Typechecker Interpreter Compiler
 
 doc: Docsyntax.dvi
 
@@ -14,6 +14,9 @@ Typechecker: Typechecker.hs  Typecheck.hs Parsyntax.hs Lexsyntax.hs Abssyntax.hs
 Interpreter: Interpreter.hs Interpret.hs Typecheck.hs Parsyntax.hs Lexsyntax.hs Abssyntax.hs
 	ghc -fglasgow-exts --make Interpreter.hs -o Interpreter
 
+Compiler: Compiler.hs Compile.hs Typecheck.hs Parsyntax.hs Lexsyntax.hs Abssyntax.hs
+	ghc -fglasgow-exts --make Compiler.hs -o Compiler
+
 Parsyntax.hs: Parsyntax.y
 	happy -gca -idebug Parsyntax.y
 
-- 
2.39.2