suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Works, but needs a workaround for typed/racket to work.

Browse Source
This commit is contained in:
Georges Dupéron 2016-06-17 13:42:41 +02:00
parent e785765209
commit 1b15bce0c7
4 changed files with 68 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
info.rkt
View File

@ -1,7 +1,11 @@
#lang info #lang info
(define collection "hyper-literate") (define collection "hyper-literate")
(define deps '("base" (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 build-deps '("scribble-lib" "racket-doc"))
(define scribblings '(("scribblings/hyper-literate.scrbl" ()))) (define scribblings '(("scribblings/hyper-literate.scrbl" ())))
(define pkg-desc "Description Here") (define pkg-desc "Description Here")

11
test/test.hl.rkt
View File

@ -1,9 +1,10 @@
#lang hyper-literate/typed typed/racket #lang hyper-literate/typed typed/racket/base
@;((curry + 1) 2) @;((curry + 1) 2)
@chunk[<*> @chunk[<*>
1 ;curry ;; should give an error when using typed/racket/base
;(ann 'eee Symbol) ((make-predicate One) 1)
;(define (f [x : 'e]) x) (ann 'sym Symbol)
#;((curry + 1) 2)] (define (f [x : 'e]) x)
(ann (f 'e) 'e)]

72
typed/lang/common.rkt
View File

@ -28,11 +28,11 @@
chunks id chunks id
`(,@(mapping-get chunks id) ,@exprs)))) `(,@(mapping-get chunks id) ,@exprs))))
(define-syntax (tangle stx) (define-for-syntax (tangle orig-stx)
(define chunk-mentions '()) (define chunk-mentions '())
(unless first-id (unless first-id
(raise-syntax-error 'scribble/lp "no chunks")) (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 (restore nstx d) (datum->syntax orig-stx d nstx nstx))
(define (shift nstx) (replace-context orig-stx nstx)) (define (shift nstx) (replace-context orig-stx nstx))
(define body (define body
@ -64,7 +64,7 @@
chunk-mentions)]) chunk-mentions)])
;(displayln (dynamic-require 'tyyyyyyyyyyyped/racket '#%module-begin)) ;(displayln (dynamic-require 'tyyyyyyyyyyyped/racket '#%module-begin))
(replace-context #'#%module-begin;modbeg-ty (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) (define-for-syntax (strip-comments body)
(cond (cond
@ -125,34 +125,72 @@
(require racket/stxparam) (require racket/stxparam)
(define-syntax-parameter mbeg #'#%module-begin) (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) (define-for-syntax ((make-module-begin submod?) stx)
(syntax-case 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 () (let ()
;; TODO: get the actual symbol, instead of the string returned by scribble's at-reader ;; 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) ""))) (define lng-sym (string->symbol (regexp-replace "^ " (syntax-e #'lng) "")))
(dynamic-require lng-sym #f) (dynamic-require lng-sym #f)
(define ns1 (module->namespace lng-sym)) (define ns1 (current-namespace));(module->namespace lng-sym))
;(define ns2 (make-empty-namespace)) ;(define ns2 (make-empty-namespace))
;(namespace-attach-module ns1 'tyyyyyyyyyyyped/racket ns2) ;(namespace-attach-module ns1 'tyyyyyyyyyyyped/racket ns2)
;(displayln ns1) ;(displayln ns1)
;(displayln ns2) ;(displayln ns2)
(parameterize ([current-namespace ns1]) (let ([expanded
(namespace-require `(for-meta -1 ,lng-sym)) (expand `(,#'module scribble-lp-tmp-name scribble/private/lp;hyper-literate/tyyyyyyyyyyyped/private/lp
#|(displayln (namespace-symbol->identifier '#%module-begin)) ,@(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 (displayln (replace-context
(namespace-symbol->identifier '#%module-begin) (namespace-symbol->identifier '#%module-begin)
#'#%module-begin))|# #'#%module-begin))|#
(replace-context (replace-context
(namespace-symbol->identifier '#%module-begin) (namespace-symbol->identifier '#%module-begin)
#'(#%module-begin #`(#%module-begin
(+ 'a) ;#,#'(let ([eee 'eee])
#;(ann (cons 1 'b) (Pairof Number Symbol)) ; (ann eee Symbol))
#;((make-predicate (Pairof Number Symbol)) (cons 1 'b)))) #,(tangle #'body0))
#;(namespace-syntax-introduce #;#`(#%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 () #;(syntax-case stx ()
[(_ body0 . body) [(_ body0 . body)
(let ([expanded (let ([expanded

5
typed/lang/reader.rkt
View File

@ -10,9 +10,8 @@ hyper-literate/typed/lang/lang
;; scribble/lp files are not directly scribble'able. ;; scribble/lp files are not directly scribble'able.
#:language-info (scribble-base-language-info) #:language-info (scribble-base-language-info)
#:info (scribble-base-reader-info) #:info (scribble-base-reader-info)
(require scribble/reader (require "my-reader.rkt"
scribble/reader
(only-in scribble/base/reader (only-in scribble/base/reader
scribble-base-reader-info scribble-base-reader-info
scribble-base-language-info)) scribble-base-language-info))