From 808f960c6aa800b0d3dcde897959a8e26303ef7d Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Sat, 10 Sep 2022 19:20:11 +0100
Subject: Better interface

---
 app/Main.hs           |  2 +-
 src/Micro/Compiler.hs | 54 +++++++++++++++++++++++++++++----------------------
 test/Language.hs      |  2 +-
 3 files changed, 33 insertions(+), 25 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index e1be59d..9cf5d75 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -68,7 +68,7 @@ compileFile filename onlyParse = do
   case res of
     Left err -> hPutStrLn stderr (showParserError err) >> exitFailure
     Right ast -> do
-      res <- return $ evalState (compileAll ast) startState
+      res <- return $ compile ast
       case crExit res of
         Right out -> if onlyParse then exitSuccess else hPutStrLn stdout out
         Left errs -> hPutStr stderr (showErrorList errs) >> exitFailure
diff --git a/src/Micro/Compiler.hs b/src/Micro/Compiler.hs
index 4d6d7a8..d27960a 100644
--- a/src/Micro/Compiler.hs
+++ b/src/Micro/Compiler.hs
@@ -1,4 +1,9 @@
-module Micro.Compiler where
+module Micro.Compiler
+  ( version,
+    Result (..),
+    compile,
+  )
+where
 
 import Control.Monad.State
 import Data.Maybe (catMaybes, fromMaybe)
@@ -18,21 +23,21 @@ data CompState = CompState
   }
   deriving (Show)
 
-data CompResult = CompResult
+data Result = CompResult
   { -- last resolved type
-    crLast :: Maybe A.Type,
+    crType :: Maybe A.Type,
     -- only in last call
     crExit :: Either [Error] String
   }
 
-typeResult :: Maybe A.Type -> CompResult
-typeResult t = CompResult {crLast = t, crExit = Left []}
+typeResult :: Maybe A.Type -> Result
+typeResult t = CompResult {crType = t, crExit = Left []}
 
-errorResult :: [Error] -> CompResult
-errorResult err = CompResult {crLast = Nothing, crExit = Left err}
+errorResult :: [Error] -> Result
+errorResult err = CompResult {crType = Nothing, crExit = Left err}
 
-successResult :: String -> CompResult
-successResult out = CompResult {crLast = Nothing, crExit = Right out}
+successResult :: String -> Result
+successResult out = CompResult {crType = Nothing, crExit = Right out}
 
 startState :: CompState
 startState = CompState emptyEnv [] []
@@ -52,7 +57,7 @@ foldlEither fn init xs =
 
 -- | @addError error@ adds @error@ to the state and returns no type to allow
 -- the compilation to continue.
-addError :: Error -> State CompState CompResult
+addError :: Error -> State CompState Result
 addError e = do
   st <- get
   put st {stErr = e : stErr st}
@@ -66,8 +71,8 @@ typecheckCall args params
   | length params == 0 = pure Nothing
   | otherwise = do
       -- resolve all args types
-      rargs <- traverse compile args
-      let targs = map crLast rargs
+      rargs <- traverse compileOne args
+      let targs = map crType rargs
       case sequence targs of
         Just t
           -- after resolution, we could have less "rights"
@@ -88,8 +93,8 @@ showMaybet (Just t) = show t
 -- returning a string describing an error or Nothing in case of type match.
 typecheckVal :: A.Expr -> Maybe A.Type -> State CompState (Maybe String)
 typecheckVal value typ = do
-  r <- compile value
-  case crLast r of
+  r <- compileOne value
+  case crType r of
     rt
       | rt == typ -> pure Nothing
       | otherwise -> return $ Just $ "type mismatch\n     found: " ++ showMaybet rt ++ "\n  expected: " ++ showMaybet typ
@@ -103,10 +108,10 @@ typecheckReturn (Just value) fret = typecheckVal value fret
 
 -- | @typecheckBinOp a b pos@ resolves @a@ (left) and compares it to the type
 -- of @b@ via typecheckVal.
-typecheckBinOp :: A.Expr -> A.Expr -> SourcePos -> State CompState CompResult
+typecheckBinOp :: A.Expr -> A.Expr -> SourcePos -> State CompState Result
 typecheckBinOp a b pos = do
-  l <- compile a
-  let tl = crLast l
+  l <- compileOne a
+  let tl = crType l
   tr <- typecheckVal b $ tl
   case tr of
     Just err -> addError $ Error TypeError err pos
@@ -136,8 +141,8 @@ verifyFuncType ident params ret pos = do
       then [Error UndefinedType ("undefined return type in \"" ++ ident ++ "\"") pos]
       else []
 
-compile :: A.Expr -> State CompState CompResult
-compile x = do
+compileOne :: A.Expr -> State CompState Result
+compileOne x = do
   case x of
     (A.Module _ _) -> return $ typeResult Nothing
     (A.Num _ _) -> return $ typeResult $ Just $ A.Type "u8" -- TODO: placeholder
@@ -174,8 +179,8 @@ compile x = do
       where
         ftype = A.toFuncType params ret
     (A.Call ident args pos) -> do
-      r <- compile ident
-      case crLast r of
+      r <- compileOne ident
+      case crType r of
         Just (A.FuncType params rtyp) -> do
           r <- typecheckCall args params
           case r of
@@ -210,12 +215,15 @@ compile x = do
         Just Sym {symType = t} -> return $ typeResult $ Just t
         Nothing -> addError $ Error Undefined ("undefined \"" ++ ident ++ "\"") pos
 
-compileAll :: [A.Expr] -> State CompState CompResult
+compileAll :: [A.Expr] -> State CompState Result
 compileAll ast = do
-  _ <- traverse compile ast
+  _ <- traverse compileOne ast
   st <- get
   let (Env sym _) = stEnv st
   let errs = stErr st
   case errs of
     [] -> pure $ successResult $ generate version sym ast
     _ -> return $ errorResult errs
+
+compile :: [A.Expr] -> Result
+compile ast = evalState (compileAll ast) startState
diff --git a/test/Language.hs b/test/Language.hs
index 9f47008..95d5e75 100644
--- a/test/Language.hs
+++ b/test/Language.hs
@@ -24,7 +24,7 @@ expectError input etyp = do
   case r of
     Left e -> assertFailure $ show e
     Right ast -> do
-      res <- return $ evalState (compileAll ast) startState
+      res <- return $ compile ast
       case crExit res of
         Left e -> case (find (\(E.Error t _ _) -> t == etyp) e) of
           Just _ -> return ()
-- 
cgit v1.2.3