Reverted old graph-6
This commit is contained in:
Georges Dupéron
parent
1743dd0e04
commit
8cff20856f
|
|
@ -1,7 +1,7 @@
|
||||||
#lang typed/racket
|
#lang typed/racket
|
||||||
|
|
||||||
(require "graph-6-rich-returns.lp2.rkt"
|
(require "graph-6-rich-returns.lp2.rkt"
|
||||||
(except-in "../lib/low.rkt" ~>)
|
"../lib/low.rkt"
|
||||||
"graph.lp2.rkt"
|
"graph.lp2.rkt"
|
||||||
"get.lp2.rkt"
|
"get.lp2.rkt"
|
||||||
"../type-expander/type-expander.lp2.rkt"
|
"../type-expander/type-expander.lp2.rkt"
|
||||||
|
|
@ -12,7 +12,6 @@
|
||||||
"rewrite-type.lp2.rkt"; debug
|
"rewrite-type.lp2.rkt"; debug
|
||||||
"meta-struct.rkt"; debug
|
"meta-struct.rkt"; debug
|
||||||
racket/splicing; debug
|
racket/splicing; debug
|
||||||
racket/stxparam; debug
|
|
||||||
(for-syntax syntax/parse)
|
(for-syntax syntax/parse)
|
||||||
(for-syntax syntax/parse/experimental/template))
|
(for-syntax syntax/parse/experimental/template))
|
||||||
|
|
||||||
|
|
@ -24,100 +23,6 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(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
|
(define-graph/rich-return grr
|
||||||
([City [streets : (~> m-streets)]]
|
([City [streets : (~> m-streets)]]
|
||||||
[Street [sname : String]])
|
[Street [sname : String]])
|
||||||
|
|
@ -130,18 +35,6 @@
|
||||||
: (Listof Street)
|
: (Listof Street)
|
||||||
(map Street snames)])
|
(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")))
|
;(first-step '(("a" "b") ("c" "d")))
|
||||||
|
|
||||||
|
|
@ -446,4 +339,3 @@
|
||||||
(map Street snames))))))))
|
(map Street snames))))))))
|
||||||
|
|
||||||
;(blah)
|
;(blah)
|
||||||
|#
|
|
||||||
|
|
@ -55,9 +55,6 @@ mapping declarations from the node definitions:
|
||||||
|
|
||||||
@chunk[<signature>
|
@chunk[<signature>
|
||||||
(define-graph/rich-return name:id
|
(define-graph/rich-return name:id
|
||||||
(~or (~seq #:definitions extra-definitions)
|
|
||||||
(~seq #:wrapping-definitions wrapping-extra-definitions)
|
|
||||||
(~seq))
|
|
||||||
((~commit [node:id <field-signature> …])
|
((~commit [node:id <field-signature> …])
|
||||||
…)
|
…)
|
||||||
(~commit <mapping-declaration>)
|
(~commit <mapping-declaration>)
|
||||||
|
|
@ -107,31 +104,22 @@ plain list.
|
||||||
(define-temp-ids "first-step-expander2" name)
|
(define-temp-ids "first-step-expander2" name)
|
||||||
(define-temp-ids "~a/simple-mapping" (node …))
|
(define-temp-ids "~a/simple-mapping" (node …))
|
||||||
(define-temp-ids "~a/node" (mapping …))
|
(define-temp-ids "~a/node" (mapping …))
|
||||||
;(define/with-syntax ~>-id #'~>);(datum->syntax #'name '~>))
|
(define/with-syntax ~>-id (datum->syntax #'name '~>))
|
||||||
;(define/with-syntax ~>-id-inner (syntax-local-introduce #'~>))
|
(template
|
||||||
(quasitemplate
|
;(debug
|
||||||
(debug
|
|
||||||
(begin
|
(begin
|
||||||
(define-graph first-step
|
(define-graph first-step
|
||||||
; . #,((make-syntax-delta-introducer #'~> #'name)
|
#:definitions [<first-pass-type-expander>]
|
||||||
; (syntax-local-introduce
|
[node [field c (Let [~>-id first-step-expander2] field-type)] …
|
||||||
; #'(
|
|
||||||
#:wrapping-definitions (begin <first-pass-type-expander>)
|
|
||||||
;. #,(syntax-local-introduce
|
|
||||||
; #'(
|
|
||||||
[node [field c (Let [~> first-step-expander2] field-type)] … ;; ~>-id-inner
|
|
||||||
[(node/simple-mapping [field c field-type] …)
|
[(node/simple-mapping [field c field-type] …)
|
||||||
;<first-pass-field-type>] …)
|
;<first-pass-field-type>] …)
|
||||||
(node field …)]]
|
(node field …)]] …
|
||||||
…
|
|
||||||
[mapping/node [returned cm result-type]
|
[mapping/node [returned cm result-type]
|
||||||
[(mapping [param cp param-type] …)
|
[(mapping [param cp param-type] …)
|
||||||
(mapping/node
|
(mapping/node
|
||||||
(let ([node node/simple-mapping] …)
|
(let ([node node/simple-mapping] …)
|
||||||
. body))]]
|
. body))]]
|
||||||
…
|
…))))]
|
||||||
;)) 'add)
|
|
||||||
)))))]
|
|
||||||
|
|
||||||
As explained above, during the first pass, the field types
|
As explained above, during the first pass, the field types
|
||||||
of nodes will allow placeholders for the temporary nodes
|
of nodes will allow placeholders for the temporary nodes
|
||||||
|
|
@ -140,7 +128,7 @@ encapsulating the result types of mappings.
|
||||||
@chunk[<first-pass-type-expander>
|
@chunk[<first-pass-type-expander>
|
||||||
;; TODO: to avoid conflicting definitions of ~>, we should either use
|
;; TODO: to avoid conflicting definitions of ~>, we should either use
|
||||||
;; syntax-parameterize, or make a #:local-definitions
|
;; syntax-parameterize, or make a #:local-definitions
|
||||||
#;(define-type-expander (~>-id stx)
|
(define-type-expander (~>-id stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ (~datum mapping)) ;; TODO: should be ~literal
|
[(_ (~datum mapping)) ;; TODO: should be ~literal
|
||||||
(template
|
(template
|
||||||
|
|
@ -151,34 +139,6 @@ encapsulating the result types of mappings.
|
||||||
…
|
…
|
||||||
;; TODO: should fall-back to outer definition of ~>, if any.
|
;; 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
|
|
||||||
(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)
|
(define-type-expander (first-step-expander2 stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ (~datum mapping)) ;; TODO: should be ~literal
|
[(_ (~datum mapping)) ;; TODO: should be ~literal
|
||||||
|
|
@ -187,13 +147,7 @@ encapsulating the result types of mappings.
|
||||||
;; TODO: should fall-back to outer definition of ~>, if any.
|
;; TODO: should fall-back to outer definition of ~>, if any.
|
||||||
)
|
)
|
||||||
#;(U (first-step #:placeholder m-streets4/node)
|
#;(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
|
@; TODO: replace-in-type doesn't work wfell here, we need to define a
|
||||||
@; type-expander.
|
@; type-expander.
|
||||||
|
|
@ -225,10 +179,9 @@ encapsulating the result types of mappings.
|
||||||
"meta-struct.rkt"; debug
|
"meta-struct.rkt"; debug
|
||||||
racket/stxparam
|
racket/stxparam
|
||||||
racket/splicing)
|
racket/splicing)
|
||||||
(provide define-graph/rich-return ~>)
|
(provide define-graph/rich-return); ~>)
|
||||||
|
|
||||||
(define-rename-transformer-parameter ~>
|
;(define-syntax-parameter ~> (make-rename-transformer #'threading:~>))
|
||||||
(make-rename-transformer #'threading:~>))
|
|
||||||
|
|
||||||
(require (for-syntax racket/pretty))
|
(require (for-syntax racket/pretty))
|
||||||
(define-syntax (debug stx)
|
(define-syntax (debug stx)
|
||||||
|
|
@ -238,6 +191,116 @@ encapsulating the result types of mappings.
|
||||||
(pretty-print (syntax->datum #'body))
|
(pretty-print (syntax->datum #'body))
|
||||||
#'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)))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
<graph-rich-return>)]
|
<graph-rich-return>)]
|
||||||
|
|
||||||
@chunk[<module-test>
|
@chunk[<module-test>
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user