Added authors

doc: change source code link

.travis.yml

@@ -6,14 +6,22 @@ env:
   global:
    - RACKET_DIR=~/racket
   matrix:
-   - RACKET_VERSION=6.1.1
+   #- RACKET_VERSION=6.1.1
-   - RACKET_VERSION=6.2
+   #- RACKET_VERSION=6.2
-   - RACKET_VERSION=6.2.1
+   #- RACKET_VERSION=6.2.1
-   - RACKET_VERSION=6.3
+   #- 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=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:
@@ -32,7 +40,7 @@ install:
 before_script:
 
 script:
- - raco pkg install --deps search-auto --link aful
+ - raco pkg install -j 2 --deps search-auto --link aful
- - raco test -x -p aful
+ - raco test -r -p aful
 
 after_script:

aful/docs/aful.scrbl

@@ -6,14 +6,16 @@
                                 read read-syntax)
                      (except-in aful/reader
                                 read read-syntax)))
-
+@author[
+  "Alex Knauth"
+  @author+email["Suzanne Soy" "racket@suzanne.soy"]]
 @title{aful}
 
 @;; example: @aful-code{(map #λ(+ % 1) '(1 2 3))}
 @(define-syntax-rule @aful-code[stuff ...]
    @code[#:lang "aful racket" stuff ...])
 
-source code: @url["https://github.com/AlexKnauth/aful"]
+source code: @url["https://github.com/jsmaniac/aful/"]
 
 @section{#lang aful}
 

aful/reader.rkt

@@ -19,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)
@@ -51,7 +54,7 @@
     ((wrap-reader read) in)))
 
 (define (aful-read-syntax [src (object-name (current-input-port))] [in (current-input-port)]
-                         #:arg-str [arg-str (current-arg-string)])
+                          #:arg-str [arg-str (current-arg-string)])
   (parameterize ([current-arg-string arg-str])
     ((wrap-reader read-syntax) src in)))
 
@@ -61,19 +64,19 @@
 (require syntax/strip-context)
 (define ((wrap-reader-unhygienic p) . p-args)
   (strip-context
-   (apply (extend-reader p
+   (apply (extend-reader-unhygienic p
-                         (λ ([orig-rt (current-readtable)]
+                                    (λ ([orig-rt (current-readtable)]
-                             #:outer-scope outer-scope
+                                        #:outer-scope outer-scope
-                             #:arg-str [arg-str (current-arg-string)])
+                                        #:arg-str [arg-str (current-arg-string)])
-                           (make-aful-readtable orig-rt
+                                      (make-aful-readtable orig-rt
-                                               #:outer-scope (λ (stx [mode 'flip]) stx)
+                                                           #:outer-scope (λ (stx [mode 'flip]) stx)
-                                               #:arg-str arg-str))
+                                                           #:arg-str arg-str))
                          #:hygiene? #f)
           p-args)))
 
 (define (make-aful-readtable [orig-rt (current-readtable)]
-                            #:outer-scope outer-scope
+                             #:outer-scope outer-scope
-                            #:arg-str [arg-str (current-arg-string)])
+                             #: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)]
@@ -146,9 +149,9 @@
     (define loc-stx (build-source-location-syntax loc))
     (define λ-loc
       (update-source-location loc-stx
-        #:column (and col (+ col 1))
+                              #:column (and col (+ col 1))
-        #:position (and pos (+ pos 1))
+                              #:position (and pos (+ pos 1))
-        #:span (and stx-pos pos (max 0 (- stx-pos pos 1)))))
+                              #:span (and stx-pos pos (max 0 (- stx-pos pos 1)))))
     (hygienic-app
      #:outer-scope outer-scope
      (lambda (stx*)
@@ -157,10 +160,14 @@
                      [% (string->id stx* arg-str)]
                      [%1 (string->id stx* arg-str "1")]
                      [body stx*])
-         (syntax/loc loc-stx
+         (syntax-property
-           (lambda args
+          (syntax/top-loc loc-stx
-             (define-syntax % (make-rename-transformer #'%1))
+            (lambda args
-             body))))
+              (define-syntax % (make-rename-transformer #'%1))
+              body))
+          'scribble-render-as
+          aful-scribble-render)
+         ))
      stx)))
 
 (define (orig stx)
@@ -172,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))
+                   (define-syntax % (make-rename-transformer #'%1))
-                  (+ 2 %1 %1)))
+                   (+ 2 %1 %1)))
   (check-equal? (chk #'(+ 2 %3 %2 %1))
                 '(lambda (%1 %2 %3)
-                  (define-syntax % (make-rename-transformer #'%1))
+                   (define-syntax % (make-rename-transformer #'%1))
-                  (+ 2 %3 %2 %1)))
+                   (+ 2 %3 %2 %1)))
   (check-equal? (chk #'(apply list* % %&))
                 '(lambda (%1 . %&)
-                  (define-syntax % (make-rename-transformer #'%1))
+                   (define-syntax % (make-rename-transformer #'%1))
-                  (apply list* % %&)))
+                   (apply list* % %&)))
   (check-equal? (parameterize ([current-arg-string "_"])
                   (chk #'(apply list* _ _&)))
                 '(lambda (_1 . _&)
-                  (define-syntax _ (make-rename-transformer #'_1))
+                   (define-syntax _ (make-rename-transformer #'_1))
-                  (apply list* _ _&))))
+                   (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/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)]))

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"
     ))