resolve-body ( body env cut quot: ( -- ) -- )

Vocabulary

logic.private

Inputs

body	an object
env	an object
cut	an object
quot	a quotation with stack effect ( -- )

Outputs

None

Definition

USING: accessors combinators formatting kernel logic namespaces
quotations sequences ;

IN: logic.private

:: resolve-body ( body env cut quot: ( -- ) -- )
    body empty?
    [ quot ( -- ) call-effect ] [
        body unclip :> ( rest-goals! first-goal! ) first-goal !!
        =
        [ rest-goals env cut quot resolve-body t cut set-info ] 
        [
            first-goal callable?
            [ first-goal ( -- goal ) call-effect first-goal! ]
            when *trace?* get-global [
                first-goal
                [ pred>> name>> "in: { %s " printf ]
                [ args>> [ "%u " printf ] each "}\n" printf ] bi
            ] when
            <env> :> d-env! f <cut> :> d-cut! first-goal pred>>
            defs>> [
                first2 :> ( d-head d-body ) first-goal d-head
                [ args>> length ] same? [
                    d-cut cut? cut cut? or
                    [ t ] [
                        ~vector~ clone :> trail first-goal env
                        d-head d-env trail d-env unify*
                        ~quotation~ when trail ~quotation~ each
                        d-env env-clear f
                    ] if
                ] [ f ] if
            ] each-until
        ] if
    ] if ;