Compare commits
16 Commits
dev-before
...
unhygienic
Author | SHA1 | Date | |
---|---|---|---|
![]() |
e7f7270bdb | ||
![]() |
bbdf6dcc6e | ||
![]() |
096f87caab | ||
![]() |
f0a2d78036 | ||
![]() |
d3614be9fd | ||
![]() |
c8a2335574 | ||
![]() |
6fe2c2903a | ||
![]() |
67fcf59464 | ||
![]() |
25731ec47e | ||
![]() |
1c7d513cf4 | ||
![]() |
72142d5374 | ||
![]() |
7e1f74afce | ||
![]() |
9bd2f079ff | ||
![]() |
769128898b | ||
![]() |
ac539a0a33 | ||
![]() |
f20a10f0b8 |
22
.travis.yml
22
.travis.yml
|
@ -6,14 +6,22 @@ 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.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 test -x -p aful
|
||||
- raco pkg install -j 2 --deps search-auto --link aful
|
||||
- raco test -r -p aful
|
||||
|
||||
after_script:
|
||||
|
|
|
@ -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}
|
||||
|
||||
|
@ -101,4 +103,4 @@ Examples:
|
|||
|
||||
@defparam[current-arg-string arg-str string?]{
|
||||
a parameter that controls default values of the @racket[arg-str] arguments to @racket[aful-read] etc.
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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
|
||||
(λ ([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))
|
||||
(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)])
|
||||
#: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)]
|
||||
|
@ -146,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*)
|
||||
|
@ -157,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)
|
||||
|
@ -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))
|
||||
(+ 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)])
|
||||
|
|
20
aful/scribble-enhanced.rkt
Normal file
20
aful/scribble-enhanced.rkt
Normal file
|
@ -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)))]))
|
|
@ -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)]))
|
Loading…
Reference in New Issue
Block a user