www

commit dc11b3014e4a8e464c5d37a57443e3e4a68449cd
parent 74c707b65dad7420114b6c5f56725a0e070f8bdd
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Fri,  7 Oct 2016 22:42:20 +0200

dispatch-union seems to work

Diffstat:
M
dispatch-union.rkt
 | 
14
+++++++-------
M
test/test-traversal-2.rkt
 | 
4
++--
M
traversal.hl.rkt
 | 
7
+++----

3 files changed, 12 insertions(+), 13 deletions(-)
diff --git a/dispatch-union.rkt b/dispatch-union.rkt
@@ -15,19 +15,19 @@
 
 (provide dispatch-union)
 
-(define-syntax/parse (dispatch-union ([type-to-replaceᵢ Aᵢ predicateᵢ] …)
-                                     [X v result] …)
+(define-syntax/parse (dispatch-union v
+                                     ([type-to-replaceᵢ Aᵢ predicateᵢ] …)
+                                     [Xⱼ result] …)
   ((λ (x) (local-require racket/pretty) #;(pretty-write (syntax->datum x)) x)
    #`(cond
        . #,(stx-map
-            (λ (X v result)
+            (λ (X result)
               (syntax-parse X
                 #:literals (tagged)
-                [(tagged name [fieldᵢ (~optional :colon) typeᵢ] …)
-                 #`[((tagged? name fieldᵢ …) #,v) #,result]]
+                [(tagged name [fieldₖ (~optional :colon) typeₖ] …)
+                 #`[((tagged? name fieldₖ …) v) #,result]]
                 [other (raise-syntax-error 'graph
                                            "Unhandled union type"
                                            #'other)]))
-            #'(X …)
-            #'(v …)
+            #'(Xⱼ …)
             #'(result …)))))
 \ No newline at end of file
diff --git a/test/test-traversal-2.rkt b/test/test-traversal-2.rkt
@@ -28,14 +28,14 @@
  : (Values (U (tagged tg [a Symbol] [b Boolean])) Integer)
  (tagged tg [a 'abc] [b #f]) 1)
 
-#;(check-equal?-values:
+(check-equal?-values:
  ((f₃ string? string->symbol+acc) (tagged tg [a "abc"] [b #f]) 0)
  : (Values (U (tagged tg [a Symbol] [b Boolean])
               (tagged tg [a Boolean] [c Symbol]))
            Integer)
  (tagged tg [a 'abc] [b #f]) 1)
 
-#;(check-equal?-values:
+(check-equal?-values:
  ((f₃ string? string->symbol+acc) (tagged tg [a #t] [c "def"]) 0)
  : (Values (U (tagged tg [a Symbol] [b Boolean])
               (tagged tg [a Boolean] [c Symbol]))
diff --git a/traversal.hl.rkt b/traversal.hl.rkt
@@ -255,10 +255,9 @@ way up, so that a simple identity function can be applied in these cases.
         (U (_txⱼ _Tᵢ …) …)
 
         #:using
-        (dispatch-union ([type-to-replaceᵢ Aᵢ predicateᵢ]
-                         …)
-                        [_Xⱼ v ((_fxⱼ . _args) v acc)]
-                        …)
+        (dispatch-union v
+                        ([type-to-replaceᵢ Aᵢ predicateᵢ] …)
+                        [_Xⱼ ((_fxⱼ . _args) v acc)] …)
 
         #:with-defintitions
         (define-fold _fxⱼ _txⱼ _Xⱼ type-to-replaceᵢ …)