diff options
Diffstat (limited to 'Sil')
| -rw-r--r-- | Sil/Check.icl | 3 | ||||
| -rw-r--r-- | Sil/Compile.dcl | 1 | ||||
| -rw-r--r-- | Sil/Compile.icl | 44 | ||||
| -rw-r--r-- | Sil/Parse.icl | 9 | ||||
| -rw-r--r-- | Sil/Syntax.dcl | 5 | ||||
| -rw-r--r-- | Sil/Util/Printer.icl | 6 |
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 |