From fdd31db155d758f4496e424a7832e4069b3abc45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Wed, 26 Apr 2017 01:31:43 +0200 Subject: [PATCH] Better unhygienic version --- dotlambda/chain.rkt | 29 ---- dotlambda/info.rkt | 2 + ...ain.rkt => test-hyper-literate-chain.rktl} | 0 dotlambda/type-expander.rkt | 132 ------------------ dotlambda/type-expander/lang/reader.rkt | 2 - dotlambda/unhygienic-implementation.rkt | 37 ++--- info.rkt | 8 +- 7 files changed, 29 insertions(+), 181 deletions(-) delete mode 100644 dotlambda/chain.rkt rename dotlambda/test/{test-hyper-literate-chain.rkt => test-hyper-literate-chain.rktl} (100%) delete mode 100644 dotlambda/type-expander.rkt delete mode 100644 dotlambda/type-expander/lang/reader.rkt diff --git a/dotlambda/chain.rkt b/dotlambda/chain.rkt deleted file mode 100644 index 406fa2c..0000000 --- a/dotlambda/chain.rkt +++ /dev/null @@ -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 index 58d40e4..14ef616 100644 --- 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 similarity index 100% rename from dotlambda/test/test-hyper-literate-chain.rkt rename to dotlambda/test/test-hyper-literate-chain.rktl diff --git a/dotlambda/type-expander.rkt b/dotlambda/type-expander.rkt deleted file mode 100644 index 39b32da..0000000 --- a/dotlambda/type-expander.rkt +++ /dev/null @@ -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 deleted file mode 100644 index 343ba79..0000000 --- a/dotlambda/type-expander/lang/reader.rkt +++ /dev/null @@ -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 index 2147333..29b2819 100644 --- 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 index e2e8769..5933dff 100644 --- 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 λ.(code) syntax") (define version "0.2")