Wrote wrappers for the configurable functions any->isyntax* syntax->isyntax* any->isyntax-e*

comments/maybe.rkt

@@ -0,0 +1,7 @@
+#lang typed/racket
+(provide (struct-out Some)
+         Maybe)
+
+(struct (A) Some ([v : A]) #:prefab)
+(define-type (Maybe A)
+  (U (Some A) #f))

comments/typed-syntax-convert2.rkt

@@ -2,7 +2,8 @@
 
 (require typed-map
          typed/racket/unsafe
-         "typed-syntax-convert.rkt")
+         "typed-syntax-convert.rkt"
+         "maybe.rkt")
 (unsafe-require/typed racket/base
                       [[datum->syntax datum->syntax*]
                        (∀ (A) (→ (Syntaxof Any)
@@ -15,15 +16,18 @@
          ISyntaxOf-E
          ISyntax
          ISyntax-E
-         ISyntax/Not
+         ISyntax/Non
-         ISyntax/Not-E
+         ISyntax/Non-E
          (struct-out NonSyntax)
          ;(struct-out NonSexp) ; already exported in typed-syntax-convert.rkt
          NonSyntaxOf
          NonSexpOf
-         any->isyntax
+         any->isyntax+non
-         syntax->isyntax
+         syntax->isyntax+non
-         any->isyntax-e)
+         any->isyntax-e+non
+         try-any->isyntax
+         try-syntax->isyntax
+         try-any->isyntax-e)
 
 (unsafe-require/typed racket/function
                       [[identity unsafe-cast-function] (∀ (A) (→ Any A))])
@@ -67,8 +71,8 @@
 (struct (A) NonSyntax ([value : A]) #:type-name NonSyntaxOf)
 (struct (A) NonSexp ([value : A]) #:type-name NonSexpOf)
 
-(define-type ISyntax/Not (ISyntaxOf (NonSyntaxOf Any) (NonSexpOf Any)))
+(define-type ISyntax/Non (ISyntaxOf (NonSyntaxOf Any) (NonSexpOf Any)))
-(define-type ISyntax/Not-E (ISyntaxOf-E (NonSyntaxOf Any) (NonSexpOf Any)))
+(define-type ISyntax/Non-E (ISyntaxOf-E (NonSyntaxOf Any) (NonSexpOf Any)))
 
 (define-type ISyntax (ISyntaxOf Nothing Nothing))
 (define-type ISyntax-E (ISyntaxOf-E Nothing Nothing))
@@ -77,28 +81,28 @@
                            (Pairof #f #f)))
 (define Result#f (cons #f #f))
 
-(: syntax->isyntax (∀ (A B) (→ (Syntaxof Any)
+(: syntax->isyntax* (∀ (A B) (→ (Syntaxof Any)
-                               (→ Any (Result A))
+                                (→ Any (Result A))
-                               (→ Any (Result B))
+                                (→ Any (Result B))
-                               (U (Result (ISyntaxOf A B)))))) ;; TODO: change to (SyntaxOf (ISnyntaxOf-E …))
+                                (U (Result (Syntaxof (ISyntaxOf-E A B)))))))
-(define (syntax->isyntax stx nstx nsexp)
+(define (syntax->isyntax* stx nstx nsexp)
   (define e (syntax-e stx))
-  (match-define (cons e* status) (any->isyntax-e e nstx nsexp))
+  (match-define (cons e* status) (any->isyntax-e* e nstx nsexp))
   (case status
     [(unmodified)
-     (cons (unsafe-cast e (ISyntaxOf A B)) 'unmodified)]
+     (cons (unsafe-cast e (Syntaxof (ISyntaxOf-E A B))) 'unmodified)]
     [(modified)
      (cons (datum->syntax* stx e* stx stx) 'modified)]
     [(#f)
      Result#f]))
 
-(: any->isyntax (∀ (A B) (→ Any
+(: any->isyntax* (∀ (A B) (→ Any
-                            (→ Any (Result A))
+                             (→ Any (Result A))
-                            (→ Any (Result B))
+                             (→ Any (Result B))
-                            (Result (ISyntaxOf A B)))))
+                             (Result (ISyntaxOf A B)))))
-(define (any->isyntax e nstx nsexp)
+(define (any->isyntax* e nstx nsexp)
   (if (syntax? e)
-      (syntax->isyntax e nstx nsexp)
+      (syntax->isyntax* e nstx nsexp)
       (nstx e)))
 
 (: listof-any->listof-isyntax
@@ -109,7 +113,7 @@
 (define (listof-any->listof-isyntax e nstx nsexp)
   (define e*+status
     (foldr (λ ([eᵢ : Any] [acc : (Result (Listof (ISyntaxOf A B)))])
-             (match-let ([(cons eᵢ* status) (any->isyntax eᵢ nstx nsexp)])
+             (match-let ([(cons eᵢ* status) (any->isyntax* eᵢ nstx nsexp)])
                (cond
                  [(and (eq? status 'unmodified)
                        (eq? (cdr acc) 'unmodified))
@@ -120,7 +124,7 @@
                  [else
                   (cons (cons eᵢ* (car acc)) 'modified)])))
            (cons '() 'unmodified)
-         e))
+           e))
   (define e* (car e*+status))
   (define status (cdr e*+status))
   (case status
@@ -157,7 +161,7 @@
                                                      (Pairof (ISyntaxOf A B)
                                                              L))))))))
 (define (handle-pair e nstx nsexp)
-  (define car*+status (any->isyntax (car e) nstx nsexp))
+  (define car*+status (any->isyntax* (car e) nstx nsexp))
   (define car* (car car*+status))
   (define status-car (cdr car*+status))
   (cond
@@ -192,7 +196,7 @@
                                              L)))))
               'modified)])]
     [else
-     (match-let ([(cons cdr* status-cdr) (any->isyntax (cdr e) nstx nsexp)])
+     (match-let ([(cons cdr* status-cdr) (any->isyntax* (cdr e) nstx nsexp)])
        (cond
          #;[(and (eq? status-car 'unmodified)
                  (eq? status-cdr 'unmodified))
@@ -207,11 +211,11 @@
          [else
           (cons (cons car* cdr*) 'modified)]))]))
 
-(: any->isyntax-e (∀ (A B) (→ Any
+(: any->isyntax-e* (∀ (A B) (→ Any
-                              (→ Any (Result A))
+                               (→ Any (Result A))
-                              (→ Any (Result B))
+                               (→ Any (Result B))
-                              (Result (ISyntaxOf-E A B)))))
+                               (Result (ISyntaxOf-E A B)))))
-(define (any->isyntax-e e nstx nsexp)
+(define (any->isyntax-e* e nstx nsexp)
   (cond
     [(boolean? e) (cons e 'unmodified)]
     [(char? e)    (cons e 'unmodified)]
@@ -222,7 +226,7 @@
                       (cons e 'unmodified)
                       (cons (string->immutable-string e) 'modified))]
     [(symbol? e)  (cons e 'unmodified)]
-    [(box? e)     (match-let ([(cons u* status) (any->isyntax (unbox e) nstx nsexp)])
+    [(box? e)     (match-let ([(cons u* status) (any->isyntax* (unbox e) nstx nsexp)])
                     (case status
                       [(unmodified)
                        ;(if (immutable? e)
@@ -248,4 +252,64 @@
                       [(#f)
                        Result#f]))]
     [else
-     (nsexp e)]))
+     (nsexp e)]))
+
+(: any->isyntax+non (→ Any ISyntax/Non))
+(define (any->isyntax+non e)
+  (define e*+status
+    (any->isyntax* e
+                   (λ (n) (cons (NonSyntax n) 'modified))
+                   (λ (n) (cons (NonSexp n) 'modified))))
+  (if (cdr e*+status)
+      (car e*+status)
+      (error "Got #f from any->isyntax* with handlers not returning #f")))
+
+(: syntax->isyntax+non (→ (Syntaxof Any) (Syntaxof ISyntax/Non-E)))
+(define (syntax->isyntax+non stx)
+  (define e*+status
+    (syntax->isyntax* stx
+                      (λ (n) (cons (NonSyntax n) 'modified))
+                      (λ (n) (cons (NonSexp n) 'modified))))
+  (if (cdr e*+status)
+      (car e*+status)
+      (error "Got #f from any->isyntax* with handlers not returning #f")))
+
+(: any->isyntax-e+non (→ Any ISyntax/Non-E))
+(define (any->isyntax-e+non e)
+  (define e*+status
+    (any->isyntax-e* e
+                     (λ (n) (cons (NonSyntax n) 'modified))
+                     (λ (n) (cons (NonSexp n) 'modified))))
+  (if (cdr e*+status)
+      (car e*+status)
+      (error "Got #f from any->isyntax* with handlers not returning #f")))
+
+(: try-any->isyntax (→ Any (Maybe ISyntax)))
+(define (try-any->isyntax e)
+  (define e*+status
+    ((inst any->isyntax* Nothing Nothing) e
+                                          (λ (n) Result#f)
+                                          (λ (n) Result#f)))
+  (if (cdr e*+status)
+      (Some (car e*+status))
+      #f))
+
+(: try-syntax->isyntax (→ (Syntaxof Any) (Maybe (Syntaxof ISyntax-E))))
+(define (try-syntax->isyntax stx)
+  (define e*+status
+    ((inst syntax->isyntax* Nothing Nothing) stx
+                                             (λ (n) Result#f)
+                                             (λ (n) Result#f)))
+  (if (cdr e*+status)
+      (Some (car e*+status))
+      #f))
+
+(: try-any->isyntax-e (→ Any (Maybe ISyntax-E)))
+(define (try-any->isyntax-e e)
+  (define e*+status
+    ((inst any->isyntax-e* Nothing Nothing) e
+                                            (λ (n) Result#f)
+                                            (λ (n) Result#f)))
+  (if (cdr e*+status)
+      (Some (car e*+status))
+      #f))

comments/typed-syntax.rkt

@@ -4,10 +4,12 @@
          try-any->isexp
          any->isexp+non-sexp
          CoreSexp
+         ISyntax
+         ISyntax-E
          ISyntaxOf
          ISyntaxOf-E
-         ISyntax/Not
+         ISyntax/Non
-         ISyntax/Not-E
+         ISyntax/Non-E
          NonSyntaxOf
          NonSexpOf
          any->isyntax ;; TODO: make wrappers for these, which discard the second value