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
(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")

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)
@chunk[<*>
1
;(ann 'eee Symbol)
;(define (f [x : 'e]) x)
#;((curry + 1) 2)]
;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)]

72
typed/lang/common.rkt
View File

@ -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

5
typed/lang/reader.rkt
View File

@ -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))