diff options
Diffstat (limited to 'Sil')
| -rw-r--r-- | Sil/Check.dcl | 15 | ||||
| -rw-r--r-- | Sil/Check.icl | 49 | ||||
| -rw-r--r-- | Sil/Compile.icl | 26 | ||||
| -rw-r--r-- | Sil/Syntax.dcl | 11 | ||||
| -rw-r--r-- | Sil/Syntax.icl | 27 |
5 files changed, 117 insertions, 11 deletions
diff --git a/Sil/Check.dcl b/Sil/Check.dcl new file mode 100644 index 0000000..b222079 --- /dev/null +++ b/Sil/Check.dcl @@ -0,0 +1,15 @@ +definition module Sil.Check + +from StdOverloaded import class toString + +from Data.Maybe import :: Maybe + +from Sil.Syntax import :: Program, :: Name + +:: CheckError + = ReturnExpressionFromVoidError Name + | NoReturnFromNonVoidError Name + +instance toString CheckError + +checkProgram :: *(Maybe *File) Program -> *([CheckError], *Maybe *File) diff --git a/Sil/Check.icl b/Sil/Check.icl new file mode 100644 index 0000000..fa93ac9 --- /dev/null +++ b/Sil/Check.icl @@ -0,0 +1,49 @@ +implementation module Sil.Check + +import StdFile +from StdFunc import flip +import StdList +import StdOverloaded +import StdString + +from Data.Func import $, mapSt, seqSt +import Data.Maybe +import Data.Tuple +from Text import <+ + +import Sil.Syntax + +instance toString CheckError +where + toString (ReturnExpressionFromVoidError f) + = "Type error: an expression was returned from void function '" <+ f <+ "'." + toString (NoReturnFromNonVoidError f) + = "Type error: no return from non-void function '" <+ f <+ "'." + +instance <<< CheckError where <<< f e = f <<< toString e <<< "\r\n" + +checkProgram :: *(Maybe *File) Program -> *([CheckError], *Maybe *File) +checkProgram err prog = checkFunction err (hd prog.p_funs) //appFst flatten $ mapSt (flip checkFunction) prog.p_funs err + +checkFunction :: *(Maybe *File) Function -> *([CheckError], *Maybe *File) +checkFunction err f = checkErrors [checkReturnExpressionFromVoid] f err +where + checkReturnExpressionFromVoid :: Function -> Maybe CheckError + checkReturnExpressionFromVoid f = case f.f_type of + TVoid -> case [st \\ st=:(Return (Just _)) <- allStatements f] of + [] -> Nothing + _ -> Just $ ReturnExpressionFromVoidError f.f_name + _ -> Nothing + +checkErrors :: [(a -> Maybe CheckError)] a *(Maybe *File) -> *([CheckError], *Maybe *File) +checkErrors cks x err = seqSt error (catMaybes $ map (flip ($) x) cks) $ noErrors err + +error :: CheckError *([CheckError], *Maybe *File) -> *([CheckError], *Maybe *File) +error e (es, err) = ([e:es], err <?< e) + +noErrors :: *(Maybe *File) -> *([CheckError], *Maybe *File) +noErrors f = ([], f) + +(<?<) infixl :: !*(Maybe *File) !a -> *Maybe *File | <<< a +(<?<) (Just f) x = Just (f <<< x) +(<?<) Nothing _ = Nothing diff --git a/Sil/Compile.icl b/Sil/Compile.icl index 7857ff2..afdfe90 100644 --- a/Sil/Compile.icl +++ b/Sil/Compile.icl @@ -36,7 +36,8 @@ compile prog = case evalRWST (gen prog) () zero of :: Address :== Int :: FunctionSymbol = - { fs_arity :: Int + { fs_arity :: Int + , fs_rettype :: Type } :: CompileState = @@ -104,7 +105,11 @@ reserveVar :: Int Name -> Gen Int reserveVar i n = modify (\cs -> {cs & addresses='M'.put n i cs.addresses}) *> pure (i+1) addFunction :: Function -> Gen () -addFunction f = modify (\cs -> {cs & symbols='M'.put f.f_name {fs_arity=length f.f_args} cs.symbols}) +addFunction f = modify (\cs -> {cs & symbols='M'.put f.f_name fs cs.symbols}) +where + fs = { fs_arity = length f.f_args + , fs_rettype = f.f_type + } cleanup :: Gen () cleanup = gets peekReturn >>= tell @@ -142,18 +147,19 @@ where modify (newReturn cleanup`) *> gen f.f_code *> cleanup *> - shrinkStack (args - 1) *> + modify (\cs -> {cs & stackoffset=0}) *> tell ['ABC'.Rtn] *> modify popReturn where cleanup` = case f.f_args of - [] -> [ 'ABC'.Annotation $ 'ABC'.DAnnot 1 [] + [] -> [ 'ABC'.Annotation $ 'ABC'.DAnnot retSize [] ] - _ -> [ 'ABC'.Comment "Cleanup" - , 'ABC'.Update_a 0 args - , 'ABC'.Pop_a args - , 'ABC'.Annotation $ 'ABC'.DAnnot 1 [] + _ -> [ 'ABC'.Comment "Cleanup"] ++ + [ 'ABC'.Update_a i (args+i) \\ i <- [0..retSize-1] ] ++ + [ 'ABC'.Pop_a args + , 'ABC'.Annotation $ 'ABC'.DAnnot retSize [] ] + retSize = typeSize f.f_type args = length f.f_args locals = length f.f_code.cb_init @@ -171,9 +177,7 @@ where where cleanup` = case cb.cb_init of [] -> [] - _ -> [ 'ABC'.Update_a 0 locals - , 'ABC'.Pop_a locals - ] + _ -> [ 'ABC'.Pop_a locals ] locals = length cb.cb_init instance gen Initialisation diff --git a/Sil/Syntax.dcl b/Sil/Syntax.dcl index aebe32c..42097c5 100644 --- a/Sil/Syntax.dcl +++ b/Sil/Syntax.dcl @@ -77,3 +77,14 @@ instance toString Expression instance toString Op1 instance toString Op2 instance toString Literal + +class allStatements a :: a -> [Statement] +instance allStatements Program +instance allStatements Function +instance allStatements CodeBlock +instance allStatements Statement + +/** + * Size of an expression on the stack + */ +typeSize :: Type -> Int diff --git a/Sil/Syntax.icl b/Sil/Syntax.icl index 0056618..f78ba83 100644 --- a/Sil/Syntax.icl +++ b/Sil/Syntax.icl @@ -1,8 +1,11 @@ implementation module Sil.Syntax +from StdFunc import o import StdOverloaded import StdString +import StdTuple +import Data.List import Data.Maybe import Text @@ -54,3 +57,27 @@ instance toString Literal where toString (BLit b) = toString b toString (ILit i) = toString i + +instance allStatements Program +where allStatements p = concatMap allStatements p.p_funs + +instance allStatements Function +where allStatements f = allStatements f.f_code + +instance allStatements CodeBlock +where allStatements cb = concatMap allStatements cb.cb_content + +instance allStatements Statement +where + allStatements st=:(Declaration _ _) = [st] + allStatements st=:(Application _) = [st] + allStatements st=:(Return _) = [st] + allStatements st=:(If bs Nothing) = [st:concatMap (allStatements o snd) bs] + allStatements st=:(If bs (Just e)) = [st:allStatements e ++ concatMap (allStatements o snd) bs] + allStatements st=:(While _ cb) = [st:allStatements cb] + allStatements st=:(MachineStm _) = [st] + +typeSize :: Type -> Int +typeSize TVoid = 0 +typeSize TBool = 1 +typeSize TInt = 1 |