diff --git a/purescript/README.md b/purescript/README.md
index 5d09b7a..2064b7a 100644
--- a/purescript/README.md
+++ b/purescript/README.md
@@ -11,6 +11,7 @@
| [existentials](./existentials) | Experiment regarding the Church-encoding of existential types |
| [gadts](./gadts) | Experiment regarding ways to encode GADTs in Purescript |
| [lambda-calculus](./lambda-calculus) | Lambda calculus evaluator |
+| [lunarline](./lunarline) | Attempt at optimizing a functional language using compile-time partial evaluation |
| [lune](./lune) | Failed effect-system project |
| [maps](./maps) | Attempt at implementing maps with membership proofs |
| [proofs](./proofs) | Attempt at expressing mathematical proofs using Purescript's effect system |
diff --git a/purescript/lunarline/.gitignore b/purescript/lunarline/.gitignore
new file mode 100644
index 0000000..30efe19
--- /dev/null
+++ b/purescript/lunarline/.gitignore
@@ -0,0 +1,10 @@
+/bower_components/
+/node_modules/
+/.pulp-cache/
+/output/
+/generated-docs/
+/.psc-package/
+/.psc*
+/.purs*
+/.psa*
+/.spago
diff --git a/purescript/lunarline/idea b/purescript/lunarline/idea
new file mode 100644
index 0000000..bbd0a1b
--- /dev/null
+++ b/purescript/lunarline/idea
@@ -0,0 +1,72 @@
+map f = case _ of
+ Nil -> Nil
+ x:xs -> f x : map f xs
+
+
+map2 f g xs = map g (map f xs)
+
+----------
+map2 f g xs = map g case xs of
+ Nil -> Nil
+ x:xs -> f x : map f xs
+
+----------
+map2 g f xs = case (case ...) ...
+
+----------
+map2 f g xs = case xs of
+ Nil -> case Nil of
+ Nil -> Nil
+ x:xs -> f x : map f xs
+ x:xs -> case f x : map f xs of
+ Nil -> Nil
+ x:xs -> g x : map g xs
+
+----------
+map2 f g xs = case xs of
+ Nil -> Nil
+ x:xs -> let
+ a = f x
+ b = map f xs
+ in g a : map g b
+
+----------
+map2 f g xs = case xs of
+ Nil -> Nil
+ x:xs -> g (f x) : map g (map f xs)
+
+----------
+map2 f g = case _ of
+ x:xs -> g (f x) : map2 f g xs
+ Nil -> Nil
+
+----------
+map2 f g = case _ of
+ x:xs -> (compose g f) x : map2 f g xs
+ Nil -> Nil
+
+==========
+Unify
+ map2 f g a
+with
+ map u1 u2
+
+u2 = a
+
+==========
+Unify
+ (compose g f) x
+with
+ u1 x
+
+u1 = compose g f
+
+==========
+Unify
+ map2 f g xs
+with
+ map (compose g f) xs
+
+TRUE
+
+map2 = map (compose g f) xs
diff --git a/purescript/lunarline/packages.dhall b/purescript/lunarline/packages.dhall
new file mode 100644
index 0000000..eb6c9f4
--- /dev/null
+++ b/purescript/lunarline/packages.dhall
@@ -0,0 +1,104 @@
+{-
+Welcome to your new Dhall package-set!
+
+Below are instructions for how to edit this file for most use
+cases, so that you don't need to know Dhall to use it.
+
+## Use Cases
+
+Most will want to do one or both of these options:
+1. Override/Patch a package's dependency
+2. Add a package not already in the default package set
+
+This file will continue to work whether you use one or both options.
+Instructions for each option are explained below.
+
+### Overriding/Patching a package
+
+Purpose:
+- Change a package's dependency to a newer/older release than the
+ default package set's release
+- Use your own modified version of some dependency that may
+ include new API, changed API, removed API by
+ using your custom git repo of the library rather than
+ the package set's repo
+
+Syntax:
+where `entityName` is one of the following:
+- dependencies
+- repo
+- version
+-------------------------------
+let upstream = --
+in upstream
+ with packageName.entityName = "new value"
+-------------------------------
+
+Example:
+-------------------------------
+let upstream = --
+in upstream
+ with halogen.version = "master"
+ with halogen.repo = "https://example.com/path/to/git/repo.git"
+
+ with halogen-vdom.version = "v4.0.0"
+ with halogen-vdom.dependencies = [ "extra-dependency" ] # halogen-vdom.dependencies
+-------------------------------
+
+### Additions
+
+Purpose:
+- Add packages that aren't already included in the default package set
+
+Syntax:
+where `<version>` is:
+- a tag (i.e. "v4.0.0")
+- a branch (i.e. "master")
+- commit hash (i.e. "701f3e44aafb1a6459281714858fadf2c4c2a977")
+-------------------------------
+let upstream = --
+in upstream
+ with new-package-name =
+ { dependencies =
+ [ "dependency1"
+ , "dependency2"
+ ]
+ , repo =
+ "https://example.com/path/to/git/repo.git"
+ , version =
+ "<version>"
+ }
+-------------------------------
+
+Example:
+-------------------------------
+let upstream = --
+in upstream
+ with benchotron =
+ { dependencies =
+ [ "arrays"
+ , "exists"
+ , "profunctor"
+ , "strings"
+ , "quickcheck"
+ , "lcg"
+ , "transformers"
+ , "foldable-traversable"
+ , "exceptions"
+ , "node-fs"
+ , "node-buffer"
+ , "node-readline"
+ , "datetime"
+ , "now"
+ ]
+ , repo =
+ "https://github.com/hdgarrood/purescript-benchotron.git"
+ , version =
+ "v7.0.0"
+ }
+-------------------------------
+-}
+let upstream =
+ https://github.com/purescript/package-sets/releases/download/psc-0.14.3-20210825/packages.dhall sha256:eee0765aa98e0da8fc414768870ad588e7cada060f9f7c23c37385c169f74d9f
+
+in upstream
diff --git a/purescript/lunarline/spago.dhall b/purescript/lunarline/spago.dhall
new file mode 100644
index 0000000..bdcb026
--- /dev/null
+++ b/purescript/lunarline/spago.dhall
@@ -0,0 +1,35 @@
+{-
+Welcome to a Spago project!
+You can edit this file as you like.
+
+Need help? See the following resources:
+- Spago documentation: https://github.com/purescript/spago
+- Dhall language tour: https://docs.dhall-lang.org/tutorials/Language-Tour.html
+
+When creating a new Spago project, you can use
+`spago init --no-comments` or `spago init -C`
+to generate this file without the comments in this block.
+-}
+{ name = "my-project"
+, dependencies =
+ [ "arrays"
+ , "console"
+ , "debug"
+ , "effect"
+ , "foldable-traversable"
+ , "lists"
+ , "maybe"
+ , "prelude"
+ , "profunctor-lenses"
+ , "psci-support"
+ , "run"
+ , "strings"
+ , "tuples"
+ , "typelevel"
+ , "typelevel-prelude"
+ , "unordered-collections"
+ , "zipperarray"
+ ]
+, packages = ./packages.dhall
+, sources = [ "src/**/*.purs", "test/**/*.purs" ]
+}
diff --git a/purescript/lunarline/src/Ast.purs b/purescript/lunarline/src/Ast.purs
new file mode 100644
index 0000000..2bbb413
--- /dev/null
+++ b/purescript/lunarline/src/Ast.purs
@@ -0,0 +1,134 @@
+module Lunarline.Ast where
+
+import Prelude
+
+import Data.Array as A
+import Data.Array as Array
+import Data.Array.NonEmpty (NonEmptyArray)
+import Data.Array.NonEmpty as NA
+import Data.Foldable (foldl)
+import Data.Lens (_2, first, over)
+import Data.List as List
+import Data.Maybe (Maybe(..))
+import Data.String (joinWith)
+import Data.Tuple.Nested (type (/\), (/\))
+import Lunarline.String (indent, parensWhen)
+
+---------- Types
+data Case
+ = Named String
+ | Deconstruct String (Array Case)
+
+data Expression
+ = Var String
+ | Lambda String Expression
+ | Call Expression Expression
+ | Match Expression (NonEmptyArray (Case /\ Expression))
+ | Let String Expression Expression
+ | Constructor String
+ | IgnoreVar String Expression
+
+---------- Helpers
+-- | Syntax sugar for creating calls from purescript
+callMany :: Expression -> Array Expression -> Expression
+callMany f args = A.foldl Call f args
+
+-- | Attempt organizing a constructor call
+-- | into the constructor name and the passed arguments
+unrollConstructor :: Expression -> Maybe (String /\ Array Expression)
+unrollConstructor (Call next argument)
+ = unrollConstructor next
+ <#> over _2 (flip Array.snoc argument)
+unrollConstructor (Constructor name) = Just (name /\ [])
+unrollConstructor _ = Nothing
+
+-- | Checks if a pattern match cases shadows a given variable name
+caseShadows :: String -> Case -> Boolean
+caseShadows target (Named name) = target == name
+caseShadows target (Deconstruct _ children) = A.any (caseShadows target) children
+
+-- | Count the number of times a variable occurs inside an expression.
+-- | Takes care of shadowing
+occurences :: String -> Expression -> Int
+occurences name = go 0
+ where
+ go acc (Var var) = if var == name then acc + 1 else acc
+ go acc (IgnoreVar var expr) = if name == var then acc else go acc expr
+ go acc (Lambda var expr) = if name == var then acc else go acc expr
+ go acc (Call function argument) = go (go acc argument) function
+ go acc (Constructor _) = acc
+ go acc (Let var value body) = if var == name then inValue else go inValue body
+ where
+ inValue = go acc value
+ go acc (Match expr cases) = foldl processCase (go acc expr) cases
+ where
+ processCase acc (thisCase /\ continuation) =
+ if caseShadows name thisCase then
+ acc else go acc continuation
+
+-- | Ignore a var which references itself. Useful for avoiding infinite recursion while optimizing
+avoidInfiniteRecursion :: String -> Expression -> Expression
+avoidInfiniteRecursion var expr
+ | occurences var expr == 0 = expr
+ | otherwise = IgnoreVar var expr
+
+---------- Pretty printing
+instance Show Case where
+ show (Named name) = name
+ show (Deconstruct constructor nested) = constructor <> " "
+ <> joinWith " " (parensWhen needsParens show <$> nested)
+ where
+ needsParens (Named _) = false
+ needsParens (Deconstruct _ nested) = A.length nested /= 0
+
+instance Show Expression where
+ show (Var name) = name
+ show (IgnoreVar var expr) =
+ if occurences var expr /= 10000 then show expr
+ else "shadow " <> show var <> ". " <> show expr
+ show (Constructor name) = name
+ show lam@(Lambda _ _) = "\\" <> joinWith " " args <> " -> " <> show body
+ where
+ args /\ body = collectLambdas lam
+ show (Let name definition body) = "let " <> name <> " = " <> show definition <> "\nin " <> show body
+ show (Match expr cases) = "case " <> parensWhen exprNeedsParens show expr <> " of" <> "\n" <> indent 2 prettyCases
+ where
+ exprNeedsParens = case _ of
+ Match _ _ -> true
+ IgnoreVar _ e -> exprNeedsParens e
+ _ -> false
+ prettyCases = joinWith "\n" $ NA.toArray $ printCase <$> cases
+ printCase (thisCase /\ continuation) = show thisCase <> " ->" <>
+ if onSeparateLine then "\n" <> indent 2 (show continuation)
+ else " " <> show continuation
+ where
+ onSeparateLine = case continuation of
+ Match _ _ -> true
+ IgnoreVar _ _ -> true
+ Lambda _ _ -> true
+ Let _ _ _ -> true
+ _ -> false
+ show (Call function argument) =
+ parensWhen leftNeedsParens show function
+ <> " "
+ <> parensWhen rightNeedsParens show argument
+ where
+ leftNeedsParens = case _ of
+ Match _ _ -> true
+ Lambda _ _ -> true
+ IgnoreVar _ _ -> true
+ Let _ _ _ -> true
+ _ -> false
+
+ rightNeedsParens = case _ of
+ Call _ _ -> true
+ IgnoreVar _ _ -> true
+ _ -> false
+
+-- | Gruop an expression into it's arguments and it's body.
+-- | In case of non lambda expressions the argument array will be empty
+collectLambdas :: Expression -> Array String /\ Expression
+collectLambdas = go >>> first A.fromFoldable
+ where
+ go (Lambda name body) = first (List.Cons name) (go body)
+ go other = List.Nil /\ other
\ No newline at end of file
diff --git a/purescript/lunarline/src/Inline.purs b/purescript/lunarline/src/Inline.purs
new file mode 100644
index 0000000..23e54bd
--- /dev/null
+++ b/purescript/lunarline/src/Inline.purs
@@ -0,0 +1,163 @@
+module Lunarline.Inline where
+
+import Prelude
+
+import Control.Bind (bindFlipped)
+import Data.Array as A
+import Data.HashMap (HashMap)
+import Data.HashMap as HM
+import Data.Lens (Lens', over, second)
+import Data.Lens.Record (prop)
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Traversable (for)
+import Data.Tuple (uncurry)
+import Data.Tuple.Nested (type (/\), (/\))
+import Data.ZipperArray (ZipperArray)
+import Data.ZipperArray as ZA
+import Effect.Console (log)
+import Effect.Unsafe (unsafePerformEffect)
+import Lunarline.Ast (Case(..), Expression(..), avoidInfiniteRecursion, occurences, unrollConstructor)
+import Run (Run)
+import Run as Run
+import Run.Except (FAIL, fail, runFail)
+import Run.Reader (READER, asks, local, runReader)
+import Type.Proxy (Proxy(..))
+import Type.Row (type (+))
+
+---------- Types
+type Scope = HashMap String Expression
+type Context
+ =
+ { scope :: Scope
+ }
+
+---------- Monad
+-- | The base context most inlining operations run inside
+type InlineM r = Run (READER Context r)
+
+-- | Same as InlineM, but might fail
+type BreakableInlineM r = InlineM (FAIL + r)
+
+-- | The default context containing no bindings in scope
+emptyContext :: Context
+emptyContext = { scope: HM.empty }
+
+-- | Run a computation inside the InlineM monad
+runInlineM :: forall a. Context -> InlineM () a -> a
+runInlineM ctx = runReader ctx >>> Run.extract
+
+---------- Helpers
+attempt :: forall r a. (a -> Run (FAIL r) a) -> a -> Run r a
+attempt f a = runFail (f a) <#> fromMaybe a
+
+lookupScope :: forall r. String -> InlineM r (Maybe Expression)
+lookupScope name = asks (_.scope >>> HM.lookup name)
+
+incorporateFailure :: forall r a. Run (FAIL r) (Maybe a) -> Run (FAIL r) a
+incorporateFailure = bindFlipped case _ of
+ Just success -> pure success
+ Nothing -> fail
+
+appendScope :: forall r. String -> Expression -> InlineM r ~> InlineM r
+appendScope name expression = local
+ (over _scope $ HM.insert name expression)
+
+dropFromScope :: forall r. String -> InlineM r ~> InlineM r
+dropFromScope name = local
+ (over _scope $ HM.delete name)
+
+extendScopeWith :: forall r. Scope -> InlineM r ~> InlineM r
+extendScopeWith extension = local (over _scope $ HM.union extension)
+
+---------- Implementation
+executeSafely :: forall r. Expression -> InlineM r ((InlineM r Expression -> InlineM r Expression) /\ Expression)
+executeSafely expr = ado
+ expr <- execute expr
+ in
+ go expr
+ where
+ go = case _ of
+ IgnoreVar name body -> (dropFromScope name >>> map (avoidInfiniteRecursion name) >>> restrain) /\ inner
+ where
+ restrain /\ inner = go body
+ other -> identity /\ other
+
+execute :: forall r. Expression -> InlineM r Expression
+execute = attempt $ go case _ of
+ Var name -> do
+ map (avoidInfiniteRecursion name) $ incorporateFailure $ lookupScope name
+ IgnoreVar name body -> do
+ dropFromScope name $ execute body
+ Call function argument -> do
+ restrain /\ function <- executeSafely function
+ restrain' /\ argument <- executeSafely argument
+ restrain $ restrain' case function of
+ Lambda name body -> do
+ appendScope name argument $ execute body
+ _ -> pure $ Call function argument
+ Lambda argument body -> do
+ restrain /\ body <- dropFromScope argument $ executeSafely body
+ restrain $ pure $ Lambda argument body
+ Match child cases -> do
+ restrain /\ child <- executeSafely child
+ restrain case child of
+ Match expr innerCases -> execute
+ $ Match expr
+ $ second (\c -> Match c cases) <$> innerCases
+ other -> do
+ executeMatch other (ZA.fromNonEmptyArray cases)
+ Let name definition continuation -> do
+ definition <- execute definition
+ continuation <- appendScope name definition $ execute continuation
+ pure
+ if occurences name definition == 0 && occurences name continuation == 0 then
+ continuation
+ else Let name definition continuation
+ Constructor name -> pure $ Constructor name
+ where
+ go f expr = do
+ res <- f expr
+ let a = unsafePerformEffect $ log $ "Inlinng: " <> show expr <> "\nwith: " <> show res <> "\n\n\n"
+ pure res
+
+-- | Attempt to create a scope from a pattern match of some case
+-- | over some expression
+matchCase
+ :: Expression -> Case -> Maybe Scope
+matchCase expression (Named name) = Just (HM.singleton name expression)
+matchCase expression (Deconstruct expectedConstructor childCases)
+ | Just (name /\ arguments) <- unrollConstructor expression
+ , name == expectedConstructor
+ , A.length childCases == A.length arguments =
+ ado
+ subMatchResults <- for subMatches (uncurry matchCase)
+ in A.foldr HM.union HM.empty subMatchResults
+ where
+ subMatches = A.zip arguments childCases
+matchCase _ _ = Nothing
+
+-- | Execute a pattern match expression
+executeMatch
+ :: forall r
+ . Expression
+ -> ZipperArray (Case /\ Expression)
+ -> BreakableInlineM r Expression
+executeMatch child cases = case matchCase child currentCase of
+ Nothing -> do
+ case ZA.goNext cases of
+ Nothing -> ado
+ cases <- for (ZA.toNonEmptyArray cases) \(currentCase /\ continuation) -> do
+ -- TODO: when encountering
+ -- case expr of A a1 ... an -> body
+ -- replace expr with `A a1 ... an` inside the body
+ execute continuation <#> (/\) currentCase
+ in Match child cases
+ Just remaining -> executeMatch child remaining
+ Just scopeExtension ->
+ extendScopeWith scopeExtension $ execute currentContinuation
+ where
+ currentCase /\ currentContinuation = ZA.current cases
+
+---------- Lenses
+_scope :: Lens' Context Scope
+_scope = prop (Proxy :: _ "scope")
\ No newline at end of file
diff --git a/purescript/lunarline/src/Main.purs b/purescript/lunarline/src/Main.purs
new file mode 100644
index 0000000..8e7f35b
--- /dev/null
+++ b/purescript/lunarline/src/Main.purs
@@ -0,0 +1,38 @@
+module Main where
+
+import Prelude
+
+import Data.Array.NonEmpty as NA
+import Data.Tuple.Nested ((/\))
+import Effect (Effect)
+import Effect.Console (logShow)
+import Lunarline.Ast (Case(..), Expression(..), callMany)
+import Lunarline.Inline (emptyContext, execute, runInlineM)
+
+myMap :: Expression
+myMap = Lambda "h"
+ $ Lambda "array"
+ $ Match (Var "array")
+ $
+ NA.cons'
+ ( Deconstruct "Cons" [ Named "x", Named "xs" ]
+ /\ callMany (Constructor "Cons")
+ [ Call (Var "h") (Var "x")
+ , callMany (Var "map")
+ [ Var "h", Var "xs" ]
+ ]
+ )
+ [ Deconstruct "Nil" [] /\ Constructor "Nil"
+ ]
+
+myMap2 :: Expression
+myMap2 = Let "map" myMap
+ $ Lambda "f"
+ $ Lambda "g"
+ $ Lambda "list"
+ $ callMany (Var "map") [ Var "g", callMany (Var "map") [ Var "f", Var "list" ] ]
+
+main :: Effect Unit
+main = do
+ logShow myMap2
+ logShow $ runInlineM emptyContext $ execute myMap2
diff --git a/purescript/lunarline/src/String.purs b/purescript/lunarline/src/String.purs
new file mode 100644
index 0000000..44c0b29
--- /dev/null
+++ b/purescript/lunarline/src/String.purs
@@ -0,0 +1,19 @@
+module Lunarline.String where
+
+import Prelude
+
+import Data.String (Pattern(..), joinWith, split)
+
+-- | Indent a multi line string
+indent :: Int -> String -> String
+indent amount = split (Pattern "\n") >>> map (indentOne amount) >>> joinWith "\n"
+
+-- | Indents a single line string
+indentOne :: Int -> String -> String
+indentOne n a
+ | n <= 0 = a
+ | otherwise = " " <> indentOne (n - 1) a
+
+-- | Add parenthesis to a pretty printer when a condition holds
+parensWhen :: forall a. (a -> Boolean) -> (a -> String) -> a -> String
+parensWhen predicate print toPrint = if predicate toPrint then "(" <> print toPrint <> ")" else print toPrint
\ No newline at end of file
diff --git a/purescript/lunarline/test/Main.purs b/purescript/lunarline/test/Main.purs
new file mode 100644
index 0000000..f91f98c
--- /dev/null
+++ b/purescript/lunarline/test/Main.purs
@@ -0,0 +1,11 @@
+module Test.Main where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Class.Console (log)
+
+main :: Effect Unit
+main = do
+ log "🍝"
+ log "You should add some tests."