diff --git a/purescript/README.md b/purescript/README.md index 2064b7a..be5ef05 100644 --- a/purescript/README.md +++ b/purescript/README.md @@ -9,6 +9,7 @@ | [ecs](./ecs/) | Purescript-wrapper for [thi.ng/ecs](thi.ng/ecs) | | [existentials-blog](./existentials-blog) | Perhaps supposed to turn into a blog about existentials? | | [existentials](./existentials) | Experiment regarding the Church-encoding of existential types | +| [free](./free/) | Experiments regarding free monads and interpreting algebras | | [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 | diff --git a/purescript/free/.gitignore b/purescript/free/.gitignore new file mode 100644 index 0000000..30efe19 --- /dev/null +++ b/purescript/free/.gitignore @@ -0,0 +1,10 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago diff --git a/purescript/free/README.md b/purescript/free/README.md new file mode 100644 index 0000000..6f6e197 --- /dev/null +++ b/purescript/free/README.md @@ -0,0 +1,11 @@ +# Free + +My experiments with free monads and interpreting algebras. + +## File structure + +| File | Description | +| -------------------------------- | -------------------------------------------------------- | +| [Exists.purs](./src/Exists.purs) | Basic existential types | +| [Lambda.purs](./src/Lambda.purs) | Function call algebra and interpreter using existentials | +| [Math.purs](./src/Math.purs) | Addition & multiplication free monad and interpreter | diff --git a/purescript/free/packages.dhall b/purescript/free/packages.dhall new file mode 100644 index 0000000..30f33df --- /dev/null +++ b/purescript/free/packages.dhall @@ -0,0 +1,110 @@ +{- +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. + +## Warning: Don't Move This Top-Level Comment! + +Due to how `dhall format` currently works, this comment's +instructions cannot appear near corresponding sections below +because `dhall format` will delete the comment. However, +it will not delete a top-level comment like this one. + +## 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" +------------------------------- + +### Additions + +Purpose: +- Add packages that aren't already included in the default package set + +Syntax: +where `` 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 = + "" + } +------------------------------- + +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.0-20210324/packages.dhall sha256:b4564d575da6aed1c042ca7936da97c8b7a29473b63f4515f09bb95fae8dddab + +in upstream diff --git a/purescript/free/spago.dhall b/purescript/free/spago.dhall new file mode 100644 index 0000000..1715bd6 --- /dev/null +++ b/purescript/free/spago.dhall @@ -0,0 +1,19 @@ +{- +Welcome to a Spago project! +You can edit this file as you like. +-} +{ name = "my-project" +, dependencies = + [ "console" + , "debug" + , "effect" + , "fixed-points" + , "free" + , "psci-support" + , "tuples" + , "undefined" + , "variant" + ] +, packages = ./packages.dhall +, sources = [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/purescript/free/src/Exists.purs b/purescript/free/src/Exists.purs new file mode 100644 index 0000000..6e0f702 --- /dev/null +++ b/purescript/free/src/Exists.purs @@ -0,0 +1,14 @@ +module Existsential where + +import Prelude + +import Unsafe.Coerce (unsafeCoerce) + +foreign import data Test :: forall k. (k -> Type) -> Type +foreign import data Exists :: forall a b. (a -> b) -> b + +mkExists :: forall f a. f a -> Exists f +mkExists = unsafeCoerce + +runExists :: forall f r. (forall a. f a -> r) -> Exists f -> r +runExists = unsafeCoerce diff --git a/purescript/free/src/Lambda.purs b/purescript/free/src/Lambda.purs new file mode 100644 index 0000000..e3289a7 --- /dev/null +++ b/purescript/free/src/Lambda.purs @@ -0,0 +1,43 @@ +module Lambda where + +import Prelude + +import Control.Monad.Free (Free, liftF, resume) +import Data.Either (Either(..)) +import Existsential (Exists, mkExists, runExists) + +data CallData t f = CallData f (f -> t) +data CallF a t = CallF (Exists (CallData t)) (t -> a) + +data LambdaF a + = Call (Exists (CallF a)) + +type Lambda = Free LambdaF + +call :: forall a b. (a -> b) -> a -> Lambda b +call f arg = liftF $ Call (mkExists (CallF callData identity)) + where + callData = mkExists (CallData arg f) + +eval :: forall a. Lambda a -> a +eval = resume >>> case _ of + Left (Call ex) -> eval $ run1 ex + where + run1 :: forall r. Exists (CallF r) -> r + run1 = runExists (\(CallF ex' cb) -> cb $ run2 ex') + + run2 :: forall t. Exists (CallData t) -> t + run2 = runExists (\(CallData arg f) -> f arg) + Right result -> result + +test :: Lambda Int +test = do + result <- call ((+) 2) 3 + pure (result * 3) + +instance functorLambdaF :: Functor LambdaF where + map f (Call ex) = Call $ flip runExists ex (\(CallF ex' f') -> mkExists (CallF ex' $ f' >>> f)) + +-- instance showLambda :: Show a => Show (LambdaF a) where +-- show (Call left right) = show left <> " " <> show right +-- show (Lambda arg body) = "(\\" <> arg <> " -> " <> show body <> ")" \ No newline at end of file diff --git a/purescript/free/src/Main.purs b/purescript/free/src/Main.purs new file mode 100644 index 0000000..673c66e --- /dev/null +++ b/purescript/free/src/Main.purs @@ -0,0 +1,11 @@ +module Main where + +import Prelude + +import Effect (Effect) +import Effect.Class.Console (logShow) +import Lambda (eval, test) + +main :: Effect Unit +main = do + logShow $ eval test diff --git a/purescript/free/src/Math.purs b/purescript/free/src/Math.purs new file mode 100644 index 0000000..f957b47 --- /dev/null +++ b/purescript/free/src/Math.purs @@ -0,0 +1,34 @@ +module Math where + +import Prelude + +import Control.Monad.Free (Free, liftF, resume) +import Data.Either (Either(..)) + +data MathF a + = Add Int Int (Int -> a) + | Multiply Int Int (Int -> a) + +type Math = Free MathF + +---------- Helpers +eval :: Math Int -> Int +eval = resume >>> case _ of + Right result -> result + Left (Add l r cb) -> eval $ cb $ l + r + Left (Multiply l r cb) -> eval $ cb $ l * r + +seven :: Math Int +seven = do + four <- multiply_ 2 2 + add_ four 3 + +---------- Free boilerplate +add_ :: Int -> Int -> Math Int +add_ l r = liftF (Add l r identity) + +multiply_ :: Int -> Int -> Math Int +multiply_ l r = liftF (Multiply l r identity) + +--------- Typeclass instances +derive instance functorMath :: Functor MathF \ No newline at end of file diff --git a/purescript/free/test/Main.purs b/purescript/free/test/Main.purs new file mode 100644 index 0000000..f91f98c --- /dev/null +++ b/purescript/free/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."