Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
G
Guile Log
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
gule-log
Guile Log
Commits
acf6a108
Commit
acf6a108
authored
Sep 16, 2016
by
Stefan Israelsson Tampe
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
swi prolog engine implementation
parent
9e627588
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
177 additions
and
0 deletions
+177
-0
Makefile.am
Makefile.am
+1
-0
engine.scm
logic/guile-log/guile-prolog/engine.scm
+176
-0
No files found.
Makefile.am
View file @
acf6a108
...
...
@@ -100,6 +100,7 @@ PSSOURCES = \
logic/guile-log/iso-prolog.scm
\
logic/guile-log/prolog/goal-expand.scm
\
logic/guile-log/guile-prolog/set.scm
\
logic/guile-log/guile-prolog/engine.scm
\
logic/guile-log/guile-prolog/delay.scm
\
logic/guile-log/guile-prolog/foldarg.scm
\
logic/guile-log/guile-prolog/ops.scm
\
...
...
logic/guile-log/guile-prolog/engine.scm
0 → 100644
View file @
acf6a108
(
define-module
(
logic
guile-log
guile-prolog
engine
)
#
:use-module
(
logic
guile-log
)
#
:use-module
((
logic
code-load
)
#
:select
())
#
:use-module
(
logic
guile-log
iso-prolog
)
#
:export
(
engine_create
engine_next
engine_next_reified
engine_post
engine_yield
engine_fetch
is_engine
engine_self
current_engine
)
(
<define>
(
engine_yield
term
)
(
<ret>
(
list
#
yield
S
P
CC
term
)))
(
<define>
(
stub-scm
goal
box
engine
)
(
<with-postbox>
(
cons
box
engine
)
(
goal
)))
(
<define>
(
engine_fetch
term
)
(
copy_term
(
variable-ref
(
car
(
<postbox-ref>
)))
term
))
(
define
postbox
(
make-variable
#f
))
(
define
(
generate-engine
s
size
name
template
goal
)
(
let
((
engine
(
make-engine
size
)))
(
letrec
((
state
#f
)
(
postbox
(
make-variable
#f
))
(
on-result
(
lambda
()
(
match
state
(
#
:exit
(
set!
engine
#f
))
((
#
:throw
e
)
(
set!
engine
#f
))
(
_
#t
))))
(
start-f
(
lambda
(
s
)
(
set!
start-f
next
)
(
let
((
s2
(
gp-new-engine
s
engine
)))
(
set!
state
(
stub-scm
(
lambda
()
(
list
#
:exit
))
(
lambda
(
s
p
.
x
)
(
cons*
#
:finish
s
p
x
))
goal
postbox
(
lambda
()
ret
)))
(
on-result
)
(
gp-pop-engine
)
state
)))
(
next
(
lambda
(
s
term
)
(
match
state
(
#
:exit
state
)
((
#
:throw
e
)
state
)
((
#
:yield
s
p
cc
x
)
(
let
((
s
(
gp-old-engine
s
engine
)))
(
set!
state
(
cc
s
p
))
(
gp-pop-engine
)
(
cons
x
state
)))
((
#
:finish
s
p
)
(
let
((
s
(
gp-old-engine
s
engine
)))
(
set!
state
(
p
))
(
gp-pop-engine
)
(
cons
template
state
))))))
(
ret
(
lambda
(
kind
s
term
)
(
match
kind
(
#
:run
(
start-f
s
term
))
(
#
:post
(
variable-set!
postbox
term
))
(
#
:exist
(
match
state
(((
#
:throw
)
.
_
)
#f
)
(
#
exit
#f
)
(
_
#f
)))))))
(
procedure-property-set!
ret
'engine
#t
)
(
procedure-property-set!
ret
'name
(
name-it
name
))
ret
)))
(
<define>
(
is_engine
term
)
(
if
(
procedure-property
(
<lookup>
term
))))
(
<define>
(
engine_next
engine
term
)
(
let*
((
engine
(
<lookup>
engine
))
(
res
(
engine
#
:run
S
term
)))
(
<<match>>
(
#
:mode
-
)
(
res
)
(
#
:exit
<fail>
)
((
#
:throw
e
)
(
<var>
(
ee
)
(
copy_term
e
ee
)
(
throw
ee
)))
((
template
#
:finish
s
p
)
(
copy_term
template
term
))
((
template
#
:yield
s
p
cc
)
(
copy_term
template
term
)))))
(
<define>
(
engine_next_reified
engine
term
)
(
let*
((
engine
(
<lookup>
engine
))
(
res
(
engine
#
:run
S
term
)))
(
<<match>>
(
#
:mode
-
)
(
res
)
(
#
:exit
(
<=>
"no"
trem
))
((
#
:throw
e
)
(
copy_term
(
vector
(
list
"exception"
e
))
term
))
((
template
#
:finish
s
p
(
x
))
(
copy_term
(
vector
(
list
"the"
template
))
term
))
((
template
#
:yield
s
p
cc
(
x
))
(
copy_term
(
vector
(
list
"the"
template
))
term
)))))
(
define
engine_post
(
case-lambda
((
engine
term
)
(
let
((
engine
(
<lookup>
engine
)))
(
<var>
(
t
)
(
copy_term
term
t
)
(
<code>
(
engine
#
:post
S
(
<lookup>
t
))))))
((
engine
term
reply
)
(
engine_post
engine
term
)
(
engine_next
engine
reply
))))
(
<define>
(
engine_self
engine
)
(
<=>
engine
(
cdr
(
<postbox-ref>
))))
(
<define>
(
current_engine
engine
)
(
is_engine
engine
)
(
if
((
<lookup>
engine
)
#
:exist
#f
#f
)))
(
define
(
name-it
x
)
(
if
(
procedure?
x
)
(
procedure-name
x
)
(
if
(
string?
x
)
(
string->symbol
x
)
x
)))
(
<define>
(
create-engine-scm
t
g
name
size
engine
)
(
let
((
e
(
generate-engine
S
(
<lookup>
size
)
(
<lookup>
name
)
t
(
<lambda>
()
(
stub
g
)))))
(
<=>
engine
e
)))
(
compile-prolog-string
"
stub(Goal) :- catch(Goal,E,set_e(E)).
parse_ops([],Ops,[]) :- !.
parse_ops([],Ops,Defaults) :- !.
parse_ops(Defaults,Ops,[]).
parse_ops([X|L],Ops,Defaults) :-
(member(X,Ops) -> true ; true),
parse_ops(L,Ops,Defaults).
defaults([alias(noname),global(100),local(100),trail(100)]).
engine_create(Template, Goal, Engine, Ops) :-
default(Default),
parse_ops(Ops, [alias(Name),local(Size)], Defaults),
copy_term([Template,Goal],[T,G]),
'create-engine-scm'(T,G,Name,Size,Engine).
"
)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment