diff options
Diffstat (limited to 'Sil')
| -rw-r--r-- | Sil/Compile.icl | 55 |
1 files changed, 31 insertions, 24 deletions
diff --git a/Sil/Compile.icl b/Sil/Compile.icl index 22b6532..7e836b8 100644 --- a/Sil/Compile.icl +++ b/Sil/Compile.icl @@ -129,7 +129,13 @@ getTypeResolver = gets typeresolvers >>= \trs -> pure $ \n -> [] -> Nothing reserveVar :: Int Name -> Gen Int -reserveVar i n = modify (\cs -> {cs & addresses='M'.put n i cs.addresses}) $> (i+1) +reserveVar i n = modify (\cs -> {cs & addresses='M'.put n i cs.addresses}) *> comment ("Reserved " <+ i <+ " for " <+ n) $> (i+1) + +findVar :: Name -> Gen Int +findVar n = gets stackoffset >>= \so -> + gets addresses >>= \addr -> case 'M'.get n addr of + Just i -> comment (n <+ " is at " <+ i <+ ", with so " <+ so <+ " so " <+ (so-i-1)) $> so - i - 1 + Nothing -> error $ UndefinedName n addFunction :: Function -> Gen () addFunction f = modify (\cs -> {cs & symbols='M'.put f.f_name fs cs.symbols}) @@ -189,7 +195,9 @@ where tell [ 'ABC'.Annotation $ 'ABC'.OAnnot args [] , 'ABC'.Label $ toLabel f.f_name ] *> - foldM reserveVar locals [a.arg_name \\ a <- reverse f.f_args] *> + tell (repeatn retSize 'ABC'.Create) *> growStack retSize *> + foldM reserveVar 0 [a.arg_name \\ a <- f.f_args] *> + growStack (sum [typeSize a.arg_type \\ a <- f.f_args]) *> newReturn cleanup` *> pushTypeResolver typeresolver *> gen f.f_code *> @@ -199,17 +207,13 @@ where tell ['ABC'.Rtn] *> popReturn where - cleanup` = case f.f_args of - [] -> [ 'ABC'.Annotation $ 'ABC'.DAnnot retSize [] - ] - _ -> [ 'ABC'.Comment "Cleanup"] ++ - [ 'ABC'.Update_a i (args+i) \\ i <- [0..retSize-1] ] ++ - [ 'ABC'.Pop_a args - , 'ABC'.Annotation $ 'ABC'.DAnnot retSize [] - ] + cleanup` = + [ 'ABC'.Comment "Cleanup" + , '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 typeresolver :: Name -> Maybe (MaybeError TypeError Type) typeresolver n = listToMaybe [Ok a.arg_type \\ a <- f.f_args | a.arg_name == n] @@ -218,7 +222,8 @@ instance gen CodeBlock where gen cb = storeStackOffset *> - foldM reserveVar 0 [i.init_name \\ i <- cb.cb_init] *> + gets stackoffset >>= \so -> + foldM reserveVar so [i.init_name \\ i <- cb.cb_init] *> mapM_ gen cb.cb_init *> addToReturn cleanup` *> pushTypeResolver typeresolver *> @@ -242,13 +247,13 @@ where instance gen Statement where - gen st=:(Declaration n e) = gets addresses >>= \addrs -> case 'M'.get n addrs of - Just i -> checkTypeName n e *> - comment (toString st) *> - gen e *> - tell ['ABC'.Update_a 0 $ i+1, 'ABC'.Pop_a 1] *> // TODO should depend on size of return type - shrinkStack 1 - _ -> liftT $ Error $ UndefinedName n + gen st=:(Declaration n e) = + checkTypeName n e *> + comment (toString st) *> + gen e *> + findVar n >>= \loc -> + tell ['ABC'.Update_a 0 loc, 'ABC'.Pop_a 1] *> // TODO should depend on size of return type + shrinkStack 1 gen (Application e) = comment "Application" *> gen e *> @@ -260,6 +265,10 @@ where gen (Return (Just e)) = comment "Return" *> gen e *> + gets stackoffset >>= \so -> + tell [ 'ABC'.Update_a 0 (so-1) + , 'ABC'.Pop_a 1 + ] *> shrinkStack 1 *> cleanup *> tell ['ABC'.Rtn] gen (Return Nothing) = @@ -277,6 +286,7 @@ where genifblock end (cond, cb) = checkType TBool cond *> fresh "ifelse" >>= \else -> + comment ("(else) if " <+ cond) *> gen cond *> toBStack 'ABC'.BT_Bool 1 *> tell [ 'ABC'.JmpFalse else ] *> @@ -301,11 +311,8 @@ where instance gen Expression where gen (Name n) = - gets stackoffset >>= \so -> - gets addresses >>= \addrs -> - case 'M'.get n addrs of - Just i -> tell ['ABC'.Push_a $ i + so] *> growStack 1 - _ -> liftT $ Error $ UndefinedName n + findVar n >>= \loc -> + tell ['ABC'.Push_a $ loc] *> growStack 1 gen (Literal (BLit b)) = tell ['ABC'.Create, 'ABC'.FillB b 0] *> growStack 1 gen (Literal (ILit i)) = tell ['ABC'.Create, 'ABC'.FillI i 0] *> growStack 1 gen (App n args) = gets addresses >>= \addrs -> case 'M'.get n addrs of |