Cleanup
This commit is contained in:
Georges Dupéron
parent
be223efb48
commit
0ed3923079
|
|
@ -48,8 +48,8 @@ before_script:
|
|||
# packages without it getting stuck on a confirmation prompt.
|
||||
script:
|
||||
- raco test -x -p hyper-literate
|
||||
- raco setup --check-pkg-deps --pkgs hyper-literate
|
||||
|
||||
after_success:
|
||||
- raco setup --check-pkg-deps --pkgs hyper-literate
|
||||
- raco pkg install --deps search-auto cover cover-coveralls
|
||||
- raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage .
|
||||
|
|
|
|||
3
info.rkt
3
info.rkt
|
|
@ -7,7 +7,8 @@
|
|||
"scribble-lib"
|
||||
"typed-racket-lib"))
|
||||
(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 version "0.0")
|
||||
(define pkg-authors '(|Georges Dupéron|))
|
||||
|
|
|
|||
|
|
@ -1,10 +1,27 @@
|
|||
#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[<*>
|
||||
;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)]
|
||||
(require typed/rackunit)
|
||||
(module ms typed/racket/base
|
||||
(define x 1)
|
||||
(provide x))
|
||||
(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)]
|
||||
|
|
|
|||
|
|
@ -130,93 +130,45 @@
|
|||
|
||||
(define-for-syntax ((make-module-begin submod?) stx)
|
||||
(syntax-case stx ()
|
||||
[(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))
|
||||
[(_modbeg lang body0 . body)
|
||||
(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 (current-namespace));(module->namespace lng-sym))
|
||||
;(define ns2 (make-empty-namespace))
|
||||
;(namespace-attach-module ns1 'tyyyyyyyyyyyped/racket ns2)
|
||||
;(displayln ns1)
|
||||
;(displayln ns2)
|
||||
;; TODO: get the actual symbol, instead of the string returned by
|
||||
;; scribble's at-reader. Or use the first line as a whole as the #lang,
|
||||
;; to allow othe meta-languages to be chained.
|
||||
(define lang-sym
|
||||
(string->symbol (regexp-replace "^ " (syntax-e #'lang) "")))
|
||||
(dynamic-require lang-sym #f)
|
||||
(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))))])
|
||||
(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
|
||||
;#,#'(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
|
||||
(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
|
||||
(let ([submod
|
||||
(strip-context
|
||||
#`(module doc scribble/doclang2
|
||||
(require scribble/manual
|
||||
(only-in hyper-literate/tyyyyyyyyyyyped/private/lp chunk CHUNK))
|
||||
(begin body0 . body)))])
|
||||
(syntax-case submod ()
|
||||
[(_ . rest)
|
||||
(datum->syntax submod (cons #'module* #'rest))])))
|
||||
'())|#))]))]))
|
||||
(let ()
|
||||
(extract-chunks #'stuff)
|
||||
(dynamic-require lang-sym #f)
|
||||
(namespace-require `(for-meta -1 ,lang-sym))
|
||||
(replace-context
|
||||
(namespace-symbol->identifier '#%module-begin)
|
||||
#`(#%module-begin
|
||||
#,(tangle #'body0)
|
||||
#,@(if submod?
|
||||
(list
|
||||
(let ([submod
|
||||
(strip-context
|
||||
#`(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
|
||||
(only-in hyper-literate/typed/private/lp chunk CHUNK))
|
||||
(begin body0 . body)))])
|
||||
(syntax-case submod ()
|
||||
[(_ . rest)
|
||||
(datum->syntax #'here (cons #'module* #'rest))])))
|
||||
'()))))])))]))
|
||||
|
||||
(define-syntax module-begin/plain (make-module-begin #f))
|
||||
(define-syntax module-begin/doc (make-module-begin #t))
|
||||
|
|
|
|||
|
|
@ -5,4 +5,4 @@
|
|||
(provide (except-out (all-from-out "common.rkt")
|
||||
module-begin/plain
|
||||
module-begin/doc)
|
||||
(rename-out [module-begin/plain #%module-begin]))
|
||||
(rename-out [module-begin/doc #%module-begin]))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user