suzanne.soy/dotlambda
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Better unhygienic version

Browse Source
This commit is contained in:
Georges Dupéron 2017-04-26 01:31:43 +02:00
parent ee26ad8101
commit fdd31db155
7 changed files with 29 additions and 181 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
dotlambda/chain.rkt
View File

@ -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))]))

2
dotlambda/info.rkt
View File

@ -1,2 +1,4 @@
#lang info #lang info
(define scribblings '(("scribblings/dotlambda.scrbl" ()))) (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"))

0
dotlambda/test/test-hyper-literate-chain.rkt → dotlambda/test/test-hyper-literate-chain.rktl
View File

132
dotlambda/type-expander.rkt
View File

@ -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]))

2
dotlambda/type-expander/lang/reader.rkt
View File

@ -1,2 +0,0 @@
(module reader syntax/module-reader
dotlambda/unhygienic)

37
dotlambda/unhygienic-implementation.rkt
View File

@ -4,8 +4,7 @@
new-#%module-begin new-#%module-begin
make-#%top-interaction) make-#%top-interaction)
(require typed/racket (require chain-module-begin)
"chain.rkt")
(require (for-syntax debug-scopes)) (require (for-syntax debug-scopes))
(require racket/stxparam (require racket/stxparam
@ -63,22 +62,17 @@
stx2)]))])) stx2)]))]))
(define-for-syntax (make-λ l args e percent?) (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* (define percent*
(if (and percent? (>= (length args) 1)) (if (and percent? (>= (length args) 1))
#`{(define-syntax #,(datum->syntax l '% %-loc) (datum->syntax l
(#%plain-app make-rename-transformer #'#,(car args)))} `{(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) ;`(letrec ([%0 (,#'λ ,args ,@percent* ,e)]) %0)
(define -λ (define -λ
(datum->syntax #'here 'λ (datum->syntax l 'λ
(build-source-location-list (build-source-location-list
(update-source-location l #:span 1)))) (update-source-location l #:span 1))))
(datum->syntax l #`(#,-λ #,args #,@percent* #,e) l l)) (datum->syntax l #`(#,-λ #,args #,@percent* #,e) l l))
@ -91,9 +85,10 @@
(define len (string-length str)) (define len (string-length str))
(cons (datum->syntax l (cons (datum->syntax l
(string->symbol str) (string->symbol str)
(update-source-location l (build-source-location-list
#:position pos (update-source-location l
#:span len) #:position pos
#:span len))
l) l)
(make-args l (cdr str*) (+ pos 1 len)))))) (make-args l (cdr str*) (+ pos 1 len))))))
@ -115,13 +110,21 @@
found) found)
(begin-for-syntax (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 (define-splicing-syntax-class elt
(pattern {~seq {~and l {~datum λ.}} e:expr} (pattern {~seq {~and l {~datum λ.}} e:expr}
#:with expanded #:with expanded
(let ([args (for/list ([arg (in-range 1 (add1 (find-% #'e)))]) (let ([args (for/list ([arg (in-range 1 (add1 (find-% #'e)))])
(datum->syntax #'l (datum->syntax #'l
(string->symbol (format "%~a" arg)) (string->symbol (format "%~a" arg))
#'l (%-loc #'l)
#'l))]) #'l))])
(make-λ #'l args #'e #t))) (make-λ #'l args #'e #t)))
(pattern {~seq l:id e:expr} (pattern {~seq l:id e:expr}

8
info.rkt
View File

@ -4,10 +4,16 @@
"rackunit-lib" "rackunit-lib"
"typed-map-lib" "typed-map-lib"
"typed-racket-lib" "typed-racket-lib"
"typed-racket-more")) "typed-racket-more"
"chain-module-begin"
"debug-scopes"))
(define build-deps '("scribble-lib" (define build-deps '("scribble-lib"
"racket-doc" "racket-doc"
"typed-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 (define pkg-desc
"Splits dotted identifiers like a.b.c, also supports λ<arg>.(code) syntax") "Splits dotted identifiers like a.b.c, also supports λ<arg>.(code) syntax")
(define version "0.2") (define version "0.2")