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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
head 1.1;
access;
symbols;
locks
keithp:1.1; strict;
comment @# @;
1.1
date 94.12.13.17.49.30; author keithp; state Exp;
branches;
next ;
desc
@@
1.1
log
@Initial revision
@
text
@#!/usr/local/klisp
;
; parser - test a parse table
;
;
; data abstraction
;
; a non terminal is a symbol bound to a list of lists
; a terminal is a symbol not bound to a list
; an action is a string
;
(defun non-terminalp (item)
(and (symbolp item)
(boundp item)
(listp (eval item))
)
)
(defun terminalp (item)
(or (null item)
(and (symbolp item)
(not (non-terminalp item))
)
)
)
(defun actionp (item)
(stringp item)
)
(defun null-production (p)
(if (null p)
t
elseif (stringp (car p))
(null-production (cdr p))
else
nil
)
)
(defun start-symbolp (item) (equal item start-symbol))
(defun parser (parse-table start-symbol end-token)
(patom "starting\n")
(let ((stack (list start-symbol end-token))
(input-token (lex))
(table-entry)
(tos)
)
(while stack
; (patom "stack is ")
; (print stack)
(setq tos (car stack)) (setq stack (cdr stack))
(if (non-terminalp tos)
(setq table-entry (dictionary-lookup parse-table
(list input-token tos))
)
(if (null table-entry)
(error (strcat "parser: error on " (sprint input-token)))
)
; (patom " pushing production ") (print (cadr table-entry)) (terpr)
(cond ((cadr table-entry)
(setq stack (conc (cadr table-entry) stack))
)
)
elseif (actionp tos)
(patom "token is ") (print input-token)
(patom " performing action ") (print tos) (terpr)
elseif (terminalp tos)
(if (= tos input-token)
(patom " matching token ") (print tos) (terpr)
(if (not (= tos end-token))
(setq input-token (lex))
)
else
(error (strcat "parser error on " (sprint input-token)))
)
)
)
)
)
(defun lex ()
(let ((char (getchar)))
(symbol (scons char nil) parse-dictionary)
)
)
(defun init ()
(setq parse-dictionary (new-dictionary))
(setq parse-table (new-dictionary))
(setq end-token (symbol "$" parse-dictionary))
)
(defun cadaar (l) (car (cdr (car (car l)))))
(defun bind-to-lists (atoms)
(cond (atoms (set (car atoms) '(foo)) (bind-to-lists (cdr atoms)))
(t nil)
)
)
(defun put-lists-into-parse-table (lists parse-table)
(cond (lists
(dictionary-insert parse-table (caar lists) (car lists))
(put-lists-into-parse-table (cdr lists) parse-table)
)
(t nil)
)
)
(defun process-file (file-in)
(init)
(setq terminals (fread-dictionary file-in parse-dictionary))
(setq non-terminals (fread-dictionary file-in parse-dictionary))
(bind-to-lists non-terminals)
(setq table (fread-dictionary file-in parse-dictionary))
(setq start-symbol (cadaar table))
(put-lists-into-parse-table table parse-table)
(parser parse-table (cadaar table) end-token)
)
(defun main-parser ()
(setq file-in stdin)
(if argv
(setq file-in (fopen (car argv) 'r))
(if (null file-in)
(error (strcat "parser: can't open " (sprint (car argv))))
)
)
(process-file file-in)
(fclose file-in)
)
(main-parser)
@
|
