From 1b15bce0c77dc33e468de315617780ec87c83a4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Fri, 17 Jun 2016 13:42:41 +0200 Subject: [PATCH] Works, but needs a workaround for typed/racket to work. --- info.rkt | 6 +++- test/test.hl.rkt | 11 ++++--- typed/lang/common.rkt | 72 +++++++++++++++++++++++++++++++++---------- typed/lang/reader.rkt | 5 ++- 4 files changed, 68 insertions(+), 26 deletions(-) diff --git a/info.rkt b/info.rkt index b1ed9a2d..147162d9 100644 --- a/info.rkt +++ b/info.rkt @@ -1,7 +1,11 @@ #lang info (define collection "hyper-literate") (define deps '("base" - "rackunit-lib")) + "rackunit-lib" + "at-exp-lib" + "scheme-lib" + "scribble-lib" + "typed-racket-lib")) (define build-deps '("scribble-lib" "racket-doc")) (define scribblings '(("scribblings/hyper-literate.scrbl" ()))) (define pkg-desc "Description Here") diff --git a/test/test.hl.rkt b/test/test.hl.rkt index 405f3dc9..46b853a4 100644 --- a/test/test.hl.rkt +++ b/test/test.hl.rkt @@ -1,9 +1,10 @@ -#lang hyper-literate/typed typed/racket +#lang hyper-literate/typed typed/racket/base @;((curry + 1) 2) @chunk[<*> - 1 - ;(ann 'eee Symbol) - ;(define (f [x : 'e]) x) - #;((curry + 1) 2)] \ No newline at end of file + ;curry ;; should give an error when using typed/racket/base + ((make-predicate One) 1) + (ann 'sym Symbol) + (define (f [x : 'e]) x) + (ann (f 'e) 'e)] diff --git a/typed/lang/common.rkt b/typed/lang/common.rkt index 159d1c2a..dec453ce 100644 --- a/typed/lang/common.rkt +++ b/typed/lang/common.rkt @@ -28,11 +28,11 @@ chunks id `(,@(mapping-get chunks id) ,@exprs)))) -(define-syntax (tangle stx) +(define-for-syntax (tangle orig-stx) (define chunk-mentions '()) (unless first-id (raise-syntax-error 'scribble/lp "no chunks")) - (define orig-stx (syntax-case stx () [(_ orig) #'orig])) + ;(define orig-stx (syntax-case stx () [(_ orig) #'orig])) (define (restore nstx d) (datum->syntax orig-stx d nstx nstx)) (define (shift nstx) (replace-context orig-stx nstx)) (define body @@ -64,7 +64,7 @@ chunk-mentions)]) ;(displayln (dynamic-require 'tyyyyyyyyyyyped/racket '#%module-begin)) (replace-context #'#%module-begin;modbeg-ty - #`(begin 'xxx body ... (let ([b-id (void)]) b-use) ...)))) + #`(begin body ... (let ([b-id (void)]) b-use) ...)))) (define-for-syntax (strip-comments body) (cond @@ -125,34 +125,72 @@ (require racket/stxparam) (define-syntax-parameter mbeg #'#%module-begin) -;(require (only-in tyyyyyyyyyyyped/racket)) +(require (only-in typed/racket)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; WORKAROUND +;(dynamic-require 'typed/racket 0) (define-for-syntax ((make-module-begin submod?) stx) (syntax-case stx () - [(mb lng . _) + [(mb lng body0 . body) + #;(let () + ;(define lng-sym (string->symbol (regexp-replace "^ " (syntax-e #'lng) ""))) + ;(define mb (dynamic-require lng-sym '#%module-begin)) + #'(mb 0)) (let () ;; TODO: get the actual symbol, instead of the string returned by scribble's at-reader (define lng-sym (string->symbol (regexp-replace "^ " (syntax-e #'lng) ""))) (dynamic-require lng-sym #f) - (define ns1 (module->namespace lng-sym)) + (define ns1 (current-namespace));(module->namespace lng-sym)) ;(define ns2 (make-empty-namespace)) ;(namespace-attach-module ns1 'tyyyyyyyyyyyped/racket ns2) ;(displayln ns1) ;(displayln ns2) - (parameterize ([current-namespace ns1]) - (namespace-require `(for-meta -1 ,lng-sym)) - #|(displayln (namespace-symbol->identifier '#%module-begin)) + (let ([expanded + (expand `(,#'module scribble-lp-tmp-name scribble/private/lp;hyper-literate/tyyyyyyyyyyyped/private/lp + ,@(strip-context #'(body0 . body))))]) + (syntax-case expanded () + [(module name lang (mb . stuff)) + (begin (extract-chunks #'stuff) + (parameterize ([current-namespace ns1]) + (dynamic-require lng-sym #f) + (namespace-require `(for-meta -1 ,lng-sym)) + #|(displayln (namespace-symbol->identifier '#%module-begin)) (displayln (replace-context (namespace-symbol->identifier '#%module-begin) #'#%module-begin))|# - (replace-context - (namespace-symbol->identifier '#%module-begin) - #'(#%module-begin - (+ 'a) - #;(ann (cons 1 'b) (Pairof Number Symbol)) - #;((make-predicate (Pairof Number Symbol)) (cons 1 'b)))) - #;(namespace-syntax-introduce - )))]) + (replace-context + (namespace-symbol->identifier '#%module-begin) + #`(#%module-begin + ;#,#'(let ([eee 'eee]) + ; (ann eee Symbol)) + #,(tangle #'body0)) + #;#`(#%module-begin + #,(strip-context #'(begin + (let ([eee 'eee]) + (ann eee Symbol)) + (let ([v (+ 1 2)]) (ann v Number)))) + #;(ann (cons 1 'b) (Pairof Number Symbol)) + #;((make-predicate (Pairof Number Symbol)) (cons 1 'b)))) + #;(namespace-syntax-introduce + )))])) + ;;;; WORKS: + #;(parameterize ([current-namespace ns1]) + (dynamic-require lng-sym #f) + (namespace-require `(for-meta -1 ,lng-sym)) + #|(displayln (namespace-symbol->identifier '#%module-begin)) + (displayln (replace-context + (namespace-symbol->identifier '#%module-begin) + #'#%module-begin))|# + (replace-context + (namespace-symbol->identifier '#%module-begin) + #`(#%module-begin + #,(strip-context #'(begin + (let ([eee 'eee]) + (ann eee Symbol)) + (let ([v (+ 1 2)]) (ann v Number)))) + #;(ann (cons 1 'b) (Pairof Number Symbol)) + #;((make-predicate (Pairof Number Symbol)) (cons 1 'b)))) + #;(namespace-syntax-introduce + )))]) #;(syntax-case stx () [(_ body0 . body) (let ([expanded diff --git a/typed/lang/reader.rkt b/typed/lang/reader.rkt index cf672b17..0ee2104d 100644 --- a/typed/lang/reader.rkt +++ b/typed/lang/reader.rkt @@ -10,9 +10,8 @@ hyper-literate/typed/lang/lang ;; scribble/lp files are not directly scribble'able. #:language-info (scribble-base-language-info) #:info (scribble-base-reader-info) -(require scribble/reader +(require "my-reader.rkt" + scribble/reader (only-in scribble/base/reader scribble-base-reader-info scribble-base-language-info)) - -