Added authors

doc: change source code link

.travis.yml

@@ -6,17 +6,27 @@ env:
   global:
    - RACKET_DIR=~/racket
   matrix:
-   - RACKET_VERSION=6.1.1
-   - RACKET_VERSION=6.2
-   - RACKET_VERSION=6.2.1
-   - RACKET_VERSION=6.3
+   #- RACKET_VERSION=6.1.1
+   #- RACKET_VERSION=6.2
+   #- RACKET_VERSION=6.2.1
+   #- RACKET_VERSION=6.3
    - RACKET_VERSION=6.4
    - RACKET_VERSION=6.5
+   - RACKET_VERSION=6.7
+   - RACKET_VERSION=6.8
+   - RACKET_VERSION=6.9
+   - RACKET_VERSION=6.10
+   - RACKET_VERSION=6.10.1
+   - RACKET_VERSION=6.11
+   - RACKET_VERSION=6.12
+   - RACKET_VERSION=7.0
+   - RACKET_VERSION=7.1
+   - RACKET_VERSION=7.2
    - RACKET_VERSION=HEAD
 
 matrix:
   allow_failures:
-   - env: RACKET_VERSION=HEAD
+  # - env: RACKET_VERSION=HEAD
   fast_finish: true
 
 before_install:
@@ -30,7 +40,7 @@ install:
 before_script:
 
 script:
- - raco pkg install --deps search-auto --link afl
- - raco test -x -p afl
+ - raco pkg install -j 2 --deps search-auto --link aful
+ - raco test -r -p aful
 
 after_script:

README.md

@@ -1,12 +1,17 @@
-afl [![Build Status](https://travis-ci.org/AlexKnauth/afl.png?branch=master)](https://travis-ci.org/AlexKnauth/afl)
+aful [![Build Status](https://travis-ci.org/jsmaniac/aful.png?branch=master)](https://travis-ci.org/jsmaniac/aful)
 ===
 
 a lang-extension for adding rackjure-like [anonymous function literals](http://www.greghendershott.com/rackjure/index.html#%28part._func-lit%29) to a language, based on at-exp and rackjure
 
-documentation: http://pkg-build.racket-lang.org/doc/afl/index.html
+documentation: http://pkg-build.racket-lang.org/doc/aful/index.html
 
 Example:
 ```racket
-#lang afl racket/base
+#lang aful racket/base
+(map #λ(+ % 1) '(1 2 3)) ;=> '(2 3 4)
+```
+
+```racket
+#lang aful/unhygienic racket/base
 (map #λ(+ % 1) '(1 2 3)) ;=> '(2 3 4)
 ```

afl/info.rkt

@@ -1,3 +0,0 @@
-#lang info
-
-(define scribblings '(["docs/afl.scrbl" ()]))

afl/lang/runtime-config.rkt

@@ -1,9 +0,0 @@
-#lang racket/base
-
-(provide configure)
-
-(require (only-in afl/reader use-afl-readtable))
-
-(define (configure data)
-  (use-afl-readtable))
-

aful/docs/aful.scrbl

@@ -4,52 +4,54 @@
           scribble-code-examples
           (for-label (except-in racket/base
                                 read read-syntax)
-                     (except-in afl/reader
+                     (except-in aful/reader
                                 read read-syntax)))
+@author[
+  "Alex Knauth"
+  @author+email["Suzanne Soy" "racket@suzanne.soy"]]
+@title{aful}
 
-@title{afl}
+@;; example: @aful-code{(map #λ(+ % 1) '(1 2 3))}
+@(define-syntax-rule @aful-code[stuff ...]
+   @code[#:lang "aful racket" stuff ...])
 
-@;; example: @afl-code{(map #λ(+ % 1) '(1 2 3))}
-@(define-syntax-rule @afl-code[stuff ...]
-   @code[#:lang "afl racket" stuff ...])
+source code: @url["https://github.com/jsmaniac/aful/"]
 
-source code: @url["https://github.com/AlexKnauth/afl"]
+@section{#lang aful}
 
-@section{#lang afl}
-
-@defmodulelang[afl]{
-The @racketmodname[afl] language is a lang-extension like @racketmodname[at-exp]
+@defmodulelang[aful]{
+The @racketmodname[aful] language is a lang-extension like @racketmodname[at-exp]
 that adds @racketmodname[rackjure]-like anonymous function literals to a language.  
 @margin-note{see @secref["func-lit" #:doc '(lib "rackjure/rackjure.scrbl")]}
 
-For example, @racket[@#,hash-lang[] @#,racketmodname[afl] @#,racketmodname[racket/base]]
+For example, @racket[@#,hash-lang[] @#,racketmodname[aful] @#,racketmodname[racket/base]]
 adds anonymous function literals to @racketmodname[racket/base], so that
 @codeblock{
-#lang afl racket/base}
-@code-examples[#:lang "afl racket/base" #:context #'here]|{
+#lang aful racket/base}
+@code-examples[#:lang "aful racket/base" #:context #'here]|{
 (map #λ(+ % 1) '(1 2 3))
 (map #λ(+ % %2) '(1 2 3) '(1 2 3))
 }|
 
-For the @racketmodname[afl] language to work properly for a module, the module
+For the @racketmodname[aful] language to work properly for a module, the module
 has to depend on @racketmodname[racket/base] in some way, although that does not
 mean it has to explicitly require it or that the language it uses has to provide
 anything from it.  It does mean that for instance
-@racket[@#,hash-lang[] @#,racketmodname[afl] @#,racketmodname[racket/kernel]]
+@racket[@#,hash-lang[] @#,racketmodname[aful] @#,racketmodname[racket/kernel]]
 won't work properly.  
 }
 
-@section{afl/reader}
+@section{aful/reader}
 
-@defmodule[afl/reader]
+@defmodule[aful/reader]
 
-@deftogether[(@defproc[(afl-read [in input-port? (current-input-port)]
+@deftogether[(@defproc[(aful-read [in input-port? (current-input-port)]
                                  [#:arg-str arg-str string? (current-arg-string)]) any]{}
-              @defproc[(afl-read-syntax [source-name any/c (object-name in)]
+              @defproc[(aful-read-syntax [source-name any/c (object-name in)]
                                         [in input-port? (current-input-port)]
                                         [#:arg-str arg-str string? (current-arg-string)])
                        (or/c syntax? eof-object?)]{})]{
-These procedures implement the @racketmodname[afl] reader.  They do so by
+These procedures implement the @racketmodname[aful] reader.  They do so by
 constructing a readtable based on the current one, and using that
 for reading.
 
@@ -57,31 +59,31 @@ The @racket[arg-str] argument lets you specify something else to use as a placeh
 @racket[%].
 
 @examples[
-  (require afl/reader)
-  (afl-read (open-input-string "#λ(+ % %2)"))
-  (afl-read (open-input-string "#λ(+ _ _2)") #:arg-str "_")
+  (require aful/reader)
+  (aful-read (open-input-string "#λ(+ % %2)"))
+  (aful-read (open-input-string "#λ(+ _ _2)") #:arg-str "_")
 ]
 
-@racketmodname[afl/reader] also exports these functions under the names @racket[read] and
+@racketmodname[aful/reader] also exports these functions under the names @racket[read] and
 @racket[read-syntax].
 }
 
-@defproc[(make-afl-readtable [orig-readtable readtable? (current-readtable)]
+@defproc[(make-aful-readtable [orig-readtable readtable? (current-readtable)]
                              [#:outer-scope outer-scope (-> syntax? syntax?)]
                              [#:arg-str arg-str string? (current-arg-string)]) readtable?]{
-makes an @racketmodname[afl] readtable based on @racket[orig-readtable].
+makes an @racketmodname[aful] readtable based on @racket[orig-readtable].
 
 The @racket[outer-scope] argument should be a function that introduce scopes to preserve hygiene,
 normally produced by @racket[make-syntax-introducer] and similar functions. For versions of racket
 that support it, these should generally be specified as use-site scopes.
 
 The @racket[arg-str] argument lets you specify something else to use as a placeholder instead of
-@racket[%], just like for @racket[afl-read].
+@racket[%], just like for @racket[aful-read].
 }
 
-@defproc[(use-afl-readtable [orig-readtable readtable? (current-readtable)]
+@defproc[(use-aful-readtable [orig-readtable readtable? (current-readtable)]
                             [#:arg-str arg-str string? (current-arg-string)]) void?]{
-passes arguments to @racket[make-afl-readtable] and sets the @racket[current-readtable] parameter to
+passes arguments to @racket[make-aful-readtable] and sets the @racket[current-readtable] parameter to
 the resulting readtable.
 It also enables line counting for the @racket[current-input-port] via @racket[port-count-lines!].
 
@@ -90,15 +92,15 @@ This is mostly useful for the REPL.
 @verbatim{
 Examples:
 
-> @afl-code{(require afl/reader)}
-> @afl-code{(use-afl-readtable)}
-> @afl-code{(map #λ(+ % %2) '(1 2 3) '(1 2 3))}
+> @aful-code{(require aful/reader)}
+> @aful-code{(use-aful-readtable)}
+> @aful-code{(map #λ(+ % %2) '(1 2 3) '(1 2 3))}
 @racketresult['(2 4 6)]
-> @afl-code{(use-afl-readtable #:arg-str "_")}
-> @afl-code{(map #λ(+ _ _2) '(1 2 3) '(1 2 3))}
+> @aful-code{(use-aful-readtable #:arg-str "_")}
+> @aful-code{(map #λ(+ _ _2) '(1 2 3) '(1 2 3))}
 @racketresult['(2 4 6)]
 }}
 
 @defparam[current-arg-string arg-str string?]{
-a parameter that controls default values of the @racket[arg-str] arguments to @racket[afl-read] etc.
-}
+a parameter that controls default values of the @racket[arg-str] arguments to @racket[aful-read] etc.
+}

aful/info.rkt

@@ -0,0 +1,3 @@
+#lang info
+
+(define scribblings '(["docs/aful.scrbl" ()]))

aful/lang/language-info.rkt

@@ -13,7 +13,7 @@
   (lambda (key default)
     (case key
       [(configure-runtime)
-       (define config-vec '#[afl/lang/runtime-config configure #f])
+       (define config-vec '#[aful/lang/runtime-config configure #f])
        (define other-config (other-get-info key default))
        (cond [(list? other-config) (cons config-vec other-config)]
              [else (list config-vec)])]

aful/lang/reader.rkt

@@ -1,10 +1,10 @@
 #lang lang-extension
-#:lang-extension afl make-afl-lang-reader
-#:lang-reader afl-lang
+#:lang-extension aful make-aful-lang-reader
+#:lang-reader aful-lang
 (require lang-reader/lang-reader
          (only-in "../reader.rkt" wrap-reader))
 
-(define (make-afl-lang-reader lang-reader)
+(define (make-aful-lang-reader lang-reader)
   (define/lang-reader [-read -read-syntax -get-info] lang-reader)
   (make-lang-reader
    (wrap-reader -read)
@@ -12,7 +12,7 @@
      (lambda args
        (define stx (apply read-syntax args))
        (define old-prop (syntax-property stx 'module-language))
-       (define new-prop `#(afl/lang/language-info get-language-info ,old-prop))
+       (define new-prop `#(aful/lang/language-info get-language-info ,old-prop))
        (syntax-property stx 'module-language new-prop)))
    -get-info))
 

aful/lang/runtime-config.rkt

@@ -0,0 +1,9 @@
+#lang racket/base
+
+(provide configure)
+
+(require (only-in aful/reader use-aful-readtable))
+
+(define (configure data)
+  (use-aful-readtable))
+

aful/reader.rkt

@@ -1,14 +1,15 @@
 #lang racket/base
 
-(provide make-afl-readtable
-         afl-read
-         afl-read-syntax
+(provide make-aful-readtable
+         aful-read
+         aful-read-syntax
          wrap-reader
-         use-afl-readtable
+         wrap-reader-unhygienic
+         use-aful-readtable
          current-arg-string
          (rename-out
-          [afl-read read]
-          [afl-read-syntax read-syntax])
+          [aful-read read]
+          [aful-read-syntax read-syntax])
          )
 
 (require racket/match
@@ -18,6 +19,9 @@
          racket/function
          syntax/srcloc
          hygienic-reader-extension/extend-reader
+         "scribble-enhanced.rkt"
+         phc-toolkit/stx
+         "unhygienic/hygienic-reader-extension--extend-reader--unhygienic.rkt"
          (for-meta -10 racket/base)
          (for-meta -9 racket/base)
          (for-meta -8 racket/base)
@@ -45,21 +49,34 @@
 (module+ test
   (require rackunit))
 
-(define (afl-read [in (current-input-port)] #:arg-str [arg-str (current-arg-string)])
+(define (aful-read [in (current-input-port)] #:arg-str [arg-str (current-arg-string)])
   (parameterize ([current-arg-string arg-str])
     ((wrap-reader read) in)))
 
-(define (afl-read-syntax [src (object-name (current-input-port))] [in (current-input-port)]
-                         #:arg-str [arg-str (current-arg-string)])
+(define (aful-read-syntax [src (object-name (current-input-port))] [in (current-input-port)]
+                          #:arg-str [arg-str (current-arg-string)])
   (parameterize ([current-arg-string arg-str])
     ((wrap-reader read-syntax) src in)))
 
 (define (wrap-reader p)
-  (extend-reader p make-afl-readtable))
+  (extend-reader p make-aful-readtable))
 
-(define (make-afl-readtable [orig-rt (current-readtable)]
-                            #:outer-scope outer-scope
-                            #:arg-str [arg-str (current-arg-string)])
+(require syntax/strip-context)
+(define ((wrap-reader-unhygienic p) . p-args)
+  (strip-context
+   (apply (extend-reader-unhygienic p
+                                    (λ ([orig-rt (current-readtable)]
+                                        #:outer-scope outer-scope
+                                        #:arg-str [arg-str (current-arg-string)])
+                                      (make-aful-readtable orig-rt
+                                                           #:outer-scope (λ (stx [mode 'flip]) stx)
+                                                           #:arg-str arg-str))
+                         #:hygiene? #f)
+          p-args)))
+
+(define (make-aful-readtable [orig-rt (current-readtable)]
+                             #:outer-scope outer-scope
+                             #:arg-str [arg-str (current-arg-string)])
   (define reader-proc (make-reader-proc orig-rt outer-scope #:arg-str arg-str))
   (let* ([rt orig-rt]
          [rt (make-readtable rt #\λ 'dispatch-macro reader-proc)]
@@ -67,19 +84,19 @@
          [rt (make-readtable rt #\l 'dispatch-macro reader-proc)])
     rt))
 
-(define (use-afl-readtable [orig-rt (current-readtable)] #:arg-str [arg-str (current-arg-string)])
+(define (use-aful-readtable [orig-rt (current-readtable)] #:arg-str [arg-str (current-arg-string)])
   (port-count-lines! (current-input-port))
-  (current-readtable (make-afl-readtable orig-rt #:outer-scope identity #:arg-str arg-str)))
+  (current-readtable (make-aful-readtable orig-rt #:outer-scope identity #:arg-str arg-str)))
 
 (define current-arg-string (make-parameter "%"))
 
 
 (module+ test
-  (check-equal? (afl-read (open-input-string "#λ(+ % %2)"))
+  (check-equal? (aful-read (open-input-string "#λ(+ % %2)"))
                 '(lambda (%1 %2)
                    (define-syntax % (make-rename-transformer #'%1))
                    (+ % %2)))
-  (check-equal? (afl-read (open-input-string "#λ(+ _ _2)") #:arg-str "_")
+  (check-equal? (aful-read (open-input-string "#λ(+ _ _2)") #:arg-str "_")
                 '(lambda (_1 _2)
                    (define-syntax _ (make-rename-transformer #'_1))
                    (+ _ _2)))
@@ -132,9 +149,9 @@
     (define loc-stx (build-source-location-syntax loc))
     (define λ-loc
       (update-source-location loc-stx
-        #:column (and col (+ col 1))
-        #:position (and pos (+ pos 1))
-        #:span (and stx-pos pos (max 0 (- stx-pos pos 1)))))
+                              #:column (and col (+ col 1))
+                              #:position (and pos (+ pos 1))
+                              #:span (and stx-pos pos (max 0 (- stx-pos pos 1)))))
     (hygienic-app
      #:outer-scope outer-scope
      (lambda (stx*)
@@ -143,10 +160,14 @@
                      [% (string->id stx* arg-str)]
                      [%1 (string->id stx* arg-str "1")]
                      [body stx*])
-         (syntax/loc loc-stx
-           (lambda args
-             (define-syntax % (make-rename-transformer #'%1))
-             body))))
+         (syntax-property
+          (syntax/top-loc loc-stx
+            (lambda args
+              (define-syntax % (make-rename-transformer #'%1))
+              body))
+          'scribble-render-as
+          aful-scribble-render)
+         ))
      stx)))
 
 (define (orig stx)
@@ -158,25 +179,25 @@
     (syntax->datum (parse stx identity)))
   (check-equal? (chk #'(+))
                 '(lambda ()
-                  (define-syntax % (make-rename-transformer #'%1))
-                  (+)))
+                   (define-syntax % (make-rename-transformer #'%1))
+                   (+)))
   (check-equal? (chk #'(+ 2 %1 %1))
                 '(lambda (%1)
-                  (define-syntax % (make-rename-transformer #'%1))
-                  (+ 2 %1 %1)))
+                   (define-syntax % (make-rename-transformer #'%1))
+                   (+ 2 %1 %1)))
   (check-equal? (chk #'(+ 2 %3 %2 %1))
                 '(lambda (%1 %2 %3)
-                  (define-syntax % (make-rename-transformer #'%1))
-                  (+ 2 %3 %2 %1)))
+                   (define-syntax % (make-rename-transformer #'%1))
+                   (+ 2 %3 %2 %1)))
   (check-equal? (chk #'(apply list* % %&))
                 '(lambda (%1 . %&)
-                  (define-syntax % (make-rename-transformer #'%1))
-                  (apply list* % %&)))
+                   (define-syntax % (make-rename-transformer #'%1))
+                   (apply list* % %&)))
   (check-equal? (parameterize ([current-arg-string "_"])
                   (chk #'(apply list* _ _&)))
                 '(lambda (_1 . _&)
-                  (define-syntax _ (make-rename-transformer #'_1))
-                  (apply list* _ _&))))
+                   (define-syntax _ (make-rename-transformer #'_1))
+                   (apply list* _ _&))))
 
 ;; parse-args : Stx -> KW-Formals-Stx
 (define (parse-args stx #:arg-str [arg-str (current-arg-string)])

aful/scribble-enhanced.rkt

@@ -0,0 +1,20 @@
+#lang racket
+(provide aful-scribble-render)
+
+(require phc-toolkit/stx)
+
+(define (aful-scribble-render self id code typeset-code uncode d->s stx-prop)
+  (syntax-case self ()
+    [(_ _ _ body)
+     ; #λ(body) reads as:
+     ; (lambda args
+     ;   (define-syntax % (make-rename-transformer #'%1))
+     ;   body)
+     (with-syntax ([uncode (datum->syntax uncode (syntax-e uncode) self)])
+       (syntax/top-loc self
+         ((uncode(let ()
+                   (local-require scribble-enhanced/with-manual)
+                   (seclink "_lang_aful"
+                            #:doc '(lib "aful/docs/aful.scrbl")
+                            (tt "#λ"))))
+          body)))]))

aful/tests/test-aful-at-exp-racket.rkt

@@ -1,4 +1,4 @@
-#lang afl at-exp racket/base
+#lang aful at-exp racket/base
 (require rackunit)
 (check-equal? (map #λ(+ % 1) '(1 2 3))
               '(2 3 4))

aful/tests/test-aful-racket.rkt

@@ -1,4 +1,4 @@
-#lang afl racket/base
+#lang aful racket/base
 (module+ test
   (require rackunit)
   (check-equal? (map #λ(+ % 1) '(1 2 3))

aful/tests/test-aful-scribble.rkt

@@ -1,4 +1,4 @@
-#lang afl scribble/base
+#lang aful scribble/base
 @(require rackunit)
 @(check-equal? @#λ@title{@%}{This is a Title}
               @title{This is a Title})

aful/unhygienic/hygienic-reader-extension--extend-reader--unhygienic.rkt

@@ -0,0 +1,27 @@
+#lang racket
+
+;; Copied and adjusted from
+;; https://github.com/AlexKnauth/hygienic-reader-extension
+;;   /blob/master/hygienic-reader-extension/extend-reader.rkt
+
+(provide extend-reader-unhygienic)
+
+;; extend-reader : (-> (-> A ... Any)
+;;                     (-> Readtable #:outer-scope (-> Syntax Syntax) Readtable)
+;;                     (-> A ... Any))
+(define (extend-reader-unhygienic proc extend-readtable #:hygiene? [hygiene? #t])
+  (lambda args
+    (define orig-readtable (current-readtable))
+    (define outer-scope (make-syntax-introducer/use-site))
+    (parameterize ([current-readtable (extend-readtable orig-readtable #:outer-scope outer-scope)])
+      (define stx (apply proc args))
+      (if (and (syntax? stx) hygiene?)
+          (outer-scope stx)
+          stx))))
+
+;; make-syntax-introducer/use-site : (-> (-> Syntax Syntax))
+(define (make-syntax-introducer/use-site)
+  (cond [(procedure-arity-includes? make-syntax-introducer 1)
+         (make-syntax-introducer #t)]
+        [else
+         (make-syntax-introducer)]))

aful/unhygienic/lang/language-info.rkt

@@ -0,0 +1,21 @@
+#lang racket/base
+
+(provide get-language-info)
+
+(require racket/match)
+
+(define (get-language-info data)
+  (define other-get-info
+    (match data
+      [(vector mod sym data2)
+       ((dynamic-require mod sym) data2)]
+      [_ (lambda (key default) default)]))
+  (lambda (key default)
+    (case key
+      [(configure-runtime)
+       (define config-vec '#[aful/lang/runtime-config configure #f])
+       (define other-config (other-get-info key default))
+       (cond [(list? other-config) (cons config-vec other-config)]
+             [else (list config-vec)])]
+      [else (other-get-info key default)])))
+

aful/unhygienic/lang/reader.rkt

@@ -0,0 +1,18 @@
+#lang lang-extension
+#:lang-extension aful make-aful-lang-reader
+#:lang-reader aful-lang
+(require lang-reader/lang-reader
+         (only-in "../../reader.rkt" wrap-reader-unhygienic))
+
+(define (make-aful-lang-reader lang-reader)
+  (define/lang-reader [-read -read-syntax -get-info] lang-reader)
+  (make-lang-reader
+   (wrap-reader-unhygienic -read)
+   (let ([read-syntax (wrap-reader-unhygienic -read-syntax)])
+     (lambda args
+       (define stx (apply read-syntax args))
+       (define old-prop (syntax-property stx 'module-language))
+       (define new-prop `#(aful/lang/language-info get-language-info ,old-prop))
+       (syntax-property stx 'module-language new-prop)))
+   -get-info))
+

aful/unhygienic/lang/runtime-config.rkt

@@ -0,0 +1,9 @@
+#lang racket/base
+
+(provide configure)
+
+(require (only-in aful/reader use-aful-readtable))
+
+(define (configure data)
+  (use-aful-readtable))
+

info.rkt

@@ -8,6 +8,9 @@
     "at-exp-lib"
     "rackjure"
     "rackunit-lib"
+    "phc-toolkit"
+    "scribble-enhanced"
+    "scribble-lib"
     ))
 
 (define build-deps
@@ -15,5 +18,6 @@
     "racket-doc"
     "scribble-doc"
     "scribble-code-examples"
+    "scribble-doc"
     ))