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

Cleanup

Browse Source
This commit is contained in:
Georges Dupéron 2016-06-17 16:19:18 +02:00
parent be223efb48
commit 0ed3923079
5 changed files with 61 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.travis.yml
View File

@ -48,8 +48,8 @@ before_script:
# packages without it getting stuck on a confirmation prompt. # packages without it getting stuck on a confirmation prompt.
script: script:
- raco test -x -p hyper-literate - raco test -x -p hyper-literate
- raco setup --check-pkg-deps --pkgs hyper-literate
after_success: after_success:
- raco setup --check-pkg-deps --pkgs hyper-literate
- raco pkg install --deps search-auto cover cover-coveralls - raco pkg install --deps search-auto cover cover-coveralls
- raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage . - raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage .

3
info.rkt
View File

@ -7,7 +7,8 @@
"scribble-lib" "scribble-lib"
"typed-racket-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" ())
("test/test.hl.rkt" ())))
(define pkg-desc "Description Here") (define pkg-desc "Description Here")
(define version "0.0") (define version "0.0")
(define pkg-authors '(|Georges Dupéron|)) (define pkg-authors '(|Georges Dupéron|))

29
test/test.hl.rkt
View File

@ -1,10 +1,27 @@
#lang hyper-literate/typed typed/racket/base #lang hyper-literate/typed typed/racket/base
@;((curry + 1) 2) @title{Title}
Hello world.
@(if-preexpanding
(void)
(require (submod "..")))
@(unless-preexpanding
(symbol->string ee))
@chunk[<*> @chunk[<*>
;curry ;; should give an error when using typed/racket/base (require typed/rackunit)
((make-predicate One) 1) (module ms typed/racket/base
(ann 'sym Symbol) (define x 1)
(define (f [x : 'e]) x) (provide x))
(ann (f 'e) 'e)] (require 'ms)
(check-equal? (+ x x) 2)
;; Gives an error because typed/racket/base is used on the #lang line:
;curry
(check-equal? ((make-predicate One) 1) #t)
(check-equal? (ann 'sym Symbol) 'sym)
(define (f [x : 'e123]) x)
(define ee (ann (f 'e123) 'e123))
(provide ee)]

94
typed/lang/common.rkt
View File

@ -130,93 +130,45 @@
(define-for-syntax ((make-module-begin submod?) stx) (define-for-syntax ((make-module-begin submod?) stx)
(syntax-case stx () (syntax-case stx ()
[(mb lng body0 . body) [(_modbeg lang 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
(define lng-sym (string->symbol (regexp-replace "^ " (syntax-e #'lng) ""))) ;; scribble's at-reader. Or use the first line as a whole as the #lang,
(dynamic-require lng-sym #f) ;; to allow othe meta-languages to be chained.
(define ns1 (current-namespace));(module->namespace lng-sym)) (define lang-sym
;(define ns2 (make-empty-namespace)) (string->symbol (regexp-replace "^ " (syntax-e #'lang) "")))
;(namespace-attach-module ns1 'tyyyyyyyyyyyped/racket ns2) (dynamic-require lang-sym #f)
;(displayln ns1)
;(displayln ns2)
(let ([expanded (let ([expanded
(expand `(,#'module scribble-lp-tmp-name scribble/private/lp;hyper-literate/tyyyyyyyyyyyped/private/lp (expand `(,#'module scribble-lp-tmp-name hyper-literate/typed/private/lp
(define-syntax-rule (if-preexpanding a b) a)
(define-syntax-rule (when-preexpanding . b) (begin . b))
(define-syntax-rule (unless-preexpanding . b) (begin))
,@(strip-context #'(body0 . body))))]) ,@(strip-context #'(body0 . body))))])
(syntax-case expanded () (syntax-case expanded ()
[(module name lang (mb . stuff)) [(module name lang (mb . stuff))
(begin (extract-chunks #'stuff) (let ()
(parameterize ([current-namespace ns1]) (extract-chunks #'stuff)
(dynamic-require lng-sym #f) (dynamic-require lang-sym #f)
(namespace-require `(for-meta -1 ,lng-sym)) (namespace-require `(for-meta -1 ,lang-sym))
#|(displayln (namespace-symbol->identifier '#%module-begin))
(displayln (replace-context
(namespace-symbol->identifier '#%module-begin)
#'#%module-begin))|#
(replace-context (replace-context
(namespace-symbol->identifier '#%module-begin) (namespace-symbol->identifier '#%module-begin)
#`(#%module-begin #`(#%module-begin
;#,#'(let ([eee 'eee]) #,(tangle #'body0)
; (ann eee Symbol)) #,@(if submod?
#,(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
(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)
#`(modbeg-ty
#,(ty-introducer #'(let ([eee 'eee])
(ann eee Symbol)))
(tangle body0)
;; The `doc` submodule allows a `scribble/lp` module
;; to be provided to `scribble`:
#|#,@(if submod?
(list (list
(let ([submod (let ([submod
(strip-context (strip-context
#`(module doc scribble/doclang2 #`(module doc scribble/doclang2
(define-syntax-rule (if-preexpanding a b) b)
(define-syntax-rule (when-preexpanding . b) (begin))
(define-syntax-rule (unless-preexpanding . b) (begin . b))
(require scribble/manual (require scribble/manual
(only-in hyper-literate/tyyyyyyyyyyyped/private/lp chunk CHUNK)) (only-in hyper-literate/typed/private/lp chunk CHUNK))
(begin body0 . body)))]) (begin body0 . body)))])
(syntax-case submod () (syntax-case submod ()
[(_ . rest) [(_ . rest)
(datum->syntax submod (cons #'module* #'rest))]))) (datum->syntax #'here (cons #'module* #'rest))])))
'())|#))]))])) '()))))])))]))
(define-syntax module-begin/plain (make-module-begin #f)) (define-syntax module-begin/plain (make-module-begin #f))
(define-syntax module-begin/doc (make-module-begin #t)) (define-syntax module-begin/doc (make-module-begin #t))

2
typed/lang/lang.rkt
View File

@ -5,4 +5,4 @@
(provide (except-out (all-from-out "common.rkt") (provide (except-out (all-from-out "common.rkt")
module-begin/plain module-begin/plain
module-begin/doc) module-begin/doc)
(rename-out [module-begin/plain #%module-begin])) (rename-out [module-begin/doc #%module-begin]))