various tests, before cleanup
This commit is contained in:
parent
b895378a51
commit
21cd1f3ae3
9
test/test.hl.rkt
Normal file
9
test/test.hl.rkt
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
#lang hyper-literate/typed racket
|
||||||
|
|
||||||
|
@;((curry + 1) 2)
|
||||||
|
|
||||||
|
@chunk[<*>
|
||||||
|
1
|
||||||
|
;(ann 'eee Symbol)
|
||||||
|
;(define (f [x : 'e]) x)
|
||||||
|
#;((curry + 1) 2)]
|
|
@ -8,6 +8,38 @@
|
||||||
(require (for-syntax racket/base syntax/boundmap racket/list
|
(require (for-syntax racket/base syntax/boundmap racket/list
|
||||||
syntax/strip-context))
|
syntax/strip-context))
|
||||||
|
|
||||||
|
(require macro-debugger/syntax-browser)
|
||||||
|
|
||||||
|
(define-for-syntax ty-introducer
|
||||||
|
(let ([si (make-syntax-introducer)])
|
||||||
|
(λ (x)
|
||||||
|
#`(browse-syntax #'#,(si x))
|
||||||
|
(si x))))
|
||||||
|
(define-syntax (req-ty stx)
|
||||||
|
(ty-introducer
|
||||||
|
(syntax-local-introduce
|
||||||
|
#'(begin
|
||||||
|
(require (only-in typed/racket
|
||||||
|
ann
|
||||||
|
Symbol))
|
||||||
|
(ann 'aaa Symbol)))))
|
||||||
|
(req-ty)
|
||||||
|
|
||||||
|
(define-syntax (later stx)
|
||||||
|
(ty-introducer
|
||||||
|
#'(ann 'bbb Symbol)))
|
||||||
|
|
||||||
|
(later)
|
||||||
|
|
||||||
|
(define-syntax (later2 stx)
|
||||||
|
#'(later))
|
||||||
|
|
||||||
|
;(later2)
|
||||||
|
|
||||||
|
(require (only-in typed/racket
|
||||||
|
[#%module-begin modbeg-ty]
|
||||||
|
require/typed))
|
||||||
|
|
||||||
(begin-for-syntax
|
(begin-for-syntax
|
||||||
(define first-id #f)
|
(define first-id #f)
|
||||||
(define main-id #f)
|
(define main-id #f)
|
||||||
|
@ -62,7 +94,9 @@
|
||||||
(syntax-local-introduce u)))
|
(syntax-local-introduce u)))
|
||||||
(mapping-get chunk-groups m)))
|
(mapping-get chunk-groups m)))
|
||||||
chunk-mentions)])
|
chunk-mentions)])
|
||||||
#`(begin body ... (let ([b-id (void)]) b-use) ...)))
|
;(displayln (dynamic-require 'typed/racket '#%module-begin))
|
||||||
|
(replace-context #'modbeg-ty
|
||||||
|
#`(begin 'xxx body ... (let ([b-id (void)]) b-use) ...))))
|
||||||
|
|
||||||
(define-for-syntax (strip-comments body)
|
(define-for-syntax (strip-comments body)
|
||||||
(cond
|
(cond
|
||||||
|
@ -120,31 +154,63 @@
|
||||||
[_
|
[_
|
||||||
(loop #'exprs)])])))
|
(loop #'exprs)])])))
|
||||||
|
|
||||||
|
(require racket/stxparam)
|
||||||
|
(define-syntax-parameter mbeg #'#%module-begin)
|
||||||
|
|
||||||
(define-for-syntax ((make-module-begin submod?) stx)
|
(define-for-syntax ((make-module-begin submod?) stx)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
|
[(mb lng . _)
|
||||||
|
(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 ns2 (make-empty-namespace))
|
||||||
|
;(namespace-attach-module ns1 'typed/racket ns2)
|
||||||
|
(displayln ns1)
|
||||||
|
;(displayln ns2)
|
||||||
|
(parameterize ([current-namespace ns1])
|
||||||
|
(displayln (namespace-symbol->identifier '#%module-begin))
|
||||||
|
(displayln (namespace-syntax-introduce #'#%module-begin))
|
||||||
|
(replace-context
|
||||||
|
(namespace-symbol->identifier '#%module-begin)
|
||||||
|
#'(#%module-begin
|
||||||
|
(ann (cons 1 'b) (Pairof Number Symbol))
|
||||||
|
((make-predicate (Pairof Number Symbol)) (cons 1 'b))))
|
||||||
|
#;(namespace-syntax-introduce
|
||||||
|
)))])
|
||||||
|
#;(with-syntax ([md (namespace-module-identifier ns)])
|
||||||
|
#'(md typed/racket (ann 1 Number)))
|
||||||
|
#;(ty-introducer
|
||||||
|
(syntax-local-introduce
|
||||||
|
#'(modbeg-ty
|
||||||
|
(ann 'ccc Symbol))))
|
||||||
|
#;(syntax-case stx ()
|
||||||
[(_ body0 . body)
|
[(_ body0 . body)
|
||||||
(let ([expanded
|
(let ([expanded
|
||||||
(expand `(,#'module scribble-lp-tmp-name scribble/private/lp
|
(expand `(,#'module scribble-lp-tmp-name scribble/private/lp;hyper-literate/typed/private/lp
|
||||||
,@(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)
|
(begin (extract-chunks #'stuff)
|
||||||
#`(#%module-begin
|
#`(modbeg-ty
|
||||||
|
#,(ty-introducer #'(let ([eee 'eee])
|
||||||
|
(ann eee Symbol)))
|
||||||
(tangle body0)
|
(tangle body0)
|
||||||
;; The `doc` submodule allows a `scribble/lp` module
|
;; The `doc` submodule allows a `scribble/lp` module
|
||||||
;; to be provided to `scribble`:
|
;; to be provided to `scribble`:
|
||||||
#,@(if submod?
|
#|#,@(if submod?
|
||||||
(list
|
(list
|
||||||
(let ([submod
|
(let ([submod
|
||||||
(strip-context
|
(strip-context
|
||||||
#`(module doc scribble/doclang2
|
#`(module doc scribble/doclang2
|
||||||
(require scribble/manual
|
(require scribble/manual
|
||||||
(only-in scribble/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 submod (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))
|
||||||
|
|
|
@ -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/doc #%module-begin]))
|
(rename-out [module-begin/plain #%module-begin]))
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
#lang s-exp syntax/module-reader
|
#lang s-exp syntax/module-reader
|
||||||
;; Forked from scribble-lib/scribble/lp/lang/reader.rkt
|
;; Forked from scribble-lib/scribble/lp/lang/reader.rkt
|
||||||
|
|
||||||
scribble/lp/lang/lang
|
hyper-literate/typed/lang/lang
|
||||||
|
|
||||||
#:read read-inside
|
#:read read-inside
|
||||||
#:read-syntax read-syntax-inside
|
#:read-syntax read-syntax-inside
|
||||||
|
|
|
@ -81,6 +81,8 @@
|
||||||
#'(elemref '(chunk tag) #:underline? #f str))]))
|
#'(elemref '(chunk tag) #:underline? #f str))]))
|
||||||
|
|
||||||
|
|
||||||
(provide (all-from-out scheme/base
|
(require typed/racket/base)
|
||||||
|
|
||||||
|
(provide (all-from-out typed/racket/base ;scheme/base
|
||||||
scribble/manual)
|
scribble/manual)
|
||||||
chunk CHUNK)
|
chunk CHUNK)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user