From 3a97b30ca886095bb204f25271f0b256f670f697 Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Sun, 8 Nov 2020 08:04:26 +0900 Subject: wip7 --- rabbit-prover.scm | 34 +++++++++++++++------------------- 1 file changed, 15 insertions(+), 19 deletions(-) (limited to 'rabbit-prover.scm') diff --git a/rabbit-prover.scm b/rabbit-prover.scm index fde842d..a3f0a58 100644 --- a/rabbit-prover.scm +++ b/rabbit-prover.scm @@ -619,43 +619,40 @@ (define current-book (make-parameter '())) -(define (add-book b x) - (cond ((assoc (proposition-name x) b) - => (lambda (prop) - (if (equal? x prop) - b - (error "add-book: error")))) - (else (cons x b)))) +(define (add-book x) + (let ((b (current-book))) + (current-book + (cond ((assoc (proposition-name x) b) + => (lambda (prop) + (if (equal? x prop) + b + (error "add-book: error")))) + (else (cons x b)))))) (define-syntax define-axiom (syntax-rules () ((_ name (var ...) expr) (current-book - (add-book (current-book) - (axiom 'name '(var ...) 'expr)))))) + (add-book (axiom 'name '(var ...) 'expr)))))) (define-syntax define-theorem (syntax-rules () ((_ name (var ...) expr) - (current-book - (add-book (current-book) - (theorem 'name '(var ...) 'expr)))))) + (add-book (theorem 'name '(var ...) 'expr))))) (define-syntax define-function (syntax-rules () ((_ name (var ...) expr) (let ((f (function 'name '(var ...) 'expr))) - (current-book (add-book (current-book) f)) + (add-book f) f)))) (define-syntax define-macro (syntax-rules () ((_ name () ((lhs1 . lhs2) rhs) ...) - (current-book - (add-book (current-book) - (macro 'name - (list (mrule (all-vars 'lhs2) '(lhs1 . lhs2) 'rhs) - ...))))))) + (add-book (macro 'name + (list (mrule (all-vars 'lhs2) '(lhs1 . lhs2) 'rhs) + ...)))))) (define-syntax define-book (syntax-rules () @@ -742,7 +739,6 @@ (equal? (app (app x y) z) (app x (app y z))))) - (define (size x) (if (pair? x) (+ 1 -- cgit v1.2.3