www

commit b6043def446124c9a21de2ea45bdfcfbf33fddcd
parent 0977529e6bf476b7ce4f20dd8665cffb314110ae
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Wed,  3 May 2017 12:57:41 +0200

Draft now compiles again.

Diffstat:
M
main-draft.hl.rkt
 | 
35
+++++++++++++++++++++++------------
M
test/adt-pre-declarations.rkt
 | 
2
++
M
test/test-graph-low1.rkt
 | 
2
++

3 files changed, 27 insertions(+), 12 deletions(-)
diff --git a/main-draft.hl.rkt b/main-draft.hl.rkt
@@ -47,7 +47,7 @@
 ♦chunk[<signature>
        (_ graph-name
           #:∀ (pvarₕ …)
-          ({~lit node} nodeᵢ [fieldᵢⱼ :colon field-τᵢⱼ] …)
+          ({~lit node} nodeᵢ [fieldᵢⱼ cᵢⱼ:colon field-τᵢⱼ] …)
           …
           ({~lit mapping} (mappingₖ [argₖₗ :colon arg-τₖₗ] …)
                           :colon result-τₖ
@@ -65,25 +65,35 @@
 
 ♦chunk[|<phase~1: call mappings and extract placeholders>|
        #'(begin
-           (define (make-placeholderₖ argₖₗ …)
-             (list 'placeholderₖ argₖₗ …))
-           …
-           
-           (define (graph-name [rootₖ : (Listof (List arg-τₖₗ …))] …)
+           (define
+             #:∀ (pvarₕ …)
+             (graph-name [rootₖ : (Listof (List arg-τₖₗ …))] …)
+
+             ;; TODO: move these to a separate literate programming chunk
+             (define-type nodeᵢ (tagged nodeᵢ [fieldᵢⱼ cᵢⱼ field-τᵢⱼ] …))
+             …
+
+             (define (make-placeholderₖ argₖₗ …)
+               (list 'placeholderₖ argₖₗ …))
+             …
+             
              (worklist
               (list rootₖ …)
-              ((λ (args)
+              ((λ ([args : (List arg-τₖₗ …)])
                  (define-values (argₖₗ …) (apply values args))
                  (define result
                    (let* ([mappingₖ make-placeholderₖ]
                           …
-                          [argₖₗ convert-inflexible-to-flexible?]
+                          [argₖₗ 'convert-inflexible-to-flexible?]
                           …
-                          [argₖₗ invariant-well-scopedness?]
+                          [argₖₗ 'invariant-well-scopedness?]
                           …)
-                     . bodyₖ))
+                     (error "NOT IMPL YET.787543")
+                     ;. bodyₖ
+                     '(bodyₖ)))
                  ;; returns placeholders + the result:
-                 (extract-placeholders result))
+                 '(extract-placeholders result)
+                 (error "NOT IMPL YET.8946513648"))
                …)
               ((List arg-τₖₗ …) result-τₖ) …)))]
 
@@ -143,7 +153,8 @@ Row polymorphism: make a generic struct->vector and vector->struct?
                 (for-template (all-from-out "literals.rkt")))
        
        (require (for-template (only-meta-in 0 type-expander/lang)
-                              typed-worklist)
+                              typed-worklist
+                              phc-adt)
                 type-expander/expander
                 phc-toolkit/untyped/aliases
                 phc-toolkit/untyped/syntax-parse
diff --git a/test/adt-pre-declarations.rkt b/test/adt-pre-declarations.rkt
@@ -16,3 +16,5 @@
 (remembered! tagged-structure (| Person-incomplete| name))
 (remembered! tagged-structure (City name))
 (remembered! tagged-structure (t0 w))
+(remembered! tagged-structure (City streets))
+(remembered! tagged-structure (Street a name))
diff --git a/test/test-graph-low1.rkt b/test/test-graph-low1.rkt
@@ -1,6 +1,8 @@
 #lang dotlambda/unhygienic type-expander/lang
 
 (require (for-syntax (lib "phc-graph/main-draft.hl.rkt")))
+(require phc-adt)
+(adt-init)
 
 (define-syntax low-graph low-graph-impl)