[#23] Implemented Frontend lang -> ALang conversion pass

Added multi-argument apply and multi-argument lambdas to frontend language

core/package.yaml

@@ -79,7 +79,6 @@ library:
   - Ohua.ParseTools.Refs
   - Ohua.ALang.Lang
   - Ohua.ALang.Refs
-  - Ohua.ALang.NS
   - Ohua.ALang.PPrint
   - Ohua.ALang.Passes
   - Ohua.ALang.Passes.SSA
@@ -97,6 +96,7 @@ library:
   - Ohua.DFGraph
   - Ohua.DFGraph.Show
   - Ohua.Frontend.Lang
+  - Ohua.Frontend.NS
   - Ohua.Serialize.JSON
   - Ohua.Stage
   - Ohua.Util

core/src/Ohua/ALang/Passes.hs

@@ -218,10 +218,10 @@ removeCurrying e = fst <$> evalRWST (para inlinePartials e) mempty ()
 -- | Ensures the expression is a sequence of let statements terminated
 -- with a local variable.
 hasFinalLet :: MonadOhua m => Expression -> m ()
-hasFinalLet = Plate.para $ \case
-    Let{} -> \[_, _, body] -> body
-    Var{} -> \[] -> return ()
-    _ -> \_ -> failWith "Final value is not a var"
+hasFinalLet = cata $ \case
+    LetF _ _ body -> body
+    VarF{} -> return ()
+    _ -> failWith "Final value is not a var"
 
 -- | Ensures all of the optionally provided stateful function ids are unique.
 noDuplicateIds :: MonadError Error m => Expression -> m ()

core/src/Ohua/Frontend/Lang.hs

@@ -1,29 +1,47 @@
-module Ohua.Frontend.Lang where
+{-# LANGUAGE TemplateHaskell #-}
+module Ohua.Frontend.Lang
+  ( Pat(..)
+  , Expr(..)
+  , PatF(..)
+  , ExprF(..)
+  , toAlang
+  ) where
 
 import Ohua.Prelude
 
+import Data.Functor.Foldable (cata)
 import Data.Functor.Foldable.TH (makeBaseFunctor)
 import Data.Generics.Uniplate.Direct
+import Control.Category ((>>>))
+
+import Ohua.ALang.Lang hiding (Expr, ExprF)
+import qualified Ohua.ALang.Lang as AL
+import qualified Ohua.ALang.Refs as Refs
+import Ohua.ParseTools.Refs (smapBuiltin, ifBuiltin)
+
 
 data Pat
     = VarP Binding
     | TupP [Pat]
+    | UnitP
     deriving (Show, Eq, Generic)
 
 data Expr
     = VarE Binding
     | LitE Lit
     | LetE Pat Expr Expr
-    | AppE Expr Expr
-    | LambdaE Pat Expr
+    | AppE Expr [Expr]
+    | LamE [Pat] Expr -- ^ An expression creating a function
     | IfE Expr Expr Expr
     | MapE Expr Expr
-    | BindE Expr Expr
-    | StmtE Expr Expr
+    | BindE Expr Expr -- ^ Bind a state value to a function
+    | StmtE Expr Expr -- ^ An expression with the return value ignored
     | SeqE Expr Expr
-    | TupE [Expr]
+    | TupE [Expr] -- ^ create a tuple value that can be destructured
     deriving (Show, Eq, Generic)
 
+
+
 makeBaseFunctor ''Pat
 
 instance Uniplate Pat where
@@ -40,8 +58,8 @@ makeBaseFunctor ''Expr
 instance Uniplate Expr where
     uniplate = \case
         LetE p e1 e2 -> plate (LetE p) |* e1 |* e2
-        AppE e2 e2 -> plate AppE |* e1 |* e2
-        LambdaE p e -> plate (LambdaE p) |* e
+        AppE e1 e2 -> plate AppE |* e1 ||* e2
+        LamE p e -> plate (LamE p) |* e
         IfE e1 e2 e3 -> plate IfE |* e1 |* e2 |* e3
         MapE e1 e2 -> plate MapE |* e1 |* e2
         BindE e1 e2 -> plate BindE |* e1 |* e2
@@ -53,8 +71,8 @@ instance Uniplate Expr where
 instance Biplate Expr Pat where
     biplate = \case
         LetE p e1 e2 -> plate LetE |* p |+ e1 |+ e2
-        AppE e2 e2 -> plate AppE |+ e1 |+ e2
-        LambdaE p e -> plate LambdaE |* p |+ e
+        AppE e1 e2 -> plate AppE |+ e1 ||+ e2
+        LamE p e -> plate LamE ||* p |+ e
         IfE e1 e2 e3 -> plate IfE |+ e1 |+ e2 |+ e3
         MapE e1 e2 -> plate MapE |+ e1 |+ e2
         BindE e1 e2 -> plate BindE |+ e1 |+ e2
@@ -65,3 +83,66 @@ instance Biplate Expr Pat where
 
 instance Hashable Expr
 instance NFData Expr
+
+
+toAlang :: MonadOhua m => Expr -> m AL.Expr
+toAlang = mkSingleLamApply >>> removeDestructuring >=> trans
+  where
+    mkSingleLamApply =
+        rewrite $ \case
+            LamE (x1:x2:xs) b -> Just $ LamE [x1] $ LamE (x2 : xs) b
+            other -> Nothing
+    removeDestructuring =
+        rewriteM $ \case
+            LetE (TupP bnds) e1 e2 -> do
+                valBnd <- generateBinding
+                pure $ Just $ LetE (VarP valBnd) e1 $ unstructure valBnd bnds e2
+            LamE [TupP bnds] e -> do
+                valBnd <- generateBinding
+                pure $ Just $ LamE [VarP valBnd] $ unstructure valBnd bnds e
+            _ -> pure Nothing
+    nthFun = LitE $ FunRefLit $ FunRef "ohua.lang/nth" Nothing
+    unstructure valBnd bnds =
+        foldl (.) id $
+        map
+            (\(idx, bnd) ->
+                 LetE bnd $ AppE nthFun [LitE (NumericLit idx), VarE valBnd])
+            (zip [0 ..] bnds)
+    sfE name = Lit $ FunRefLit $ FunRef name Nothing
+    trans =
+        cata $
+        sequence >=> \case
+            VarEF b -> pure $ Var b
+            LitEF l -> pure $ Lit l
+            LetEF p e1 e2 ->
+                case p of
+                    VarP b -> pure $ Let b e1 e2
+                    _ ->
+                        throwErrorDebugS $
+                        "Invariant broken: Found destructure pattern: " <> show p
+            AppEF e1 e2
+                | null e2 -> pure $ e1 `Apply` Lit UnitLit
+                | otherwise -> pure $ foldl Apply e1 e2
+            LamEF p e ->
+                case p of
+                    [] -> pure $ Lambda "_" e
+                    [VarP b] -> pure $ Lambda b e
+                    _ ->
+                        throwErrorDebugS $
+                        "Invariant broken: Found multi apply or destucture lambda: " <>
+                        show p
+            IfEF cont then_ else_ ->
+                pure $
+                ifBuiltin `Apply` cont `Apply` Lambda "_" then_ `Apply`
+                Lambda "_" else_
+            MapEF function coll -> do
+                lamBnd <- generateBinding
+                pure $
+                    smapBuiltin `Apply`
+                    Lambda lamBnd (function `Apply` Var lamBnd) `Apply`
+                    coll
+            BindEF e1 e2 ->
+                throwError "State binding not yet implemented in ALang"
+            StmtEF e1 cont -> pure $ Let "_" e1 cont
+            SeqEF source target -> throwError "Seq not yet implemented"
+            TupEF parts -> pure $ foldl Apply (sfE Refs.mkTuple) parts

core/src/Ohua/ALang/NS.hs → core/src/Ohua/Frontend/NS.hs

@@ -11,7 +11,7 @@
 --
 {-# LANGUAGE DeriveLift, TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module Ohua.ALang.NS
+module Ohua.Frontend.NS
     ( FunAnn(..)
     , Imports
     , Namespace

core/src/Ohua/Unit.hs

@@ -3,7 +3,6 @@ module Ohua.Unit where
 import Ohua.Prelude
 
 import Ohua.ALang.Lang
-import Ohua.Constants.HostExpr as HEConst
 import Ohua.DFLang.Lang