/
parser.rkt
114 lines (98 loc) · 3.86 KB
/
parser.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
#lang racket
(require rackunit)
(provide parse-expr)
;; While loops...
(define-syntax-rule (while test body ...)
(let loop ()
(when test
body ...
(loop))))
;; ignorable-next-char?: input-port -> boolean
;; Produces true if the next character is something we should ignore.
(define (ignorable-next-char? in)
(let ([next-ch (peek-char in)])
(cond
[(eof-object? next-ch)
#f]
[else
(not (member next-ch '(#\< #\> #\+ #\- #\, #\. #\[ #\])))])))
;; parse-expr: any input-port -> (U syntax eof)
;; Either produces a syntax object or the eof object.
(define (parse-expr source-name in)
(while (ignorable-next-char? in) (read-char in))
(let*-values ([(line column position) (port-next-location in)]
[(next-char) (read-char in)])
;; We'll use this function to generate the syntax objects by
;; default.
;; The only category this doesn't cover are brackets.
(define (default-make-syntax type)
(datum->syntax #f
(list type)
(list source-name line column position 1)))
(cond
[(eof-object? next-char) eof]
[else
(case next-char
[(#\<) (default-make-syntax 'less-than)]
[(#\>) (default-make-syntax 'greater-than)]
[(#\+) (default-make-syntax 'plus)]
[(#\-) (default-make-syntax 'minus)]
[(#\,) (default-make-syntax 'comma)]
[(#\.) (default-make-syntax 'period)]
[(#\[)
;; The slightly messy case is bracket. We keep reading
;; a list of exprs, and then construct a wrapping bracket
;; around the whole thing.
(let*-values ([(elements) (parse-exprs source-name in)]
[(following-line following-column
following-position)
(port-next-location in)])
(datum->syntax #f
`(brackets ,@elements)
(list source-name
line
column
position
(- following-position
position))))]
[(#\])
eof])])))
;; parse-exprs: input-port -> (listof syntax)
;; Parse a list of expressions.
(define (parse-exprs source-name in)
(let ([next-expr (parse-expr source-name in)])
(cond
[(eof-object? next-expr)
empty]
[else
(cons next-expr (parse-exprs source-name in))])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; simple tests
(check-equal? eof (parse-expr 'test (open-input-string "")))
(check-equal? '(greater-than)
(syntax->datum (parse-expr 'test (open-input-string ">"))))
(check-equal? '(less-than)
(syntax->datum (parse-expr 'test (open-input-string "<"))))
(check-equal? '(plus)
(syntax->datum (parse-expr 'test (open-input-string "+"))))
(check-equal? '(minus)
(syntax->datum (parse-expr 'test (open-input-string "-"))))
(check-equal? '(comma)
(syntax->datum (parse-expr 'test (open-input-string ","))))
(check-equal? '(period)
(syntax->datum (parse-expr 'test (open-input-string "."))))
;; bracket tests
(check-equal? '(brackets)
(syntax->datum (parse-expr 'test (open-input-string "[]"))))
(check-equal? '(brackets (brackets))
(syntax->datum (parse-expr 'test (open-input-string "[[]]"))))
;; Parsing the "cat" function
(let ([port (open-input-string ",[.,]")])
(check-equal? '(comma)
(syntax->datum (parse-expr 'test port)))
(check-equal? '(brackets (period) (comma))
(syntax->datum (parse-expr 'test port)))
(check-equal? eof
(parse-expr 'test port)))