bergamot/src/Language/Bergamot/Syntax.purs

module Language.Bergamot.Syntax where

import Prelude

import Control.Monad.Unify.Class (class Unifiable, class UnificationVariable, Stream(..), squash, alongside, ComparisonAction(..))
import Data.Foldable (class Foldable)
import Data.Traversable (class Traversable)
import Data.Lazy (defer)
import Data.List (List(..), (:))

data Expr v
    = Var v
    | Atom String (List (Expr v))

derive instance Eq v => Eq (Expr v)
derive instance Functor Expr
derive instance Foldable Expr
derive instance Traversable Expr

newtype IntVar = MkIntVar Int
derive instance Eq IntVar
derive instance Ord IntVar

instance UnificationVariable IntVar where
    variables = mkVarList 0
        where mkVarList n = StreamCons (MkIntVar n) $ defer $ \_ -> mkVarList (n+1)

instance UnificationVariable k => Unifiable k Expr where
    variable = Var
    squash (Var f) = f
    squash (Atom name args) = Atom name $ squash <$> args
    alongside (Var k1) (Var k2) = Var (Merge k1 k2)
    alongside (Var k) f = Var (Store k f)
    alongside f (Var k) = Var (Store k f)
    alongside (Atom n1 _) (Atom n2 _) | n1 /= n2 = Var Fail
    alongside (Atom n1 args1) (Atom _ args2) = Atom n1 $ combine args1 args2
        where
          combine Nil Nil = Nil
          combine (_:_) Nil = (Var Fail) : Nil
          combine Nil (_:_) = (Var Fail) : Nil
          combine (x:xs) (y:ys) = alongside x y : combine xs ys