Rework AST

.pre-commit-config.yaml

@@ -7,7 +7,7 @@ repos:
       - id: check-yaml
       - id: fix-byte-order-marker
       - id: mixed-line-ending
-  - repo: https://github.com/pre-commit/mirrors-prettier
-    rev: v4.0.0-alpha.8
-    hooks:
-      - id: prettier
+    # - repo: https://github.com/pre-commit/mirrors-prettier
+    #   rev: v4.0.0-alpha.8
+    #   hooks:
+    #     - id: prettier

distiller/distiller.cabal

@@ -32,11 +32,14 @@ library
       Paths_distiller
   hs-source-dirs:
       src
+  default-extensions:
+      OverloadedStrings
   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
     , lang
-  default-language: Haskell2010
+    , text
+  default-language: GHC2021
 
 executable distiller-exe
   main-is: Main.hs
@@ -46,12 +49,15 @@ executable distiller-exe
       Paths_distiller
   hs-source-dirs:
       app
+  default-extensions:
+      OverloadedStrings
   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
     , distiller
     , lang
-  default-language: Haskell2010
+    , text
+  default-language: GHC2021
 
 test-suite distiller-test
   type: exitcode-stdio-1.0
@@ -62,9 +68,12 @@ test-suite distiller-test
       Paths_distiller
   hs-source-dirs:
       test
+  default-extensions:
+      OverloadedStrings
   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
     , distiller
     , lang
-  default-language: Haskell2010
+    , text
+  default-language: GHC2021

distiller/package.yaml

@@ -22,6 +22,12 @@ description: Please see the README on GitHub at <https://github.com/KubEF/distil
 dependencies:
   - base >= 4.7 && < 5
   - lang
+  - text
+
+language: GHC2021
+
+default-extensions:
+  - OverloadedStrings
 
 ghc-options:
   - -Wall

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,17 +25,22 @@ source-repository head
 
 library
   exposed-modules:
-      Syntax
+      Ast
   other-modules:
       Paths_lang
   autogen-modules:
       Paths_lang
   hs-source-dirs:
       src
+  default-extensions:
+      OverloadedStrings
   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
-  default-language: Haskell2010
+    , containers
+    , text
+    , wl-pprint-text
+  default-language: GHC2021
 
 executable lang-exe
   main-is: Main.hs
@@ -45,11 +50,16 @@ executable lang-exe
       Paths_lang
   hs-source-dirs:
       app
+  default-extensions:
+      OverloadedStrings
   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
-  default-language: Haskell2010
+    , text
+    , wl-pprint-text
+  default-language: GHC2021
 
 test-suite lang-test
   type: exitcode-stdio-1.0
@@ -60,8 +70,13 @@ test-suite lang-test
       Paths_lang
   hs-source-dirs:
       test
+  default-extensions:
+      OverloadedStrings
   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
-  default-language: Haskell2010
+    , text
+    , wl-pprint-text
+  default-language: GHC2021

lang/package.yaml

@@ -21,6 +21,14 @@ 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
+
+default-extensions:
+  - OverloadedStrings
 
 ghc-options:
   - -Wall

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 (FunName fun) = textStrict fun
+
+-- | Variable name, must be lowercase
+newtype Var = VarName {varName :: Text}
+    deriving (Show)
+
+instance Pretty Var where
+    pretty :: Var -> Doc
+    pretty (VarName var) = textStrict 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 (ConName con) = textStrict 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