Expr

Expr.purs

module Main where

import Prelude

import Data.Functor.Mu (Mu(..))
import Data.Functor.Variant (VariantF, case_, inj, on, onMatch)
import Data.Symbol (class IsSymbol, SProxy(..))
import Data.Variant.Internal (FProxy)
import Effect (Effect)
import Effect.Console (log, logShow)
import Matryoshka (Algebra, cata)
import Prim.Row as Row
import Type.Row (type (+))

type MuV t = Mu (VariantF t)

injMu :: forall a b f s. Row.Cons s (FProxy f) a b 
  => IsSymbol s 
  => Functor f 
  => SProxy s 
  -> f (Mu (VariantF b)) 
  -> Mu (VariantF b)
injMu label = In <<< (inj label)

data ValF a = ValF Int
derive instance functorValF :: Functor ValF

data AddF a = AddF a a
derive instance functorAddF :: Functor AddF

data MulF a = MulF a a
derive instance functorMulF :: Functor MulF

type Val r = (val :: FProxy ValF | r)
type Add r = (add :: FProxy AddF | r)
type Mul r = (mul :: FProxy MulF | r)

type BaseExpr r = Val + Add + r

_val = SProxy :: SProxy "val"
_add = SProxy :: SProxy "add"
_mul = SProxy :: SProxy "mul"

val :: forall r. Int -> MuV (Val r)
val v = injMu _val (ValF v)

add :: forall r. MuV (Add + r) -> MuV (Add + r) -> MuV (Add + r)
add x y = injMu _add (AddF x y)

mul :: forall r. MuV (Mul + r) -> MuV (Mul + r) -> MuV (Mul + r)
mul x y = injMu _mul (MulF x y)

exprAlg :: forall r. Algebra (VariantF r) Int -> Algebra (VariantF (BaseExpr + r)) Int     
exprAlg = onMatch 
  { val: case _ of ValF x -> x
  , add: case _ of AddF x y -> x + y }

exprAlg2 :: forall r. Algebra (VariantF r) Int -> Algebra (VariantF (BaseExpr + Mul + r)) Int 
exprAlg2 = exprAlg
  >>> on _mul case _ of MulF x y -> x * y

expr :: forall r. MuV (BaseExpr + Mul + r)
expr = mul (add (val 10) (val 20)) (val 10)

expr2 :: forall r. MuV (BaseExpr + r)
expr2 = add (val 10) (val 20)

main :: Effect Unit
main = do
  log "Hello sailor!"
  logShow $ cata (case_ # exprAlg) expr2
  logShow $ cata (case_ # exprAlg2) expr