Better unhygienic version
This commit is contained in:
Georges Dupéron
parent
ee26ad8101
commit
fdd31db155
|
|
@ -1,29 +0,0 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide chain-module-begin)
|
||||
|
||||
(require (for-syntax racket/base
|
||||
syntax/parse
|
||||
debug-scopes/named-scopes/exptime))
|
||||
|
||||
(define-syntax continue
|
||||
(syntax-parser
|
||||
[(_ whole-ctx lang lang-modbeg . body)
|
||||
#:with ({~literal #%plain-module-begin} . expanded-body)
|
||||
(local-expand (datum->syntax #'whole-ctx
|
||||
`(,#'lang-modbeg . ,#'body)
|
||||
#'whole-ctx)
|
||||
'module-begin
|
||||
'())
|
||||
(define new-scope (make-module-like-named-scope
|
||||
(format "nested-lang-~a" (syntax-e #'lang))))
|
||||
(new-scope #`(begin . expanded-body))]))
|
||||
|
||||
(define-syntax chain-module-begin
|
||||
(syntax-parser
|
||||
[{~and whole (_ lang . body)}
|
||||
#:with lang-modbeg (datum->syntax #'lang '#%module-begin #'lang)
|
||||
#:with whole-ctx (datum->syntax #'whole 'ctx #'whole)
|
||||
#'(#%plain-module-begin
|
||||
(require lang)
|
||||
(continue whole-ctx lang lang-modbeg . body))]))
|
||||
|
|
@ -1,2 +1,4 @@
|
|||
#lang info
|
||||
(define scribblings '(("scribblings/dotlambda.scrbl" ())))
|
||||
(define compile-omit-paths '("dotlambda/test/test-hyper-literate-chain.rkt"))
|
||||
(define test-omit-paths '("dotlambda/test/test-hyper-literate-chain.rkt"))
|
||||
|
|
@ -1,132 +0,0 @@
|
|||
#lang racket/base
|
||||
|
||||
(require dotlambda/implementation
|
||||
(for-meta -10 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta -9 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta -8 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta -7 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta -6 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta -5 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta -4 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta -3 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta -2 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta -1 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 0 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 1 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 2 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 3 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 4 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 5 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 6 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 7 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 8 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 9 (only-meta-in 0 type-expander/lang))
|
||||
(for-meta 10 (only-meta-in 0 type-expander/lang))
|
||||
(only-in (for-meta -10 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta -9 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta -8 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta -7 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta -6 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta -5 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta -4 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta -3 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta -2 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta -1 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 0 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 1 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 2 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 3 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 4 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 5 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 6 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 7 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 8 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 9 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax])
|
||||
(only-in (for-meta 10 racket/base)
|
||||
[make-rename-transformer -make-rename-transformer]
|
||||
[#%plain-app -#%plain-app]
|
||||
[syntax -syntax]))
|
||||
|
||||
(make-#%module-begin new-#%module-begin
|
||||
#%module-begin
|
||||
λ
|
||||
define-syntax
|
||||
-make-rename-transformer
|
||||
-#%plain-app
|
||||
-syntax)
|
||||
(make-#%top-interaction new-#%top-interaction
|
||||
#%top-interaction
|
||||
λ
|
||||
define-syntax
|
||||
-make-rename-transformer
|
||||
-#%plain-app
|
||||
-syntax)
|
||||
|
||||
(provide (except-out (all-from-out type-expander/lang)
|
||||
#%module-begin
|
||||
#%top-interaction)
|
||||
(except-out (all-from-out dotlambda/implementation)
|
||||
make-#%module-begin
|
||||
make-#%top-interaction)
|
||||
(rename-out [new-#%module-begin #%module-begin]
|
||||
[new-#%top-interaction #%top-interaction]))
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(module reader syntax/module-reader
|
||||
dotlambda/unhygienic)
|
||||
|
|
@ -4,8 +4,7 @@
|
|||
new-#%module-begin
|
||||
make-#%top-interaction)
|
||||
|
||||
(require typed/racket
|
||||
"chain.rkt")
|
||||
(require chain-module-begin)
|
||||
(require (for-syntax debug-scopes))
|
||||
|
||||
(require racket/stxparam
|
||||
|
|
@ -63,22 +62,17 @@
|
|||
stx2)]))]))
|
||||
|
||||
(define-for-syntax (make-λ l args e percent?)
|
||||
(define %-loc
|
||||
(build-source-location-list
|
||||
(update-source-location l
|
||||
#:position (let ([p (syntax-position l)])
|
||||
(and p (+ p 1)))
|
||||
#:column (let ([c (syntax-column l)])
|
||||
(and c (+ c 1)))
|
||||
#:span 1)))
|
||||
(define percent*
|
||||
(if (and percent? (>= (length args) 1))
|
||||
#`{(define-syntax #,(datum->syntax l '% %-loc)
|
||||
(#%plain-app make-rename-transformer #'#,(car args)))}
|
||||
(datum->syntax l
|
||||
`{(define-syntax ,(datum->syntax l '% (%-loc l))
|
||||
(#%plain-app make-rename-transformer #',(car args)))}
|
||||
(build-source-location-list
|
||||
(update-source-location l #:span 1)))
|
||||
#'{}))
|
||||
;`(letrec ([%0 (,#'λ ,args ,@percent* ,e)]) %0)
|
||||
(define -λ
|
||||
(datum->syntax #'here 'λ
|
||||
(datum->syntax l 'λ
|
||||
(build-source-location-list
|
||||
(update-source-location l #:span 1))))
|
||||
(datum->syntax l #`(#,-λ #,args #,@percent* #,e) l l))
|
||||
|
|
@ -91,9 +85,10 @@
|
|||
(define len (string-length str))
|
||||
(cons (datum->syntax l
|
||||
(string->symbol str)
|
||||
(update-source-location l
|
||||
#:position pos
|
||||
#:span len)
|
||||
(build-source-location-list
|
||||
(update-source-location l
|
||||
#:position pos
|
||||
#:span len))
|
||||
l)
|
||||
(make-args l (cdr str*) (+ pos 1 len))))))
|
||||
|
||||
|
|
@ -115,13 +110,21 @@
|
|||
found)
|
||||
|
||||
(begin-for-syntax
|
||||
(define (%-loc l)
|
||||
(build-source-location-list
|
||||
(update-source-location l
|
||||
#:position (let ([p (syntax-position l)])
|
||||
(and p (+ p 1)))
|
||||
#:column (let ([c (syntax-column l)])
|
||||
(and c (+ c 1)))
|
||||
#:span 1)))
|
||||
(define-splicing-syntax-class elt
|
||||
(pattern {~seq {~and l {~datum λ.}} e:expr}
|
||||
#:with expanded
|
||||
(let ([args (for/list ([arg (in-range 1 (add1 (find-% #'e)))])
|
||||
(datum->syntax #'l
|
||||
(string->symbol (format "%~a" arg))
|
||||
#'l
|
||||
(%-loc #'l)
|
||||
#'l))])
|
||||
(make-λ #'l args #'e #t)))
|
||||
(pattern {~seq l:id e:expr}
|
||||
|
|
|
|||
8
info.rkt
8
info.rkt
|
|
@ -4,10 +4,16 @@
|
|||
"rackunit-lib"
|
||||
"typed-map-lib"
|
||||
"typed-racket-lib"
|
||||
"typed-racket-more"))
|
||||
"typed-racket-more"
|
||||
"chain-module-begin"
|
||||
"debug-scopes"))
|
||||
(define build-deps '("scribble-lib"
|
||||
"racket-doc"
|
||||
"typed-racket-doc"))
|
||||
(define compile-omit-paths '("dotlambda/dotlambda/test/test-hyper-literate-chain.rkt"
|
||||
"dotlambda/test/test-hyper-literate-chain.rkt"))
|
||||
(define test-omit-paths '("dotlambda/dotlambda/test/test-hyper-literate-chain.rkt"
|
||||
"dotlambda/test/test-hyper-literate-chain.rkt"))
|
||||
(define pkg-desc
|
||||
"Splits dotted identifiers like a.b.c, also supports λ<arg>.(code) syntax")
|
||||
(define version "0.2")
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user