49 lines
1.6 KiB
Plaintext
49 lines
1.6 KiB
Plaintext
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
|
|
| IntLit Int
|
|
| StringLit String
|
|
| 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 (IntLit i) = IntLit i
|
|
squash (StringLit s) = StringLit s
|
|
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 (IntLit i1) (IntLit i2) | i1 == i2 = IntLit i1
|
|
alongside (StringLit s1) (StringLit s2) | s1 == s2 = StringLit s1
|
|
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
|
|
alongside _ _ = Var Fail
|