1#lang racket/base 2(require "../common/contract.rkt" 3 "readtable.rkt" 4 (rename-in "../syntax/read-syntax.rkt" 5 [read-syntax raw:read-syntax] 6 [read-syntax/recursive raw:read-syntax/recursive] 7 [read raw:read] 8 [read/recursive raw:read/recursive] 9 [read-language raw:read-language])) 10 11(provide read-syntax 12 read-syntax/recursive 13 read 14 read/recursive 15 read-language) 16 17(define/who (read-syntax [src (object-name (current-input-port))] [in (current-input-port)]) 18 (check who input-port? in) 19 (raw:read-syntax src in)) 20 21(define/who (read-syntax/recursive [src (object-name (current-input-port))] 22 [in (current-input-port)] 23 [start #f] 24 [readtable (current-readtable)] 25 [graph? #t]) 26 (check who input-port? in) 27 (check who char? #:or-false start) 28 (check who readtable? #:or-false readtable) 29 (raw:read-syntax/recursive src in start readtable graph?)) 30 31(define/who (read [in (current-input-port)]) 32 (check who input-port? in) 33 (raw:read in)) 34 35(define/who (read/recursive [in (current-input-port)] 36 [start #f] 37 [readtable (current-readtable)] 38 [graph? #t]) 39 (check who input-port? in) 40 (check who char? #:or-false start) 41 (check who readtable? #:or-false readtable) 42 (raw:read/recursive in start readtable graph?)) 43 44(define/who (read-language [in (current-input-port)] 45 [fail-thunk read-language-fail-thunk]) 46 (check who input-port? in) 47 (check who (procedure-arity-includes/c 0) fail-thunk) 48 (raw:read-language in (if (eq? fail-thunk read-language-fail-thunk) 49 #f 50 fail-thunk))) 51 52;; Not actually called --- just used to recognize a default 53(define (read-language-fail-thunk) (error "fail")) 54