various fixes to make the compilation smooth

parent 4f4a090c
......@@ -45,15 +45,15 @@ SOURCES = \
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/var.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/base.scm \
logic/guile-log/prolog/io.scm \
logic/guile-log/prolog/char-conversion.scm \
logic/guile-log/prolog/load.scm \
......
......@@ -9,6 +9,21 @@
run run2 run3 run4))
;; Sielence the compiler
(define eat #f)
(define feed #f)
(define iter #f)
(define pr #f)
(define pr2 #f)
(define pr3 #f)
(define pr4 #f)
(define n #f)
(define y #f)
(define sum #f)
(define iter2 #f)
(define iter3 #f)
(define iter4 #f)
(define prompt-tag (list 'prolog-prompt))
(<define> (abort_to_prompt tag data feed)
(<abort> prompt-tag (<lambda> (x) (<=> x feed) <cc>) tag data))
......@@ -77,8 +92,8 @@ iter(N) :- write(iter(N)),nl,N < 10 -> (yield(N),N2 is N + 1, iter(N2)).
(compile-prolog-string
"
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.
run2 :- generator(iter2(0),F),pr2(F,_).
pr2(F,_) :- next(F,_,_),fail.
")
;; Example 3 (run3)
......
......@@ -222,17 +222,17 @@
'()))))))
(let ((l (map (gen-fkn stx lam?) (pp 'com com))))
(if lam?
(ppp 'res #`(let ()
#,@ini
(let ()
#,@l
#,@evl
#,(datum->syntax stx name))))
(ppp 'res #`(begin
(add-non-defined
(quote #,(datum->syntax stx (get-syms))))
#,@ini #,@l #,@evl))))))
(pp 'res #`(let ()
#,@ini
(let ()
#,@l
#,@evl
#,(datum->syntax stx name))))
(pp 'res #`(begin
(add-non-defined
(quote #,(datum->syntax stx (get-syms))))
#,@ini #,@l #,@evl))))))
(define-syntax save-operator-table
(lambda (x)
......
......@@ -7,7 +7,8 @@
#:select (! fail true))
#:use-module (logic guile-log prolog goal-functors)
#:use-module (system base compile)
#:use-module (logic guile-log umatch)
#:use-module ((logic guile-log umatch)
#:select (gp-make-var gp-var? gp-lookup))
#:export (compile-prolog))
......
(define-module (logic guile-log prolog directives)
#:use-module (logic guile-log)
#:use-module (logic guile-log prolog goal-transformers)
#:use-module (logic guile-log prolog names)
#:use-module (logic guile-log umatch)
#:use-module (logic guile-log prolog dynamic)
......@@ -77,7 +76,7 @@
((#:atom f . _)
(list f))
((#:list a _ _) (apply append (map PI (get.. "," a))))
(_ (format #f err M N))))))
(_ (err N M))))))
PI))
(define *dynamics* (make-fluid '()))
......@@ -352,7 +351,9 @@
k v (get-refstr N M))))))
#f)
(define (mk-err nm) (string-append "at ~a in " nm ", not a PI list"))
(define (mk-err nm)
(lambda (N M)
(format #f "at ~a in ~a , not a PI list" (get-refstr N M) nm)))
(define-PI dynamic define-dynamic! (mk-err "dynamic"))
(define-PI multifile define-multifile! (mk-err "multifile"))
......
......@@ -132,6 +132,10 @@
(define arith-ints '("ash" "logior" "logand" "lognot" "modulo"))
(define number #f)
(define integer #f)
(define source_sink #f)
(define scheme-wrapper
(let ()
(letrec ((g (lambda (fkn)
......@@ -173,7 +177,7 @@
(wrap (instantiation_error s p cc)))
((member fkn ariths)
(warap (type_error s p cc number val)))
(wrap (type_error s p cc number val)))
((member fkn arith-ints)
(wrap (type_error s p cc integer val)))
......
......@@ -192,7 +192,7 @@
((#:list (or (#:variable x _ _)
(#:atom x _ _ _ _)
(#:string x _ _)) _ _)
(datum->syntax stx (pk `(load-prolog ,x))))
(datum->syntax stx `(load-prolog ,x)))
((#:atom 'true . _) #'<cc>)
((#:atom 'fail . _) #'<fail>)
......@@ -254,6 +254,6 @@
(define (fff stx x)
(match x
((and atom (#:atom f _ _ _ _))
(get-binding atom stx))
(get-binding atom stx (lambda (x) x)))
((#:variable v _ _)
(datum->syntax stx v))))
\ No newline at end of file
(define-module (logic guile-log prolog io)
#:use-module (logic guile-log)
#:use-module (logic guile-log umatch)
#:use-module ((logic guile-log umatch)
#:select (gp-var? gp-lookup gp->scm))
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (logic guile-log prolog base)
#:use-module ((logic guile-log prolog util)
#:select ((member . pr-member) append))
......
......@@ -220,6 +220,7 @@
(mk-sym double_quotes)
(mk-sym float)
(mk-sym number)
(mk-sym integer)
(mk-sym force)
(mk-sym input)
......@@ -259,4 +260,8 @@
(mk-sym char_conversion)
(mk-sym char-convert)
\ No newline at end of file
(mk-sym char-convert)
(set! (@@ (logic guile-log prolog error) number) number)
(set! (@@ (logic guile-log prolog error) integer) integer)
(set! (@@ (logic guile-log prolog error) source_sink) source_sink)
\ No newline at end of file
(define-module (logic guile-log prolog pre)
#:use-module (ice-9 match)
#:use-module (logic guile-log prolog error)
#:use-module (ice-9 pretty-print)
#:export (get.. get-c pp get-binding get-refstr *prolog-file*
attach-defined-module! get-attached-module))
......
......@@ -2,6 +2,7 @@
#:use-module (logic guile-log)
#:use-module (logic guile-log prolog error)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (logic guile-log umatch)
#:use-module (logic guile-log prompts)
#:export (prolog-run))
......
......@@ -108,7 +108,7 @@
(let ((l.a (fluid-ref *unwind-parameters*)))
(if (pair? l.a)
(gp-fluid-set *unwind-parameters*
(cons l
(cons (car l.a)
(map (lambda (f) (cons f (f)))
(car l.a)))))
(newf s))))
......
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