From d9273eccf3dc9d0d0b06567b19a78fcadff5a74d Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 20 May 2018 22:35:26 -0700 Subject: [PATCH] =?utf8?q?Implement=20spar-arg:id!=3D=3F=20to=20handle=20u?= =?utf8?q?seful=20case.?= --- src/runtime/runtime.pkg | 1 + src/runtime/syntax-parser.scm | 16 +++++++++++++--- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 59d13a93b..3713409d5 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -4614,6 +4614,7 @@ USA. spar-arg:close spar-arg:form spar-arg:hist + spar-arg:id!=? spar-arg:id=? spar-arg:senv spar-arg:value diff --git a/src/runtime/syntax-parser.scm b/src/runtime/syntax-parser.scm index 30f5b82a6..d6c374242 100644 --- a/src/runtime/syntax-parser.scm +++ b/src/runtime/syntax-parser.scm @@ -157,8 +157,10 @@ USA. ((eq? arg spar-arg:close) (make-closer (%input-closing-senv input))) ((eq? arg spar-arg:ctx) (serror-ctx (%input-form input) senv (%input-hist input))) + ((eq? arg spar-arg:id!=?) + (make-id!=? (%input-closing-senv input) senv (%input-form input))) ((eq? arg spar-arg:id=?) - (make-comparer (%input-closing-senv input) senv (%input-form input))) + (make-id=? (%input-closing-senv input) senv (%input-form input))) ((eq? arg spar-arg:senv) senv) ((eq? arg spar-arg:value) (%output-top output)) ((eq? arg spar-arg:values) (%output-all output)) @@ -168,21 +170,28 @@ USA. (lambda (expr) (close-syntax expr closing-senv))) -(define (make-comparer closing-senv use-senv form) +(define (make-id=? closing-senv use-senv form) (lambda (reference #!optional comparand) (let ((comparand (if (default-object? comparand) form comparand))) (and (identifier? comparand) (identifier=? closing-senv reference use-senv comparand))))) +(define (make-id!=? closing-senv use-senv form) + (lambda (reference #!optional comparand) + (let ((comparand (if (default-object? comparand) form comparand))) + (and (identifier? comparand) + (not (identifier=? closing-senv reference use-senv comparand)))))) + (define-deferred spar-arg:form (string->uninterned-symbol ".form.")) (define-deferred spar-arg:hist (string->uninterned-symbol ".hist.")) (define-deferred spar-arg:close (string->uninterned-symbol ".close.")) (define-deferred spar-arg:ctx (string->uninterned-symbol ".ctx.")) +(define-deferred spar-arg:id!=? (string->uninterned-symbol ".id!=?.")) (define-deferred spar-arg:id=? (string->uninterned-symbol ".id=?.")) (define-deferred spar-arg:senv (string->uninterned-symbol ".senv.")) (define-deferred spar-arg:value (string->uninterned-symbol ".value.")) (define-deferred spar-arg:values (string->uninterned-symbol ".values.")) - + (define (spar-match predicate . args) (lambda (input senv output success failure) (if (apply (%subst-arg input senv output predicate) @@ -523,6 +532,7 @@ USA. ((form) spar-arg:form) ((hist) spar-arg:hist) ((close) spar-arg:close) + ((id!=?) spar-arg:id!=?) ((id=?) spar-arg:id=?) ((senv) spar-arg:senv) ((value) spar-arg:value) -- 2.25.1