Commits

Moritz Heidkamp committed 3f4126d

Don't apply tag handlers in discard parser

Comments (0)

Files changed (2)

                (edn-element)))
 
 (define edn-discard
-  (preceded-by (char-seq "#_") (edn-element) (edn-element)))
+  (preceded-by (char-seq "#_")
+               (lambda (input)
+                 (parameterize ((apply-tag-handlers? #f))
+                   ((edn-element) input)))
+               (edn-element)))
 
 (define edn-element*
   (any-of (edn-element)
            (tag-ref* #f #f))
       (error "Undefined tag" ns name)))
 
+(define apply-tag-handlers?
+  (make-parameter #t))
+
 (define edn-tag
-  (bind (preceded-by
-         (is #\#)
-         (lambda (input)
-           (parameterize ((edn-parsers `((symbol . ,list))))
-             (edn-symbol input))))
-        (lambda (tag)
-          (let* ((tag (map maybe-string->symbol tag))
-                 (tag-parser (apply tag-ref tag)))
-            (bind (any-of (edn-element)
-                          (parser-error "Missing tag element"))
-                  (lambda (el)
-                    (result (apply tag-parser el tag))))))))
+  (sequence* ((tag (preceded-by
+                    (is #\#)
+                    (lambda (input)
+                      (parameterize ((edn-parsers `((symbol . ,list))))
+                        (edn-symbol input)))))
+              (el (any-of (edn-element)
+                          (parser-error "Missing tag element"))))
+    (if (apply-tag-handlers?)
+        (let ((tag (map maybe-string->symbol tag)))
+          (result (apply (apply tag-ref tag) el tag)))
+        (result tag))))
 
 
 (define (read-edn #!optional (input (current-input-port)))
 (test-group "discard"
   (test-read "#_x y" 'y)
   (test-read "#_  \nice 123" 123)
-  (test-read-error "#_("))
+  (test-read-error "#_(")
+  (register-edn-tag-parser! 'foo 'bar error)
+  (test-read "#_#foo/bar 1 2" 2))
 
 (test-end)