aboutsummaryrefslogtreecommitdiff
path: root/Sil
diff options
context:
space:
mode:
Diffstat (limited to 'Sil')
-rw-r--r--Sil/Check.dcl15
-rw-r--r--Sil/Check.icl49
-rw-r--r--Sil/Compile.icl26
-rw-r--r--Sil/Syntax.dcl11
-rw-r--r--Sil/Syntax.icl27
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