diff options
Diffstat (limited to 'Sil/Compile.icl')
| -rw-r--r-- | Sil/Compile.icl | 52 |
1 files changed, 26 insertions, 26 deletions
diff --git a/Sil/Compile.icl b/Sil/Compile.icl index 5e0aec1..41dad98 100644 --- a/Sil/Compile.icl +++ b/Sil/Compile.icl @@ -185,8 +185,8 @@ popTypeResolver = modify \cs -> {cs & typeresolvers=tl cs.typeresolvers} getTypeResolver :: Gen TypeResolver getTypeResolver = gets typeresolvers >>= \trs -> pure $ \n -> case catMaybes $ map (flip ($) n) trs of - [t:_] -> Just t - [] -> Nothing + [t:_] -> ?Just t + [] -> ?None reserveVar :: (Name, Type) -> Gen Address reserveVar (n,t) = gets stackoffsets >>= put @@ -204,9 +204,9 @@ where findVar :: ParsePosition Name -> Gen Address findVar p n = gets stackoffsets >>= \(aso, bso) -> gets addresses >>= \addr -> case 'Data.Map'.get n addr of - Just (AAddr i) -> comment (n <+ " is on AStack at " <+ i <+ ", with aso " <+ aso <+ " so " <+ (aso-i)) $> AAddr (aso - i) - Just (BAddr i) -> comment (n <+ " is on BStack at " <+ i <+ ", with bso " <+ bso <+ " so " <+ (bso-i)) $> BAddr (bso - i) - Nothing -> error $ C_UndefinedName (errpos p) n + ?Just (AAddr i) -> comment (n <+ " is on AStack at " <+ i <+ ", with aso " <+ aso <+ " so " <+ (aso-i)) $> AAddr (aso - i) + ?Just (BAddr i) -> comment (n <+ " is on BStack at " <+ i <+ ", with bso " <+ bso <+ " so " <+ (bso-i)) $> BAddr (bso - i) + ?None -> error $ C_UndefinedName (errpos p) n addFunction :: Function -> Gen () addFunction f = modify (\cs -> {cs & symbols='Data.Map'.put f.f_name fs cs.symbols}) @@ -235,9 +235,9 @@ where getType :: Expression -> Gen Type getType e = getTypeResolver >>= \tr -> case type tr e of - Nothing -> error $ C_CouldNotDeduceType e - Just (Error err) -> error err - Just (Ok t) -> pure $ t + ?None -> error $ C_CouldNotDeduceType e + ?Just (Error err) -> error err + ?Just (Ok t) -> pure $ t checkType :: Type Expression -> Gen () checkType t e = getType e >>= \t` -> if (t == t`) nop (error $ C_TypeMisMatch t e t`) @@ -291,12 +291,12 @@ where mapM_ gen p.p_funs *> popTypeResolver where - typeresolver :: Name -> Maybe (MaybeError Error Type) + typeresolver :: Name -> ?(MaybeError Error Type) typeresolver n = case [f \\ f <- p.p_funs | f.f_name == n] of [f:_] -> type typeresolver f [] -> case [g.init_type \\ g <- p.p_globals | g.init_name == n] of - [t:_] -> Just $ Ok t - [] -> Nothing + [t:_] -> ?Just $ Ok t + [] -> ?None instance gen Function where @@ -329,7 +329,7 @@ where ] retSize = typeSize f.f_type - typeresolver :: Name -> Maybe (MaybeError Error Type) + typeresolver :: Name -> ?(MaybeError Error Type) typeresolver n = listToMaybe [Ok a.arg_type \\ a <- f.f_args | a.arg_name == n] mainBootstrap :: Gen () @@ -389,18 +389,18 @@ where ] locals = foldr (+~) zero [typeSize i.init_type \\ i <- cb.cb_init] - typeresolver :: Name -> Maybe (MaybeError Error Type) + typeresolver :: Name -> ?(MaybeError Error Type) typeresolver n = listToMaybe [Ok i.init_type \\ i <- cb.cb_init | i.init_name == n] instance gen Initialisation where gen init = case typeSize init.init_type of s=:{bsize=0} -> case init.init_value of - Nothing -> tell $ repeatn s.asize 'ABC'.Create - Just v -> shrinkStack s *> gen v + ?None -> tell $ repeatn s.asize 'ABC'.Create + ?Just v -> shrinkStack s *> gen v s=:{asize=0} -> case init.init_value of - Nothing -> error $ C_BasicInitWithoutValue (errpos init) init.init_name - Just v -> checkType init.init_type v *> shrinkStack s *> gen v + ?None -> error $ C_BasicInitWithoutValue (errpos init) init.init_name + ?Just v -> checkType init.init_type v *> shrinkStack s *> gen v instance gen Statement where @@ -422,10 +422,10 @@ where comment "Application" *> gen e *> getTypeResolver >>= \tr -> case fmap typeSize <$> type tr e of - Just (Ok sz) -> tell ['ABC'.Pop_a sz.asize, 'ABC'.Pop_b sz.bsize] *> shrinkStack sz - Just (Error err) -> error err - Nothing -> error $ C_CouldNotDeduceType e - gen (Return _ (Just e)) = + ?Just (Ok sz) -> tell ['ABC'.Pop_a sz.asize, 'ABC'.Pop_b sz.bsize] *> shrinkStack sz + ?Just (Error err) -> error err + ?None -> error $ C_CouldNotDeduceType e + gen (Return _ (?Just e)) = comment "Return" *> gen e *> gets returnType >>= \rettype -> @@ -441,7 +441,7 @@ where updateReturnFrame {asize=0,bsize=0} _ = nop updateReturnFrame {bsize=0} (aso, _) = tell ['ABC'.Update_a 0 (aso-1), 'ABC'.Pop_a 1] // TODO should depend on return type updateReturnFrame _ (_, bso) = tell ['ABC'.Update_b 0 (bso-1)] // TODO should depend on return type - gen (Return _ Nothing) = + gen (Return _ ?None) = comment "Return" *> cleanup *> tell ['ABC'.Rtn] @@ -464,9 +464,9 @@ where tell [ 'ABC'.Jmp end , 'ABC'.Label else ] - genelse :: 'ABC'.Label (Maybe CodeBlock) -> Gen () - genelse end Nothing = tell ['ABC'.Label end] - genelse end (Just cb) = gen cb *> tell ['ABC'.Label end] + genelse :: 'ABC'.Label (?CodeBlock) -> Gen () + genelse end ?None = tell ['ABC'.Label end] + genelse end (?Just cb) = gen cb *> tell ['ABC'.Label end] gen (While _ cond do) = checkType TBool cond *> fresh "while" >>= \loop -> fresh "whileend" >>= \end -> @@ -492,7 +492,7 @@ where tell ['ABC'.PushI i] *> growStack {zero & bsize=1,btypes=['ABC'.BT_Int]} gen (App p n args) = gets symbols >>= \syms -> case 'Data.Map'.get n syms of - Just fs -> + ?Just fs -> comment "Retrieve arguments" *> mapM gen args *> comment "Apply function" *> |