From ad6afe0004ea32d239e6d06add5768b4b46e2d48 Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Sun, 20 Dec 2020 05:11:47 +0900 Subject: wip59 --- vikalpa.scm | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/vikalpa.scm b/vikalpa.scm index 40b4bf1..1c29e7e 100644 --- a/vikalpa.scm +++ b/vikalpa.scm @@ -21,8 +21,6 @@ system-rewrite system-check system-apropos - system-code - system-load system-eval system-lookup set-measure-predicate @@ -238,7 +236,7 @@ ;; (expression? x) -> boolean? (define (expression? expr) (cond ((expr-quoted? expr) - (or (natural? (expr-unquote expr)) + (or (exact-integer? (expr-unquote expr)) (boolean? (expr-unquote expr)) (symbol? (expr-unquote expr)) (null? (expr-unquote expr)))) @@ -462,7 +460,7 @@ (cond ((assoc expr env) => (const #t)) (else #f))) (else #t))) - (debug "rule: ~a~%" rl) + (debug "rule: lhs: ~a rhs: ~a~%" (rule-lhs rl) (rule-rhs rl)) (debug "preconds: ~a~%" preconds) (debug "expr: ~a~%" expr) (reset @@ -766,14 +764,14 @@ (cond ((if-form? expr) (let ((precond (if-form-test expr))) - (receive (extracted-expr extracted-preconds builder) + (receive (extracted-expr preconds builder) (extract (cdr path) (list-ref expr i) fail) (values extracted-expr (case i - ((1) '()) + ((1) preconds) ((2) (cons (prop-not (prop-not precond)) - extracted-preconds)) - ((3) (cons (prop-not precond) extracted-preconds)) + preconds)) + ((3) (cons (prop-not precond) preconds)) (else (fail 'if-invaild-path path))) (lambda (x) (append (list-head expr i) -- cgit v1.2.3