Rework IL Ast

distiller/src/Lib.hs

@@ -2,10 +2,10 @@ module Lib (
     someFunc,
 ) where
 
-import Syntax
+import Ast
 
-f :: Expression
-f = Lambda "x" (Variable "x")
+f :: Expr
+f = Lam (VarName "x") (Var $ VarName "x")
 
 someFunc :: IO ()
 someFunc = print f

lang/app/Main.hs

@@ -1,30 +1,39 @@
 module Main (main) where
 
-import Syntax
+import Ast
+import Data.Map.Strict as Map
+import Text.PrettyPrint.Leijen.Text (pretty)
 
 {-
 append xs ys = λ xs . λ ys . case xs of
     Nil => ys
     Cons x' xs' => Cons x' (append xs' ys)
 -}
 
-bodyOfAppend :: Expression
+bodyOfAppend :: Expr
 bodyOfAppend =
     Case
-        (Variable "xs")
-        [ (Pat "Nil" [], Variable "ys")
-        ,
-            ( Pat "Cons" ["x'", "xs'"]
-            , Constructor "Cons" [Variable "x'", Application (Application (Function "append") (Variable "xs'")) (Variable "ys")]
-            )
-        ]
+        (Var $ VarName "xs")
+        $ Map.fromList
+            [ (ConName "Nil", Alt [] (Var $ VarName "ys"))
+            ,
+                ( ConName "Cons"
+                , Alt
+                    [VarName "x'", VarName "xs'"]
+                    ( Con (ConName "Cons") [Var $ VarName "x'", App (App (Fun $ FunName "append") (Var $ VarName "xs'")) (Var $ VarName "ys")]
+                    )
+                )
+            ]
 
-appendInExp :: FunctionHeader
+appendInExp :: Expr
 appendInExp =
-    Header
-        "append"
-        ["xs", "ys"]
-        (Lambda "xs" (Lambda "ys" bodyOfAppend))
+    App
+        ( Fun
+            (FunName "append")
+        )
+        (Lam (VarName "xs") (Lam (VarName "ys") bodyOfAppend))
 
 main :: IO ()
-main = print appendInExp
+main = do
+    print $ appendInExp
+    print $ pretty appendInExp

lang/lang.cabal

@@ -25,7 +25,7 @@ source-repository head
 
 library
   exposed-modules:
-      Syntax
+      Ast
   other-modules:
       Paths_lang
   autogen-modules:
@@ -37,7 +37,9 @@ library
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
+    , containers
     , text
+    , wl-pprint-text
   default-language: GHC2021
 
 executable lang-exe
@@ -53,8 +55,10 @@ executable lang-exe
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , containers
     , lang
     , text
+    , wl-pprint-text
   default-language: GHC2021
 
 test-suite lang-test
@@ -71,6 +75,8 @@ test-suite lang-test
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , containers
     , lang
     , text
+    , wl-pprint-text
   default-language: GHC2021

lang/package.yaml

@@ -22,6 +22,8 @@ description: Please see the README on GitHub at <https://github.com/Lamagraph/in
 dependencies:
   - base >= 4.7 && < 5
   - text
+  - wl-pprint-text
+  - containers
 
 language: GHC2021
 

lang/src/Ast.hs

@@ -0,0 +1,102 @@
+{-# LANGUAGE InstanceSigs #-}
+
+{- | Basic IL datatypes
+
+The grammar is based on [A Hierarchy of Program Transformers](https://www.researchgate.net/publication/229062264_A_Hierarchy_of_Program_Transformers).
+-}
+module Ast (
+    Expr (Var, Con, Lam, Fun, App, Case, Let),
+    Fun (FunName, funName),
+    Var (VarName, varName),
+    Con (ConName, conName),
+    Alt (Alt),
+) where
+
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Text (Text)
+
+import Text.PrettyPrint.Leijen.Text (
+    Doc,
+    Pretty,
+    align,
+    hsep,
+    parens,
+    pretty,
+    text,
+    textStrict,
+    vsep,
+    (<+>),
+ )
+
+-- | Function name, must be lowercase
+newtype Fun = FunName {funName :: Text}
+    deriving (Show)
+
+instance Pretty Fun where
+    pretty :: Fun -> Doc
+    pretty fun = textStrict $ funName fun
+
+-- | Variable name, must be lowercase
+newtype Var = VarName {varName :: Text}
+    deriving (Show)
+
+instance Pretty Var where
+    pretty :: Var -> Doc
+    pretty var = textStrict $ varName var
+
+-- | Constructor name, must start with uppercase letter
+newtype Con = ConName {conName :: Text}
+    deriving (Show, Ord, Eq)
+
+instance Pretty Con where
+    pretty :: Con -> Doc
+    pretty con = textStrict $ conName con
+
+-- | Case pattern-matching alternatives map
+type Alts = Map Con Alt
+
+instance Pretty Alts where
+    pretty :: Alts -> Doc
+    pretty alts = vsep $ map (\(con, alt) -> pretty con <+> pretty alt) list
+      where
+        list = Map.toList alts
+
+-- | Case pattern-matching alternative
+data Alt = Alt [Var] Expr
+    deriving (Show)
+
+instance Pretty Alt where
+    pretty :: Alt -> Doc
+    pretty (Alt vars expr) = hsep (fmap pretty vars) <> text " => " <> pretty expr
+
+-- | IL expression type
+data Expr
+    = -- | Variable
+      Var Var
+    | -- | Sum type constructor with arbitrary expression inside
+      Con Con [Expr]
+    | -- | Lambda abstraction
+      Lam Var Expr
+    | -- | Function call
+      Fun Fun
+    | -- | Expressions' application
+      App Expr Expr
+    | -- | Pattern-matching using case, patterns must be non-overlapping and exhaustive
+      Case Expr Alts
+    | -- | Simple let expression, can be introduced only by distillation
+      Let Var Expr Expr
+    deriving (Show)
+
+{- | PPrinting currently is very simple and only used for debugging.
+Most probably will change after source language design.
+-}
+instance Pretty Expr where
+    pretty :: Expr -> Doc
+    pretty (Var var) = pretty var
+    pretty (Con con exprs) = pretty con <+> hsep (fmap pretty exprs)
+    pretty (Lam var expr) = text "\\" <> pretty var <> text "." <> pretty expr
+    pretty (Fun fun) = pretty fun
+    pretty (App expr1 expr2) = parens (pretty expr1) <+> parens (pretty expr2)
+    pretty (Case expr alts) = text "case" <+> pretty expr <+> text "of" <+> align (pretty alts)
+    pretty (Let var varExpr expr) = text "let" <+> pretty var <+> text "=" <+> pretty varExpr <+> text "in" <+> pretty expr