prepare usage of MicroHs backend

Author: Thomas Mahler

app/Main.hs

@@ -20,6 +20,7 @@ import qualified Data.Bifunctor
 import LambdaToSKI (compileBracket)
 import TermReducer
 import IonAssembly (toIon)
+import MicroHsExp (toMhsPrg)
 
 
 printGraph :: ST s (STRef s (Graph s)) -> ST s String
@@ -63,7 +64,7 @@ ackermann = [r|
 
 factorial :: SourceCode
 factorial = [r| 
-  fact = y(λf n. if (is0 n) 1 (* n (f (sub1 n))))
+  fact = y(λf n. if (eql n 0) 1 (* n (f (- n 1))))
   main = fact 100
 |]
 
@@ -73,6 +74,10 @@ fibonacci = [r|
   main = fib 10
 |]
 
+printMhs :: CL -> IO ()
+printMhs cl = do
+  --let (n, exps, prg) = toStringCMdl ([], toMhsExp cl)
+  putStrLn ("MicroHs expression: " ++ toMhsPrg cl)
 
 printCS :: CL -> IO ()
 printCS cl = do
@@ -98,17 +103,20 @@ showCompilations source = do
   putStrLn "The main expression compiled to SICKBY combinator expressions by recursice bracket abstraction:"
   print expr
   printCS expr
+  printMhs expr
   putStrLn ""
 
   putStrLn "applying plain Kiselyov compilation:"
   print $ compilePlain env
   printCS $ compilePlain env
+  printMhs $ compilePlain env
   putStrLn ""
 
   let exprK = compileK env
   putStrLn "The main expression compiled to SICKBY combinator expressions with K-optimization:"
   print exprK
   printCS exprK
+  printMhs exprK
   putStrLn ""
 
 

cabal.project

@@ -0,0 +1,6 @@
+packages: .
+
+source-repository-package
+    type: git
+    location: https://github.com/augustss/MicroHs.git
+    tag: 38cbb10b8f1bd5bee13d9afb2b15239d8c897000

lambda-ski.cabal

@@ -34,6 +34,7 @@ library
       IonAssembly
       Kiselyov
       LambdaToSKI
+      MicroHsExp
       Parser
       TermReducer
   other-modules:

src/MicroHsExp.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE OverloadedStrings #-}
+module MicroHsExp where
+
+import CLTerm
+import MicroHs.Exp
+import MicroHs.Expr
+import MicroHs.ExpPrint (toStringCMdl)
+import MicroHs.Desugar (LDef)
+import MicroHs.Ident
+
+{--
+
+data Exp
+  = Var Ident
+  | App Exp Exp
+  | Lam Ident Exp
+  | Lit Lit
+  deriving (Eq)
+
+type LDef = (Ident, Exp)
+
+data SLoc = SLoc FilePath Line Col
+type Line = Int
+type Col  = Int
+
+data Ident = Ident SLoc Text
+
+
+-- The argument is all definitions and the main expression.
+-- The result is the number of definitions, all foreign export identifiers, and the program as a string.
+toStringCMdl :: ([LDef], Exp) -> (Int, [Ident], String)
+
+
+--}
+
+example :: Exp
+example = Lit (LInt 42)
+  --Var sampleIdent
+  --`App` Lam sampleIdent (Var sampleIdent)
+  --`App` Lit (LInt 42)
+
+sampleIdent :: Ident
+sampleIdent = mkIdent "sample"
+
+samplePrg :: ([LDef], Exp)
+samplePrg = ([(sampleIdent, example)], example)
+
+addExp :: Exp
+addExp = App (Lit (LPrim "IO.print")) (App (App (Lit (LPrim "+")) (Lit (LInt 42))) (Lit (LInt 23)))
+
+addPrg :: ([LDef], Exp)
+addPrg = ([], addExp)
+
+
+toMhsExp :: CL -> Exp
+toMhsExp (Com c) = Lit (LPrim (show c))
+toMhsExp (INT i) = Lit (LInt (fromIntegral i))
+toMhsExp (t :@ u) = App (toMhsExp t) (toMhsExp u)
+
+toMhsPrg :: CL -> String
+toMhsPrg cl = let (n, exps, prg) = toStringCMdl ([], toMhsExp cl)
+              in prg
+
+toIon :: CL -> String
+toIon (Com c) = show c
+toIon (INT i) = "(" ++ show i ++ ")"
+toIon (t :@ u) = "`" ++ toIon t  ++ toIon u
+
+test :: CL
+test = Com B :@ Com S :@ (Com B :@ Com B)
+
+main :: IO ()
+main = do
+
+  let (n, exps, prg) = toStringCMdl addPrg
+  putStrLn $ "Number of definitions: " ++ show n
+  putStrLn $ "Foreign exports: " ++ show exps
+  putStrLn $ "Program: " ++ prg
+
+  -- let (n, exps, prg) = toStringCMdl samplePrg
+  -- putStrLn $ "Number of definitions: " ++ show n
+  -- putStrLn $ "Foreign exports: " ++ show exps
+  -- putStrLn $ "Program: " ++ prg
+
+  -- let mhsExp = toMhsExp test
+  -- putStrLn $ "MicroHs expression: " ++ show mhsExp
+
+  -- putStrLn $ "Test expression: " ++ (show $ toStringCMdl ([], mhsExp))

stack.yaml

@@ -37,8 +37,8 @@ packages:
 #
 extra-deps:
 #- MicroHs-0.10.5.0
-- git: https://github.com/thma/MicroHs
-  commit: a0426a5bc5e8461bd7937dd2ae1db9dea98724c2
+- git: https://github.com/augustss/MicroHs.git
+  commit: 38cbb10b8f1bd5bee13d9afb2b15239d8c897000
 
 
 # - acme-missiles-0.3