suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Revert "Problem on expansion step 10086 in __DEBUG_graph6.2.rkt : clicking on City9/make-placeholder-type:14 shows that it hasn't the same scopes afterwards.". Now at commit 876c4d2 Fixed most bugs related to ~> type expander.

Browse Source 
This reverts commit 56fdfaeb8f.
This commit is contained in:
Georges Dupéron 2016-02-26 23:30:13 +01:00
parent 9d68e98882
commit ada994beb9
9 changed files with 139 additions and 416 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
graph-lib/graph/__DEBUG_graph6.2.rkt
View File

@ -1,38 +0,0 @@
#lang typed/racket
(require ;"graph-6-rich-returns.lp2.rkt"
(except-in "../lib/low.rkt" ~>)
"graph.lp2.rkt"
"get.lp2.rkt"
"../type-expander/type-expander.lp2.rkt"
"../type-expander/multi-id.lp2.rkt"
"structure.lp2.rkt" ; debug
"variant.lp2.rkt" ; debug
"fold-queues.lp2.rkt"; debug
"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))
(define-graph gr
#:wrapping-definitions (begin (define-graph-rest))
[City [streets : (Listof Street)] [people : (Listof Person)]
[(m-city [c : (Listof (Pairof String String))])
(City (remove-duplicates (map (curry m-street c) (cdrs c)))
(remove-duplicates (map m-person (cars c))))]]
[Street [sname : String] [houses : (Listof House)]
[(m-street [c : (Listof (Pairof String String))] [s : String])
(Street s (map (curry (curry m-house s) c)
(cars (filter (λ ([x : (Pairof String String)])
(equal? (cdr x) s))
c))))]]
[House [owner : Person] [location : Street]
[(m-house [s : String]
[c : (Listof (Pairof String String))]
[p : String])
(House (m-person p) (m-street c s))]]
[Person [name : String]
[(m-person [p : String])
(Person p)]])

106
graph-lib/graph/__DEBUG_graph6.rkt
View File

@ -1,7 +1,7 @@
#lang typed/racket
(require "graph-6-rich-returns.lp2.rkt"
(except-in "../lib/low.rkt" ~>)
"../lib/low.rkt"
"graph.lp2.rkt"
"get.lp2.rkt"
"../type-expander/type-expander.lp2.rkt"
@ -12,7 +12,6 @@
"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))
@ -24,96 +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-syntax-parameterize
((~> (make-rename-transformer #'first-step-expander1)))))
(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]])
@ -126,18 +35,6 @@
: (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")))
@ -442,4 +339,3 @@
(map Street snames))))))))
;(blah)
|#

39
graph-lib/graph/__DEBUG_graph6E.rkt
View File

@ -1,39 +0,0 @@
#lang typed/racket
(module m typed/racket
(define-syntax (m1 stx)
(syntax-case stx ()
[(_ (_ (e) _) b)
(begin (displayln (free-identifier=? #'e #'b))
#'(void))]))
(define-syntax (frozen stx)
(syntax-case stx ()
[(_ def b)
#`(begin def ;#,(datum->syntax #'a (syntax->datum #'(define def val)))
(m1 def b))]))
(define-syntax (goo stx)
(syntax-case stx ()
[(_ b)
;(begin (define i1 (make-syntax-delta-introducer #'te #'b))
; (define i2 (make-syntax-delta-introducer #'b #'te))
#`(frozen (define (te) 1)
#,(syntax-local-introduce #'b))]))
(provide goo))
(require 'm)
(goo te)
#|
(define-syntax (lake stx)
(syntax-parse stx
[(_ val a)
#`(let ((#,(datum->syntax stx 'tea) val)) a)]))
(lake 3 tea)
|#

41
graph-lib/graph/__DEBUG_graph6EB.rkt
View File

@ -1,41 +0,0 @@
#lang typed/racket
(require #|"graph-6-rich-returns.lp2.rkt"
"../lib/low.rkt"
"graph.lp2.rkt"
"get.lp2.rkt"
"../type-expander/type-expander.lp2.rkt"
(for-syntax (submod "../type-expander/type-expander.lp2.rkt" expander))
"../type-expander/multi-id.lp2.rkt"
"structure.lp2.rkt" ; debug
"variant.lp2.rkt" ; debug
"fold-queues.lp2.rkt"; debug
"rewrite-type.lp2.rkt"; debug
"meta-struct.rkt"; debug
"../lib/debug-syntax.rkt"
racket/splicing|#
(for-syntax syntax/parse)
(for-syntax syntax/parse/experimental/template))
;(syntax-local-lift-expression #`(browse-syntaxes (list #'e #'b)))
(define-syntax (d-exp stx)
(syntax-parse stx
[(_ (_ (e) _) b)
(displayln (free-identifier=? #'e #'b))
#'(void)]))
(define-syntax (frozen stx)
(syntax-parse stx
[(_ def b)
#`(begin def ;#,(datum->syntax #'a (syntax->datum #'(define def val)))
(d-exp def b))]))
(define-syntax (goo stx)
(syntax-parse stx
[(_ b)
(define i1 (make-syntax-delta-introducer #'te #'b))
(define i2 (make-syntax-delta-introducer #'b #'te))
#`(frozen (define (#,(i2 #'te)) 1)
#,(i1 #'b))]))
(provide goo)

37
graph-lib/graph/__DEBUG_graph6F.rkt
View File

@ -1,37 +0,0 @@
#lang racket
(module m racket
(require macro-debugger/syntax-browser)
(define-syntax (m1 stx)
(syntax-case stx ()
[(_ sol (su sv) m2-id user-id i-user-id a f r aa ff rr)
(syntax-local-lift-expression
#`(browse-syntaxes
(list #'sol #'m2-id #'user-id #'i-user-id #'a #'f #'r #'aa #'ff #'rr)))
#`(cons (list (su) sv) #,(free-identifier=? #'m2-id #'sol))]))
(define-syntax (m2 stx)
(syntax-case stx ()
[(_ user-id val)
#`(begin
(define (foo) 1)
(m1
;#,((make-syntax-delta-introducer #'foo #'user-id) (syntax-local-introduce #'user-id) 'add)
#,((make-syntax-delta-introducer #'foo stx) (syntax-local-introduce #'user-id) 'add)
#,((make-syntax-delta-introducer #'foo stx) (syntax-local-introduce #'(user-id val)) 'add)
foo
user-id
#,(syntax-local-introduce #'user-id)
#,((make-syntax-delta-introducer #'foo #'user-id) #'user-id 'add)
#,((make-syntax-delta-introducer #'foo #'user-id) #'user-id 'flip)
#,((make-syntax-delta-introducer #'foo #'user-id) #'user-id 'remove)
#,((make-syntax-delta-introducer #'user-id #'foo) #'user-id 'add)
#,((make-syntax-delta-introducer #'user-id #'foo) #'user-id 'flip)
#,((make-syntax-delta-introducer #'user-id #'foo) #'user-id 'remove)))]))
(provide m2))(require 'm)
(let ((y 1))
(m2 foo y))
(let ((y 2))
(m2 foo y))

29
graph-lib/graph/__DEBUG_graph6G-req.rkt
View File

@ -1,29 +0,0 @@
#lang typed/racket
(require "graph-6-rich-returns.lp2.rkt"
"../lib/low.rkt"
"graph.lp2.rkt"
"get.lp2.rkt"
"../type-expander/type-expander.lp2.rkt"
"../type-expander/multi-id.lp2.rkt"
"structure.lp2.rkt" ; debug
"variant.lp2.rkt" ; debug
"fold-queues.lp2.rkt"; debug
"rewrite-type.lp2.rkt"; debug
"meta-struct.rkt"; debug
racket/splicing; debug
)
(provide (all-from-out "graph-6-rich-returns.lp2.rkt"
"../lib/low.rkt"
"graph.lp2.rkt"
"get.lp2.rkt"
"../type-expander/type-expander.lp2.rkt"
"../type-expander/multi-id.lp2.rkt"
"structure.lp2.rkt" ; debug
"variant.lp2.rkt" ; debug
"fold-queues.lp2.rkt"; debug
"rewrite-type.lp2.rkt"; debug
"meta-struct.rkt"; debug
racket/splicing; debug
))

33
graph-lib/graph/__DEBUG_graph6G.rkt
View File

@ -1,33 +0,0 @@
#lang typed/racket
(require "__DEBUG_graph6G-req.rkt")
(module m typed/racket
(require "__DEBUG_graph6G-req.rkt"
macro-debugger/syntax-browser
(for-syntax syntax/parse)
(for-syntax syntax/parse/experimental/template))
(define-syntax (m1 stx)
(syntax-parse stx
[(_ m2-id (~and code (_ _ (~and (~datum foo) su))))
#`(begin code
#,(free-identifier=? #'m2-id #'su))]))
(define-syntax (rich-graph stx)
(syntax-parse stx
[(_ user-code)
(define i (make-syntax-introducer))
#`(begin
#,(i #'(define-type-expander (foo stx) #'Number))
(m1 foo #,(i #'user-code)))]))
(provide rich-graph))
(require 'm)
(let ((y 1))
(rich-graph (ann y foo)))
(let ((y 2))
(rich-graph (ann y foo)))

199
graph-lib/graph/graph-6-rich-returns.lp2.rkt
View File

@ -55,9 +55,6 @@ mapping declarations from the node definitions:
@chunk[<signature>
(define-graph/rich-return name:id
(~or (~seq #:definitions extra-definitions)
(~seq #:wrapping-definitions wrapping-extra-definitions)
(~seq))
((~commit [node:id <field-signature> …])
…)
(~commit <mapping-declaration>)
@ -107,31 +104,22 @@ 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 '~>))
;(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 <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] …)
;<first-pass-field-type>] …)
(node field …)]]
…
[mapping/node [returned cm result-type]
[(mapping [param cp param-type] …)
(mapping/node
(let ([node node/simple-mapping] …)
. body))]]
…
;)) 'add)
)))))]
(define/with-syntax ~>-id (datum->syntax #'name '~>))
(template
;(debug
(begin
(define-graph first-step
#:definitions [<first-pass-type-expander>]
[node [field c (Let [~>-id first-step-expander2] field-type)] …
[(node/simple-mapping [field c field-type] …)
;<first-pass-field-type>] …)
(node field …)]] …
[mapping/node [returned cm result-type]
[(mapping [param cp param-type] …)
(mapping/node
(let ([node node/simple-mapping] …)
. body))]]
…))))]
As explained above, during the first pass, the field types
of nodes will allow placeholders for the temporary nodes
@ -140,34 +128,7 @@ encapsulating the result types of mappings.
@chunk[<first-pass-type-expander>
;; TODO: to avoid conflicting definitions of ~>, we should either use
;; syntax-parameterize, or make a #:local-definitions
#;(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)
(define-type-expander (~>-id stx)
(syntax-parse stx
[(_ (~datum mapping)) ;; TODO: should be ~literal
(template
@ -178,7 +139,6 @@ 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
@ -187,13 +147,7 @@ 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))))
(splicing-syntax-parameterize ([~> (make-rename-transformer
#'first-step-expander1)])
(?? wrapping-extra-definitions
(?? (?@ extra-definitions
(define-graph-rest)))))]
(Listof (first-step #:placeholder Street))))]
@; TODO: replace-in-type doesn't work wfell here, we need to define a
@; type-expander.
@ -225,10 +179,9 @@ encapsulating the result types of mappings.
"meta-struct.rkt"; debug
racket/stxparam
racket/splicing)
(provide define-graph/rich-return ~>)
(define-rename-transformer-parameter ~>
(make-rename-transformer #'threading:~>))
(provide define-graph/rich-return); ~>)
;(define-syntax-parameter ~> (make-rename-transformer #'threading:~>))
(require (for-syntax racket/pretty))
(define-syntax (debug stx)
@ -237,6 +190,116 @@ 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)))))))
<graph-rich-return>)]

33
graph-lib/graph/graph.lp2.rkt
View File

@ -156,9 +156,7 @@ flexible through wrapper macros.
(define-graph . (~and main-args <main-macro-arguments>))]
@chunk[<main-macro-arguments>
(name (~optional (~and debug #:debug))
(~or (~seq #:definitions extra-definitions)
(~seq #:wrapping-definitions wrapping-extra-definitions)
(~seq))
(~maybe #:definitions (extra-definition:expr …))
[node <field-signature> … <mapping-declaration>]
…)]
@ -347,31 +345,12 @@ extra definitions, and a call to the second step macro:
…
[node node/make-incomplete]
…)
(?? <wrapping-first-step>
(?@ (?? extra-definitions)
<call-second-step>)))]
When the user gave @tc[#:wrapping-definitions] instead of @tc[#:definitions], we
use syntax-parameterize to enable the @tc[(define-graph-rest)] form.
@chunk[<wrapping-first-step>
(splicing-syntax-parameterize
([define-graph-rest
(syntax-rules () ;; TODO: indentation bug here in v 6.4.0.8
[(_) #';(splicing-syntax-parameterize
; ([define-graph-rest default-define-graph-rest])
<call-second-step>])]);)])])
wrapping-extra-definitions)]
(?? (begin extra-definition …))
<call-second-step>)]
The first step macro is defined as follows:
@chunk[<first-step>
(define-for-syntax (default-define-graph-rest stx)
(raise-syntax-error 'define-graph-rest
"can only be used inside define-graph"
stx))
(define-syntax-parameter define-graph-rest default-define-graph-rest)
(define-syntax/parse <signature>
<define-ids/first-step>
(debug-template debug
@ -790,7 +769,6 @@ We will be able to use this type expander in function types, for example:
"../lib/low-untyped.rkt"
"meta-struct.rkt")
racket/splicing
racket/stxparam
"fold-queues.lp2.rkt"
"rewrite-type.lp2.rkt"
"../lib/low.rkt"
@ -800,7 +778,10 @@ We will be able to use this type expander in function types, for example:
"../type-expander/multi-id.lp2.rkt"
"meta-struct.rkt")
(provide define-graph define-graph-rest)
;(begin-for-syntax
;<multiassoc-syntax>)
(provide define-graph)
<first-step>
<second-step>)]