diff --git a/.gitignore b/.gitignore index 1a59348..c90ae9b 100644 --- a/.gitignore +++ b/.gitignore @@ -3,4 +3,4 @@ .\#* .DS_Store compiled/ -/doc/ +/dotlambda/doc/ diff --git a/implementation.rkt b/dotlambda/implementation.rkt similarity index 82% rename from implementation.rkt rename to dotlambda/implementation.rkt index 67beb3b..5fb13e2 100644 --- a/implementation.rkt +++ b/dotlambda/implementation.rkt @@ -1,8 +1,8 @@ #lang racket (provide #%dotted-id #%dot-separator - (rename-out [new-#%module-begin #%module-begin] - [new-#%top-interaction #%top-interaction])) + make-#%module-begin + make-#%top-interaction) (require typed/racket) @@ -37,27 +37,35 @@ [(_ {~seq #%dot-separator e} …) #'(λ (v) (~> v e …))] [(_ e₀ {~seq #%dot-separator e} …) #'(~> e₀ e …)])) -(define-syntax (new-#%module-begin stx) +(define-syntax (make-#%module-begin stx) (syntax-case stx () - [(_ . body) - #`(#%module-begin - . #,(fold-syntax replace-dots - #'body))])) + ;; -mrt = -make-rename-transformer + [(_ name wrapped-#%module-begin -λ -define-syntax -mrt) + #'(define-syntax (name stx2) + (syntax-case stx2 () + [(_ . body) + #`(wrapped-#%module-begin + . #,(fold-syntax (replace-dots #'-λ #'-define-syntax #'-mrt) + #'body))]))])) -(define-syntax (new-#%top-interaction stx) +(define-syntax (make-#%top-interaction stx) (syntax-case stx () - [(_ . body) - #`(#%top-interaction - . #,(fold-syntax replace-dots - #'body))])) + ;; -mrt = -make-rename-transformer + [(_ name wrapped-#%top-interaction -λ -define-syntax -mrt) + #'(define-syntax (name stx2) + (syntax-case stx2 () + [(_ . body) + #`(wrapped-#%top-interaction + . #,(fold-syntax (replace-dots #'-λ #'-define-syntax #'-mrt) + #'body))]))])) -(define-for-syntax (make-λ l args e percent?) +(define-for-syntax (make-λ l args e percent? -λ -define-syntax -mrt) (define percent* (if (and percent? (>= (length args) 1)) - `{(,#'define-syntax % (make-rename-transformer #',(car args)))} + `{(,-define-syntax % (,-mrt #',(car args)))} '{})) ;`(letrec ([%0 (,#'λ ,args ,@percent* ,e)]) %0) - (datum->syntax l `(,#'λ ,args ,@percent* ,e) l l)) + (datum->syntax l `(,-λ ,args ,@percent* ,e) l l)) (define-for-syntax (make-args l str* pos) (if (empty? str*) @@ -91,7 +99,7 @@ found) (begin-for-syntax - (define-splicing-syntax-class elt + (define-splicing-syntax-class (elt -λ -define-syntax -mrt) (pattern {~seq {~and l {~datum λ.}} e:expr} #:with expanded (let ([args (for/list ([arg (in-range 1 (add1 (find-% #'e)))]) @@ -99,7 +107,7 @@ (string->symbol (format "%~a" arg)) #'l #'l))]) - (make-λ #'l args #'e #t))) + (make-λ #'l args #'e #t -λ -define-syntax -mrt))) (pattern {~seq l:id e:expr} #:when (regexp-match #px"^λ([^.]+\\.)+$" (identifier→string #'l)) #:with expanded @@ -107,11 +115,11 @@ [args (make-args #'l m (+ (syntax-position #'l) 1))]) - (make-λ #'l args #'e #f))) + (make-λ #'l args #'e #f -λ -define-syntax -mrt))) (pattern e #:with expanded #'e))) -(define-for-syntax (replace-dots stx recurse) +(define-for-syntax ((replace-dots -λ -define-syntax -mrt) stx recurse) (syntax-parse stx ;; Fast path: no dots or ellipses. [x:id #:when (regexp-match #px"^[^.…]*$" (identifier→string #'x)) @@ -149,13 +157,14 @@ #,(car identifiers)) (quasisyntax/loc stx (#,(datum->syntax #'here '#%dotted-id stx stx) id …))))] - [{~and whole (:elt … . {~and tail {~not (_ . _)}})} + [{~and whole ({~var || (elt -λ -define-syntax -mrt)} … + . {~and tail {~not (_ . _)}})} ;; TODO: keep the stx-pairs vs stx-lists structure where possible. (recurse (datum->syntax #'whole (syntax-e #'(expanded … . tail)) #'whole #'whole))] - [_ (datum->syntax stx (recurse stx) stx stx)])) + [_ (recurse stx)])) (define-for-syntax (to-ids stx) (define (process component* unescaped* len-before dot?) diff --git a/dotlambda/info.rkt b/dotlambda/info.rkt new file mode 100644 index 0000000..58d40e4 --- /dev/null +++ b/dotlambda/info.rkt @@ -0,0 +1,2 @@ +#lang info +(define scribblings '(("scribblings/dotlambda.scrbl" ()))) diff --git a/lang/reader.rkt b/dotlambda/lang/reader.rkt similarity index 100% rename from lang/reader.rkt rename to dotlambda/lang/reader.rkt diff --git a/literals.rkt b/dotlambda/literals.rkt similarity index 100% rename from literals.rkt rename to dotlambda/literals.rkt diff --git a/dotlambda/main.rkt b/dotlambda/main.rkt new file mode 100644 index 0000000..c705cb7 --- /dev/null +++ b/dotlambda/main.rkt @@ -0,0 +1,24 @@ +#lang racket/base + +(require dotlambda/implementation + (for-syntax racket/base)) + +(make-#%module-begin new-#%module-begin + #%module-begin + λ + define-syntax + make-rename-transformer) +(make-#%top-interaction new-#%top-interaction + #%top-interaction + λ + define-syntax + make-rename-transformer) + +(provide (except-out (all-from-out racket/base) + #%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/scribblings/dotlambda.scrbl b/dotlambda/scribblings/dotlambda.scrbl similarity index 87% rename from scribblings/dotlambda.scrbl rename to dotlambda/scribblings/dotlambda.scrbl index c7dda6f..43ecf7b 100644 --- a/scribblings/dotlambda.scrbl +++ b/dotlambda/scribblings/dotlambda.scrbl @@ -6,17 +6,19 @@ @author[@author+email["Georges Dupéron" "georges.duperon@gmail.com"]] @(begin - (module orig racket/base - (require scribble/manual - typed/racket/base) - (provide orig:#%module-begin) - (define orig:#%module-begin (racket #%module-begin))) - (require 'orig)) + (module orig-racket/base racket/base + (require scribble/manual) + (provide racket/base:#%module-begin + racket/base:#%top-interaction) + (define racket/base:#%module-begin (racket #%module-begin)) + (define racket/base:#%top-interaction (racket #%top-interaction))) + (require 'orig-racket/base)) @defmodulelang[dotlambda]{ - This @hash-lang[] language overrides @orig:#%module-begin from - @racketmodname[typed/racket/base], and splits identifiers which contain dots, - following these rules: + This @hash-lang[] language overrides @racket/base:#%module-begin and + @racket/base:#%top-interaction from @racketmodname[racket/base], and splits + identifiers which contain dots, following these rules: + @itemlist[ @item{A single dot splits the identifier, and the dot is replaced with @racket[#%dot-separator]. If an identifier is split by one or more @@ -82,4 +84,6 @@ (usually @racket["."] or the empty string @racket[""] for an implicit dot before or after an ellipsis) is normally stored in the @racket['dotted-original-chars] syntax property of the occurrence of the - @racket[#%dot-separator] identifier.} \ No newline at end of file + @racket[#%dot-separator] identifier.} + +@include-section{typed-dotlambda.scrbl} \ No newline at end of file diff --git a/dotlambda/scribblings/typed-dotlambda.scrbl b/dotlambda/scribblings/typed-dotlambda.scrbl new file mode 100644 index 0000000..021082c --- /dev/null +++ b/dotlambda/scribblings/typed-dotlambda.scrbl @@ -0,0 +1,20 @@ +#lang scribble/manual +@require[@for-label[@only-in[dotlambda #%dot-separator #%dotted-id] + racket/stxparam]] + +@title{Typed version of @racketmodname[dotlambda]} + +@(begin + (module orig-typed/racket/base racket/base + (require scribble/manual + typed/racket/base) + (provide typed/racket/base:#%module-begin + typed/racket/base:#%top-interaction) + (define typed/racket/base:#%module-begin (racket #%module-begin)) + (define typed/racket/base:#%top-interaction (racket #%top-interaction))) + (require 'orig-typed/racket/base)) + +@defmodulelang[typed/dotlambda]{ + Like @racket[#,(hash-lang) dotlambda], but overrides + @typed/racket/base:#%module-begin and @typed/racket/base:#%top-interaction + from @racketmodname[typed/racket/base], instead.} diff --git a/dotlambda/test/test-dotlambda.rkt b/dotlambda/test/test-dotlambda.rkt new file mode 100644 index 0000000..a7d908d --- /dev/null +++ b/dotlambda/test/test-dotlambda.rkt @@ -0,0 +1,95 @@ +#lang dotlambda + +(require rackunit + (for-syntax racket/base)) + +(require racket/stxparam) + +(check-equal? + (syntax-parameterize ([#%dotted-id (make-rename-transformer #'list)]) + (let ([x 1] [y 2] [z 3] [#%dot-separator '|.|]) + (list 'x.y + '.x.y + x.y + .x.y))) + '((#%dotted-id x #%dot-separator y) + (#%dotted-id #%dot-separator x #%dot-separator y) + (1 |.| 2) + (|.| 1 |.| 2))) + +(check-equal? (let ([v 4]) v.sqrt.-) -2) + +(let ((foo..bar 42)) + (check-equal? foo..bar 42)) + +(define di '#%dotted-id) +(define d '#%dot-separator) + +(check-equal? 'foo.bar (list di 'foo d 'bar)) + +;; Srcloc tests: +;(let .a b) ;; Error on the whole .a +;(let .a.b b) ;; Error on the whole .a.b +;(let a.b b) ;; Error on the whole a.b + +(define (slen n str) + (check-equal? (string-length str) n) + (string->symbol str)) + +(check-equal? '(a . b) (cons 'a 'b)) +(check-equal? '(a . b.c) (list 'a di 'b d 'c)) +(check-equal? '(a . b.c.d) (list 'a di 'b d 'c d 'd)) +(check-equal? '(a.c . b) (cons (list di 'a d 'c) 'b)) +(check-equal? '(a.c.d . b) (cons (list di 'a d 'c d 'd) 'b)) + +(check-equal? '.aa.bb..cc.d (list di d 'aa d (slen 5 "bb.cc") d 'd)) +(check-equal? '…aa...bb..cc.d (list di '… d (slen 9 "aa..bb.cc") d 'd)) +(check-equal? '.…aa...bb..cc.d (list di d '… d (slen 9 "aa..bb.cc") d 'd)) +(check-equal? '…aa.….bb..cc.d + (list di '… d 'aa d '… d (slen 5 "bb.cc") d 'd)) +(check-equal? '.…aa.….bb..cc.d + (list di d '… d 'aa d '… d (slen 5 "bb.cc") d 'd)) +(check-equal? '.aa.….bb..cc.d (list di d 'aa d '… d (slen 5 "bb.cc") d 'd)) +(check-equal? '.aa.….bb.cc.d (list di d 'aa d '… d 'bb d 'cc d 'd)) +(check-equal? '…aa.….bb.cc.d (list di '… d 'aa d '… d 'bb d 'cc d 'd)) +(check-equal? '.…aa.….bb.cc.d (list di d '… d 'aa d '… d 'bb d 'cc d 'd)) + +(check-equal? 'aa.bb..cc.d (list di 'aa d (slen 5 "bb.cc") d 'd)) +(check-equal? 'aa...bb..cc.d (list di (slen 9 "aa..bb.cc") d 'd)) +(check-equal? 'aa…bb..cc.d (list di 'aa d '… d (slen 5 "bb.cc") d 'd)) +(check-equal? 'aa.….bb..cc.d (list di 'aa d '… d (slen 5 "bb.cc") d 'd)) +(check-equal? 'aa.….bb.cc.d (list di 'aa d '… d 'bb d 'cc d 'd)) + +(check-equal? 'aa…bb (list di 'aa d '… d 'bb)) +(check-equal? 'aa… (list di 'aa d '…)) +(check-equal? 'aa…. (slen 3 "aa…")) +(check-equal? 'aa.. (slen 3 "aa.")) +(check-equal? 'aa... (slen 4 "aa..")) + +(check-equal? '… (slen 1 "…")) +(check-equal? '…+ (slen 2 "…+")) +(check-equal? '... (slen 3 "...")) +(check-equal? '...+ (slen 4 "...+")) + +(check-equal? (λx.(+ x x) 3) 6) +(check-equal? (λy.(+ y y) 3) 6) +(check-equal? (λ.(+ % %) 3) 6) +(check-equal? (λy.(+ y) 3) 3) +(check-equal? (λy. y.sqrt.- 4) -2) +(check-equal? (.sqrt.- 4) -2) + +(check-equal? '…aa.…bb..cc.d (list di '… d 'aa d '… d (slen 5 "bb.cc") d 'd)) +(check-equal? '…aa….bb..cc.d (list di '… d 'aa d '… d (slen 5 "bb.cc") d 'd)) +(check-equal? '.…aa.…bb..cc.d + (list di d '… d 'aa d '… d (slen 5 "bb.cc") d 'd)) +(check-equal? '.…aa….bb..cc.d + (list di d '… d 'aa d '… d (slen 5 "bb.cc") d 'd)) + + +(check-equal? (map λx.(* x x) '(1 2 3)) '(1 4 9)) +(check-equal? (map λ.(* % %) '(1 2 3)) '(1 4 9)) +(check-equal? (map λ.(* %1 %2) '(1 2 3) '(10 100 1000)) '(10 200 3000)) +(check-equal? (map λx.y.(* x y) '(1 2 3) '(10 100 1000)) '(10 200 3000)) + +;; Factorial function, works only in untyped racket due to recursion: +;; ((λ.(if (> % 0) (* %1 (%0 (sub1 %))) 1)) 5) \ No newline at end of file diff --git a/test/test-dotlambda.rkt b/dotlambda/test/test-typed-dotlambda.rkt similarity index 96% rename from test/test-dotlambda.rkt rename to dotlambda/test/test-typed-dotlambda.rkt index b77b6e3..b7bd864 100644 --- a/test/test-dotlambda.rkt +++ b/dotlambda/test/test-typed-dotlambda.rkt @@ -1,11 +1,10 @@ -#lang dotlambda +#lang typed/dotlambda -(require typed/rackunit - phc-toolkit +(require phc-toolkit/typed-rackunit ;"get.lp2.rkt" ;"graph-test.rkt" typed-map - ) + (for-syntax racket/base)) (require racket/stxparam) diff --git a/info.rkt b/info.rkt index 741ba5b..047dfdb 100644 --- a/info.rkt +++ b/info.rkt @@ -1,5 +1,5 @@ #lang info -(define collection "dotlambda") +(define collection 'multi) (define deps '("base" "rackunit-lib" "phc-toolkit" @@ -9,8 +9,7 @@ (define build-deps '("scribble-lib" "racket-doc" "typed-racket-doc")) -(define scribblings '(("scribblings/dotlambda.scrbl" ()))) (define pkg-desc - "Splits dotted identifiers like a.b.c, also supports λ.code syntax") -(define version "0.1") -(define pkg-authors '(georges)) + "Splits dotted identifiers like a.b.c, also supports λ.(code) syntax") +(define version "0.2") +(define pkg-authors '("Georges Dupéron")) diff --git a/main.rkt b/main.rkt deleted file mode 100644 index 50051f4..0000000 --- a/main.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket - -(require dotlambda/implementation - (except-in typed/racket - #%module-begin - #%top-interaction)) -(provide (except-out (all-from-out typed/racket)) - (all-from-out dotlambda/implementation)) \ No newline at end of file diff --git a/typed/dotlambda.rkt b/typed/dotlambda.rkt new file mode 100644 index 0000000..c9a3c81 --- /dev/null +++ b/typed/dotlambda.rkt @@ -0,0 +1,25 @@ +#lang racket/base + +(require dotlambda/implementation + typed/racket/base + (for-syntax racket/base)) + +(make-#%module-begin new-#%module-begin + #%module-begin + λ + define-syntax + make-rename-transformer) +(make-#%top-interaction new-#%top-interaction + #%top-interaction + λ + define-syntax + make-rename-transformer) + +(provide (except-out (all-from-out typed/racket/base) + #%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/typed/dotlambda/lang/reader.rkt b/typed/dotlambda/lang/reader.rkt new file mode 100644 index 0000000..695528c --- /dev/null +++ b/typed/dotlambda/lang/reader.rkt @@ -0,0 +1,2 @@ +(module reader syntax/module-reader + typed/dotlambda) \ No newline at end of file diff --git a/typed/dotlambda/main.rkt b/typed/dotlambda/main.rkt new file mode 100644 index 0000000..d819268 --- /dev/null +++ b/typed/dotlambda/main.rkt @@ -0,0 +1,8 @@ +#lang racket/base +;; Not sure if this file is necessary. For some reason, #lang typed/dotlambda +;; tries to access +;; /home/me/.racket/snapshot/pkgs/alexis-util/typed/dotlambda.rkt +;; unless there's a typed/dotlambda.rkt file. I would have expected the main.rkt +;; file to be selected here, but that's not the case. +(require "../dotlambda.rkt") +(provide (all-from-out "../dotlambda.rkt")) \ No newline at end of file diff --git a/typed/info.rkt b/typed/info.rkt new file mode 100644 index 0000000..e0c94f2 --- /dev/null +++ b/typed/info.rkt @@ -0,0 +1 @@ +#lang info