[honu] use reified syntax classes to check for literals instead of direct comparisons with free-identifier=?

collects/honu/core/private/class.rkt

@@ -6,6 +6,7 @@
          (for-syntax racket/base
                      "literals.rkt"
                      "parse2.rkt"
+                     "util.rkt"
                      syntax/parse)
          racket/class)
 
@@ -17,7 +18,7 @@
   (define-splicing-syntax-class honu-class-thing
                                 #:literals (honu-equal)
     [pattern method:honu-function
-             #:with result (replace-with-public #'method.result)]
+             #:with result (replace-with-public (local-binding method.result))]
     [pattern var:honu-declaration
              #:with result #'(field [var.name var.expression] ...)]))
 
@@ -25,14 +26,14 @@
 (define-honu-syntax honu-class
   (lambda (code context)
     (syntax-parse code #:literal-sets (cruft)
-      [(_ name (#%parens (~var constructor-argument (separate-ids #'honu-comma #'dont-care)))
+      [(_ name (#%parens (~var constructor-argument (separate-ids (literal-syntax-class honu-comma) (literal-syntax-class honu-comma))))
           (#%braces method:honu-class-thing ...) . rest)
        (define class
          #'(%racket (define name (class* object% ()
                                          (super-new)
                                          (init-field constructor-argument.id ...)
                                          method.result ...))))
-       (values class #'rest #t)])))
+       (values class (local-binding rest) #t)])))
 
 (provide honu-new)
 (define-honu-syntax honu-new
@@ -42,5 +43,5 @@
        (define new #'(%racket (make-object name arg.result ...)))
        (values
          new
-         #'rest
+         (local-binding rest)
          #f)])))

collects/honu/core/private/honu2.rkt

@@ -16,7 +16,9 @@
                   define-literal
                   %racket)
          (for-syntax syntax/parse
+                     syntax/parse/experimental/reflect
                      racket/syntax
+                     "util.rkt"
                      "debug.rkt"
                      "literals.rkt"
                      "parse2.rkt"
@@ -261,16 +263,16 @@
 
 (begin-for-syntax
   (define-splicing-syntax-class (id-must-be what)
-    [pattern x:id #:when (free-identifier=? #'x what)])
+    [pattern (~reflect x (what))])
-  (define-splicing-syntax-class (id-except ignores)
+  (define-syntax-class (id-except ignore1 ignore2)
-    [pattern x:id #:when (not (for/fold ([ok #f])
+    [pattern (~and x:id (~not (~or (~reflect x1 (ignore1))
-                                        ([ignore ignores])
+                                   (~reflect x2 (ignore2)))))])
-                                (or ok (free-identifier=? #'x ignore))))])
+
   (provide separate-ids)
   (define-splicing-syntax-class (separate-ids separator end)
-    [pattern (~seq (~var first (id-except (list separator end)))
+    [pattern (~seq (~var first (id-except separator end))
                    (~seq (~var between (id-must-be separator))
-                         (~var next (id-except (list separator end)))) ...)
+                         (~var next (id-except separator end))) ...)
              #:with (id ...) #'(first.x next.x ...)]))
 
 (begin-for-syntax
@@ -278,7 +280,8 @@
 
   (define-literal-set declaration-literals (honu-comma honu-equal))
   (define-splicing-syntax-class var-id
-    [pattern x:id #:when (not ((literal-set->predicate declaration-literals) #'x))])
+    [pattern (~var x (id-except (literal-syntax-class honu-comma)
+                                (literal-syntax-class honu-equal)))])
 
   ;; parses a declaration
   ;; var x = 9
@@ -286,7 +289,8 @@
   (define-splicing-syntax-class honu-declaration
                               #:literal-sets (cruft)
                               #:literals (honu-equal honu-var)
-     [pattern (~seq honu-var (~var variables (separate-ids #'honu-comma #'honu-equal))
+     [pattern (~seq honu-var (~var variables (separate-ids (literal-syntax-class honu-comma)
+                                                           (literal-syntax-class honu-equal)))
                     honu-equal one:honu-expression)
               #:with (name ...) #'(variables.id ...)
               #:with expression #'one.result]))

collects/honu/core/private/util.rkt

@@ -3,7 +3,12 @@
 (provide (except-out (all-defined-out) test-delimiter))
 (require "debug.rkt"
          racket/match
-         (for-syntax racket/base)
+         syntax/parse
+         syntax/parse/experimental/reflect
+         (for-syntax racket/base
+                     syntax/parse
+                     "debug.rkt"
+                     )
          syntax/stx
          racket/list)
 
@@ -94,3 +99,32 @@
                    [match-variable (extract-variable #'pattern)])
        #'(match expression
            [match-pattern match-variable]))]))
+
+;; local-binding and module-binding check that the identifier is bound at the given phase
+(define-syntax (local-binding stx)
+  (syntax-parse stx
+    [(_ name)
+     (define type (identifier-binding #'name))
+     (when (not (eq? type 'lexical))
+       (raise-syntax-error 'local-binding "not bound locally" #'name))
+     #'#'name]))
+
+(define-syntax (module-binding stx)
+  (syntax-parse stx
+    [(_ name level)
+     (define type (identifier-binding #'name (syntax-e #'level)))
+     (when (not (and (list? type)
+                     (= (length type) 7)))
+       (raise-syntax-error 'module-binding
+                           (format "not bound by a module at phase ~a" (syntax-e #'level))
+                           #'name))
+     #'#'name]))
+
+(define-syntax-rule (literal-syntax-class literal)
+  (let ()
+    (define-literal-set set (literal))
+    (define-syntax-class class
+      #:literal-sets (set)
+      ;; BUG! shouldn't need ~literal here since we are using literal sets
+      [pattern (~literal literal)])
+    (reify-syntax-class class)))