documentation

parent ade0ec4f
This diff is collapsed.
......@@ -6,10 +6,7 @@
#:use-module (ice-9 pretty-print)
#:use-module (srfi srfi-1)
#:use-module (system repl repl)
#:re-export (u-cons u-abort u-var! u-scm u-unify! u-unify-raw!)
#:export (umatch))
(define-syntax umatch (syntax-rules () ((a . l) (um . l))))
#:re-export (umatch u-cons u-abort u-var! u-scm u-unify! u-unify-raw!))
(define log-module
(resolve-module
......
......@@ -2,12 +2,12 @@
<with-prolog-environment> <collector> parse<> <eval>
<cc> <fail> <let> <let*> <var> </.> <ask> <ret> <when>
<define> <cut> <pp> <pp-dyn> <set-cut>
bag-of/3 set-of/3 <run> <recur>
bag-of/3 set-of/3 <run> <recur> <letrec>
<with-bt> <exec> <funcall> <take> <*> <lambda>
<match> <=> <==> *r* ! !! <repl-vars> <unify> <apply>
<and!> <and!!> <if-only> <succeeds>
<match> <=> <r=> <==> *r* ! !! <repl-vars> <unify> <apply>
<and!> <and!!> <succeeds>
<format> <tail-code> <code> <ret> <return>
<def> <<define>>
<def> <<define>> <with-fail>
unwind-mute unwind-interval unwind-token
let<> mark-once/2 mark/2
<or!>)
......@@ -411,11 +411,6 @@
((_ (cut fi pr cc) a ...)
(let ((ccc (lambda (cc) (lambda (Pr) (cc pr)))))
(and!! w ccc a ...)))))
#|
(<if-only> cond then) = (<and> (<and!> cond) then)
(<if-only> cond then else) = (<or> (<and> (<and!> cond) then)
(<and> (<not> cond) else))
|#
;; this will try to make a success and if so reset the state and continue it's a
;; companion to <not>.
......@@ -683,6 +678,11 @@
(<and> code ...)))))
(n p cc v ...)))))
(define-guile-log <letrec>
((_ (cut q p cc) ((v lam) ...) code ...)
(letrec ((v lam) ...)
(parse<> (cut q p cc)
(<and> code ...)))))
(define-syntax find-last0
(syntax-rules ()
......@@ -822,7 +822,7 @@
(define-guile-log let<>
(syntax-rules ()
((_ w (a b ...) code ...)
(let<>0 w a (let<> (b ...) code ...)))
(let<>0 w a (let<> w (b ...) code ...)))
((_ w () code ...)
(parse<> w (<and> code ...)))))
......@@ -852,6 +852,12 @@
(<=>q wc (u-unify! +) X Y))))
(log-code-macro '<=>)
(define-guile-log <r=>
(syntax-rules ()
((_ wc X Y)
(<=>q wc (gp-unify-raw! ++) X Y))))
(log-code-macro '<=>)
(define-guile-log <==>
(syntax-rules ()
((_ wc X Y)
......
......@@ -150,6 +150,13 @@ static inline void gp_unwind0(SCM *ci, SCM *si)
DB(printf("unwind>\n");fflush(stdout));
if(ci >= gp_ci || si >= gp_si)
{
if(ci >= gp_ci && si >= gp_si)
return;
printf("ERROR in unwind, ci and si not larger at the same time\n");
return;
}
ci_old = gp_ci;
gp_ci = ci;
gp_si = si;
......
......@@ -23,19 +23,18 @@
#:use-module (ice-9 pretty-print)
#:use-module (srfi srfi-1)
#:export (gp-clear gp-unify! gp-unify-raw! gp-newframe gp-unwind gp-var!
gp->scm scm->gp gp-atom fast-match def
gp-print
gp->scm gp-print
gp-budy gp-swap-to-a gp-swap-to-b gp-m-unify!
fun *gp-fi* g-member g-iright u-prompt
u-abort u-set! u-var! u-call u-deref gp-atomic?
u-context u-modded
u-unify! u-scm u-unify-raw! u-cons gp-lookup
gp-var? gp-cons? gp-cons! let-alias gp-set! u-list
gp-lookup
gp-var? gp-cons! gp-set! u-list
gp-printer gp-var-number
gp-car gp-cdr
gp-car gp-cdr gp-pair?
gp-store-state gp-restore-state
gp-make-fluid gp-fluid-set! gp-fluid-ref with-gp-fluids
u-dynwind umatch um <umatch> gp-copy))
u-prompt u-abort u-set! u-var! u-call u-deref gp-atomic?
u-context u-modded
u-unify! u-scm u-unify-raw! u-consu-dynwind umatch
gp-copy))
;;need to add modded,
......@@ -197,7 +196,8 @@
(define-syntax umatch**+
(syntax-rules ()
((_ ((code) ...) a . l) (umatch*** (code ...) a . l))
((_ ((code) ...) a . l)
(umatch*** (code ...) a . l))
((_ ((a as ...) ...) () . l)
(umatch** ((as ...) ...) ((a) ...) . l))
......@@ -213,26 +213,29 @@
;(pk `(umatch*** ,@(syntax->datum #'l)))
#'(umatch***+ . l)))))
(define (ppq a x)
;(pk `(,a ,x))
x)
(define-syntax ppq
(syntax-rules () ((_ a x) x)))
(define (mk-failure0 fr code)
(letrec ((base (case-lambda
(()
(gp-unwind fr)
(code))
((x)
(gp-unwind fr)
(let ((s (gp-store-state)))
(letrec ((self (case-lambda
(() (base))
((x) self))))
self))))))
base))
(define-syntax mk-failure
(syntax-rules ()
((_ fr code)
(letrec ((base (case-lambda
(()
(gp-unwind fr)
code)
((x)
(gp-unwind fr)
(let ((s (gp-store-state)))
(letrec ((self (case-lambda
(() (base))
((x) self))))
self))))))
base))))
(mk-failure0 fr (lambda () code)))))
(define-syntax umatch***+
(syntax-rules (+)
......@@ -264,5 +267,3 @@
(_ (error (format #f "umatch ~a did not match" n))))))))
(define-syntax um (syntax-rules () ((a . l) (umatch . l))))
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