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

First attempt at let-type, using syntax-local-bind-syntaxes. Does not work.

Browse Source
This commit is contained in:
Georges Dupéron 2016-02-24 17:21:28 +01:00
parent 03984dc0f6
commit 6eb0a52040
1 changed files with 22 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
graph-lib/type-expander/type-expander.lp2.rkt
View File

@ -95,6 +95,15 @@ else.
[(v:id …) (syntax->list #'(v …))])]) [(v:id …) (syntax->list #'(v …))])])
(syntax-local-bind-syntaxes (list var) err-expr def-ctx)) (syntax-local-bind-syntaxes (list var) err-expr def-ctx))
(internal-definition-context-seal def-ctx) (internal-definition-context-seal def-ctx)
(internal-definition-context-introduce def-ctx stx 'add)))]
@CHUNK[<let-type-todo>
(define (let-type-todo id expr stx)
(let ([def-ctx (syntax-local-make-definition-context)])
(syntax-local-bind-syntaxes (list id)
#'(lambda _ (displayln 'expr) (error "errr"))
def-ctx)
(internal-definition-context-seal def-ctx)
(internal-definition-context-introduce def-ctx stx)))] (internal-definition-context-introduce def-ctx stx)))]
@CHUNK[<expand-type> @CHUNK[<expand-type>
@ -128,6 +137,11 @@ else.
#`(∀ (TVar ...) #,(expand-type (bind-type-vars #'(TVar ...) #'T)))] #`(∀ (TVar ...) #,(expand-type (bind-type-vars #'(TVar ...) #'T)))]
[((~literal Rec) R:id T:expr) [((~literal Rec) R:id T:expr)
#`(Rec R #,(expand-type (bind-type-vars #'(R) #'T)))] #`(Rec R #,(expand-type (bind-type-vars #'(R) #'T)))]
[((~literal Let) [V:id E:id] T:expr)
;; TODO : for now we only allow aliasing (which means E is an id),
;; not on-the-fly declaration of type expanders. This would require
;; us to (expand) them.
#`#,(expand-type (let-type-todo #'V #'E #'T))]
[((~literal quote) T) (expand-quasiquote 'quote 1 #'T)] [((~literal quote) T) (expand-quasiquote 'quote 1 #'T)]
[((~literal quasiquote) T) (expand-quasiquote 'quasiquote 1 #'T)] [((~literal quasiquote) T) (expand-quasiquote 'quasiquote 1 #'T)]
[((~literal syntax) T) (expand-quasiquote 'syntax 1 #'T)] [((~literal syntax) T) (expand-quasiquote 'syntax 1 #'T)]
@ -136,6 +150,9 @@ else.
#`(Struct #,(expand-type #'T))] #`(Struct #,(expand-type #'T))]
[(T TArg ...) [(T TArg ...)
#`(T #,@(stx-map expand-type #'(TArg ...)))] #`(T #,@(stx-map expand-type #'(TArg ...)))]
[(~and T (~datum e)) ;; DEBUG
(syntax-local-lift-expression #`(browse-syntax #'T))
#'Number]
[T #'T]))] [T #'T]))]
@CHUNK[<define-type-expander> @CHUNK[<define-type-expander>
@ -1004,6 +1021,9 @@ in a separate module (that will be used only by macros, so it will be written in
(require (for-template typed/racket)) (require (for-template typed/racket))
;; DEBUG:
(require (for-template "../lib/debug-syntax.rkt"))
(provide prop:type-expander (provide prop:type-expander
type-expander type-expander
apply-type-expander apply-type-expander
@ -1017,6 +1037,7 @@ in a separate module (that will be used only by macros, so it will be written in
<apply-type-expander> <apply-type-expander>
<expand-quasiquote> <expand-quasiquote>
<bind-type-vars> <bind-type-vars>
<let-type-todo>
<expand-type>)] <expand-type>)]
We can finally define the overloaded forms, as well as the extra We can finally define the overloaded forms, as well as the extra