From 0ed39230796240b9110b15ee9da9e5b9a16d5612 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Fri, 17 Jun 2016 16:19:18 +0200 Subject: [PATCH] Cleanup --- .travis.yml | 2 +- info.rkt | 3 +- test/test.hl.rkt | 29 ++++++++--- typed/lang/common.rkt | 116 +++++++++++++----------------------------- typed/lang/lang.rkt | 2 +- 5 files changed, 61 insertions(+), 91 deletions(-) diff --git a/.travis.yml b/.travis.yml index 74853289..d057f9df 100644 --- a/.travis.yml +++ b/.travis.yml @@ -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 . diff --git a/info.rkt b/info.rkt index 147162d9..bfa72937 100644 --- a/info.rkt +++ b/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|)) diff --git a/test/test.hl.rkt b/test/test.hl.rkt index 46b853a4..334bab06 100644 --- a/test/test.hl.rkt +++ b/test/test.hl.rkt @@ -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)] diff --git a/typed/lang/common.rkt b/typed/lang/common.rkt index dec453ce..ad799d22 100644 --- a/typed/lang/common.rkt +++ b/typed/lang/common.rkt @@ -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)) diff --git a/typed/lang/lang.rkt b/typed/lang/lang.rkt index 681a1fbb..4daed8bf 100644 --- a/typed/lang/lang.rkt +++ b/typed/lang/lang.rkt @@ -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]))