diff --git a/graph-lib/graph/__DEBUG_graph6.2.rkt b/graph-lib/graph/__DEBUG_graph6.2.rkt deleted file mode 100644 index 432ec331..00000000 --- a/graph-lib/graph/__DEBUG_graph6.2.rkt +++ /dev/null @@ -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)]]) \ No newline at end of file diff --git a/graph-lib/graph/__DEBUG_graph6.rkt b/graph-lib/graph/__DEBUG_graph6.rkt index 530f7d71..0e15d65e 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" - (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) -|# \ No newline at end of file diff --git a/graph-lib/graph/__DEBUG_graph6E.rkt b/graph-lib/graph/__DEBUG_graph6E.rkt deleted file mode 100644 index 40a6254e..00000000 --- a/graph-lib/graph/__DEBUG_graph6E.rkt +++ /dev/null @@ -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) - -|# \ No newline at end of file diff --git a/graph-lib/graph/__DEBUG_graph6EB.rkt b/graph-lib/graph/__DEBUG_graph6EB.rkt deleted file mode 100644 index 5e7f5b15..00000000 --- a/graph-lib/graph/__DEBUG_graph6EB.rkt +++ /dev/null @@ -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) \ No newline at end of file diff --git a/graph-lib/graph/__DEBUG_graph6F.rkt b/graph-lib/graph/__DEBUG_graph6F.rkt deleted file mode 100644 index fc983be4..00000000 --- a/graph-lib/graph/__DEBUG_graph6F.rkt +++ /dev/null @@ -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)) diff --git a/graph-lib/graph/__DEBUG_graph6G-req.rkt b/graph-lib/graph/__DEBUG_graph6G-req.rkt deleted file mode 100644 index 70d3a906..00000000 --- a/graph-lib/graph/__DEBUG_graph6G-req.rkt +++ /dev/null @@ -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 - )) \ No newline at end of file diff --git a/graph-lib/graph/__DEBUG_graph6G.rkt b/graph-lib/graph/__DEBUG_graph6G.rkt deleted file mode 100644 index 1c918043..00000000 --- a/graph-lib/graph/__DEBUG_graph6G.rkt +++ /dev/null @@ -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))) diff --git a/graph-lib/graph/graph-6-rich-returns.lp2.rkt b/graph-lib/graph/graph-6-rich-returns.lp2.rkt index 6d862c75..e4a5708a 100644 --- a/graph-lib/graph/graph-6-rich-returns.lp2.rkt +++ b/graph-lib/graph/graph-6-rich-returns.lp2.rkt @@ -55,9 +55,6 @@ 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 ) @@ -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 ) - ;. #,(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) - )))))] + (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))]] + …))))] 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[ ;; 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))))))) + + + + + + )] diff --git a/graph-lib/graph/graph.lp2.rkt b/graph-lib/graph/graph.lp2.rkt index b6ba31e6..42019bb6 100644 --- a/graph-lib/graph/graph.lp2.rkt +++ b/graph-lib/graph/graph.lp2.rkt @@ -156,9 +156,7 @@ flexible through wrapper macros. (define-graph . (~and main-args ))] @chunk[ (name (~optional (~and debug #:debug)) - (~or (~seq #:definitions extra-definitions) - (~seq #:wrapping-definitions wrapping-extra-definitions) - (~seq)) + (~maybe #:definitions (extra-definition:expr …)) [node … ] …)] @@ -347,31 +345,12 @@ extra definitions, and a call to the second step macro: … [node node/make-incomplete] …) - (?? - (?@ (?? extra-definitions) - )))] - -When the user gave @tc[#:wrapping-definitions] instead of @tc[#:definitions], we -use syntax-parameterize to enable the @tc[(define-graph-rest)] form. - -@chunk[ - (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]) - ])]);)])]) - wrapping-extra-definitions)] + (?? (begin extra-definition …)) + )] The first step macro is defined as follows: @chunk[ - (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 (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 + ;) + + (provide define-graph) )]