lambda-reader.rkt

#lang racket/base

(require syntax/parse
         racket/match
         racket/port
         (only-in racket/list filter-map remove-duplicates)
         rackjure/threading)

(provide -read
         -read-syntax
         lambda-readtable)

(define (%n-args stxs)
  ;; Filter the stxs to those that are %1..%9 or %, removing
  ;; duplicates and sorting textually.
  ;;
  ;; Although Clojure doc implies it supports %10 and greater, this
  ;; doesn't. INHO using that in a reader lambda would be a code
  ;; smell.
  ;;
  ;; Caveat: This does no checking for non-contiguous numbers (such as
  ;; %1 and %3 but missing %2) or for using both % and %1.
  (define (symbol< a b)
    (string<? (symbol->string a) (symbol->string b)))
  (~> (filter-map (lambda (stx)
                    (define e (syntax-e stx))
                    (and (symbol? e)
                         (match (symbol->string e)
                           [(pregexp "^%[1-9]$") stx]
                           [(pregexp "^%$")      stx]
                           [_ #f])))
                  stxs)
      (remove-duplicates #:key syntax-e)
      (sort symbol< #:key syntax-e))) ;; textual sort fine for %1 .. %9
        
(define (%&-arg? stxs)
  (for/or ([stx stxs])
    (eq? '%& (syntax-e stx))))
        
(define (parse stx)
  (syntax-parse stx
    [(xs:expr ...)
     (with-syntax ([(args ...) (%n-args (syntax->list #'(xs ...)))])
       (cond [(%&-arg? (syntax->list #'(xs ...)))
              #'(lambda (args ... . %&)
                  (xs ...))]
             [(not (null? (syntax->list #'(args ...))))
              #'(lambda (args ...)
                  (xs ...))]
             [else
              #`(vector (quote xs) ...)]))]))

(module+ test
  (require rackunit)
  (define chk (compose1 syntax->datum parse))
  (check-equal? (chk '(+ 2 %1 %1))
                '(lambda (%1) (+ 2 %1 %1)))
  (check-equal? (chk '(+ 2 %3 %2 %1))
                '(lambda (%1 %2 %3) (+ 2 %3 %2 %1)))
  (check-equal? (chk '(apply list* % %&))
                '(lambda (% . %&) (apply list* % %&))))

(define orig-readtable (current-readtable))

(define (reader-proc ch in src line col pos)
  ;; 1. When `ch` is #\( we use input-port-append to "ungetc" the #\(
  ;; so we can use read-syntax as usual.
  ;;
  ;; 2. Nested lambda literals aren't supported, so we restore the
  ;; original readtable prior to calling read-syntax.
  (let ([in (cond [(eq? ch #\()
                   (input-port-append #f (open-input-string "(") in)] ;1
                  [else in])])
    (~> (parameterize ([current-readtable orig-readtable]) ;2
          (read-syntax src in))
        parse)))

(define lambda-readtable (make-readtable orig-readtable
                                         #\(
                                         'dispatch-macro
                                         reader-proc))
(current-readtable lambda-readtable)

(define (-read in)
  (parameterize ([current-readtable lambda-readtable])
    (read in)))

(define (-read-syntax src in)
  (parameterize ([current-readtable lambda-readtable])
    (read-syntax src in)))

;; see test.rkt for tests for readtable per se