From e695af93a134b235b5feb5ee5f064546313fe25f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Sun, 9 Apr 2017 16:28:17 +0200
Subject: [PATCH] Made separate typed/dotlambda and dotlambda languages.
---
.gitignore | 2 +-
.../implementation.rkt | 51 ++++++----
dotlambda/info.rkt | 2 +
{lang => dotlambda/lang}/reader.rkt | 0
literals.rkt => dotlambda/literals.rkt | 0
dotlambda/main.rkt | 24 +++++
.../scribblings}/dotlambda.scrbl | 24 +++--
dotlambda/scribblings/typed-dotlambda.scrbl | 20 ++++
dotlambda/test/test-dotlambda.rkt | 95 +++++++++++++++++++
.../test/test-typed-dotlambda.rkt | 7 +-
info.rkt | 9 +-
main.rkt | 8 --
typed/dotlambda.rkt | 25 +++++
typed/dotlambda/lang/reader.rkt | 2 +
typed/dotlambda/main.rkt | 8 ++
typed/info.rkt | 1 +
16 files changed, 229 insertions(+), 49 deletions(-)
rename implementation.rkt => dotlambda/implementation.rkt (82%)
create mode 100644 dotlambda/info.rkt
rename {lang => dotlambda/lang}/reader.rkt (100%)
rename literals.rkt => dotlambda/literals.rkt (100%)
create mode 100644 dotlambda/main.rkt
rename {scribblings => dotlambda/scribblings}/dotlambda.scrbl (87%)
create mode 100644 dotlambda/scribblings/typed-dotlambda.scrbl
create mode 100644 dotlambda/test/test-dotlambda.rkt
rename test/test-dotlambda.rkt => dotlambda/test/test-typed-dotlambda.rkt (96%)
delete mode 100644 main.rkt
create mode 100644 typed/dotlambda.rkt
create mode 100644 typed/dotlambda/lang/reader.rkt
create mode 100644 typed/dotlambda/main.rkt
create mode 100644 typed/info.rkt
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 λ<arg>.code syntax")
-(define version "0.1")
-(define pkg-authors '(georges))
+ "Splits dotted identifiers like a.b.c, also supports λ<arg>.(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