Cleanup

1 files changed, 36 insertions, 37 deletions

diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index e930c44..af82f3e 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -82,40 +82,15 @@ addresses cs = cs.addresses
 symbols :: CompileState -> 'M'.Map Name FunctionSymbol
 symbols cs = cs.symbols
 
-newReturn :: 'ABC'.Assembler CompileState -> CompileState
-newReturn ret cs = {cs & returns=[ret:cs.returns]}
-
-addToReturn :: 'ABC'.Assembler CompileState -> CompileState
-addToReturn ret cs=:{returns=[r:rs]} = {cs & returns=[ret ++ r:rs]}
-
-removeFromReturn :: Int CompileState -> CompileState
-removeFromReturn i cs=:{returns=[r:rs]} = {cs & returns=[drop i r:rs]}
-
-popReturn :: CompileState -> CompileState
-popReturn cs = {cs & returns=tl cs.returns}
-
 peekReturn :: CompileState -> 'ABC'.Assembler
 peekReturn cs = hd cs.returns
 
 stackoffset :: CompileState -> Int
 stackoffset cs = cs.stackoffset
 
-storeStackOffset :: CompileState -> CompileState
-storeStackOffset cs = {cs & storedoffsets=[cs.stackoffset:cs.storedoffsets]}
-
-restoreStackOffset :: CompileState -> CompileState
-restoreStackOffset cs = {cs & stackoffset=so, storedoffsets=sos}
-where [so:sos] = cs.storedoffsets
-
 typeresolvers :: CompileState -> [TypeResolver]
 typeresolvers cs = cs.typeresolvers
 
-pushTypeResolver :: TypeResolver CompileState -> CompileState
-pushTypeResolver tr cs = {cs & typeresolvers=[tr:cs.typeresolvers]}
-
-popTypeResolver :: CompileState -> CompileState
-popTypeResolver cs = {cs & typeresolvers=tl cs.typeresolvers}
-
 :: Gen a :== RWST () 'ABC'.Assembler CompileState (MaybeError CompileError) a
 
 fresh :: a -> Gen 'ABC'.Label | toString a
@@ -123,6 +98,30 @@ fresh n = gets labels
 	>>= \labs -> modify (\cs -> {cs & labels=tl labs})
 	$> n <+ hd labs
 
+storeStackOffset :: Gen ()
+storeStackOffset = modify \cs -> {cs & storedoffsets=[cs.stackoffset:cs.storedoffsets]}
+
+restoreStackOffset :: Gen ()
+restoreStackOffset = modify \cs=:{storedoffsets=[so:sos]} -> {cs & stackoffset=so, storedoffsets=sos}
+
+newReturn :: 'ABC'.Assembler -> Gen ()
+newReturn ret = modify \cs -> {cs & returns=[ret:cs.returns]}
+
+addToReturn :: 'ABC'.Assembler -> Gen ()
+addToReturn ret = modify \cs=:{returns=[r:rs]} -> {cs & returns=[ret ++ r:rs]}
+
+removeFromReturn :: Int -> Gen ()
+removeFromReturn i = modify \cs=:{returns=[r:rs]} -> {cs & returns=[drop i r:rs]}
+
+popReturn :: Gen ()
+popReturn = modify \cs -> {cs & returns=tl cs.returns}
+
+pushTypeResolver :: TypeResolver -> Gen ()
+pushTypeResolver tr = modify \cs -> {cs & typeresolvers=[tr:cs.typeresolvers]}
+
+popTypeResolver :: Gen ()
+popTypeResolver = modify \cs -> {cs & typeresolvers=tl cs.typeresolvers}
+
 getTypeResolver :: Gen TypeResolver
 getTypeResolver = gets typeresolvers >>= \trs -> pure $ \n ->
 	case catMaybes $ map (flip ($) n) trs of
@@ -174,10 +173,10 @@ where
 		     , 'ABC'.Fill "_" 0 "main" 0
 		     , 'ABC'.Jmp "_driver"
 		     ] *>
-		modify (pushTypeResolver typeresolver) *>
+		pushTypeResolver typeresolver *>
 		mapM_ addFunction p.p_funs *>
 		mapM_ gen p.p_funs *>
-		modify popTypeResolver
+		popTypeResolver
 	where
 		typeresolver :: Name -> Maybe (MaybeError TypeError Type)
 		typeresolver n = case [f \\ f <- p.p_funs | f.f_name == n] of
@@ -191,14 +190,14 @@ where
 		     , 'ABC'.Label f.f_name
 		     ] *>
 		foldM reserveVar locals [a.arg_name \\ a <- reverse f.f_args] *>
-		modify (newReturn cleanup`) *>
-		modify (pushTypeResolver typeresolver) *>
+		newReturn cleanup` *>
+		pushTypeResolver typeresolver *>
 		gen f.f_code *>
-		modify popTypeResolver *>
+		popTypeResolver *>
 		cleanup *>
 		modify (\cs -> {cs & stackoffset=0}) *>
 		tell ['ABC'.Rtn] *>
-		modify popReturn
+		popReturn
 	where
 		cleanup` = case f.f_args of
 			[] -> [ 'ABC'.Annotation $ 'ABC'.DAnnot retSize []
@@ -218,16 +217,16 @@ where
 instance gen CodeBlock
 where
 	gen cb =
-		modify storeStackOffset *>
+		storeStackOffset *>
 		foldM reserveVar 0 [i.init_name \\ i <- cb.cb_init] *>
 		mapM_ gen cb.cb_init *>
-		modify (addToReturn cleanup`) *>
-		modify (pushTypeResolver typeresolver) *>
+		addToReturn cleanup` *>
+		pushTypeResolver typeresolver *>
 		mapM_ gen cb.cb_content *>
-		modify popTypeResolver *>
+		popTypeResolver *>
 		tell cleanup` *>
-		modify (removeFromReturn $ length cleanup`) *>
-		modify restoreStackOffset
+		removeFromReturn (length cleanup`) *>
+		restoreStackOffset
 	where
 		cleanup` = case cb.cb_init of
 			[] -> []