some standard prolog libraries

parent e63b9ed6
......@@ -91,6 +91,7 @@ SOURCES = \
logic/guile-log/guile-prolog/attributator.scm \
logic/guile-log/examples/kanren/type-inference.scm \
prolog-user.scm \
language/prolog/install.scm \
language/prolog/spec.scm \
language/prolog/modules/library/error.pl \
language/prolog/modules/library/pairs.pl \
......@@ -100,12 +101,28 @@ SOURCES = \
language/prolog/modules/library/optparse.pl \
language/prolog/modules/library/sort.pl \
language/prolog/modules/library/apply.pl \
language/prolog/modules/library/apply_macros.pl \
language/prolog/modules/library/ugraphs.pl \
language/prolog/modules/library/heaps.pl \
language/prolog/modules/library/assoc.pl \
language/prolog/modules/library/gensym.pl \
language/prolog/modules/library/ordsets.pl \
language/prolog/modules/library/oset.pl \
language/prolog/modules/library/rbtrees.pl
language/prolog/modules/library/rbtrees.pl \
language/prolog/modules/library/error.pl.scm \
language/prolog/modules/library/pairs.pl.scm \
language/prolog/modules/library/lists.pl.scm \
language/prolog/modules/library/option.pl.scm \
language/prolog/modules/library/optparse.pl.scm \
language/prolog/modules/library/sort.pl.scm \
language/prolog/modules/library/apply.pl.scm \
language/prolog/modules/library/heaps.pl.scm \
language/prolog/modules/library/assoc.pl.scm \
language/prolog/modules/library/gensym.pl.scm \
language/prolog/modules/library/oset.pl.scm \
language/prolog/modules/library/ordsets.pl.scm \
language/prolog/modules/library/dcg_basics.pl.scm \
language/prolog/modules/library/rbtrees.pl.scm
AM_MAKEINFOFLAGS=--force
AM_MAKEINFOHTMLFLAGS=--force
......
......@@ -2,7 +2,7 @@ GOBJECTS = $(SOURCES:%.scm=%.go)
nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
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
......@@ -16,4 +16,4 @@ EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
SUFFIXES = .scm .go
.scm.go:
$(AM_V_GEN)$(top_builddir)/env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
\ No newline at end of file
$(AM_V_GEN)$(top_builddir)/env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
(define-module (language prolog install)
#:use-module (logic guile-log iso-prolog))
(eval-when (compile load eval)
(define (pwd)
(let lp ((l (environ)))
(if (pair? l)
(let ((x (string-split (car l) #\=)))
(if (equal? (car x) "PWD")
(cadr x)
(lp (cdr l))))
#f)))
(set! %load-path (cons (pwd) %load-path))
(fluid-set! (@@ (logic guile-log prolog modules) relative-path) #t)
(define sources
'((language prolog modules library error)
(language prolog modules library pairs)
(language prolog modules library lists)
(language prolog modules library assoc)
(language prolog modules library rbtrees)
(language prolog modules library oset)
(language prolog modules library ordsets)
(language prolog modules library option)
(language prolog modules library optparse)
(language prolog modules library sort)
(language prolog modules library apply)
(language prolog modules library heaps)
(language prolog modules library gensym)
(language prolog modules library apply_macros)
(language prolog modules library ugraphs)
(language prolog modules library dcg_basics)))
(system* "pwd")
(for-each
(lambda (pth)
((@@ (logic guile-log prolog modules) pre-compile-prolog-file) pth))
sources))
(define-module (language prolog modules library apply.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (include exclude partition partition maplist maplist maplist maplist foldl foldl foldl foldl scanl scanl scanl scanl))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/apply.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../apply.pl")
(define-module (language prolog modules library apply_macros.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (expand_phrase))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/apply_macros.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../apply_macros.pl")
(define-module (language prolog modules library assoc.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (empty_assoc is_assoc assoc_to_list assoc_to_keys assoc_to_values gen_assoc get_assoc get_assoc list_to_assoc map_assoc map_assoc max_assoc min_assoc ord_list_to_assoc put_assoc del_assoc del_min_assoc del_max_assoc))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/assoc.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../assoc.pl")
(define-module (language prolog modules library dcg_basics.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (white whites blank blanks nonblank nonblanks blanks_to_nl string string_without alpha_to_lower digits digit integer float number xdigits xdigit xinteger prolog_var_name eos atom))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/dcg_basics.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../dcg_basics.pl")
(define-module (language prolog modules library error.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (type_error domain_error existence_error permission_error instantiation_error representation_error syntax_error must_be is_of_type))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/error.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../error.pl")
(define-module (language prolog modules library gensym.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (reset_gensym reset_gensym gensym))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/gensym.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../gensym.pl")
(define-module (language prolog modules library heaps.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (add_to_heap delete_from_heap empty_heap get_from_heap heap_size heap_to_list is_heap list_to_heap merge_heaps min_of_heap min_of_heap singleton_heap))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/heaps.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../heaps.pl")
(define-module (language prolog modules library lists.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (member append append prefix select selectchk select selectchk nextto delete nth0 nth1 nth0 nth1 last proper_length same_length reverse permutation flatten max_member min_member sum_list max_list min_list numlist is_set list_to_set intersection union subset subtract))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/lists.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../lists.pl")
(define-module (language prolog modules library occurs.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (contains_term contains_var free_of_term free_of_var occurrences_of_term occurrences_of_var sub_term sub_var))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/occurs.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "/home/stis/src/guile-log/language/prolog/modules/library/occurs.pl")
(define-module (language prolog modules library option.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (option option select_option select_option merge_options meta_options))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/option.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../option.pl")
(define-module (language prolog modules library optparse.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (opt_parse opt_parse opt_arguments opt_help))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/optparse.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../optparse.pl")
(define-module (language prolog modules library ordsets.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (is_ordset list_to_ord_set ord_add_element ord_del_element ord_intersect ord_intersect ord_intersection ord_intersection ord_disjoint ord_subtract ord_union ord_union ord_union ord_subset ord_empty ord_memberchk ord_symdiff ord_seteq ord_intersection))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/ordsets.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../ordsets.pl")
(define-module (language prolog modules library oset.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (oset_is oset_union oset_int oset_diff oset_dint oset_dunion oset_addel oset_delel oset_power))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/oset.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../oset.pl")
(define-module (language prolog modules library pairs.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (pairs_keys_values pairs_values pairs_keys group_pairs_by_key transpose_pairs map_list_to_pairs))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/pairs.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../pairs.pl")
(define-module (language prolog modules library rbtrees.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (rb_new rb_empty rb_lookup rb_update rb_update rb_apply rb_lookupall rb_insert rb_insert_new rb_delete rb_delete rb_visit rb_visit rb_keys rb_keys rb_map rb_map rb_partial_map rb_clone rb_clone rb_min rb_max rb_del_min rb_del_max rb_next rb_previous list_to_rbtree ord_list_to_rbtree is_rbtree rb_size rb_in))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/rbtrees.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../rbtrees.pl")
(define-module (language prolog modules library sort.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (predsort locale_sort))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/sort.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../sort.pl")
(define-module (language prolog modules library ugraphs.pl.scm)
#:use-module (logic guile-log iso-prolog)
#:replace (add_edges add_vertices complement compose del_edges del_vertices edges neighbors neighbours reachable top_sort top_sort transitive_closure transpose vertices vertices_edges_to_ugraph ugraph_union))
(clear-directives)
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/library/ugraphs.pl")
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "../ugraphs.pl")
......@@ -54,6 +54,7 @@
(lp (cdr l) #f r))
r)))
(define relative-path (make-fluid #f))
(define (write-module fpl fscm path)
(define (m p)
(let ((rev (reverse path)))
......@@ -63,8 +64,24 @@
(lambda ()
(prolog-parse-module #f))))
(define (add.. n x)
(if (> n 0)
(add.. (- n 1) (string-append "../" x))
x))
(lambda ()
(let ((r module-data))
(define rpl #f)
(let* ((r module-data)
(a.b (let lp ((rpl (string-split fpl #\/))
(rsc (string-split fscm #\/)))
(if (pair? rpl)
(if (equal? (car rpl) (car rsc))
(lp (cdr rpl) (cdr rsc))
(cons (add.. (length rsc) (string-join rpl "/"))
(string-join rsc "/"))))))
(rpl0 (if (fluid-ref relative-path) (car a.b) fpl))
(rsc (cdr a.b)))
(set! rpl rpl0)
(if r
(format #t "
(define-module ~a
......@@ -77,8 +94,8 @@
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))~%")
(format #t "((@ (guile) define) *prolog-scm-path* ~s)~%" fscm)
(format #t "((@ (guile) define) *prolog-reverse-path* ~s)~%" fpl)))
(format #t "((@ (guile) define) *prolog-scm-path* ~s)~%" "./")
(format #t "((@ (guile) define) *prolog-reverse-path* ~s)~%" rpl)))
(define reg (make-regexp "\\W*\\:\\-\\W*module\\(([^,]*)"))
......
......@@ -83,8 +83,10 @@ subdir = logic/guile-log/src
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/build-aux/depcomp $(noinst_HEADERS)
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \
$(top_srcdir)/configure.ac
am__aclocal_m4_deps = $(top_srcdir)/m4/libtool.m4 \
$(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \
$(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \
$(top_srcdir)/acinclude.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
......@@ -222,10 +224,10 @@ FGREP = /bin/grep -F
GREP = /bin/grep
GUILD = /usr/bin/guild
GUILE = /usr/bin/guile
GUILE_CFLAGS = -pthread -I/usr/include/guile/2.0
GUILE_CFLAGS = -pthread -I/usr/include/guile/2.0
GUILE_CONFIG = /usr/bin/guile-config
GUILE_EFFECTIVE_VERSION = 2.0
GUILE_LIBS = -lguile-2.0 -lgc
GUILE_LIBS = -lguile-2.0 -lgc
GUILE_TOOLS = /usr/bin/guild
INSTALL = /usr/bin/install -c
INSTALL_DATA = ${INSTALL} -m 644
......@@ -308,7 +310,7 @@ mandir = ${datarootdir}/man
mkdir_p = $(MKDIR_P)
oldincludedir = /usr/include
pdfdir = ${docdir}
prefix = /usr
prefix = /usr/local
program_transform_name = s,x,x,
psdir = ${docdir}
sbindir = ${exec_prefix}/sbin
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment