diff --git a/graph-lib/graph/__DEBUG_graph6.rkt b/graph-lib/graph/__DEBUG_graph6.rkt index 0e15d65..351db7d 100644 --- a/graph-lib/graph/__DEBUG_graph6.rkt +++ b/graph-lib/graph/__DEBUG_graph6.rkt @@ -1,7 +1,7 @@ #lang typed/racket (require "graph-6-rich-returns.lp2.rkt" - "../lib/low.rkt" + (except-in "../lib/low.rkt" ~>) "graph.lp2.rkt" "get.lp2.rkt" "../type-expander/type-expander.lp2.rkt" @@ -12,6 +12,7 @@ "rewrite-type.lp2.rkt"; debug "meta-struct.rkt"; debug racket/splicing; debug + racket/stxparam; debug (for-syntax syntax/parse) (for-syntax syntax/parse/experimental/template)) @@ -23,6 +24,100 @@ + + + + + + + + + + + + + + +(define-rename-transformer-parameter ~> + (make-rename-transformer #'+)) + + + +(begin + (define-graph + first-step + #:wrapping-definitions + (begin + (define-type-expander + (first-step-expander1 stx) + #;#'Number + (syntax-parse + stx + ((_ (~datum m-cities)) + (template + (U + (first-step #:placeholder m-cities3/node) + (Listof (first-step #:placeholder City))))) + ((_ (~datum m-streets)) + (template + (U + (first-step #:placeholder m-streets4/node) + (Listof (first-step #:placeholder Street))))))) + (define-type-expander + (first-step-expander2 stx) + #;#'Number + (syntax-parse + stx + ((_ (~datum m-cities)) #'(U m-cities3/node (Listof City))) + ((_ (~datum m-streets)) #'(U m-streets4/node (Listof Street))))) + (splicing-let-syntax + ([~> (make-rename-transformer #'first-step-expander1)]) + (define-graph-rest)) + #;(splicing-syntax-parameterize + ((~> (make-rename-transformer #'first-step-expander1))) + (define-graph-rest))) + (City + (streets : (Let (~> first-step-expander2) (~> m-streets))) + ((City1/simple-mapping (streets : (~> m-streets))) (City streets))) + (Street + (sname : (Let (~> first-step-expander2) String)) + ((Street2/simple-mapping (sname : String)) (Street sname))) + (m-cities3/node + (returned : (Listof City)) + ((m-cities (cnames : (Listof (Listof String)))) + (m-cities3/node + (let ((City City1/simple-mapping) (Street Street2/simple-mapping)) + (define (strings→city (s : (Listof String))) (City (m-streets s))) + (map strings→city cnames))))) + (m-streets4/node + (returned : (Listof Street)) + ((m-streets (snames : (Listof String))) + (m-streets4/node + (let ((City City1/simple-mapping) (Street Street2/simple-mapping)) + (map Street snames))))))) + + + + + + + + + + + + + + + + + + + + + + +#| (define-graph/rich-return grr ([City [streets : (~> m-streets)]] [Street [sname : String]]) @@ -35,6 +130,18 @@ : (Listof Street) (map Street snames)]) +#;(define-graph/rich-return grra + ([City [streets : (~> m-streets)]] + [Street [sname : String]]) + [(m-cities [cnames : (Listof (Listof String))]) + : (Listof City) + (define (strings→city [s : (Listof String)]) + (City (m-streets s))) + (map strings→city cnames)] + [(m-streets [snames : (Listof String)]) + : (Listof Street) + (map Street snames)]) + ;(first-step '(("a" "b") ("c" "d"))) @@ -339,3 +446,4 @@ (map Street snames)))))))) ;(blah) +|# \ No newline at end of file diff --git a/graph-lib/graph/graph-6-rich-returns.lp2.rkt b/graph-lib/graph/graph-6-rich-returns.lp2.rkt index e4a5708..6d862c7 100644 --- a/graph-lib/graph/graph-6-rich-returns.lp2.rkt +++ b/graph-lib/graph/graph-6-rich-returns.lp2.rkt @@ -55,6 +55,9 @@ mapping declarations from the node definitions: @chunk[ (define-graph/rich-return name:id + (~or (~seq #:definitions extra-definitions) + (~seq #:wrapping-definitions wrapping-extra-definitions) + (~seq)) ((~commit [node:id …]) …) (~commit ) @@ -104,22 +107,31 @@ plain list. (define-temp-ids "first-step-expander2" name) (define-temp-ids "~a/simple-mapping" (node …)) (define-temp-ids "~a/node" (mapping …)) - (define/with-syntax ~>-id (datum->syntax #'name '~>)) - (template - ;(debug - (begin - (define-graph first-step - #:definitions [] - [node [field c (Let [~>-id first-step-expander2] field-type)] … - [(node/simple-mapping [field c field-type] …) - ;] …) - (node field …)]] … - [mapping/node [returned cm result-type] - [(mapping [param cp param-type] …) - (mapping/node - (let ([node node/simple-mapping] …) - . body))]] - …))))] + ;(define/with-syntax ~>-id #'~>);(datum->syntax #'name '~>)) + ;(define/with-syntax ~>-id-inner (syntax-local-introduce #'~>)) + (quasitemplate + (debug + (begin + (define-graph first-step + ; . #,((make-syntax-delta-introducer #'~> #'name) + ; (syntax-local-introduce + ; #'( + #:wrapping-definitions (begin ) + ;. #,(syntax-local-introduce + ; #'( + [node [field c (Let [~> first-step-expander2] field-type)] … ;; ~>-id-inner + [(node/simple-mapping [field c field-type] …) + ;] …) + (node field …)]] + … + [mapping/node [returned cm result-type] + [(mapping [param cp param-type] …) + (mapping/node + (let ([node node/simple-mapping] …) + . body))]] + … + ;)) 'add) + )))))] As explained above, during the first pass, the field types of nodes will allow placeholders for the temporary nodes @@ -128,7 +140,34 @@ encapsulating the result types of mappings. @chunk[ ;; TODO: to avoid conflicting definitions of ~>, we should either use ;; syntax-parameterize, or make a #:local-definitions - (define-type-expander (~>-id stx) + #;(define-type-expander (~>-id stx) + (syntax-parse stx + [(_ (~datum mapping)) ;; TODO: should be ~literal + (template + (U (first-step #:placeholder mapping/node) + (tmpl-replace-in-type result-type + [node (first-step #:placeholder node)] + …)))] + … + ;; TODO: should fall-back to outer definition of ~>, if any. + )) + #;(define-type-expander (first-step-expander2 stx) + (syntax-parse stx + [(_ (~datum mapping)) ;; TODO: should be ~literal + #'(U mapping/node result-type)] + … + ;; TODO: should fall-back to outer definition of ~>, if any. + ) + #;(U (first-step #:placeholder m-streets4/node) + (Listof (first-step #:placeholder Street)))) + + + + + + + + (define-type-expander (first-step-expander1 stx) (syntax-parse stx [(_ (~datum mapping)) ;; TODO: should be ~literal (template @@ -139,6 +178,7 @@ encapsulating the result types of mappings. … ;; TODO: should fall-back to outer definition of ~>, if any. )) + (define-type-expander (first-step-expander2 stx) (syntax-parse stx [(_ (~datum mapping)) ;; TODO: should be ~literal @@ -147,7 +187,13 @@ encapsulating the result types of mappings. ;; TODO: should fall-back to outer definition of ~>, if any. ) #;(U (first-step #:placeholder m-streets4/node) - (Listof (first-step #:placeholder Street))))] + (Listof (first-step #:placeholder Street)))) + + (splicing-syntax-parameterize ([~> (make-rename-transformer + #'first-step-expander1)]) + (?? wrapping-extra-definitions + (?? (?@ extra-definitions + (define-graph-rest)))))] @; TODO: replace-in-type doesn't work wfell here, we need to define a @; type-expander. @@ -179,9 +225,10 @@ encapsulating the result types of mappings. "meta-struct.rkt"; debug racket/stxparam racket/splicing) - (provide define-graph/rich-return); ~>) - - ;(define-syntax-parameter ~> (make-rename-transformer #'threading:~>)) + (provide define-graph/rich-return ~>) + + (define-rename-transformer-parameter ~> + (make-rename-transformer #'threading:~>)) (require (for-syntax racket/pretty)) (define-syntax (debug stx) @@ -190,116 +237,6 @@ encapsulating the result types of mappings. ;; syntax->string (pretty-print (syntax->datum #'body)) #'body])) - - - - - - -#;(begin - (define-graph - first-step - #:definitions - ((define-type-expander - (~> stx) - (syntax-parse - stx - ((_ (~datum m-cities)) - (template - (U - (first-step #:placeholder m-cities3/node) - (Listof (first-step #:placeholder City))))) - ((_ (~datum m-streets)) - (template - (U - (first-step #:placeholder m-streets4/node) - (Listof (first-step #:placeholder Street))))))) - (define-type-expander - (first-step-expander2 stx) - (syntax-parse - stx - ((_ (~literal m-cities)) - (template - (U m-streets4/node (Listof Street)))) - ((_ (~literal m-streets)) - (template - (U m-streets4/node (Listof Street))))))) - (City - (streets : (Let [~> first-step-expander2] (~> m-streets))#;(~> m-streets)) - ((City1/simple-mapping (streets : (~> m-streets))) (City streets))) - (Street - (sname : String) - ((Street2/simple-mapping (sname : String)) (Street sname))) - (m-cities3/node - (returned : (Listof City)) - ((m-cities (cnames : (Listof (Listof String)))) - (m-cities3/node - (let ((City City1/simple-mapping) (Street Street2/simple-mapping)) - (define (strings→city (s : (Listof String))) (City (m-streets s))) - (map strings→city cnames))))) - (m-streets4/node - (returned : (Listof Street)) - ((m-streets (snames : (Listof String))) - (m-streets4/node - (let ((City City1/simple-mapping) (Street Street2/simple-mapping)) - (map Street snames))))))) - - - - - - - - -#;(begin - (define-graph - first-step - #:definitions - ((define-type-expander - (~> stx) - (syntax-parse - stx - ((_ (~datum m-cities)) - (template - (U - (first-step #:placeholder m-cities3/node) - (Listof (first-step #:placeholder City))))) - ((_ (~datum m-streets)) - (template - (U - (first-step #:placeholder m-streets4/node) - (Listof (first-step #:placeholder Street))))))) - (define-type-expander - (first-step-expander2 stx) - (syntax-parse - stx - ((_ (~datum m-cities)) #'(U m-cities3/node (Listof City))) - ((_ (~datum m-streets)) #'(U m-streets4/node (Listof Street)))))) - (City - (streets : (Let (~> first-step-expander2) (~> m-streets))) - ((City1/simple-mapping (streets : (~> m-streets))) (City streets))) - (Street - (sname : (Let (~> first-step-expander2) String)) - ((Street2/simple-mapping (sname : String)) (Street sname))) - (m-cities3/node - (returned : (Listof City)) - ((m-cities (cnames : (Listof (Listof String)))) - (m-cities3/node - (let ((City City1/simple-mapping) (Street Street2/simple-mapping)) - (define (strings→city (s : (Listof String))) (City (m-streets s))) - (map strings→city cnames))))) - (m-streets4/node - (returned : (Listof Street)) - ((m-streets (snames : (Listof String))) - (m-streets4/node - (let ((City City1/simple-mapping) (Street Street2/simple-mapping)) - (map Street snames))))))) - - - - - - )]