diff options
| -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 | ||||
| -rw-r--r-- | examples/fib.sil | 12 | ||||
| -rw-r--r-- | examples/while.sil | 3 | ||||
| -rw-r--r-- | sil.icl | 21 |
8 files changed, 140 insertions, 24 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 diff --git a/examples/fib.sil b/examples/fib.sil index 71a9bb1..db66783 100644 --- a/examples/fib.sil +++ b/examples/fib.sil @@ -1,13 +1,13 @@ Int fib(Int n) { - if (n == 100) { - return 100; - } else if (n == 200) { - return 100; + if (n == 1) { + return 1; + } else if (n == 2) { + return 1; } else { - return fib(n - 100) + fib(n - 200); + return fib(n - 1) + fib(n - 2); } } Int main() { - return fib(1000); + return fib(10); } diff --git a/examples/while.sil b/examples/while.sil index b6ae2cc..49186fb 100644 --- a/examples/while.sil +++ b/examples/while.sil @@ -1,9 +1,8 @@ -Int print(Int n) { +Void print(Int n) { |~ push_a 0 |~.d 1 0 |~ jsr _print_graph |~.o 0 0 - return n; } Int loop(Int start, Int end) { @@ -14,12 +14,14 @@ import Control.Monad import Data.Error from Data.Func import $ import Data.Functor +import Data.Tuple import System.CommandLine import System.File import System.Process import ABC.Assembler +from Sil.Check import :: CheckError, checkProgram import qualified Sil.Compile as SC from Sil.Compile import :: CompileError, instance toString CompileError import Sil.Parse @@ -30,6 +32,7 @@ from Sil.Util.Printer import :: PrintState, instance zero PrintState, :: CLI = { prettyprint :: Bool + , check :: Bool , compile :: Bool , generate :: Bool , run :: Bool @@ -40,6 +43,7 @@ instance zero CLI where zero = { prettyprint = False + , check = False , compile = False , generate = False , run = False @@ -63,9 +67,15 @@ Start w | isError prog # err = err <<< toString (fromError prog) <<< "\r\n" = finish io err w +# prog = fromOk prog # io = if args.prettyprint - (io <<< print zero (fromOk prog) <<< "\r\n") + (io <<< print zero prog <<< "\r\n") io +# (errs, err) = if args.check + (appSnd fromJust $ checkProgram (Just err) prog) + ([], err) +| not (isEmpty errs) + = finish io err w | not args.compile = finish io err w # (ok,f,w) = fopen "sil_compiled.dcl" FWriteText w @@ -79,7 +89,7 @@ Start w | not ok # err = err <<< "Could not open 'sil_compiled.abc' for writing\r\n" = finish io err w -# f = f <<< 'SC'.compile (fromOk prog) +# f = f <<< 'SC'.compile prog # (_,w) = fclose f w | not args.generate = finish io err w @@ -98,9 +108,10 @@ where arg :: Parser String (CLI -> CLI) arg = peek >>= \opt -> ( item "--pretty-print" *> pure (\cli -> {cli & prettyprint=True}) - <|> item "--compile" *> pure (\cli -> {cli & compile=True}) - <|> item "--generate" *> pure (\cli -> {cli & generate=True}) - <|> item "--run" *> pure (\cli -> {cli & run=True}) + <|> item "--check" *> pure (\cli -> {cli & check=True}) + <|> item "--compile" *> pure (\cli -> {cli & compile=True}) + <|> item "--generate" *> pure (\cli -> {cli & generate=True}) + <|> item "--run" *> pure (\cli -> {cli & run=True}) <|> (satisfy isFilename >>= \name -> pure (\cli -> {cli & inputfile=name})) <?> Invalid "command line argument" opt ) |