Refactor, return MaybeError from lookupFunction and lookupConstructor

1 files changed, 22 insertions, 20 deletions

diff --git a/snug-clean/src/Snug/Compile.icl b/snug-clean/src/Snug/Compile.icl
index de7078a..8c23134 100644
--- a/snug-clean/src/Snug/Compile.icl
+++ b/snug-clean/src/Snug/Compile.icl
@@ -5,12 +5,14 @@ import StdEnv
 import Control.Monad
 import Control.Monad.Fail
 import Control.Monad.State
+import Control.Monad.Trans
 import Data.Error
 import Data.Func
 import Data.Functor
 import Data.List
 import qualified Data.Map
 from Data.Map import :: Map
+from Text import concat4
 
 import MIPS.MIPS32
 import Snug.Compile.ABI
@@ -69,11 +71,15 @@ gatherGlobals ns defs =
 		]
 	}
 
-lookupConstructor :: !Namespace !ConstructorIdent !Globals -> ?ConstructorDef
-lookupConstructor ns id globs = 'Data.Map'.get {ns=ns, id=id} globs.constructors
+lookupConstructor :: !Namespace !ConstructorIdent !Globals -> MaybeError String ConstructorDef
+lookupConstructor ns id globs = mb2error
+	(concat4 "Unknown constructor " ns "." id)
+	('Data.Map'.get {ns=ns, id=id} globs.constructors)
 
-lookupFunction :: !Namespace !SymbolIdent !Globals -> ?FunctionInfo
-lookupFunction ns id globs = 'Data.Map'.get {ns=ns, id=id} globs.functions
+lookupFunction :: !Namespace !SymbolIdent !Globals -> MaybeError String FunctionInfo
+lookupFunction ns id globs = mb2error
+	(concat4 "Unknown symbol " ns "." id)
+	('Data.Map'.get {ns=ns, id=id} globs.functions)
 
 compileDefinition :: !Namespace !Globals !Definition -> CompileM [Line]
 compileDefinition _ _ (TypeDef _ _) = pure
@@ -138,30 +144,26 @@ simulator ns globals locals (Symbol id) =
 		?Just (FrontPtrArg i) ->
 			stackSize >>= \n ->
 			pushArg (n-1) i
-		?None -> case lookupFunction ns id globals of
-			?None -> fail ("unknown symbol: " +++ id)
-			?Just info ->
-				case info.arity of
-					0 ->
-						buildThunk (functionLabel ns NodeEntry id) 0
-					_ ->
-						fail "symbol with arity > 0" // TODO implement
+		?None ->
+			liftT (lookupFunction ns id globals) >>= \info -> case info.arity of
+				0 ->
+					buildThunk (functionLabel ns NodeEntry id) 0
+				_ ->
+					fail "symbol with arity > 0" // TODO implement
 simulator ns globals locals expr=:(ExpApp _ _) =
 	case f of
 		Symbol id -> // TODO include locals
-			case lookupFunction ns id globals of
-				?None -> fail ("unknown symbol: " +++ id)
-				?Just info | info.arity == length args ->
+			liftT (lookupFunction ns id globals) >>= \info
+				| info.arity == length args ->
 					mapM_ (simulator ns globals locals) (reverse args) >>|
 					buildThunk (functionLabel ns NodeEntry id) info.arity
-				_ -> fail "arity mismatch in application" // TODO implement
+				| otherwise -> fail "arity mismatch in application" // TODO implement
 		Constructor id ->
-			case lookupConstructor ns id globals of
-				?None -> fail ("unknown constructor: " +++ id)
-				?Just (ConstructorDef _ arg_types) | length arg_types == length args ->
+			liftT (lookupConstructor ns id globals) >>= \(ConstructorDef _ arg_types)
+				| length arg_types == length args ->
 					mapM_ (simulator ns globals locals) (reverse args) >>|
 					buildCons (constructorLabel ns id) (length args)
-				_ -> fail ("arity mismatch in application of " +++ id) // TODO implement
+				| otherwise -> fail ("arity mismatch in application of " +++ id) // TODO implement
 		_ -> // TODO
 			fail "unexpected lhs of function application"
 where