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

Initial commit

Browse Source
This commit is contained in:
Georges Dupéron 2017-04-08 22:37:01 +02:00
commit e2805e639d
12 changed files with 568 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitignore vendored Normal file
View File

@ -0,0 +1,6 @@
*~
\#*
.\#*
.DS_Store
compiled/
/doc/

37
.travis.yml Normal file
View File

@ -0,0 +1,37 @@
language: c
sudo: false
env:
global:
# RACKET_DIR is an argument to install-racket.sh
- RACKET_DIR=~/racket
- PATH="$RACKET_DIR/bin:$PATH"
matrix:
# RACKET_VERSION is an argument to install-racket.sh
- RACKET_VERSION=6.0
- RACKET_VERSION=6.1
- RACKET_VERSION=6.1.1
- RACKET_VERSION=6.2
- RACKET_VERSION=6.3
- RACKET_VERSION=6.4
- RACKET_VERSION=6.5
- RACKET_VERSION=6.6
- RACKET_VERSION=6.7
- RACKET_VERSION=6.8
- RACKET_VERSION=RELEASE
- RACKET_VERSION=HEAD
before_install:
- curl -L https://raw.githubusercontent.com/greghendershott/travis-racket/master/install-racket.sh | bash
- raco pkg install --deps search-auto doc-coverage cover cover-codecov # or cover-coveralls
install:
- raco pkg install --deps search-auto -j 2
script:
- raco test -x -p "$(basename "$TRAVIS_BUILD_DIR")"
- raco setup --check-pkg-deps --no-zo --no-launcher --no-install --no-post-install --no-docs --pkgs "$(basename "$TRAVIS_BUILD_DIR")"
- raco doc-coverage "$(basename "$TRAVIS_BUILD_DIR")"
- raco cover -s main -s test -s doc -f codecov -f html -d ~/coverage . || true
# TODO: add an option to cover to run the "outer" module too, not just the submodules.
# TODO: deploy the coverage info.

24
LICENSE-more.md Normal file
View File

@ -0,0 +1,24 @@
anaphoric
Copyright (c) 2016-2017 Georges Dupéron
This package is in distributed under the Creative Commons CC0 license
https://creativecommons.org/publicdomain/zero/1.0/, as specified by
the LICENSE.txt file.
The CC0 license is equivalent to a dedication to the Public Domain
in most countries, but is also effective in countries which do not
recognize explicit dedications to the Public Domain.
In order to avoid any potential licensing issues, this package is explicitly
distributed under the Creative Commons CC0 license
https://creativecommons.org/publicdomain/zero/1.0/, or under the GNU Lesser
General Public License (LGPL) https://opensource.org/licenses/LGPL-3.0, or
under the Apache License Version 2.0
https://opensource.org/licenses/Apache-2.0, or under the MIT license
https://opensource.org/licenses/MIT, at your option.

116
LICENSE.txt Normal file
View File

@ -0,0 +1,116 @@
CC0 1.0 Universal
Statement of Purpose
The laws of most jurisdictions throughout the world automatically confer
exclusive Copyright and Related Rights (defined below) upon the creator and
subsequent owner(s) (each and all, an "owner") of an original work of
authorship and/or a database (each, a "Work").
Certain owners wish to permanently relinquish those rights to a Work for the
purpose of contributing to a commons of creative, cultural and scientific
works ("Commons") that the public can reliably and without fear of later
claims of infringement build upon, modify, incorporate in other works, reuse
and redistribute as freely as possible in any form whatsoever and for any
purposes, including without limitation commercial purposes. These owners may
contribute to the Commons to promote the ideal of a free culture and the
further production of creative, cultural and scientific works, or to gain
reputation or greater distribution for their Work in part through the use and
efforts of others.
For these and/or other purposes and motivations, and without any expectation
of additional consideration or compensation, the person associating CC0 with a
Work (the "Affirmer"), to the extent that he or she is an owner of Copyright
and Related Rights in the Work, voluntarily elects to apply CC0 to the Work
and publicly distribute the Work under its terms, with knowledge of his or her
Copyright and Related Rights in the Work and the meaning and intended legal
effect of CC0 on those rights.
1. Copyright and Related Rights. A Work made available under CC0 may be
protected by copyright and related or neighboring rights ("Copyright and
Related Rights"). Copyright and Related Rights include, but are not limited
to, the following:
i. the right to reproduce, adapt, distribute, perform, display, communicate,
and translate a Work;
ii. moral rights retained by the original author(s) and/or performer(s);
iii. publicity and privacy rights pertaining to a person's image or likeness
depicted in a Work;
iv. rights protecting against unfair competition in regards to a Work,
subject to the limitations in paragraph 4(a), below;
v. rights protecting the extraction, dissemination, use and reuse of data in
a Work;
vi. database rights (such as those arising under Directive 96/9/EC of the
European Parliament and of the Council of 11 March 1996 on the legal
protection of databases, and under any national implementation thereof,
including any amended or successor version of such directive); and
vii. other similar, equivalent or corresponding rights throughout the world
based on applicable law or treaty, and any national implementations thereof.
2. Waiver. To the greatest extent permitted by, but not in contravention of,
applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and
unconditionally waives, abandons, and surrenders all of Affirmer's Copyright
and Related Rights and associated claims and causes of action, whether now
known or unknown (including existing as well as future claims and causes of
action), in the Work (i) in all territories worldwide, (ii) for the maximum
duration provided by applicable law or treaty (including future time
extensions), (iii) in any current or future medium and for any number of
copies, and (iv) for any purpose whatsoever, including without limitation
commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes
the Waiver for the benefit of each member of the public at large and to the
detriment of Affirmer's heirs and successors, fully intending that such Waiver
shall not be subject to revocation, rescission, cancellation, termination, or
any other legal or equitable action to disrupt the quiet enjoyment of the Work
by the public as contemplated by Affirmer's express Statement of Purpose.
3. Public License Fallback. Should any part of the Waiver for any reason be
judged legally invalid or ineffective under applicable law, then the Waiver
shall be preserved to the maximum extent permitted taking into account
Affirmer's express Statement of Purpose. In addition, to the extent the Waiver
is so judged Affirmer hereby grants to each affected person a royalty-free,
non transferable, non sublicensable, non exclusive, irrevocable and
unconditional license to exercise Affirmer's Copyright and Related Rights in
the Work (i) in all territories worldwide, (ii) for the maximum duration
provided by applicable law or treaty (including future time extensions), (iii)
in any current or future medium and for any number of copies, and (iv) for any
purpose whatsoever, including without limitation commercial, advertising or
promotional purposes (the "License"). The License shall be deemed effective as
of the date CC0 was applied by Affirmer to the Work. Should any part of the
License for any reason be judged legally invalid or ineffective under
applicable law, such partial invalidity or ineffectiveness shall not
invalidate the remainder of the License, and in such case Affirmer hereby
affirms that he or she will not (i) exercise any of his or her remaining
Copyright and Related Rights in the Work or (ii) assert any associated claims
and causes of action with respect to the Work, in either case contrary to
Affirmer's express Statement of Purpose.
4. Limitations and Disclaimers.
a. No trademark or patent rights held by Affirmer are waived, abandoned,
surrendered, licensed or otherwise affected by this document.
b. Affirmer offers the Work as-is and makes no representations or warranties
of any kind concerning the Work, express, implied, statutory or otherwise,
including without limitation warranties of title, merchantability, fitness
for a particular purpose, non infringement, or the absence of latent or
other defects, accuracy, or the present or absence of errors, whether or not
discoverable, all to the greatest extent permissible under applicable law.
c. Affirmer disclaims responsibility for clearing rights of other persons
that may apply to the Work or any use thereof, including without limitation
any person's Copyright and Related Rights in the Work. Further, Affirmer
disclaims responsibility for obtaining any necessary consents, permissions
or other rights required for any use of the Work.
d. Affirmer understands and acknowledges that Creative Commons is not a
party to this document and has no duty or obligation with respect to this
CC0 or use of the Work.
For more information, please see
<http://creativecommons.org/publicdomain/zero/1.0/>

3
README.md Normal file
View File

@ -0,0 +1,3 @@
dotlambda
=========
README text here.

16
info.rkt Normal file
View File

@ -0,0 +1,16 @@
#lang info
(define collection "dotlambda")
(define deps '("base"
"rackunit-lib"
"phc-toolkit"
"typed-map-lib"
"typed-racket-lib"
"typed-racket-more"))
(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))

6
lang.rkt Normal file
View File

@ -0,0 +1,6 @@
#lang racket
(require dotlambda
(except-in typed/racket #%module-begin))
(provide (except-out (all-from-out typed/racket))
(all-from-out dotlambda))

2
lang/reader.rkt Normal file
View File

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

3
literals.rkt Normal file
View File

@ -0,0 +1,3 @@
#lang racket
(require (only-in dotlambda #%dotted-id #%dot-separator))

190
main.rkt Normal file
View File

@ -0,0 +1,190 @@
#lang racket
(provide #%dotted-id
#%dot-separator
(rename-out [new-#%module-begin #%module-begin]))
(require typed/racket)
(require (submod phc-toolkit untyped)
racket/stxparam
(for-syntax racket/string
racket/list
syntax/parse
racket/syntax
syntax/strip-context
racket/struct
racket/function
syntax/srcloc
phc-toolkit/stx/fold
(only-in racket/base [... …])))
(define-for-syntax identifier→string (compose symbol->string syntax-e))
(define-syntax (#%dot-separator stx)
(raise-syntax-error '#%dot-separator
"Can only be used in special contexts"
stx))
(define-syntax (~> stx)
(syntax-case stx ()
[(_ v) #'v]
[(_ v f . f*) #'(~> (f v) . f*)]))
(define-syntax-parameter #%dotted-id
(syntax-parser
#:literals (#%dot-separator)
[(_ {~seq #%dot-separator e} …) #'(λ (v) (~> v e …))]
[(_ e₀ {~seq #%dot-separator e} …) #'(~> e₀ e …)]))
(define-syntax (new-#%module-begin stx)
(syntax-case stx ()
[(_ . body)
#`(#%module-begin
. #,(fold-syntax replace-dots
#'body))]))
(define-for-syntax (make-λ l args e percent?)
(define percent*
(if (and percent? (>= (length args) 1))
`{(,#'define-syntax % (make-rename-transformer #',(car args)))}
'{}))
;`(letrec ([%0 (,#'λ ,args ,@percent* ,e)]) %0)
(datum->syntax l `(,#'λ ,args ,@percent* ,e) l l))
(define-for-syntax (make-args l str* pos)
(if (empty? str*)
'()
(let ()
(define str (car str*))
(define len (string-length str))
(cons (datum->syntax l
(string->symbol str)
(update-source-location l
#:position pos
#:span len)
l)
(make-args l (cdr str*) (+ pos 1 len))))))
(define-for-syntax (find-% stx)
(define found 0)
(define (found! n) (set! found (max found n)))
(fold-syntax (λ (e recurse)
(if (and (identifier? e)
(regexp-match #px"^%[1-9][0-9]*$"
(identifier→string e)))
(found! (string->number
(cadr (regexp-match #px"^%([1-9][0-9]*)$"
(identifier→string e)))))
(if (and (identifier? e)
(string=? (identifier→string e) "%"))
(found! 1)
(recurse e))))
stx)
found)
(begin-for-syntax
(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
#'l))])
(make-λ #'l args #'e #t)))
(pattern {~seq l:id e:expr}
#:when (regexp-match #px"^λ([^.]+\\.)+$" (identifier→string #'l))
#:with expanded
(let* ([m (regexp-match* #px"[^.]+" (identifier→string #'l) 1)]
[args (make-args #'l
m
(+ (syntax-position #'l) 1))])
(make-λ #'l args #'e #f)))
(pattern e
#:with expanded #'e)))
(define-for-syntax (replace-dots stx recurse)
(syntax-parse stx
;; Fast path: no dots or ellipses.
[x:id #:when (regexp-match #px"^[^.…]*$" (identifier→string #'x))
#'x]
;; Protected identifiers, which are not altered.
[x:id #:when (regexp-match #px"^(\\.*|…|\\.\\.\\.?[+*]|…[+*]|::\\.\\.\\.)$"
(identifier→string #'x))
#'x]
;; A trailing dot is dropped and escapes the preceding identifier.
[x:id #:when (regexp-match #px"\\.$" (identifier→string #'x))
(let* ([str (identifier→string #'x)]
[unescaped (substring str 0 (sub1 (string-length str)))])
(datum->syntax stx (string->symbol unescaped) stx stx))]
[x:id #:when (regexp-match #px"[.…]"
(identifier→string #'x))
(let* ([str (symbol->string (syntax-e #'x))]
[leading-dot? (regexp-match #px"^\\." str)]
[components* (regexp-match* #px"([^.…]|\\.\\.+)+|…"
str
#:gap-select? #t)]
[components (if leading-dot?
(drop-right components* 1)
(cdr (drop-right components* 1)))]
[unescaped (map (λ (m)
(regexp-replace* #px"\\.(\\.+)" m "\\1"))
components)]
[identifiers ((to-ids stx) components
unescaped
0
leading-dot?)]
[trailing-dot? (regexp-match #px"\\.$" str)])
(define/with-syntax (id …) identifiers)
(if (= (length identifiers) 1)
(quasisyntax/loc stx
#,(car identifiers))
(quasisyntax/loc stx
(#,(datum->syntax #'here '#%dotted-id stx stx) id …))))]
[{~and whole (:elt … . {~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)]))
(define-for-syntax (to-ids stx)
(define (process component* unescaped* len-before dot?)
(if (empty? component*)
'()
(let ()
(define component (car component*))
(define unescaped (car unescaped*))
(define len (string-length component))
(define len-after (+ len-before len))
(define pos (+ (syntax-position stx) len-before))
(define loc (update-source-location stx #:position pos #:span len))
(define id
(datum->syntax stx
(if dot?
'#%dot-separator
(string->symbol unescaped))
loc
stx))
(define id-p
(if dot? (syntax-property id 'dotted-original-chars unescaped) id))
(cons id-p
(process (cdr component*)
(cdr unescaped*)
len-after
(not dot?))))))
process)
(define-for-syntax (map-fold f init . l*)
(car
(apply foldl
(λ all-args
(define vs+acc (last all-args))
(define args (drop-right all-args 1))
(define new-v+new-acc (apply f (append args (list (cdr vs+acc)))))
(cons (cons (car new-v+new-acc)
(car vs+acc))
(cdr new-v+new-acc)))
(cons '() init)
l*)))

56
scribblings/dotlambda.scrbl Normal file
View File

@ -0,0 +1,56 @@
#lang scribble/manual
@require[@for-label[dotlambda]]
@title{Dotted identifiers and @racket[λ<arg>.code] syntax}
@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))
@defmodulelang[dotlambda]{
This @hash-lang[] language overrides @orig:#%module-begin from
@racketmodname[typed/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
non-consecutive dots, all the resulting identifiers, including the
occurrences @racket[#%dot-separator] are placed in a syntax list, starting
with @racket[#%dotted-id], so that @racket[a.b.c] gets transformed into
@racket[(#%dotted-id a #%dot-separator b #%dot-separator c)].}
@item{A leading dot (which is not followed by another dot) is allowed, and is
replaced with @racket[#%dot-separator], like dots occurring in the middle of
the identifier.}
@item{A dot immediately preceded or followed by an ellipsis @racket[…] can be
omitted, so that @racket[a.….b], @racket[a….b], @racket[a.…b] and
@racket[a…b] are all translated to
@racket[(#%dotted-id a #%dot-separator … #%dot-separator b)].}
@item{Two or more dots do not split the identifier, but one of the dots is
removed (i.e. it escapes the other dots).}
@item{If an identifier ends with a dot, a single trailing dot is removed and
the identifier is otherwise left intact (i.e. the trailing dot escapes the
whole identifier).}
@item{Identifiers consisting only of dots are left unchanged, as well as the
following: @racket[..+], @racket[...+], @racket[..*], @racket[...*],
@racket[…], @racket[…+], @racket[…*] and @racket[::...].}]
Furthermore the syntax @racket[λvar.(expr …)] is recognised as a shorthand for
@racket[(λ (var) (expr …))], so that @racket[λx.(+ x 2)] is translated to
@racket[(λ (x) (+ x 2))]. If the @racket[_var] part is left empty, then it
defaults to @racket[%], so that @racket[λ.(+ % 2)] is translated to
@racket[(λ (%) (+ % 2))].}
@section{Module language for @racket[dotlambda]}
@defmodulelang[dotlambda/lang]{
This language is equivalent to
@racket[#,(hash-lang) #,(racketmodname dotlambda)], but can also be used as
a module language.
}

109
test/test-dotlambda.rkt Normal file
View File

@ -0,0 +1,109 @@
#lang dotlambda
(require typed/rackunit
phc-toolkit
;"get.lp2.rkt"
;"graph-test.rkt"
typed-map
)
(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
#|
TODO: re-enable or move these tests.
(check-equal?: g.streets…houses…owner.name
: (Listof (Listof String))
(list (list "Amy" "Anabella") (list "Jack")))
(check-equal?: (map: (curry map .owner.name) g.streets…houses)
: (Listof (Listof String))
(list (list "Amy" "Anabella") (list "Jack")))
|#
(define (slen [n : Index] [str : String])
(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)