diff options
| -rw-r--r-- | vikalpa.scm | 30 |
1 files changed, 15 insertions, 15 deletions
diff --git a/vikalpa.scm b/vikalpa.scm index c66e130..fb6b500 100644 --- a/vikalpa.scm +++ b/vikalpa.scm @@ -418,19 +418,6 @@ (define (primitive-function-vars pf) (list-ref pf 2)) -(define (match-primitive-function pf expression) - (and (pair? expression) - (eq? (primitive-function-name pf) (car expression)) - (list? (cdr expression)) - (every identity (map (lambda (pred expr) - (and (expr-quoted? expr) - (pred (expr-unquote expr)))) - (primitive-function-preds pf) - (cdr expression))))) - -(define (apply-primitive-function pf expression) - (apply (primitive-function-proc pf) (cdr expression))) - (define (function? x) (and (list? x) (= 4 (length x)) @@ -945,6 +932,18 @@ (error "define-system: error")) (current-system)))))) +(define-syntax system + (syntax-rules () + ((_ (systems ...) expr ...) + (lambda* (#:optional (parent (make-system '() '()))) + (parameterize ([current-system + ((compose systems ... identity) parent)]) + expr + ... + (unless (system? (current-system)) + (error "define-system: error")) + (current-system)))))) + (define (atom? x) (not (pair? x))) @@ -1271,7 +1270,7 @@ (proof-sequence pf))) (() (rewrite sys - (theorem*-expression pf) + (theorem*-expression t) (proof-sequence pf))) (else (error "prove/theorem: fail")))) @@ -1378,6 +1377,7 @@ (next (definition-name (car defs)))))))) (else (format #t "~a の証明がありません(しょぼ〜ん)~%" - (definition-name (car defs)))))))) + (definition-name (car defs))) + (next (definition-name (car defs)))))))) (else (next)))))) |