commit fdd31db155d758f4496e424a7832e4069b3abc45
parent ee26ad81011f07e13d5508095868d196d72dac66
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Wed, 26 Apr 2017 01:31:43 +0200
Better unhygienic version
Diffstat:
7 files changed, 30 insertions(+), 184 deletions(-)
diff --git a/dotlambda/chain.rkt b/dotlambda/chain.rkt
@@ -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))]))
-\ No newline at end of file
diff --git a/dotlambda/info.rkt b/dotlambda/info.rkt
@@ -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"))
+\ No newline at end of file
diff --git a/dotlambda/test/test-hyper-literate-chain.rkt b/dotlambda/test/test-hyper-literate-chain.rktl
diff --git a/dotlambda/type-expander.rkt b/dotlambda/type-expander.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]))
-\ No newline at end of file
diff --git a/dotlambda/type-expander/lang/reader.rkt b/dotlambda/type-expander/lang/reader.rkt
@@ -1,2 +0,0 @@
-(module reader syntax/module-reader
- dotlambda/unhygienic)
-\ No newline at end of file
diff --git a/dotlambda/unhygienic-implementation.rkt b/dotlambda/unhygienic-implementation.rkt
@@ -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}
diff --git a/info.rkt b/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")
