aboutsummaryrefslogtreecommitdiff
path: root/Sil
diff options
context:
space:
mode:
Diffstat (limited to 'Sil')
-rw-r--r--Sil/Check.icl3
-rw-r--r--Sil/Compile.dcl1
-rw-r--r--Sil/Compile.icl44
-rw-r--r--Sil/Parse.icl9
-rw-r--r--Sil/Syntax.dcl5
-rw-r--r--Sil/Util/Printer.icl6
6 files changed, 44 insertions, 24 deletions
diff --git a/Sil/Check.icl b/Sil/Check.icl
index 89ed73e..c51d73c 100644
--- a/Sil/Check.icl
+++ b/Sil/Check.icl
@@ -61,7 +61,8 @@ checkFunction err f = checkErrors
[ checkLocals
, checkReturnAndVoid
, checkMainFunctionType
- ] f $ noErrors err
+ ] f
+ $ noErrors err
where
checkReturnAndVoid :: Function -> [CheckError]
checkReturnAndVoid f = case f.f_type of
diff --git a/Sil/Compile.dcl b/Sil/Compile.dcl
index 4857ba9..5eb35a2 100644
--- a/Sil/Compile.dcl
+++ b/Sil/Compile.dcl
@@ -17,6 +17,7 @@ from Sil.Types import :: Type, :: TypeError
| TypeError TypeError Expression
| CouldNotDeduceType Expression
| TypeMisMatch Type Expression
+ | BasicInitWithoutValue Name
| UnknownError
instance toString CompileError
diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index 9bfd4f5..254cc67 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -28,13 +28,14 @@ import Sil.Util.Printer
instance toString CompileError
where
- toString (UndefinedName n) = "Undefined name '" <+ n <+ "'."
- toString VariableLabel = "Variable stored at label."
- toString FunctionOnStack = "Function stored on the stack."
- toString (TypeError err e) = "Type error in '" <+ e <+ "': " <+ err
- toString (CouldNotDeduceType e) = "Could not deduce type of '" <+ e <+ "'."
- toString (TypeMisMatch t e) = "Type mismatch: expected " <+ t <+ " for '" <+ e <+ "'."
- toString UnknownError = "Unknown error."
+ toString (UndefinedName n) = "Undefined name '" <+ n <+ "'."
+ toString VariableLabel = "Variable stored at label."
+ toString FunctionOnStack = "Function stored on the stack."
+ toString (TypeError err e) = "Type error in '" <+ e <+ "': " <+ err
+ toString (CouldNotDeduceType e) = "Could not deduce type of '" <+ e <+ "'."
+ toString (TypeMisMatch t e) = "Type mismatch: expected " <+ t <+ " for '" <+ e <+ "'."
+ toString (BasicInitWithoutValue n) = "Basic value '" <+ n <+ "' must have an initial value."
+ toString UnknownError = "Unknown error."
error :: CompileError -> RWST r w s (MaybeError CompileError) a
error e = RWST \_ _ -> Error e
@@ -164,8 +165,8 @@ getTypeResolver = gets typeresolvers >>= \trs -> pure $ \n ->
[t:_] -> Just t
[] -> Nothing
-reserveVar :: Bool (Name, Type) -> Gen Address
-reserveVar canBeOnBStack (n,t) = gets stackoffsets >>= put
+reserveVar :: (Name, Type) -> Gen Address
+reserveVar (n,t) = gets stackoffsets >>= put
where
put :: (Int, Int) -> Gen Address
put (aso, bso) =
@@ -173,10 +174,9 @@ where
comment ("Reserved " <+ addr <+ " for " <+ n) $>
addr
where
- (so`, addr) = case (canBeOnBStack, typeSize t) of
- (False, _) -> ((aso+1, bso), AAddr $ aso+1)
- (True, {bsize=0}) -> ((aso+1, bso), AAddr $ aso+1)
- (True, {btypes}) -> ((aso, bso + length btypes), BAddr $ bso+1)
+ (so`, addr) = case typeSize t of
+ {asize,bsize=0} -> ((aso + asize, bso), AAddr $ aso + asize)
+ {asize=0,bsize} -> ((aso, bso + bsize), BAddr $ bso + bsize)
findVar :: Name -> Gen Address
findVar n = gets stackoffsets >>= \(aso, bso) ->
@@ -253,7 +253,7 @@ where
, 'ABC'.Label $ toLabel f.f_name
] *>
tell (repeatn retSize.asize 'ABC'.Create) *> growStack {retSize & bsize=0} *>
- mapM_ (reserveVar True) [(a.arg_name, a.arg_type) \\ a <- f.f_args] *>
+ mapM_ reserveVar [(a.arg_name, a.arg_type) \\ a <- f.f_args] *>
newReturn cleanup` *>
pushTypeResolver typeresolver *>
setReturnType f.f_type *>
@@ -303,7 +303,7 @@ where
gen cb =
storeStackOffsets *>
gets stackoffsets >>= \so ->
- mapM_ (reserveVar False) [(i.init_name, i.init_type) \\ i <- cb.cb_init] *>
+ mapM_ reserveVar [(i.init_name, i.init_type) \\ i <- cb.cb_init] *>
mapM_ gen cb.cb_init *>
addToReturn cleanup` *>
pushTypeResolver typeresolver *>
@@ -315,13 +315,21 @@ where
where
cleanup` = case cb.cb_init of
[] -> []
- _ -> [ 'ABC'.Pop_a locals ]
- locals = length cb.cb_init
+ _ -> [ 'ABC'.Pop_a locals.asize
+ , 'ABC'.Pop_b locals.bsize
+ ]
+ locals = foldr (+~) zero [typeSize i.init_type \\ i <- cb.cb_init]
typeresolver :: Name -> Maybe (MaybeError TypeError Type)
typeresolver n = listToMaybe [Ok i.init_type \\ i <- cb.cb_init | i.init_name == n]
-instance gen Initialisation where gen init = tell ['ABC'.Create]
+instance gen Initialisation
+where
+ gen init = case typeSize init.init_type of
+ s=:{bsize=0} -> tell $ repeatn s.asize 'ABC'.Create
+ s=:{asize=0} -> case init.init_value of
+ Nothing -> error $ BasicInitWithoutValue init.init_name
+ Just v -> gen v *> shrinkStack s
instance gen Statement
where
diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index 4d4b5eb..d5c97ef 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -137,9 +137,14 @@ codeblock = many initialisation >>= \is ->
initialisation :: Parser Token [Initialisation]
initialisation =
type >>= \t ->
- seplist TComma name >>= \ns ->
+ seplist TComma init >>= \nvs ->
item TSemicolon $>
- [{init_type=t, init_name=n} \\ n <- ns]
+ [{init_type=t, init_name=n, init_value=v} \\ (n,v) <- nvs]
+where
+ init =
+ name >>= \n ->
+ optional (item TAssign *> expression) >>= \v ->
+ pure (n,v)
statement :: Parser Token Statement
statement = declaration
diff --git a/Sil/Syntax.dcl b/Sil/Syntax.dcl
index 1b3b44a..669f2f6 100644
--- a/Sil/Syntax.dcl
+++ b/Sil/Syntax.dcl
@@ -28,8 +28,9 @@ from Sil.Types import :: Type
}
:: Initialisation =
- { init_type :: Type
- , init_name :: Name
+ { init_type :: Type
+ , init_name :: Name
+ , init_value :: Maybe Expression
}
:: Statement
diff --git a/Sil/Util/Printer.icl b/Sil/Util/Printer.icl
index ff9c3f2..3ed15fb 100644
--- a/Sil/Util/Printer.icl
+++ b/Sil/Util/Printer.icl
@@ -88,7 +88,11 @@ where
instance PrettyPrinter Initialisation
where
- print st init = st <+ init.init_type <+ " " <+ init.init_name <+ ";"
+ print st init = st <+ init.init_type <+ " " <+ init.init_name <+ val <+ ";"
+ where
+ val = case init.init_value of
+ Nothing -> ""
+ Just v -> " := " <+ v
instance PrettyPrinter Statement
where