From: Michael Andreen <harv@ruin.nu>
Date: Tue, 14 Mar 2006 18:08:37 +0000 (+0000)
Subject: merged changes to function branch
X-Git-Url: https://ruin.nu/git/?p=proglang.git;a=commitdiff_plain;h=04f0a9566794cf761b7bcf83190051a400ec3653;hp=8687a7c6790e959242228d64c8c513771565f8c1

merged changes to function branch
---

diff --git a/CompInt.hs b/CompInt.hs
new file mode 100644
index 0000000..d5aa2ca
--- /dev/null
+++ b/CompInt.hs
@@ -0,0 +1,53 @@
+-- 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 Interpret
+import Compile
+
+import ErrM
+
+type ParseFun a = [Token] -> Err a
+
+myLLexer = myLexer
+
+splitFunStm :: [FuncStm] -> ([Func],[Stm])
+splitFunStm [] = ([],[])
+splitFunStm ((F f):fss) = let (fs,ss) = splitFunStm fss in (f:fs,ss)
+splitFunStm ((S s):fss) = let (fs,ss) = splitFunStm fss in (fs,s:ss)
+
+putStrV :: Int -> String -> IO ()
+putStrV v s = if v > 1 then putStrLn s else return ()
+
+runFile :: ([Func] -> [Stm] -> IO()) -> ParseFun Program -> FilePath -> IO ()
+runFile e p f = readFile f >>= run e p
+
+run :: ([Func] -> [Stm] -> IO()) -> ParseFun Program -> String -> IO ()
+run e p s = let ts = myLLexer s in case p ts of
+	Bad s    -> do
+		putStrLn "\nParse              Failed...\n"
+		putStrLn "Tokens:"
+		putStrLn $ show ts
+		putStrLn s
+	Ok (Program s) -> let (fun,st) = splitFunStm (s) in do
+		typeCheck fun st
+		e fun st
+
+main :: IO ()
+main = do 
+	args <- getArgs
+	case args of
+		[] -> hGetContents stdin >>= run interpret pProgram
+		"-c":f:[] -> runFile (\fun st -> writeFile (f++".c") $ compile fun st)  pProgram f
+		f:[] -> runFile interpret pProgram f
+		_ -> print "Too many arguments"
diff --git a/Compile.hs b/Compile.hs
index 0e1cf22..eb70d0c 100644
--- a/Compile.hs
+++ b/Compile.hs
@@ -1,8 +1,15 @@
-module Compile (compileExp, compileStm) where
+module Compile (compile,compileExp, compileStm) where
 
 import Abssyntax
 import Prelude hiding (lookup)
 
+cHeader = "#include <stdio.h>\nint read(){\nint n;\nscanf(\"%d\",&n);\nreturn n;\n}\nint main(void){\n"
+
+cFooter = "return 0;}"
+
+compile :: [Func] -> [Stm] -> String
+compile f s = cHeader++concat (map compileStm s)++cFooter
+
 compileExp :: Exp -> String
 compileExp (EBool True) = "1";
 compileExp (EBool False) = "0";
diff --git a/Interpret.hs b/Interpret.hs
index 0e39285..5afcefb 100644
--- a/Interpret.hs
+++ b/Interpret.hs
@@ -1,4 +1,4 @@
-module Interpret (eval, execute,addFunction, emptyState, Value(..), State(..)) where
+module Interpret (interpret, eval, execute,addFunction, emptyState, Value(..), State(..)) where
 
 import Abssyntax
 import Control.Monad.State hiding (State)
@@ -21,6 +21,12 @@ type Function = ([Decl],[Stm])
 
 data State = State {variables::Variables,functions::(Map Ident Function),ret::(MVar Value)}
 
+interpret :: [Func] -> [Stm] -> IO ()
+interpret fun st = do
+	mv <- newEmptyMVar
+	runStateT (do mapM Interpret.addFunction fun; mapM execute st) emptyState{ret=mv}
+	return ()
+
 --eval :: (MonadState Variables m) => Exp -> m Value
 eval :: Exp -> StateT State IO Value
 eval (EBool b) = return (VBool b)
diff --git a/Interpreter.hs b/Interpreter.hs
index e41759d..ae73abb 100644
--- a/Interpreter.hs
+++ b/Interpreter.hs
@@ -13,9 +13,6 @@ import Abssyntax
 
 import Typecheck
 import Interpret
-import Control.Monad.State hiding (State)
-import Control.Concurrent.MVar
-import Data.Map as Map hiding (showTree)
 
 import ErrM
 
@@ -46,13 +43,11 @@ run v p s = let ts = myLLexer s in case p ts of
 	Ok (Program s) -> let (fun,st) = splitFunStm (s) in do
 		putStrLn "\nParse Successful!"
 		showTree v (Program s)
-		runStateT (do mapM Typecheck.addFunction fun; mapM typeCheckFunction fun; mapM typeCheckStm st) Typecheck.emptyState
+		typeCheck fun st
 		print "The program is type-correct!!"
 		print "Running program:"
-		mv <- newEmptyMVar
-		runStateT (do mapM Interpret.addFunction fun; mapM execute st) Interpret.emptyState{ret=mv}
+		interpret fun st
 		print "Done running program!"
-		return ()
 
 showTree :: (Show a, Print a) => Int -> a -> IO ()
 showTree v tree
diff --git a/Makefile b/Makefile
index e013775..b6815c2 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-all: Testsyntax Typechecker Interpreter
+all: CompInt
 
 doc: Docsyntax.dvi
 
@@ -17,6 +17,9 @@ Interpreter: Interpreter.hs Interpret.hs Typecheck.hs Parsyntax.hs Lexsyntax.hs
 Compiler: Compiler.hs Compile.hs Typecheck.hs Parsyntax.hs Lexsyntax.hs Abssyntax.hs
 	ghc -fglasgow-exts --make Compiler.hs -o Compiler
 
+CompInt: CompInt.hs Compile.hs Interpret.hs Typecheck.hs Parsyntax.hs Lexsyntax.hs Abssyntax.hs
+	ghc -fglasgow-exts --make CompInt.hs -o CompInt
+
 Parsyntax.hs: Parsyntax.y
 	happy -gca -idebug Parsyntax.y
 
diff --git a/Typecheck.hs b/Typecheck.hs
index 5c70ccf..a8c10e5 100644
--- a/Typecheck.hs
+++ b/Typecheck.hs
@@ -1,4 +1,4 @@
-module Typecheck (typeCheckExp, typeCheckStm, typeCheckVar, typeCheckFunction, addFunction, emptyState, State(..)) where 
+module Typecheck (typeCheck, typeCheckExp, typeCheckStm, typeCheckVar, typeCheckFunction, addFunction, emptyState, State(..)) where 
 
 
 import Abssyntax
@@ -17,6 +17,11 @@ assert :: Monad m => Bool -> String -> m ()
 assert True _ = return ()
 assert False s = fail s
 
+typeCheck :: [Func] -> [Stm] -> IO ()
+typeCheck fun st = do
+	runStateT (do mapM addFunction fun; mapM typeCheckFunction fun; mapM typeCheckStm st) emptyState
+	return ()
+
 typeCheckExp :: (MonadState State m) => Exp -> m Type
 typeCheckExp (BiOpExp e o e') = do
 	t1 <- typeCheckExp e
diff --git a/documentation b/documentation
index bbb604f..c3ac4e0 100644
--- a/documentation
+++ b/documentation
@@ -13,131 +13,98 @@ typing rules
 ++++++++++++
 
 
-(t is used for types, T is the context, and + is used for in)
+(v is used for values, e for expressions, s for statements, c is the context)
 
 
-[Eq, NEq]
+[Eq, NEq, Plus, Minus, Times, Div, Lt, ELt, Gt, EGt]
 
-T+ e1 Eq e2:bool  <=  T+ e1:t  &  T+ e2:t
-
-If e1 and e2 are of the same type, then Eq or NEq return bool
-
-
-[Plus, Minus, Times, Div]
-
-T+ e1 Plus e2:int  <=  T+ e1:int  &  T+ e2:int
-
-The operators Plus/Minus/Times/Div return int if both operands are ints
-
-
-[Lt, ELt, Gt, EGt]
-
-T+ e1 Lt e2:bool  <=  T+ e1:int  &  T+ e2:int
-
-The operators Lt/ELt/Gt/EGt return bool if both operands are ints
+<e1 o e2,c> => <v,c''> <= <e1,c> => <v1,c'>  <e2,c'> => <v2,c''> v is the result of using operator o on v1 and v2
 
 
 [Assignment]
 
-T+ i := e:t  <=  i:t in T  &  T+ e:t
-
-The assignemnt of e to i returns type t if both i and e have type t.
+<i := e,c> => c'[i -> v] <= <e,c> => <v,c'>
 
+Assign the value v to i in the first scope i is found in.
 
 [ENeg]
 
-T+ ENeg e:int  <=  T+ e:int
+<e,c> => <-v,c'> <= <e,c> => <v,c'>
 
-ENeg e returns int if e is of type int
 
 [ENot]
 
-T+ ENot e:bool  <=  e:bool
-
-ENot e returns bool if e is of type bool
+<e,c> => <not v,c'> <= <e,c> => <v,c'>
 
 [EVar]
 
-T+ i:t <= i:t in T
-
-i has type t if i is defined in the context with type t.
+<i,c> => <c(i),c>
 
 [EInt]
 
-T+ n:int
-
-n has type int
+<n,c> => <n,c>
 
 [EBool]
 
-T+ b:bool
-
-b has type bool
-
-[EReadI]
-
-T+ n:int
+<b,c> => <b,c>
 
-EReadI returns an int
+[EReadI,EReadB]
 
-[EReadB]
-
-T+ b:bool
-
-EReadB returns a bool
+<c> => <v,c'> <= <IO,c> => <v,c'>
 
 [EPost]
 
-T+ EPost i:int <= i:int in T
+<i,c> => <v,c[i->v']> <= c(i) => v, v±1 => v'
 
-EPost i is of type int if i is defined in T with type int.
+Look up the variable, add/subtract 1 from the value then return the old value and context with modified value
 
 [SExp]
 
-T+ e   <=  T+ e:t
+<e,c> => c' <= <e,c> => <v,c'>
 
 [SBlock]
 
-T+ s;SBlock ss <= T+ s => T' , T'+ ss => T''
+<SBlock s,c> => c'''  <= push(c) => c' <s,c'> => c'' pop(c'') => c'''
+
+Push a new scope onto the context, execute the statements in this context and the pop the scope from the context
 
-the first statment s, in the block, is typechecked in the context T and returns the context T', the rest of the block is then recursively typeckecked in the context T' 
+[SEQ]
 
+<s1;s2,c> => c'' <= <s1,c> => c' <s2,c'> => c''
 
 [SIf]
 
-T+ if e then s1 else s2  <=  T+ e:bool  &  T+ s1  &  T+ s2
+<if e s1 s2,c> => pop(c''') <= <e,c> => <true,c'> push(c') <s1,c''> => c'''
 
-if e is of type bool and s1 and and s2 typechecks in the context T, then the same context is returned
+<if e s1 s2,c> => pop(c''') <= <e,c> => <false,c'> push(c') <s2,c''> => c'''
 
 
 [SWhile]
 
-T+ while e do s  <=  T+ e:bool  &  T+ s
-
-If e is of type bool and s typechecks in context T then the same context is returned
+<while e s,c> => c' => <e,c> => <false,c'>
 
+<while e s,c> => pop(c''') => <e,c> => <true,c'> push(c') => c'' <s,c''> => c'''
 
 
 [SDecl]
 
-T+ t i = e => T,i:t  <=  i not in T  &  e:t 
+<i := e,c> => c'[i->v] <= <e,c> => <v,c'>
 
-if i and e are of the same type and i is not declared in the current scope then i is added with type t to the context.
+Adds i with value v to the current scope in the context
 
 [SDeclD]
 
-T+ t i => T,i:t  <=  i not in T
+<int i,c> => c[i->0]
+<bool i,c> => c[i->false]
 
-if i is not declared in the current scope, then i is added to the context with type t
+Adds i with default value in the current scope
 
 [SNoop]
 
-T+ s
+<SNoop,c> => c
 
 SNoops does nothing so the same context is returned
 
 [SPrint]
 
-T+ e <= T+ e:t
-
-if e has type t then SPrint returns the same context
+<e,c> => c'' <= <e,c> => <v,c'> <IO v,c'>  => c''