commit 66b41f4a21d39e539632099200751e3002ac2a62 Author: Georges Dupéron Date: Sat Oct 15 05:35:20 2016 +0200 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..1a59348 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +*~ +\#* +.\#* +.DS_Store +compiled/ +/doc/ diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..4419525 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,60 @@ +language: c + +# Based from: https://github.com/greghendershott/travis-racket + +# Optional: Remove to use Travis CI's older infrastructure. +sudo: false + +env: + global: + # Supply a global RACKET_DIR environment variable. This is where + # Racket will be installed. A good idea is to use ~/racket because + # that doesn't require sudo to install and is therefore compatible + # with Travis CI's newer container infrastructure. + - RACKET_DIR=~/racket + matrix: + # Supply at least one RACKET_VERSION environment variable. This is + # used by the install-racket.sh script (run at before_install, + # below) to select the version of Racket to download and install. + # + # Supply more than one RACKET_VERSION (as in the example below) to + # create a Travis-CI build matrix to test against multiple Racket + # versions. + #- 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 # Not yet + - RACKET_VERSION=HEAD + +matrix: + allow_failures: +# - env: RACKET_VERSION=HEAD + fast_finish: true + +before_install: +- git clone https://github.com/greghendershott/travis-racket.git ~/travis-racket +- cat ~/travis-racket/install-racket.sh | bash # pipe to bash not sh! +- export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us + +install: + - raco pkg install --deps search-auto + +before_script: + +# Here supply steps such as raco make, raco test, etc. You can run +# `raco pkg install --deps search-auto` to install any required +# packages without it getting stuck on a confirmation prompt. +script: + - raco test -x -p typed-map + - raco setup --check-pkg-deps --pkgs typed-map + - raco pkg install --deps search-auto doc-coverage + - if test "$RACKET_VERSION" != "6.2" -a "$RACKET_VERSION" != "6.3"; then raco doc-coverage typed-map; fi + +after_success: + - raco pkg install --deps search-auto cover cover-coveralls + - raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage . diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 0000000..48d24e8 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,11 @@ +typed-map +Copyright (c) 2016 georges + +This package is distributed under the GNU Lesser General Public +License (LGPL). This means that you can link typed-map into proprietary +applications, provided you follow the rules stated in the LGPL. You +can also modify this package; if you distribute a modified version, +you must distribute it under the terms of the LGPL, which in +particular means that you must release the source code for the +modified software. See http://www.gnu.org/copyleft/lesser.html +for more information. diff --git a/README.md b/README.md new file mode 100644 index 0000000..7cdf0e1 --- /dev/null +++ b/README.md @@ -0,0 +1,10 @@ +[![Build Status,](https://img.shields.io/travis/jsmaniac/typed-map/master.svg)](https://travis-ci.org/jsmaniac/typed-map) +[![Coverage Status,](https://img.shields.io/coveralls/jsmaniac/typed-map/master.svg)](https://coveralls.io/github/jsmaniac/typed-map) +[![Build Stats,](https://img.shields.io/badge/build-stats-blue.svg)](http://jsmaniac.github.io/travis-stats/#jsmaniac/typed-map) +[![Online Documentation.](https://img.shields.io/badge/docs-online-blue.svg)](http://docs.racket-lang.org/typed-map/) + +typed-map +========= + +Type inference helper for map with Typed/Racket. +Supports afl, un-annotated lambdas and polymorphic functions. \ No newline at end of file diff --git a/info.rkt b/info.rkt new file mode 100644 index 0000000..d3200a8 --- /dev/null +++ b/info.rkt @@ -0,0 +1,15 @@ +#lang info +(define collection "typed-map") +(define deps '("base" + "rackunit-lib" + "typed-racket-lib")) +(define build-deps '("scribble-lib" + "racket-doc" + "afl")) +(define scribblings '(("scribblings/typed-map.scrbl" ()))) +(define pkg-desc + (string-append "Type inference helper for map with Typed/Racket." + " Supports afl, un-annotated lambdas and polymorphic" + " functions.")) +(define version "1.0") +(define pkg-authors '("Georges Dupéron")) diff --git a/main.rkt b/main.rkt new file mode 100644 index 0000000..0945dec --- /dev/null +++ b/main.rkt @@ -0,0 +1,74 @@ +#lang typed/racket + +(require (only-in racket/base [map orig-map])) + +(provide map generalize) + +(module m racket/base + (provide unoptimizable-false) + (define (unoptimizable-false) #f)) +(require/typed 'm [unoptimizable-false (→ Boolean)]) + +(define #:∀ (A) (generalize [l : (Listof A)]) + (if (unoptimizable-false) + l + ;; the double-reverse is complex enough that Typed/Racket does not + ;; infer that generalize has type (→ A A) instead of + ;; (→ (Listof A) (Listof A)) + ;; The unoptimizable-false above means that this is never executed, + ;; so the performance cost of the double-reverse is not incured. + (reverse (reverse l)))) + +(define-syntax (map stx) + (syntax-case stx (λ) + [self (identifier? #'self) #'orig-map] + [(_ (λ (argᵢ ...) body ...) lᵢ ...) + (begin + (unless (equal? (length (syntax->list #'(argᵢ ...))) + (length (syntax->list #'(lᵢ ...)))) + (raise-syntax-error 'infer-map + "wrong number of argument lists for the function" + stx)) + (with-syntax ([(l-cacheᵢ ...) (generate-temporaries #'(lᵢ ...))] + [(upcast-lᵢ ...) (generate-temporaries #'(lᵢ ...))] + [(l-loopᵢ ...) (generate-temporaries #'(lᵢ ...))]) + #'(let ([l-cacheᵢ lᵢ] ...) + (let ([upcast-lᵢ (generalize l-cacheᵢ)] + ...) + (if (or (null? l-cacheᵢ) ...) + (begin + (unless (and (null? l-cacheᵢ) ...) + ;; TODO: copy the error message from map. + (error "all lists must have same size")) + '()) + ;; Possibility to call (generalize) on the single-element + ;; list if Typed Racket does not generalize the (List B) + ;; type to (Listof B) thanks to the use of set!. + ;; If necessary, use the following structure: + ;; ((λ #:∀ (B) ([upcast-first-result : B]) + ;; (let ([mutable-list : (Listof B)]) + ;; … (set! mutable-list (cons … …) …)) + ;; ;; compute the first result: + ;; (let ([argᵢ (car upcast-lᵢ)] ...) body ...)) + (let ([upcast-result (list (let ([argᵢ (car upcast-lᵢ)] + ...) + body ...))]) + (let loop ([l-loopᵢ (cdr upcast-lᵢ)] + ...) + (if (or (null? l-loopᵢ) ...) + (begin + (unless (and (null? l-loopᵢ) ...) + ;; TODO: copy the error message from map. + (error "all lists must have same size")) + (void)) + (begin (set! upcast-result + (cons (let ([argᵢ (car l-loopᵢ)] + ...) + body ...) + upcast-result)) + (loop (cdr l-loopᵢ) ...)))) + (reverse upcast-result)))))))] + [(_ f lᵢ ...) + ;; TODO: multiple l + (with-syntax ([(argᵢ ...) (generate-temporaries #'(lᵢ ...))]) + #'(map (λ (argᵢ ...) (f argᵢ ...)) lᵢ ...))])) diff --git a/scribblings/typed-map.scrbl b/scribblings/typed-map.scrbl new file mode 100644 index 0000000..178913a --- /dev/null +++ b/scribblings/typed-map.scrbl @@ -0,0 +1,75 @@ +#lang scribble/manual +@require[scribble/example + @for-label[typed-map]] + +@title{typed-map} +@author[@author+email["Georges Dupéron" "georges.duperon@gmail.com"]] + +@(module orig racket/base + (require scribble/manual + (for-label racket/base)) + (provide orig:map) + (define orig:map @racket[map])) +@(require 'orig) + +@defmodule[typed-map] + +@defproc[#:kind "syntax" + (map [f (→ A ... B)] [l (Listof A)] ...) (Listof B)]{ + Like @orig:map, but with better type inference for Typed Racket. + + When @racket[f] is a literal lambda of the form + @racket[(λ (arg ...) body ...)], it is not necessary to specify the type of + the arguments, as they will be inferred from the list. + + @examples[#:eval ((make-eval-factory '(typed-map) #:lang 'typed/racket)) + (map (λ (x) (* x 2)) '(1 2 3)) + (let ([l '(4 5 6)]) + (map (λ (x) (* x 2)) l))] + + This enables the use of @racket[#,hash-lang afl] for @racket[map] in Typed + Racket. + + Furthermore, when @racket[f] is a polymorphic function, type annotations are + not needed: + + @examples[#:eval ((make-eval-factory '(typed-map) #:lang 'typed/racket)) + (map car '([a . 1] [b . 2] [c . 3]))] + + Compare this with the behaviour of @orig:map from + @racketmodname[racket/base], which generates a type error: + + @examples[#:eval ((make-eval-factory '() #:lang 'typed/racket)) + (eval:alts (#,orig:map car '([a . 1] [b . 2] [c . 3])) + (eval:error (map car '([a . 1] [b . 2] [c . 3]))))] + + When used as an identifier, the @racket[map] macro expands to the original + @orig:map from @racketmodname[racket/base]: + + @examples[#:eval ((make-eval-factory '(typed-map) #:lang 'typed/racket)) + (require (only-in racket/base [map orig:map])) + (equal? map orig:map)] + + Note that the implementation expands to a large expression, and makes use of + @racket[set!] internally to build the result list. The trick used proceeds as + follows: + @itemlist[ + @item{It uses @racket[(reverse (reverse l))] to generalise the type of the + list, without having to express that type, so that Type / Racket infers a + more general type of the form @racket[(Listof A)], without detecting that the + output is identical to the input. An unoptimizable guard prevents the + double-reverse from actually being executed, so it does not incur a + performance cost.} + @item{It uses a named let to perform the loop the function @racket[f] is + never passed as an argument to another polymorphic function, and is instead + directly called with the appropriate arguments. The error message + "Polymorphic function `map' could not be applied to arguments" is therefore + not raised.} + @item{To have the most precise and correct types, it uses a named let with a + single variable containing the list (with the generalized type). An outer let + binds a mutable accumulator, initialized with a single-element list + containing the result of applying @racket[f] on the first element of the + list. Since all elements of the list belong to the generalized type, the + result of calling @racket[f] on any element has the same type, therefore the + accumulator has the type @racket[(Listof B)], where @racket[B] is the + inferred type of the result of @racket[f].}]} diff --git a/test/test-map.rkt b/test/test-map.rkt new file mode 100644 index 0000000..f67bb97 --- /dev/null +++ b/test/test-map.rkt @@ -0,0 +1,37 @@ +#lang afl typed/racket + +(require typed-map) + +;; without ann +(let () + (map (λ (x) (* x 2)) '()) + (map (λ (x) (* x 2)) '(1)) + (map (λ (x) (* x 2)) '(1 2)) + (map (λ (x) (* x 2)) '(1 2 3)) + (map + '(1 2 3) '(4 5 6)) + (map car '((1 2) (3 4))) + (map #λ(+ % 1) '(1 2 3)) + + ;; used as a function (identifier macro), looses the inference abilities + (map map (list add1 sub1) '((1 2 3) (4 5 6))) + (map map + (ann (list car cdr) (Listof (→ (List Number) (U Number Null)))) + '(((1) (2) (3)) ((4) (5) (6)))) + + (λ #:∀ (A) ([l : (Listof A)]) + (map (λ (x) x) l)) + + (void)) + +;; with ann +(ann (map (λ (x) (* x 2)) '()) Null) +(ann (map (λ (x) (* x 2)) '(1)) (Listof Positive-Byte)) +(ann (map (λ (x) (* x 2)) '(1 2)) (Listof Positive-Index)) +(ann (map (λ (x) (* x 2)) '(1 2 3)) (Listof Positive-Index)) +(ann (map + '(1 2 3) '(4 5 6)) (Listof Positive-Index)) +(ann (map car '((1 2) (3 4))) (Listof Positive-Byte)) +(ann (map #λ(+ % 1) '(1 2 3)) (Listof Positive-Index)) + +(ann (λ #:∀ (A) ([l : (Listof A)]) + (map (λ (x) x) l)) + (∀ (A) (→ (Listof A) (Listof A))))