fix bug in prolog/compile.scm that affected dynamic functions

parent 1cd4f59d
......@@ -45,6 +45,7 @@
(define (get-fkn x)
(let ((r (hashq-ref fkns x #f)))
(unless r (error "BUG, prolog compile did not manage to find fkn"))
(pp 'get-fkn `(,x ,r))
r))
(define (get-var x)
......@@ -215,12 +216,12 @@
(define (compile-var x)
(define (map-cons l)
(umatch (#:mode - #:status s #:name compile-match) ((pp 'compile-var l))
(umatch (#:mode - #:status s #:name compile-match) ((pp 'compile-var2 l))
((a . l)
(list 'cons (compile-var a) (map-cons l)))
(a (compile-var a))))
(umatch (#:mode - #:status s #:name compile-match) (x)
(umatch (#:mode - #:status s #:name compile-match) ((pp 'compil-var1 x))
(#((f . a))
(list 'vector (cons* 'list (get-fkn f)
(map* compile-var a))))
......@@ -228,12 +229,12 @@
(list 'cons (compile-var a) (map-cons l)))
(a
(let ((a (gp-lookup a s)))
(let ((a (pp 'u (gp-lookup a s))))
(cond
((gp-var? a s)
(get-var a))
((procedure? a)
(get-fkn f))
(get-fkn a))
((symbol? a)
(list 'quote a))
((not (ident? a))
......@@ -246,12 +247,12 @@
(scan-var add-exvar a)
(scan-goal f)
(pp `(compile ,a ,f))
(let ((aa (compile-match a))
(let ((aa (pp 'aa (compile-match a)))
(ff (compile-goal f))
(aaa (compile-var a))
(aaa (pp 'aaa (compile-var a)))
(fff (compile-var f))
(vfkn (hash-fold (lambda (k v r) (cons v r)) '() fkns))
(ffkn (hash-fold (lambda (k v r) (cons k r)) '() fkns))
(ffkn (pp 'ffkn (hash-fold (lambda (k v r) (cons k r)) '() fkns)))
(vars (hash-fold (lambda (k v r) (cons v r)) '() in-house))
(ovars (hash-fold (lambda (k v r) (cons v r)) '() ex-house)))
(apply (compile (pp `(lambda (,@vfkn ,@vars ,@ovars)
......
......@@ -58,9 +58,9 @@
(#((F . A))
(<cut>
(<recur> lp ((F (<lookup> F)))
(if (not (dynamic? F))
(if (procedure? F)
(if (object-property F 'prolog-symbol)
(if (not (dynamic? F))
(if (procedure? F)
(if (object-property F 'prolog-symbol)
(lp (F))
(permission_error modify static_procedure
(vector
......@@ -69,12 +69,13 @@
(length (<scm> A))))))
(type_error callable F))
(<push-dynamic> (<lookup> F)
(catch #t
(lambda () (compile-prolog S A true))
(lambda x
(format #t "~a" x)
(type_error S P CC callable true))))))))
(<and>
(<push-dynamic> (<lookup> F)
(catch #t
(lambda () (compile-prolog S A true))
(lambda x
(format #t "~a" x)
(type_error S P CC callable true)))))))))
(F
(if (procedure? (<lookup> F))
......@@ -147,8 +148,8 @@
(cond
((dynamic? F)
(<and>
(<clause-dynamic> F A true)
(<retract-dynamic> F (cons A true))))
(<clause-dynamic> F A true))
(<retract-dynamic> F (cons A true)))
((object-property F 'prolog-symbol)
(lp (F)))
......
......@@ -247,11 +247,7 @@
(else
(<code> (error "Bug in prolog flag 'unknown' implementation"))))))))
(<define> (<iss> x y)
(<let> ((x (<lookup> x)))
(if (<var?> x)
(<=> x y)
(when (my-equal? x y)))))
(<define> (<iss> x y) (<r=> x y))
(define-syntax-rule (mk-prolog-abstract tp op fk-name tr-name)
(begin
......
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