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

merged changes to function branch
---

04f0a9566794cf761b7bcf83190051a400ec3653
diff --cc CompInt.hs
index 0000000,1188466..d5aa2ca
mode 000000,100644..100644
--- a/CompInt.hs
+++ b/CompInt.hs
@@@ -1,0 -1,54 +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 Data.Map as Map hiding (showTree)
+ 
+ import ErrM
+ 
+ type ParseFun a = [Token] -> Err a
+ 
+ myLLexer = myLexer
+ 
 -
 -cHeader = "#include <stdio.h>\nint read(){\nint n;\nscanf(\"%d\",&n);\nreturn n;\n}\nint main(void){\n"
 -
 -cFooter = "return 0;}"
++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 :: ([Stm] -> IO()) -> ParseFun Stms -> FilePath -> IO ()
++runFile :: ([Func] -> [Stm] -> IO()) -> ParseFun Program -> FilePath -> IO ()
+ runFile e p f = readFile f >>= run e p
+ 
 -run :: ([Stm] -> IO()) -> ParseFun Stms -> String -> IO ()
++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) -> do
 -		typeCheck s
 -		e 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 pStms
 -		"-c":f:[] -> runFile (writeFile (f++".c") . compile)  pStms f
 -		f:[] -> runFile interpret pStms f
++		[] -> 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 --cc Compile.hs
index 0e1cf22,2252fc5..eb70d0c
--- a/Compile.hs
+++ b/Compile.hs
@@@ -3,6 -3,13 +3,13 @@@ module Compile (compile,compileExp, com
  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 :: [Stm] -> String
 -compile s = cHeader++concat (map compileStm s)++cFooter
++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 --cc Interpret.hs
index 0e39285,0728d51..5afcefb
--- a/Interpret.hs
+++ b/Interpret.hs
@@@ -1,9 -1,7 +1,9 @@@
- module Interpret (eval, execute,addFunction, emptyState, Value(..), State(..)) where
 -module Interpret (interpret, eval, execute, Value(VInt, VBool)) where
++module Interpret (interpret, eval, execute,addFunction, emptyState, Value(..), State(..)) where
  
  import Abssyntax
 -import Control.Monad.State
 +import Control.Monad.State hiding (State)
 +import Control.Monad.Error
 +import Control.Concurrent.MVar
  import Data.Map as Map
  import Prelude hiding (lookup)
  
@@@ -17,12 -13,12 +17,18 @@@ instance Show Value wher
  	show (VBool False) = "0"
  
  type Variables = [Map Ident Value]
 +type Function = ([Decl],[Stm])
 +
 +data State = State {variables::Variables,functions::(Map Ident Function),ret::(MVar Value)}
  
 -interpret :: [Stm] -> IO ()
 -interpret s = runStateT (mapM execute s) [empty] >> return ()
++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 Variables IO Value
 +eval :: Exp -> StateT State IO Value
  eval (EBool b) = return (VBool b)
  eval (EInt n) = return (VInt n)
  eval (EVar i) = getVariableValue i
diff --cc Interpreter.hs
index e41759d,694ce23..ae73abb
--- a/Interpreter.hs
+++ b/Interpreter.hs
@@@ -13,9 -13,8 +13,6 @@@ import Abssynta
  
  import Typecheck
  import Interpret
- import Control.Monad.State hiding (State)
- import Control.Concurrent.MVar
 -import Control.Monad.State
--import Data.Map as Map hiding (showTree)
  
  import ErrM
  
@@@ -43,16 -37,14 +40,14 @@@ run v p s = let ts = myLLexer s in cas
  		putStrV v "Tokens:"
  		putStrV v $ show ts
  		putStrLn s
 -	Ok (Program s) -> do
 -		--putStrLn "\nParse Successful!"
 -		--showTree v (Program s)
 -		typeCheck s
 -		--print "The program is type-correct!!"
 -		--print "Running program:"
 -		interpret s
 -		--print "Done running program!"
 +	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 --cc Typecheck.hs
index 5c70ccf,1b0baa0..a8c10e5
--- a/Typecheck.hs
+++ b/Typecheck.hs
@@@ -1,4 -1,4 +1,4 @@@
- module Typecheck (typeCheckExp, typeCheckStm, typeCheckVar, typeCheckFunction, addFunction, emptyState, State(..)) where 
 -module Typecheck (typeCheck,typeCheckExp, typeCheckStm, typeCheckVar) where 
++module Typecheck (typeCheck, typeCheckExp, typeCheckStm, typeCheckVar, typeCheckFunction, addFunction, emptyState, State(..)) where 
  
  
  import Abssyntax
@@@ -17,7 -16,10 +17,12 @@@ assert :: Monad m => Bool -> String -> 
  assert True _ = return ()
  assert False s = fail s
  
 -typeCheck :: [Stm] -> IO ()
 -typeCheck s = runStateT (mapM typeCheckStm s) [empty] >> return ()
++typeCheck :: [Func] -> [Stm] -> IO ()
++typeCheck fun st = do
++	runStateT (do mapM addFunction fun; mapM typeCheckFunction fun; mapM typeCheckStm st) emptyState
++	return ()
+ 
 -typeCheckExp :: (MonadState Types m) => Exp -> m Type
 +typeCheckExp :: (MonadState State m) => Exp -> m Type
  typeCheckExp (BiOpExp e o e') = do
  	t1 <- typeCheckExp e
  	t2 <- typeCheckExp e'