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

Fixed problem with typed/untyped stx-cons.

Browse Source
This commit is contained in:
Georges Dupéron 2016-01-20 21:25:55 +01:00
parent 1619bfb0ef
commit d49160b6ea
1 changed files with 18 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1015,34 +1015,33 @@
(stx-cdr l2) (stx-cdr l2)
(stx-cdr l3)))])) (stx-cdr l3)))]))
;; stx-cons
(module m-stx-untyped racket (module m-stx-untyped racket
(require syntax/stx) (require syntax/stx)
(provide stx-cons #;stx-drop-last) (provide stx-cons #;stx-drop-last)
;(: stx-cons (∀ (A B) (→ A B (Syntaxof (Pairof A B))))) (define (stx-cons a b) #`(#,a . #,b)))
(define (stx-cons a b) #`(#,a . #,b))
;(: stx-drop-last (∀ (A) (→ (Syntaxof (Listof A)) (Syntaxof (Listof A))))) (typed/untyped-prefix
#;(define (stx-drop-last l) [module m-stx-typed typed/racket
(if (and (stx-pair? l) (stx-pair? (stx-cdr l))) (require (only-in typed/racket/unsafe unsafe-require/typed))
(stx-cons (stx-car l) (stx-drop-last (stx-cdr l))) (unsafe-require/typed (submod ".." m-stx-untyped)
#'()))) [stx-cons (∀ (A B)
(→ (Syntaxof A)
(Syntaxof B)
(Syntaxof (Pairof (Syntaxof A)
(Syntaxof B)))))])
(provide stx-cons)]
[module m-stx-typed typed/racket/no-check
(require (submod ".." m-stx-untyped))
(provide stx-cons)])
;; stx-cons (require/provide 'm-stx-typed)
(module m-stx-typed typed/racket
(require typed/racket/unsafe)
(unsafe-require/typed (submod ".." m-stx-untyped)
[stx-cons (∀ (A B)
(→ (Syntaxof A)
(Syntaxof B)
(Syntaxof (Pairof (Syntaxof A)
(Syntaxof B)))))])
(provide stx-cons))
(module+ test (module+ test
(require ;(submod "..") (require ;(submod "..")
typed/rackunit) typed/rackunit)
(check-equal? (syntax->datum (check-equal? (syntax->datum
(ann (stx-cons #'a #'(b c)) (ann (stx-cons #'a #'(b c))
@ -1057,8 +1056,6 @@
(Syntaxof 2))))) (Syntaxof 2)))))
'(1 . 2))) '(1 . 2)))
(require/provide 'm-stx-typed)
;; stx-pair? ;; stx-pair?
(: stx-pair? (→ Any Boolean : (Syntaxof Any))) (: stx-pair? (→ Any Boolean : (Syntaxof Any)))