This commit is contained in:
Georges Dupéron 2016-03-25 18:59:10 +01:00
parent 2982e49e6e
commit e9c3fbf8e5
2 changed files with 16 additions and 38 deletions

View File

@ -192,9 +192,9 @@ produced by the first step.
[mapping/node mapping/node-marker] ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;TODO: test: I'm unsure here [mapping/node mapping/node-marker] ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;TODO: test: I'm unsure here
[node (name #:placeholder City)]) [node (name #:placeholder City)])
#;(U (name/first-step mapping/node) #;(U (name/first-step mapping/node)
(tmpl-replace-in-type result-type (tmpl-replace-in-type result-type
[mapping/node (name/first-step mapping/node)] [mapping/node (name/first-step mapping/node)]
[node (name/first-step node)]))) [node (name/first-step node)])))
;; TODO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;TODO;^^;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;TODO;^^;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -302,22 +302,14 @@ recursively:
("inline-instance" stx) ("inline-instance" stx)
(syntax-parse stx (syntax-parse stx
[(_ i-t (~and seen (:id ( )))) [(_ i-t (~and seen (:id ( ))))
(define/with-syntax typp #'i-t)
(define/with-syntax repl (replace-in-instance #'typp
#'(<inline-instance-replacement>
<inline-instance-nodes>)))
(displayln (list "i-t=" #'typp))
<inline-check-seen> <inline-check-seen>
#'repl (replace-in-instance #'i-t
#;#'(λ ([x : i-t]) #'(<inline-instance-replacement>
: (inline-type* i-t seen) <inline-instance-nodes>))])))]
(ann (repl x)
(inline-type* i-t seen "HERE"))
#;(error "NIY2"))])))]
@chunk[<inline-instance-replacement> @chunk[<inline-instance-replacement>
[second-step-mapping/node-of-first ;; from [second-step-mapping/node-of-first ;; from
(inline-type* result-type (mapping/node . seen) "RESSSS") ;; to (inline-type result-type (mapping/node . seen)) ;; to
(name/first-step #:? mapping/node) ;; pred? (name/first-step #:? mapping/node) ;; pred?
(λ ([x : second-step-mapping/node-of-first]) ;; fun (λ ([x : second-step-mapping/node-of-first]) ;; fun
((inline-instance* result-type (mapping/node . seen)) ((inline-instance* result-type (mapping/node . seen))
@ -457,20 +449,6 @@ which does not allow variants of (~> …).
---- ----
@chunk[<inline-type> @chunk[<inline-type>
(define-type-expander (inline-type* stx)
(dbg
("inline-type*" stx)
(syntax-parse stx
[(_ i-tyy (~and seen (:id ( ))) (~optional msg))
(when (attribute msg)
(displayln (syntax-e #'msg)))
(define/with-syntax replt
;; Same as above in inline-instance*, TODO: factor it out.
#'i-tyy
#;(replace-in-type #'(Let (id-~> second-step-marker-expander) i-tyy)
#'([node second-step-node-of-first]
)))
#'(inline-type replt seen)])))
(define-type-expander (inline-type stx) (define-type-expander (inline-type stx)
(dbg (dbg
("inline-type" stx) ("inline-type" stx)
@ -483,8 +461,8 @@ which does not allow variants of (~> …).
@chunk[<inline-type-replacement> @chunk[<inline-type-replacement>
[second-step-mapping/node-of-first ;mapping/node-marker ;; from [second-step-mapping/node-of-first ;; from
(inline-type* result-type (mapping/node . seen))] ;; to (inline-type result-type (mapping/node . seen))] ;; to
] ]
@chunk[<inline-type-nodes> @chunk[<inline-type-nodes>
@ -577,10 +555,10 @@ encapsulating the result types of mappings.
(begin-for-syntax (begin-for-syntax
(define-syntax-rule (dbg log . body) (define-syntax-rule (dbg log . body)
(begin (begin
(display ">>> ")(displayln (list . log)) ;(display ">>> ")(displayln (list . log))
(let ((res (let () . body))) (let ((res (let () . body)))
(display "<<< ")(displayln (list . log)) ;(display "<<< ")(displayln (list . log))
(display "<<<= ")(display (car (list . log)))(display res)(displayln ".") ;(display "<<<= ")(display (car (list . log)))(display res)(displayln ".")
res)))) res))))
<graph-rich-return>)] <graph-rich-return>)]

View File

@ -84,12 +84,12 @@ set of known type constructors like @tc[List] or @tc[Pairof], and recursively
calls itself on the components of the type. calls itself on the components of the type.
@CHUNK[<replace-in-type> @CHUNK[<replace-in-type>
(define/debug (replace-in-type t r) (define (replace-in-type t r)
(define (recursive-replace new-t) (replace-in-type new-t r)) (define (recursive-replace new-t) (replace-in-type new-t r))
(define/with-syntax ([from to] ...) r) (define/with-syntax ([from to] ...) r)
(displayln (format "~a\n=> ~a" ;(displayln (format "~a\n=> ~a"
(syntax->datum t) ; (syntax->datum t)
(syntax->datum (expand-type t)))) ; (syntax->datum (expand-type t))))
(syntax-parse (expand-type t) (syntax-parse (expand-type t)
#:context #'(replace-in-type t r) #:context #'(replace-in-type t r)
<replace-in-type-substitute> <replace-in-type-substitute>