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