diff --git a/afl/reader.rkt b/afl/reader.rkt index 5adc71a..d68adb1 100644 --- a/afl/reader.rkt +++ b/afl/reader.rkt @@ -32,15 +32,17 @@ (parameterize ([current-readtable (make-afl-readtable orig-readtable)]) (apply p args)))) -(define (make-afl-readtable [orig-rt (current-readtable)]) - (define reader-proc (make-reader-proc orig-rt)) +(define (make-afl-readtable [orig-rt (current-readtable)] #:arg-char [arg-char #\%]) + (define reader-proc (make-reader-proc orig-rt #:arg-char arg-char)) (let* ([rt orig-rt] [rt (make-readtable rt #\λ 'dispatch-macro reader-proc)] [rt (make-readtable rt #\f 'dispatch-macro reader-proc)] [rt (make-readtable rt #\l 'dispatch-macro reader-proc)]) rt)) -(define ((make-reader-proc [orig-rt (current-readtable)]) + + +(define ((make-reader-proc [orig-rt (current-readtable)] #:arg-char [arg-char #\%]) char in source line column pos) (define (unget-normal-read-syntax str src in) (define rt (current-readtable)) @@ -50,20 +52,24 @@ (and (equal? str (peek-string (string-length str) 0 in)) (read-string (string-length str) in))) (cond [(char=? char #\l) - (cond [(peek/read? "ambda" in) (parse (read-syntax source in))] + (cond [(peek/read? "ambda" in) (parse (read-syntax source in) #:arg-char arg-char)] [else (unget-normal-read-syntax "#l" source in)])] [(char=? char #\f) - (cond [(peek/read? "n" in) (parse (read-syntax source in))] - [(peek/read? "unction" in) (parse (read-syntax source in))] + (cond [(peek/read? "n" in) (parse (read-syntax source in) #:arg-char arg-char)] + [(peek/read? "unction" in) (parse (read-syntax source in) #:arg-char arg-char)] [else (unget-normal-read-syntax "#f" source in)])] - [(char=? char #\λ) (parse (read-syntax source in))] + [(char=? char #\λ) (parse (read-syntax source in) #:arg-char arg-char)] ;[else (unget-normal-read-syntax (string #\# char) source in)] - [else (parse (read-syntax source in))] ;single letter e.g. #λ + [else (parse (read-syntax source in) #:arg-char arg-char)] ;single letter e.g. #λ )) -(define (parse stx) - (with-syntax ([args (parse-args stx)] - [%1 (datum->syntax stx '%1 stx)] +(define (parse stx #:arg-char [arg-char #\%]) + (define arg-str (string arg-char)) + (define (string->id stx . strs) + (datum->syntax stx (string->symbol (apply string-append strs)) stx)) + (with-syntax ([args (parse-args stx #:arg-char arg-char)] + [% (string->id #'args arg-str)] + [%1 (string->id #'args arg-str "1")] [body stx]) #'(lambda args (define-syntax % (make-rename-transformer #'%1)) @@ -91,49 +97,52 @@ (apply list* % %&)))) ;; parse-args : Stx -> KW-Formals-Stx -(define (parse-args stx) +(define (parse-args stx #:arg-char arg-char) ;; Filter the stxs to those that start with %, ;; find the maximum, find whether there are any ;; keyword arguments or a rest argument, and ;; produce kw-formals based on that. + (define arg-str (string arg-char)) (define-values (max-num rest? kws) - (find-arg-info stx)) + (find-arg-info stx #:arg-char arg-char)) (define datum-kw-formals (append (for/list ([n (in-range 1 (add1 max-num))]) - (string->symbol (string-append "%" (number->string n)))) + (string->symbol (string-append arg-str (number->string n)))) (append* (for/list ([kw (in-list kws)]) - (list kw (string->symbol (string-append "%#:" (keyword->string kw)))))) - (cond [rest? '%&] + (list kw (string->symbol (string-append arg-str "#:" (keyword->string kw)))))) + (cond [rest? (string->symbol (string-append arg-str "&"))] [else '()]))) (datum->syntax stx datum-kw-formals stx)) ;; find-arg-info : Any -> (Values Natural Boolean (Listof Keyword)) -(define (find-arg-info v) +(define (find-arg-info v #:arg-char arg-char) (match (maybe-syntax-e v) - [(? symbol? sym) (find-arg-info/sym sym)] - [(? pair? pair) (find-arg-info/pair pair)] + [(? symbol? sym) (find-arg-info/sym sym #:arg-char arg-char)] + [(? pair? pair) (find-arg-info/pair pair #:arg-char arg-char)] [_ (return)])) ;; find-arg-info/sym : Symbol -> (Values Natural Boolean (Listof Keyword)) -(define (find-arg-info/sym sym) +(define (find-arg-info/sym sym #:arg-char arg-char) + (define (arg-char? char) + (char=? char arg-char)) (match (~> sym symbol->string string->list) - [(list) (return)] - [(list #\%) (return #:max-num 1)] - [(list #\% #\&) (return #:rest? #t)] - [(list* #\% #\# #\: cs) + [(list) (return)] + [(list (? arg-char?)) (return #:max-num 1)] + [(list (? arg-char?) #\&) (return #:rest? #t)] + [(list* (? arg-char?) #\# #\: cs) (return #:kws (~> cs list->string string->keyword list))] - [(list #\% (? char-numeric? cs) ...) + [(list (? arg-char?) (? char-numeric? cs) ...) (return #:max-num (~> cs list->string string->number))] [_ (return)])) ;; find-arg-info/pair : ;; (Cons Symbol Symbol) -> (Values Natural Boolean (Listof Keyword)) -(define (find-arg-info/pair pair) +(define (find-arg-info/pair pair #:arg-char arg-char) (define-values (car.max-num car.rest? car.kws) - (find-arg-info (car pair))) + (find-arg-info (car pair) #:arg-char arg-char)) (define-values (cdr.max-num cdr.rest? cdr.kws) - (find-arg-info (cdr pair))) + (find-arg-info (cdr pair) #:arg-char arg-char)) (return #:max-num (max car.max-num cdr.max-num) #:rest? (or car.rest? cdr.rest?) #:kws (remove-duplicates (append car.kws cdr.kws)))) diff --git a/afl/tests/test.rkt b/afl/tests/test-afl-at-exp-racket.rkt similarity index 100% rename from afl/tests/test.rkt rename to afl/tests/test-afl-at-exp-racket.rkt diff --git a/afl/tests/test-afl-scribble.rkt b/afl/tests/test-afl-scribble.rkt new file mode 100644 index 0000000..521aae0 --- /dev/null +++ b/afl/tests/test-afl-scribble.rkt @@ -0,0 +1,27 @@ +#lang afl scribble/base +@(require rackunit) +@(check-equal? @#λ@title{@%}{This is a Title} + @title{This is a Title}) +#λ +@(check-equal? (map #λ(+ % 1) '(1 2 3)) + '(2 3 4)) +@(check-equal? (map #λ(+ % %2) '(1 2 3) '(1 2 3)) + '(2 4 6)) +@(check-equal? (#λ(apply list* % %&) 1 '(2 3)) + '(1 2 3)) +@(check-equal? (#λ(* 1/2 %#:m (* %#:v %#:v)) #:m 2 #:v 1) + 1) +@(check-equal? (let ([x (#λ"I am x")]) + (#λx)) + "I am x") +@(check-equal? (#λ(begin (set! % "%") %1) "%1") + "%") +@(check-equal? (map #λ@+[% 1] '(1 2 3)) + '(2 3 4)) +@(check-equal? @#λ(+ % 1)[1] + 2) +@(check-equal? @#λ@+[% 1][1] + 2) +@(check-equal? @#λ%{#λ} + "#λ") +#λ \ No newline at end of file