compile to source bug removed in match.scm

parent 48253741
......@@ -162,7 +162,7 @@
:- op(700, xfx, cis_leq).
:- op(700, xfx, cis_lt).
%:- fast_compile(true).
:- fast_compile(true).
/** <module> Constraint Logic Programming over Finite Domains
......
......@@ -15,10 +15,14 @@
(if r
#`(list-ref taglist #,r)
r)))
(define (mks x) (datum->syntax stx (procedure-name x)))
(let ((x (gp-lookup x s)))
(cond
((number? x)
((and (pair? x) (number? (car x))) ;; internal variable
(car x))
((number? x) ;;Instruction
(mkn x))
((procedure? x)
(mks x))
......@@ -34,7 +38,7 @@
(set! i (+ i 1)))
taglist)
m))
(define pp #f)
(define* (tr x #:optional (m #f))
(define-syntax-rule (tr-it x (i j nm) ...)
......@@ -260,7 +264,8 @@
`(,@(lp x mode) ,(tr 'next-vec) ,@(lp2 l))))))))))
(x
(if (gp-var? x s)
(let ((x (gp-lookup x s)))
(if (gp-var? x s)
(if (hashq-ref ev x #f)
(aif (r) (hashq-ref touch x #f)
(list (tr 'unify_external mode)
......@@ -276,10 +281,10 @@
(list-ref external-vars next-e)))))
(aif (r) (hashq-ref touch x #f)
(list (tr 'unify_internal mode) r)
(let ((next-i (ni)))
(let ((next-i (if source? (list (ni)) (ni))))
(hashq-set! touch x next-i)
(list (tr 'match_var) next-i))))
(list (tr 'unify_scm mode) x)))))))))
(list (tr 'unify_scm mode) x))))))))))
(define mu (make-fluid '()))
......@@ -318,9 +323,9 @@
#`((@ (guile) vector) #,@(pu (map (lambda (co) (repr s source? co))
(vector->list comp)))))
;(set! pp #t)
;(pretty-print `(compiled ,(compile-match source? s pat code)))
;(set! pp #f)
; (set! pp #t)
; (pretty-print `(compiled ,(compile-match source? s pat code)))
; (set! pp #f)
(let* ((comp.table (compile-match source? s pat code))
(comp (car comp.table))
(table (cdr comp.table))
......
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