shithub: MicroHs

Download patch

ref: f4365f7c4698a7c2251704fd8aa699bf21208af7
parent: f5cacb9496b3a9e073d04b3eea27bae3fb37c4dc
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Tue Sep 19 13:12:54 EDT 2023

Refactor a little.

--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -52,7 +52,7 @@
     mapM_ (\ (i, e) -> putStrLn $ showIdent i ++ " = " ++ toStringP e "") ds
   if runIt flags then do
     let
-      prg = translate cmdl
+      prg = translateAndRun cmdl
 --    putStrLn "Run:"
 --    writeSerialized "ser.comb" prg
     prg
--- a/src/MicroHs/Translate.hs
+++ b/src/MicroHs/Translate.hs
@@ -1,7 +1,7 @@
 -- Copyright 2023 Lennart Augustsson
 -- See LICENSE file for full license.
 module MicroHs.Translate(
-  translate
+  translate, translateAndRun
   ) where
 import Prelude
 import Data.Maybe
@@ -18,17 +18,20 @@
 import MicroHs.Exp
 import MicroHs.Ident
 
-translate :: (Ident, [LDef]) -> IO ()
-translate (mainName, ds) = do
-  let
-    look m n = fromMaybe (error $ "not found " ++ showIdent n) $ M.lookup n m
-    mp = M.fromList [(n, trans (look mp) d) | (n, d) <- ds ]
-
+translateAndRun :: (Ident, [LDef]) -> IO ()
+translateAndRun defs = do
   -- Drop all argument up to '--'
   args <- getArgs
-  let prog = unsafeCoerce $ look mp mainName
+  let prog = unsafeCoerce $ translate defs
   withDropArgs (length (takeWhile (not . eqString "--") args) + 1)
     prog
+
+translate :: (Ident, [LDef]) -> Any
+translate (mainName, ds) =
+  let
+    look m n = fromMaybe (error $ "not found " ++ showIdent n) $ M.lookup n m
+    mp = M.fromList [(n, trans (look mp) d) | (n, d) <- ds ]
+  in look mp mainName
 
 trans :: (Ident -> Any) -> Exp -> Any
 trans r ae =
--