Implemented proper autotools support

parent 8729041a
SUBDIRS = logic/guile-log/src/
ice-9/match-phd-lookup.scm \
ice-9/match-phd.scm \
logic/guile-log/guile-log-pre.scm \
logic/guile-log/ck.scm \
logic/guile-log/code-load.scm \
logic/guile-log/vlist.scm \
logic/guile-log/indexer.scm \
logic/guile-log/umatch.scm \
logic/guile-log/macros.scm \
logic/guile-log/run.scm \
logic/guile-log/macro-help.scm \
logic/guile-log/interleave.scm \
logic/guile-log/tools.scm \
logic/guile-log/prompts.scm \
logic/guile-log.scm \
logic/guile-log/collects.scm \
logic/guile-log/canonacalize.scm \
logic/guile-log/kanren.scm \
logic/guile-log/grep.scm \
logic/guile-log/hash.scm \
logic/guile-log/memoize.scm \
logic/guile-log/parsing/scanner.scm \
logic/guile-log/parser.scm \
logic/guile-log/parsing/operator-parser.scm \
logic/guile-log/parsing/scheme.scm \
logic/guile-log/parsing/sch-match.scm \
logic/guile-log/dynlist.scm \
logic/guile-log/postpone.scm \
logic/guile-log/util.scm \
logic/guile-log/functional-database.scm \
logic/guile-log/iso-prolog.scm \
logic/guile-log/prolog/pre.scm \
logic/guile-log/prolog/error.scm \
logic/guile-log/prolog/symbols.scm \
logic/guile-log/prolog/names.scm \
logic/guile-log/prolog/parser.scm \
logic/guile-log/prolog/run.scm \
logic/guile-log/prolog/base.scm \
logic/guile-log/prolog/var.scm \
logic/guile-log/prolog/goal.scm \
logic/guile-log/prolog/goal-functors.scm \
logic/guile-log/prolog/compile.scm \
logic/guile-log/prolog/dynamic.scm \
logic/guile-log/prolog/directives.scm \
logic/guile-log/prolog/order.scm \
logic/guile-log/prolog/goal-transformers.scm \
logic/guile-log/prolog/io.scm \
logic/guile-log/prolog/char-conversion.scm \
logic/guile-log/prolog/load.scm \
logic/guile-log/prolog/char.scm \
logic/guile-log/prolog/functions.scm \
logic/guile-log/prolog/util.scm \
logic/guile-log/prolog/conversion.scm \
logic/guile-log/guile-prolog/continuations.scm \
logic/guile-log/guile-prolog/hash.scm \
info_TEXINFOS = doc/guile-log.texi
......@@ -4,3 +4,14 @@ Version 0.3
* Fluids following the guile-log stack.
* Acumulators.
* and much more
Version 0.4
* Fast and scalable vhash version of the assoc variable binding system, OK-
* Functional Dynamic Functions, OK
* Functional Hash implementation using vhashes, OK-,
* Program flow dynamic varible analytics OK-.
* An iso prolog implementation, OK.
* Delimeted continuations, OK.
* A catch and throw system. OK.
* Tabling or memoization features Not yet implemented
\ No newline at end of file
dnl -*- Autoconf -*-
AC_INIT(guile-log, 0.4.0, [])
AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign serial-tests])
AC_ARG_ENABLE([Werror], AC_HELP_STRING([--disable-Werror],[Don't stop the build on errors]),
[], WARN_CFLAGS="-Wall")
PKG_CHECK_MODULES(GUILE, [guile-2.0 >= 2.0.0])
AC_CONFIG_FILES([env], [chmod +x env])
......@@ -425,7 +425,6 @@ a method of doing an undoable set.
@node guile-log
@chapter Introduction
Guile log is a basic framework of macrology that implements functionality that can be compared to both kanren and prolog plus some extra features. The feature set is close to what can be accomplish with plain kanren but more at the speed of prolog. Usually kanren is a more expressive way of implementation and can many times easier be extended with new features, on the other hand, most features in kanren is available in guile-log and performs about 10x faster then scheme kanren. Other possibilities are using the kanren interface ontop of guile-log and then the speed difference is about a factor of 2 slower then guile-log close to the speed that kanren does in compiled chicken.
......@@ -686,7 +685,7 @@ In the forms below remember to use @code{unquote} for forms that need to be sche
@section variable binding
@findex <let>
@findex <let*>
@dindex <letrec>
@findex <letrec>
@findex <var>
@findex <hvar>
......@@ -1431,7 +1430,7 @@ returned by the parser function @code{f}. We may also in the second version use
@chapter Overview
This is a configureable expression parser that can be used for prolog parsing as well as parsing C and C++ expressions. To note is that the data is functionally updated and hence one can store the state at will and later reinstate the parser. The parser ideom is a direct translation of the commonly described prolog parser written in prolog to guile-log. It is then extended to allow ternial operators like @code{?} in c as well. To use it load the module @code{(logic guile-log parsing operator-parser)}
@chapter Api
@section Api
@findex make-opdata
@code{(make-opdata)}, initiates a datastructure to containe needed operator data. The result is a fluid pointing to a functional datastructure.
if test "@abs_top_srcdir@" != "@abs_top_builddir@"; then
export PATH
exec "$@"
GOBJECTS = $(SOURCES:%.scm=%.go)
nobase_go_DATA = $(GOBJECTS)
# Make sure source files are installed first, so that the mtime of
# installed compiled files is greater than that of installed source
# files. See
# <>
# for details.
guile_install_go_files = install-nobase_goDATA
$(guile_install_go_files): install-nobase_modDATA
GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
SUFFIXES = .scm .go
$(AM_V_GEN)$(top_builddir)/env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
\ No newline at end of file
......@@ -73,10 +73,24 @@
;;need to add modded,
(let ((file (%search-load-path "logic/guile-log/src/")))
(if file
(load-extension file "gp_init")
(error " is not present, did you forget to make it?")))
(catch #t
(lambda ()
(load-extension "libguile-log" "gp_init"))
(lambda x
(warn "libguile-log is not reached from standard extension location")
(let ((file
(%search-load-path "logic/guile-log/src/.libs/")))
(catch #t
(lambda ()
(load-extension file "gp_init"))
(lambda x
(pk x)
"libguile-log is not loadable!")))
"libguile-unify is not present, did you forget to make it?")))))
(define-syntax-rule (definek x val)
(module-define! (current-module) 'x val))
......@@ -37,85 +37,87 @@
(<define> (<collect> Lam X L)
(<fold> cons '() X L))
(<fold> cons '() Lam X L))
(<define> (<collect-2> Lam X Y L)
(<fix-fold> cons '() X Y L))
(<fix-fold> cons '() Lam X Y L))
(<define> (<sum> Lam X L)
(<fold> + 0 X L))
(<fold> + 0 Lam X L))
(<define> (<sum-2> Lam X Y L)
(<fix-fold> + 0 X Y L))
(<fix-fold> + 0 Lam X Y L))
(<define> (<prod> Lam X L)
(<fold> * 1 X L))
(<fold> * 1 Lam X L))
(<define> (<prod-2> Lam X Y L)
(<fix-fold> * 1 X Y L))
(<fix-fold> * 1 Lam X Y L))
(<define> (<max> Lam X L)
(<fold> max -Inf.0 X L))
(<fold> max -Inf.0 Lam X L))
(<define> (<max-2> Lam X Y L)
(<fix-fold> max -Inf.0 X Y L))
(<fix-fold> max -Inf.0 Lam X Y L))
(<define> (<min> Lam X L)
(<fold> min Inf.0 X L))
(<fold> min Inf.0 Lam X L))
(<define> (<min-2> Lam X Y L)
(<fix-fold> mix Inf.0 X Y L))
(<define> (<min-2> Lam X Y L)
(<fix-fold> mix Inf.0 Lam X Y L))
(define (and* x y) (and x y))
(define (or* x y) (or x y))
(<define> (<soland> Lam X L)
(<fold> and #t X L))
(<fold> and* #t Lam X L))
(<define> (<soland-2> Lam X Y L)
(<fix-fold> and #t X Y L))
(<fix-fold> and* #t Lam X Y L))
(<define> (<solor> Lam X L)
(<fold> or #f X L))
(<fold> or* #f Lam X L))
(<define> (<solor-2> Lam X Y L)
(<fix-fold> or #f X Y L))
(<fix-fold> or* #f Lam X Y L))
(<define> (<collect-step> Lam X L)
(<fold-step> cons '() X L))
(<fold-step> cons '() Lam X L))
(<define> (<collect-step-2> Lam X Y L)
(<fix-fold-step> cons '() X Y L))
(<fix-fold-step> cons '() Lam X Y L))
(<define> (<sum-step> Lam X L)
(<fold> + 0 X L))
(<fold> + 0 Lam X L))
(<define> (<sum-step-2> Lam X Y L)
(<fix-fold> + 0 X Y L))
(<fix-fold> + 0 Lam X Y L))
(<define> (<prod-step> Lam X L)
(<fold> * 1 X L))
(<fold> * 1 Lam X L))
(<define> (<prod-step-2> Lam X Y L)
(<fix-fold> * 1 X Y L))
(<fix-fold> * 1 Lam X Y L))
(<define> (<max-step> Lam X L)
(<fold-step> max -Inf.0 X L))
(<fold-step> max -Inf.0 Lam X L))
(<define> (<max-step-2> Lam X Y L)
(<fix-fold-step> max -Inf.0 X Y L))
(<fix-fold-step> max -Inf.0 Lam X Y L))
(<define> (<min-step> Lam X L)
(<fold> min Inf.0 X L))
(<fold> min Inf.0 Lam X L))
(<define> (<min-step-2> Lam X Y L)
(<fix-fold> mix Inf.0 X Y L))
(<fix-fold> mix Inf.0 Lam X Y L))
(<define> (<soland-step> Lam X L)
(<fold> and #t X L))
(<fold> and* #t Lam X L))
(<define> (<soland-step-2> Lam X Y L)
(<fix-fold> and #t X Y L))
(<fix-fold> and* #t Lam X Y L))
(<define> (<solor-step> Lam X L)
(<fold> or #f X L))
(<fold> or* #f Lam X L))
(<define> (<solor-step-2> Lam X Y L)
(<fix-fold> or #f X Y L))
(<fix-fold> or* #f Lam X Y L))
(define-module (logic guile-log guile-prolog continuations)
#:use-module (logic guile-log)
#:use-module (logic guile-log prompts)
#:use-module (logic guile-log umatch)
#:use-module (logic guile-log prolog goal-functors)
#:use-module (logic guile-log iso-prolog)
#:export (abort_to_prompt with_prompt generator next yield translate
re_prompt call_k
run run2 run3 run4))
(define prompt-tag (list 'prolog-prompt))
(<define> (abort_to_prompt tag data feed)
(<abort> prompt-tag (<lambda> (x) (<=> x feed) <cc>) tag data))
(<define> (with_prompt tag code handler-data handler)
(<prompt> prompt-tag '()
(<lambda> () (goal-eval code))
(<lambda> (t next k tt data)
(<if> (<=> tt tag)
(<=> handler-data ,(list tt next k data))
(goal-eval handler))
(define re_prompt
((tag k hdata handle data)
(<re-prompt> (<lookup> k)
(<lambda> (t next k tt data)
(<if> (<=> tt tag)
(<=> hdata ,(list tt next k data))
(goal-eval handle))
(list data)))
((k hdata handle data)
(<re-prompt> (<lookup> k)
(<lambda> (t next k tt data)
(<=> hdata ,(list tt next k data))
(goal-eval handle))
(list data)))))
(define call_k
(([K X] X D (((<lookup> K)) D)))))
(compile-string "yield(X) :- abort_to_prompt(generator,X,_).")
(compile-string "eat(X) :- abort_to_prompt(generator,_,X).")
(compile-string "generator(Goal,F) :-
with_prompt(generator, Goal,[generator,_,K,X],
(<define> (pref)
(<pp> (gp-handlers-ref)))
next([K,X],X,F) :- re_prompt(K,[generator,_,K2,XX],F=[K2,XX],_).
feed([K,_],Y,F) :- re_prompt(K,[generator,_,K2,_ ],F=[K2,_ ],Y).
translate([K,X],X,Y,F) :- re_prompt(K,[generator,_,K2,XX],F=[K2,XX],Y).
;; Example 1 (run)
sum(S) :- write(sum(S)),nl,eat(X),write(y(X)),nl,SS is S + X,sum(SS).
run :- generator(iter(0),F),generator(sum(0),S),pr(F,S).
pr(F,S) :- next(F,X,FF) -> write(n(X)),nl, feed(S,X,SS),pr(FF,SS).
iter(N) :- write(iter(N)),nl,N < 10 -> (yield(N),N2 is N + 1, iter(N2)).
;; Example 2 (run2)
iter2(N) :- write(iter2(N)),nl,N < 10 -> (yield(N) ; N2 is N + 1, iter2(N2)).
run2 :- generator(iter2(0),F),pr2(F,S).
pr2(F,S) :- next(F,X,FF),fail.
;; Example 3 (run3)
iter3(S,N) :- N < 10 -> (write(iter3(S,N)),nl,N2 is N + 1, iter3(S,N2)) ; true.
run3 :- generator((eat(X),iter3(X,X)),F),pr3(F).
pr3(F) :- call_k(F,_,0),write('--------'),nl,call_k(F,_,5).
;; Example 4 (run4)
iter4(S,N) :- N < 10 -> (write(iter4(S,N)),nl;N2 is N + 1, iter4(S,N2)).
run4 :- generator((eat(X),iter4(X,X)),F),pr4(F).
pr4(F) :- (call_k(F,_,0);call_k(F,_,5)),fail.
\ No newline at end of file
(define-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log memoize)
#:use-module (logic guile-log hash)
#:use-module (logic guile-log vlist)
#:use-module (logic guile-log prolog utils)
#:use-module (logic guile-log)
#:export (hashp hash_ref hash_cons guard_hash
dynamic_hashp dynamic_hash_ref dynamic_hash_set
with_dynamic_hash gurad_dynamic_hash
(mk-sym hash)
;; TODO: debug and stabilize the C-vlist code
;; TODO: These hashes get's bloated if we do a lot of hash-cons in which case
;; onw might wand hash_set_x!! in stead of vhash-cons
;; TODO we need to make a better matcher between K,V in case of variables
;; We need to support vectors or f(X) like objects
;; TODO: vhash must be intelligent with respect to truncate
;; TODO: EQ, hashes EQV hashes?
;; TODO: hash fold
;; TODO: region guarding.
A fundamental issue with a hash-table with vhashes is that of making it
robust and fast at the same time. The problem has to do with the ability
to store an old value of the hash for use later we need an actions to
backtrack hashes a cool way of doing this is with the help of a var-list
We need to patch the unwind function and make use of a list of parameters
(<define> (dynamic-hashp x) (when (dynamic-vhash? (<lookup> x))))
(<define> (hashp x) (when (vhash? (<lookup> x))))
(<define> (hash_ref h k ret)
(<let> ((h (<lookup> h))
(k (memo-it k)))
((<var?> h)
((not (vash? h))
(type_error hash h))
(<let> ((val (vhash-assoc h (<scm> k))))
(when val
(<=> ,(unmemo-it ret) (k . val))))))))
(<define> (hash_cons h k v hret)
(<let*> ((h (<lookup> h))
(k.v (memo-it (cons k v)))
(k (car k.v))
(v (cdr k.v)))
((<var?> h)
((not (vhash? h))
(type_error hash h))
(<=> hret ,(vhash-cons h k v))))))
(<define> (dynamic_hash_ref h k ret)
(<let> ((h (<lookup> h))
(k (<lookup> k)))
((<var?> h)
((not (dynamic-vhash? h))
(type_error hash h))
(<let> ((h (fluid-ref? h)))
(<let> ((val (vhash-assoc h (memo-it k))))
(when val
(<=> ret (k . val))))))))
(<define> (dynamic_hash_set h k v)
(<let> ((h (<lookup> h)))
((<var?> h)
((not (dynamic-vhash? h))
(type_error hash h))
(<let>* ((hh (fluid-ref h))
(k.v (memo-it (cons k v)))
(k (car k.v))
(v (cdr k.v)))
(<code> (fluid-set! h (vhash-cons hh k v))))))))
(define with_hash <with-hash>)
(define guard_hash <guard-hash>)
(define dynamic_with_hash <with-mutating-hash>)
(define dynamic_guard_hash <guard-mutating-hash>)
\ No newline at end of file
(define-module (logic guile-log guile-prolog interleave)
#:use-module (logic guile-log)
#:export (or_i and_i or_union))
(define-syntax-rule (mk-i or_i f)
(<define> (or_i . x)
(<let> ((x (map (lambda (x) (<lambda> () (goal-evel x))) x)))
(<apply> (@@ (logic guile-log interleave) f) x))))
(mk-i or_i f-interleave)
(mk-i and_i and-interleave)
(mk-i or_union f-interleave-union)
\ No newline at end of file
interact with scheme expressions e.g.
(<define> (scheme L Out)
(<=> Out ,(eval (<scm> L) (current-module))))
(define-module (logic guile-log guile-prolog zip)
#:use-module (logic guile-log)
#:use-module (logic guile-log prolog error)
#:use-module (logic guile-log prolog names)
#:use-module (logic guile-log prolog goal-functors)
#:use-module (logic guile-log prolog goal-transformers)
#:export (zip usr_zip update lane update)
#:export (zip #;usr_zip #;update lane update))
(define-syntax-rule (mk-sym a)
......@@ -43,7 +44,7 @@
(zip_ x code))
(type_error zip l))))
(<define> (usr_zip_ fs xs cs guard)
(<match> (#:mode - #:name zip_) (fs xs codes)
(() () ()
......@@ -88,7 +89,7 @@
(usr_zip fl xl cl guard)))))
(<define> (usr_zip . l)
(<match> (#:mode - #:name zip) (l)
((#((,lane f x cs)) ... guard)
......@@ -96,6 +97,7 @@
(type_error zip l))))
(define update
(<define> (zip_ xs codes)
(<match> (#:mode - #:name zip_) (xs codes)
(() ()
((x) (c)
(goal-eval c))
((x1 x2) (c1 c2)
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))))
((x1 x2 x3) (c1 c2 c3)
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))
(x3 (goal-eval c3))))
((x1 x2 x3 x4) (c1 c2 c3 c4)
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))
(x3 (goal-eval c3))
(x4 (goal-eval c4))))
((x1 x2 x3 x4 . xl) (c1 c2 c3 c4 . cl)
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))
(x3 (goal-eval c3))
(x4 (goal-eval c4))
(xl (zip_ xl cl))))))
\ No newline at end of file
......@@ -3,15 +3,14 @@
#:use-module (ice-9 match)
#:use-module (logic guile-log)
#:use-module (logic guile-log functional-database)
#:use-module ((logic guile-log prolog goal-transformers)
#:use-module ((logic guile-log prolog names)
#:select (! fail true))
#:use-module (logic guile-log prolog goal-functors)
#:use-module (system base compile)
#:use-module (logic guile-log umatch)
#:export (compile-prolog))
(define cm (resolve-module '(logic guile-log prolog goal-transformers)))
;(define cm (resolve-module '(logic guile-log iso-prolog)))
(define do-print #f)
(define pp
......@@ -8,15 +8,11 @@
#:use-module (logic guile-log prolog var)
#:use-module ((logic guile-log prolog util)
#:select ((member . pr-member)))
#:use-module ((logic guile-log prolog goal-transformers)
#:select (atom))
#:use-module (logic guile-log)
#:use-module (ice-9 match)
#:re-export (define-dynamic define-dynamic!)
#:export (asserta assertz clause retract abolish current_predicate))
(define divide (@@ (logic guile-log prolog goal-transformers) divide))
(define-syntax-rule (mk-assert+ asserta <push-dynamic>)
(<define> (asserta Arg)
(<match> (#:mode - #:name asserta) (Arg)
......@@ -5,7 +5,6 @@
#:use-module (ice-9 match)
#:use-module (logic guile-log prompts)
#:use-module (logic guile-log umatch)
#:use-module (logic guile-log prolog names)
#:use-module (system repl error-handling)
#:replace (error)
......@@ -193,6 +192,3 @@
(define *call-expression* (gp-make-var #f))
(set! (@@ (logic guile-log prolog names) type_error) type_error)
(set! (@@ (logic guile-log prolog names) existence_error) existence_error)
......@@ -32,10 +32,10 @@
#:replace (catch throw)
#:export (call unify_with_occurs_check copy_term
findall bagof setof functor arg
var atom atomic compound nonvar
var atomic compound nonvar
! once
-var -atom unary-minus
......@@ -769,6 +769,7 @@ floor(x) (floor x)
(<define> (fail) <fail>)
(<define> (true) <cc>)
(define-goal-functor (!)
(<with-fail> CUT <cc>))
......@@ -819,3 +820,5 @@ floor(x) (floor x)
(set! (@ (logic guile-log prolog names) fact) fact)
(set! (@ (logic guile-log prolog names) true) true)
(set! (@ (logic guile-log prolog names) fail) fail)
(set! (@ (logic guile-log prolog names) !) !)
(set! (@ (logic guile-log prolog names) atom) atom)
......@@ -26,10 +26,12 @@
;; directives
......@@ -162,10 +164,6 @@
(define a (make-unbound-fkn 'a))
(set-procedure-property! a 'name 'a)))
;; Error
(mk-sym type_error)
(mk-sym existence_error)
(mk-sym is-a-num?)
(mk-sym check-num)
......@@ -174,6 +172,8 @@
(mk-sym fact)
(mk-sym true)
(mk-sym fail)
(mk-sym !)
(mk-sym atom)
(mk-sym character_code)
(mk-sym not_less_than_zero)
This diff is collapsed.
## The library
extlibdir = $(libdir)/guile/2.0/extensions
libguile_log_la_SOURCES = unify.c
libguile_log_la_CFLAGS = $(AM_CFLAGS) $(GUILE_CFLAGS)
libguile_log_la_LIBADD = $(GUILE_LIBS)
libguile_log_la_LDFLAGS = -export-dynamic -module -avoid-version
noinst_HEADERS = unify.h