Add an initial implementation of proof search
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
parent
7d78db96d6
commit
6271dd8c2b
87
src/Bergamot/Rules.elm
Normal file
87
src/Bergamot/Rules.elm
Normal file
|
@ -0,0 +1,87 @@
|
|||
module Bergamot.Rules exposing (..)
|
||||
|
||||
import Bergamot.Syntax exposing (Term, Metavariable, UnificationVar, unify, emptyUnificationState, instantiate, instantiateList, emptyInstantiationState, resetVars, InstantiationState, UnificationState)
|
||||
import Bergamot.Search as Search exposing (Search)
|
||||
|
||||
import Debug
|
||||
|
||||
type alias Rule =
|
||||
{ name : String
|
||||
, conclusion : Term Metavariable
|
||||
, premises : List (Term Metavariable)
|
||||
}
|
||||
|
||||
type ProofTree = MkProofTree
|
||||
{ name : String
|
||||
, conclusion : Term UnificationVar
|
||||
, premises : List ProofTree
|
||||
}
|
||||
|
||||
type alias RuleEnv =
|
||||
{ rules : List Rule
|
||||
}
|
||||
|
||||
type alias ProveState =
|
||||
{ unificationState : UnificationState
|
||||
, instantiationState : InstantiationState
|
||||
}
|
||||
|
||||
type alias Prover a = RuleEnv -> ProveState -> Search (a, ProveState)
|
||||
|
||||
andThen : (a -> Prover b) -> Prover a -> Prover b
|
||||
andThen f p env ps =
|
||||
p env ps
|
||||
|> Search.andThen (\(a, psp) -> (f a) env psp)
|
||||
|
||||
map : (a -> b) -> Prover a -> Prover b
|
||||
map f p env ps =
|
||||
p env ps
|
||||
|> Search.map (Tuple.mapFirst f)
|
||||
|
||||
interleave : Prover a -> Prover a -> Prover a
|
||||
interleave p1 p2 env ps =
|
||||
Search.interleave (p1 env ps) (p2 env ps)
|
||||
|
||||
pure : a -> Prover a
|
||||
pure a env ps = Search.pure (a, ps)
|
||||
|
||||
fail : Prover a
|
||||
fail env ps = Search.fail
|
||||
|
||||
getEnv : Prover RuleEnv
|
||||
getEnv env ps = Search.pure (env, ps)
|
||||
|
||||
rule : Term UnificationVar -> Rule -> Prover ProofTree
|
||||
rule t r env ps =
|
||||
let
|
||||
(conc, is) = instantiate r.conclusion ps.instantiationState
|
||||
(prems, isp) = instantiateList r.premises is
|
||||
in
|
||||
case unify t conc ps.unificationState of
|
||||
Nothing -> Search.fail
|
||||
Just (tp, usp) ->
|
||||
let
|
||||
psp = { ps | instantiationState = resetVars isp
|
||||
, unificationState = usp }
|
||||
in
|
||||
provePremises prems env psp
|
||||
|> Search.map (Tuple.mapFirst (\trees -> MkProofTree { name = r.name, conclusion = tp, premises = trees }))
|
||||
|
||||
provePremises : List (Term UnificationVar) -> Prover (List ProofTree)
|
||||
provePremises l =
|
||||
case l of
|
||||
t :: ts ->
|
||||
prove t
|
||||
|> andThen (\tree -> map (\trees -> tree :: trees) (provePremises ts))
|
||||
[] -> pure []
|
||||
|
||||
prove : Term UnificationVar -> Prover ProofTree
|
||||
prove t =
|
||||
getEnv
|
||||
|> andThen (List.foldl (\r -> interleave (rule t r)) fail << .rules)
|
||||
|
||||
single : RuleEnv -> Prover a -> Maybe a
|
||||
single env p =
|
||||
p env { instantiationState = emptyInstantiationState, unificationState = emptyUnificationState }
|
||||
|> Search.one
|
||||
|> Maybe.map (Tuple.first << Tuple.first)
|
Loading…
Reference in New Issue
Block a user