prolog_in_haskell/app/Binding.hs

50 lines
1.4 KiB
Haskell

module Binding
( newVar, unify, instantiate
) where
import Terms
import Nondeterminism
import Primitives
import Control.Monad
import Control.Applicative
newVar :: Name -> PrologStream Var
newVar name = reversibly (newVarPrim name) unnewVarPrim
getVar :: Var -> PrologStream (Maybe Term)
getVar var = liftPrologIO (getVarPrim var)
setVar :: Var -> Term -> PrologStream ()
setVar var value = reversibly set unset
where
set = do
oldValue <- getVarPrim var
when (oldValue /= Nothing) (errorPrim "cannot set var that is currently set")
setVarPrim var (Just value)
unset = do
oldValue <- getVarPrim var
when (oldValue == Nothing) (errorPrim "cannot unset var that is already unset")
setVarPrim var Nothing
unify :: Term -> Term -> PrologStream ()
unify (Compound h0 args0) (Compound h1 args1) = do
when (h0 /= h1) empty
when (length args0 /= length args1) empty
forM_ (zip args0 args1) $ \(arg0, arg1) -> unify arg0 arg1
unify (Var v0) (Var v1) | v0 == v1 = return ()
unify (Var v0) t1 = do
binding <- getVar v0
case binding of
Just t0 -> unify t0 t1
Nothing -> setVar v0 t1
unify t0 t1@(Var _) = unify t1 t0
instantiate :: Term -> PrologStream Term
instantiate t@(Var v) = do
binding <- getVar v
case binding of
Just t0 -> instantiate t0
Nothing -> return t
instantiate (Compound h args) = do
instantiatedArgs <- mapM instantiate args
return (Compound h instantiatedArgs)