Implement spar-arg:id!=? to handle useful case.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 59d13a93b4c17b6175a6cafe30578e37b029c9dd..3713409d5da39788f6db028a173e4f4f84404f29 100644 (file)
--- 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 30f5b82a60c570f8b1e2729fd7f7811e19d32183..d6c37424209cd06bc3243a606e4627276bad31cb 100644 (file)
--- 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."))
-
+\f
 (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)