Handling lists in get and λget: ((λget streets … houses … owner name) g) now works, so does (get g streets … houses … owner name). Worked a bit more on the inference-friendly macro.

graph/graph/__DEBUG_graph__.rkt

@@ -26,13 +26,15 @@
 (require "../lib/low.rkt")
 (require "../type-expander/type-expander.lp2.rkt")
 
+(get '((1 2) (3)) … …)
 (structure-get (cadr (force g)) people)
 (get g people)
 (get g streets cadr houses car owner name)
 ((λget people) g)
 ((λget owner name) (get g streets cadr houses car))
-;;((λget streets cadr houses car owner name) g)
+(get g streets … houses … owner name)
-;;(map (λget houses car owner name) (get g streets))
+((λget streets … houses … owner name) g)
+;(map: (λget houses … owner name) (get g streets))
 
 
 #|

graph/graph/graph4.lp2.rkt

@@ -1,4 +1,4 @@
-#lang scribble/lp2
+#lang debug scribble/lp2
 @(require "../lib/doc.rkt")
 @doc-lib-setup
 
@@ -16,6 +16,12 @@ more than 4 letters.
 
 @CHUNK[<c…r-syntax-class>
        (define-syntax-class c…r
+         #:attributes ([expanded 1] [reverse-expanded 1])
+         (pattern :c…r1
+                  #:with (reverse-expanded …)
+                  (reverse (syntax->list #'(expanded …)))))
+       
+       (define-syntax-class c…r1
          ;(pattern (~literal car) #:with (expanded …) #'(car))
          ;(pattern (~literal cdr) #:with (expanded …) #'(cdr))
          (pattern (~literal caar) #:with (expanded …) #'(car car))
@@ -67,20 +73,40 @@ otherwise throw an error:
        (raise-syntax-error 'c*r "expected a or d" #'id)]
 
 @chunk[<get>
-       (define-syntax (get stx)
+       (define-multi-id has-get
-         (syntax-parse stx
+         #:type-expander <type-for-get>)
-           [(_ v:expr)
+       (define-multi-id result-get
-            #'v]
+         #:type-expander <result-type-for-get>)
-           [(_ v:expr (~and c?r (~or (~lit car) (~lit cdr))) other-fields …)
+       (define-multi-id get
-            #'(get (c?r v) other-fields …)]
+         ;#:type-expander <type-for-get>
-           [(_ v:expr c…r:c…r other-fields …)
+         #:call
-            #`(get v #,@(reverse (syntax->list #'(c…r.expanded …)))
+         (λ (stx)
-                   other-fields …)]
+           (syntax-parse stx
-           [(_ v:expr field other-fields:id …)
+             [(_ v:expr)
-            #'(let ([v-cache v])
+              #'v]
-                (cond <get-tagged>
+             [(_ v:expr (~and c?r (~or (~lit car) (~lit cdr))) other-fields …)
-                      <get-promise>
+              #'(get (c?r v) other-fields …)]
-                      <get-plain-struct>))]))]
+             [(_ v:expr c…r:c…r other-fields …)
+              #`(get v c…r.reverse-expanded … other-fields …)]
+             [(_ v:expr (~literal …) other-fields …)
+              #;#'((map:: T
+                          (result-get T other-fields …)
+                          (has-get T other-fields …)
+                          (λget other-fields …))
+                   v)
+              #'((λ #:∀ (T) ([l : (Listof (has-get T other-fields …))])
+                   : (Listof (result-get T other-fields …))
+                   ((inst map
+                          (result-get T other-fields …)
+                          (has-get T other-fields …))
+                    (λget other-fields …)
+                    l))
+                 v)]
+             [(_ v:expr field other-fields:id …)
+              #'(let ([v-cache v])
+                  (cond <get-tagged>
+                        <get-promise>
+                        <get-plain-struct>))])))]
 
 @chunk[<get-tagged>
        [((make-predicate (List Symbol Any)) v-cache)
@@ -105,14 +131,10 @@ otherwise throw an error:
 @chunk[<λget>
        (define-syntax (λget stx)
          (syntax-parse stx
-           ;[(_ v:expr (~and c?r (~or (~lit car) (~lit cdr))) other-fields …)
+           [(_ field-or-accessor …)
-           ; #'(get (c?r v) other-fields …)]
+            #'(ann (λ (v) (get v field-or-accessor …))
-           ;[(_ v:expr c…r:c…r other-fields …)
+                   (∀ (T) (→ (has-get T field-or-accessor …)
-           ; #`(get v #,@(reverse (syntax->list #'(c…r.expanded …)))
+                             (result-get T field-or-accessor …))))]))]
-           ;        other-fields …)]
-           [(_ field:id …)
-            #'(ann (λ (v) (get v field …))
-                   (∀ (T) (→ (λget-type-helper T field …) T)))]))]
 
 The type for the function generated by @tc[λget] mirrors the cases from
 @tc[get].
@@ -135,19 +157,43 @@ The type for the function generated by @tc[λget] mirrors the cases from
 @;                                       (Promise (U S (List Symbol S)))
 @;                                       (→ (maybe-wrapped S) unforgeable))))]
 
-@chunk[<λget-type-helper>
+@chunk[<type-for-get>
-       (define-type-expander (λget-type-helper stx)
+       (λ (stx)
          (syntax-parse stx
-           [(_ T:expr)
+           [(_ T:expr) #'T]
-            #'T]
+           <type-for-get-pairs>
-           [(_ T:expr field:id other-fields:id …)
+           <type-for-get-field>))]
-            #;#'(U <r>
-                   (List Symbol <r>)
-                   (Promise (U <r> (List Symbol <r>))))
-            #'(Promise (List Symbol <r>))]))]
 
-@chunk[<r>
+@chunk[<type-for-get-pairs>
-       (structure-supertype [field (λget-type-helper T other-fields …)])]
+       ;; TODO: car, cdr, c…r.
+       [(_ T:expr (~literal car) other-fields:id …)
+        #'(Pairof (has-get T other-fields …) Any)]
+       [(_ T:expr (~literal cdr) other-fields:id …)
+        #'(Pairof Any (has-get T other-fields …))]
+       [(_ T:expr c…r:c…r other-fields:id …)
+        #'(has-get T c…r.reverse-expanded … other-fields …)]
+       [(_ T:expr (~literal …) other-fields:id …)
+        #'(Listof (has-get T other-fields …))]]
+
+@chunk[<type-for-get-field>
+       [(_ T:expr field:id other-fields:id …)
+        #'(Promise
+           (List Symbol
+                 (structure-supertype [field : (has-get T other-fields …)])))]]
+
+@chunk[<result-type-for-get>
+       (λ (stx)
+         (syntax-parse stx
+           [(_ T:expr) #'T]
+           [(_ T:expr (~literal …) other-fields:id …)
+            #'(Listof (result-get T other-fields …))]
+           [(_ T:expr
+               (~or (~lit car)
+                    (~lit cdr)
+                    :c…r
+                    field:id)
+               other-fields:id …)
+            #'(result-get T other-fields …)]))]
 
 @section{Conclusion}
 
@@ -160,15 +206,17 @@ The type for the function generated by @tc[λget] mirrors the cases from
                   "structure.lp2.rkt"
                   "variant.lp2.rkt"
                   "graph3.lp2.rkt"
+                  "../type-expander/multi-id.lp2.rkt"
                   "../type-expander/type-expander.lp2.rkt")
          (provide get
-                  λget)
+                  λget
+                  has-get
+                  result-get)
          
          (begin-for-syntax
            <c…r-syntax-class>)
          
          <get>
-         <λget-type-helper>
          <λget>)]
 
 @chunk[<module-test>

graph/graph/map.rkt

@@ -1,7 +1,8 @@
 #lang typed/racket
 
 (require (for-syntax syntax/parse)
-         "../lib/low.rkt")
+         "../lib/low.rkt"
+         "map1.rkt")
 
 (provide map:)
 
@@ -9,18 +10,16 @@
   (define-syntax-class lam
     (pattern (~or (~literal λ) (~literal lambda)))))
 
-(define-syntax-rule (map:: TVar Element-Type f l)
-  ((λ #:∀ (TVar) ([lst : (Listof Element-Type)])
-     ((inst map TVar Element-Type) f lst)) l))
-
 (define-syntax (map: stx)
   (syntax-parse stx
-    [(_ (~literal car) l) #'(map:: A (Pairof A Any) car l)]
+    [(_ (~literal car) l) #'((curry-map A A (Pairof A Any) car) l)]
-    [(_ (~literal cdr) l) #'(map:: B (Pairof Any B) cdr l)]
+    [(_ (~literal cdr) l) #'((curry-map B B (Pairof Any B) cdr) l)]
     ;; TODO: add caar etc.
     [(_ ((~literal values)) l) #'l]
     [(_ ((~literal compose)) l) #'l]
     [(_ ((~literal compose) f0 . fs) l) #'(map: f0 (map: (compose . fs) l))]
+    [(_ ((~literal curry) map: f) l)
+     #''_]
     [(_ f . ls)
      #'(map f . ls)]))
 

graph/graph/map1.rkt

@@ -0,0 +1,33 @@
+#lang typed/racket
+
+(require (for-syntax syntax/parse
+                     "../lib/low-untyped.rkt"))
+
+(provide curry-map)
+
+(begin-for-syntax
+  (define-syntax-class curry-map-rec
+    #:attributes (inner bottom bottom? wrap)
+    (pattern ((~lit curry) (~lit map) inner:curry-map-rec)
+             #:attr wrap (λ (x w) (w ((attribute inner.wrap) x w)))
+             #:attr bottom #'inner.bottom
+             #:attr bottom? #f)
+    (pattern f
+             #:attr wrap (λ (x w) x)
+             #:attr bottom #'f
+             #:attr bottom? #t
+             #:attr inner #f)))
+
+(define-syntax (curry-map stx)
+  (syntax-parse stx
+    [(_ TVar Result-Type Element-Type f:curry-map-rec)
+     (if (attribute f.bottom?)
+         #'(ann (λ (l) ((inst map Result-Type Element-Type) f l))
+                (∀ (TVar) (→ (Listof Element-Type)
+                             (Listof Result-Type))))
+         #`(curry-map TVar
+                      #,((attribute f.wrap) #'Result-Type
+                                            (λ (t) #`(Listof #,t)))
+                      #,((attribute f.wrap) #'Element-Type
+                                            (λ (t) #`(Listof #,t)))
+                      (curry-map TVar Result-Type Element-Type f.inner)))]))

graph/graph/structure.lp2.rkt

@@ -318,7 +318,7 @@ The fields in @tc[fields→stx-name-alist] are already sorted.
 @chunk[<structure-supertype>
        (define-multi-id structure-supertype
          #:type-expander
-         (λ/syntax-parse (_ [field:id type:expr] …)
+         (λ/syntax-parse (_ [field:id (~optional (~lit :)) type:expr] …)
            (define/with-syntax ([(all-field …) . _] …)
              (fields→supertypes #'(field …)))
            (template