1 |
|
---|
2 | ;;; *VERSION* ("1.3 28-jun-96") [PARAMETER]
|
---|
3 | ;;;
|
---|
4 | ;;; *PRINT-INFIX-COPYRIGHT* (t) [PARAMETER]
|
---|
5 | ;;; If non-NIL, prints a copyright notice upon loading this file.
|
---|
6 | ;;;
|
---|
7 | ;;; INFIX-COPYRIGHT (&optional (stream *standard-output*)) [FUNCTION]
|
---|
8 | ;;; Prints an INFIX copyright notice and header upon startup.
|
---|
9 | ;;;
|
---|
10 | ;;; *INFIX-READTABLE* ((copy-readtable nil)) [PARAMETER]
|
---|
11 | ;;;
|
---|
12 | ;;; *NORMAL-READTABLE* ((copy-readtable nil)) [PARAMETER]
|
---|
13 | ;;;
|
---|
14 | ;;; INFIX-ERROR (format-string &rest args) [MACRO]
|
---|
15 | ;;;
|
---|
16 | ;;; INFIX-READER (stream subchar arg) [FUNCTION]
|
---|
17 | ;;;
|
---|
18 | ;;; STRING->PREFIX (string) [FUNCTION]
|
---|
19 | ;;; Convert a string to a prefix s-expression using the infix reader.
|
---|
20 | ;;; If the argument is not a string, just return it as is.
|
---|
21 | ;;;
|
---|
22 | ;;; READ-INFIX (stream) [FUNCTION]
|
---|
23 | ;;;
|
---|
24 | ;;; READ-REGULAR (stream) [FUNCTION]
|
---|
25 | ;;;
|
---|
26 | ;;; SAME-OPERATOR-P (x y) [FUNCTION]
|
---|
27 | ;;;
|
---|
28 | ;;; SAME-TOKEN-P (x y) [FUNCTION]
|
---|
29 | ;;;
|
---|
30 | ;;; *PEEKED-TOKEN* (nil) [VARIABLE]
|
---|
31 | ;;;
|
---|
32 | ;;; READ-TOKEN (stream) [FUNCTION]
|
---|
33 | ;;;
|
---|
34 | ;;; PEEK-TOKEN (stream) [FUNCTION]
|
---|
35 | ;;;
|
---|
36 | ;;; FANCY-NUMBER-FORMAT-P (left operator stream) [FUNCTION]
|
---|
37 | ;;;
|
---|
38 | ;;; VALID-NUMBERP (string) [FUNCTION]
|
---|
39 | ;;;
|
---|
40 | ;;; GATHER-SUPERIORS (previous-operator stream) [FUNCTION]
|
---|
41 | ;;; Gathers an expression whose operators all exceed the precedence of
|
---|
42 | ;;; the operator to the left.
|
---|
43 | ;;;
|
---|
44 | ;;; GET-FIRST-TOKEN (stream) [FUNCTION]
|
---|
45 | ;;;
|
---|
46 | ;;; APPLY-TOKEN-PREFIX-OPERATOR (token stream) [FUNCTION]
|
---|
47 | ;;;
|
---|
48 | ;;; GET-NEXT-TOKEN (stream left) [FUNCTION]
|
---|
49 | ;;;
|
---|
50 | ;;; APPLY-TOKEN-INFIX-OPERATOR (token left stream) [FUNCTION]
|
---|
51 | ;;;
|
---|
52 | ;;; INFIX-READ-DELIMITED-LIST (end-token delimiter-token stream) [FUNCTION]
|
---|
53 | ;;;
|
---|
54 | ;;; *OPERATOR-ORDERING* ('(([ |(| !) (^) (~) (* / %) (+ -) (<< >>) [PARAMETER]
|
---|
55 | ;;; (< == > <= != >=) (&) (^^) (|\||) (not)
|
---|
56 | ;;; (and) (or) (= |:=| += -= *= /=) (|,|) (if)
|
---|
57 | ;;; (then else) (] |)|) (%infix-end-token%)))
|
---|
58 | ;;; Ordered list of operators of equal precedence.
|
---|
59 | ;;;
|
---|
60 | ;;; OPERATOR-LESSP (op1 op2) [FUNCTION]
|
---|
61 | ;;;
|
---|
62 | ;;; *RIGHT-ASSOCIATIVE-OPERATORS* ('(^ =)) [PARAMETER]
|
---|
63 | ;;;
|
---|
64 | ;;; OPERATOR-RIGHT-ASSOCIATIVE-P (operator) [FUNCTION]
|
---|
65 | ;;;
|
---|
66 | ;;; *TOKEN-OPERATORS* (nil) [VARIABLE]
|
---|
67 | ;;;
|
---|
68 | ;;; *TOKEN-PREFIX-OPERATOR-TABLE* ((make-hash-table)) [VARIABLE]
|
---|
69 | ;;;
|
---|
70 | ;;; *TOKEN-INFIX-OPERATOR-TABLE* ((make-hash-table)) [VARIABLE]
|
---|
71 | ;;;
|
---|
72 | ;;; TOKEN-OPERATOR-P (token) [FUNCTION]
|
---|
73 | ;;;
|
---|
74 | ;;; GET-TOKEN-PREFIX-OPERATOR (token) [FUNCTION]
|
---|
75 | ;;;
|
---|
76 | ;;; GET-TOKEN-INFIX-OPERATOR (token) [FUNCTION]
|
---|
77 | ;;;
|
---|
78 | ;;; DEFINE-TOKEN-OPERATOR (operator-name &key (prefix nil prefix-p) [MACRO]
|
---|
79 | ;;; (infix nil infix-p))
|
---|
80 | ;;;
|
---|
81 | ;;; DEFINE-CHARACTER-TOKENIZATION (char function) [MACRO]
|
---|
82 | ;;;
|
---|
83 | ;;; POST-PROCESS-EXPRESSION (expression) [FUNCTION]
|
---|
84 | ;;;
|
---|
85 | ;;; *TEST-CASES* ('(("1 * +2" (* 1 2)) ("1 * -2" (* 1 (- 2))) ("1 [PARAMETER]
|
---|
86 | ;;; * /2" (* 1 (/ 2))) ("/2" (/ 2)) ("not true"
|
---|
87 | ;;; (not true)) ("foo\\-bar" foo-bar) ("a + b-c"
|
---|
88 | ;;; (+ a b (- c))) ("a + b\\-c" (+ a b-c)) ("f\\oo"
|
---|
89 | ;;; |foo|)
|
---|
90 | ;;; ("!foo-bar * 2" (* foo-bar 2)) ("!(foo bar baz)"
|
---|
91 | ;;; (foo bar baz)) ("!foo-bar " foo-bar) ("!foo-bar"
|
---|
92 | ;;; foo-bar)
|
---|
93 | ;;; ("a+-b" (+ a (- b))) ("a+b" (+ a b)) ("a+b*c" (+
|
---|
94 | ;;; a (* b c))) ("a+b+c" (+ a b c)) ("a+b-c" (+ a b
|
---|
95 | ;;; (- c))) ("a+b-c+d" (+ a b (- c) d)) ("a+b-c-d" (+
|
---|
96 | ;;; a b (- c) (- d))) ("a-b" (- a b)) ("a*b" (* a b))
|
---|
97 | ;;; ("a*b*c" (* a b c)) ("a*b+c" (+ (* a b) c))
|
---|
98 | ;;; ("a/b" (/ a b)) ("a^b" (expt a b)) ("foo/-bar"
|
---|
99 | ;;; (/ foo (- bar))) ("1+2*3^4" (+ 1
|
---|
100 | ;;; (* 2 (expt 3 4)))) ("1+2*3^4+5" (+ 1 (* 2
|
---|
101 | ;;; (expt 3 4)) 5)) ("2*3^4+1" (+ (* 2 (expt 3 4))
|
---|
102 | ;;; 1))
|
---|
103 | ;;; ("2+3^4*5" (+ 2 (* (expt 3 4) 5))) ("2^3^4" (expt
|
---|
104 | ;;; 2 (expt 3 4))) ("x^2 + y^2" (+ (expt x 2)
|
---|
105 | ;;; (expt y 2))) ("(1+2)/3" (/ (+ 1 2) 3)) ("(a=b)"
|
---|
106 | ;;; (setq a b)) ("(a=b,b=c)"
|
---|
107 | ;;; (progn (setq a b) (setq b c))) ("1*(2+3)" (* 1
|
---|
108 | ;;; (+ 2 3))) ("1+2/3" (+ 1 (/ 2 3))) ("a,b" (progn a
|
---|
109 | ;;; b))
|
---|
110 | ;;; ("a,b,c" (progn a b c)) ("foo(a,b,(c,d))"
|
---|
111 | ;;; (foo a b (progn c d))) ("foo(a,b,c)" (foo a b c))
|
---|
112 | ;;; ("(a+b,c)" (progn (+ a b) c)) ("1" 1) ("-1"
|
---|
113 | ;;; (- 1)) ("+1" 1) ("1." 1) ("1.1" 1.1) ("1e3"
|
---|
114 | ;;; 1000.0)
|
---|
115 | ;;; ("1e-3" 0.001) ("1f-3" 0.001) ("1e-3e" (- 1e 3e))
|
---|
116 | ;;; ("!1e-3 " 0.001) ("a and b and c" (and a b c))
|
---|
117 | ;;; ("a and b or c" (or (and a b) c)) ("a and b" (and
|
---|
118 | ;;; a b))
|
---|
119 | ;;; ("a or b and c" (or a (and b c))) ("a or b" (or a
|
---|
120 | ;;; b))
|
---|
121 | ;;; ("a<b and b<c" (and (< a b) (< b c))) ("if (if a
|
---|
122 | ;;; then b else c) then e"
|
---|
123 | ;;; (when (if a b c) e)) ("if 1 then 2 else 3+4" (if
|
---|
124 | ;;; 1 2 (+ 3 4))) ("(if 1 then 2 else 3)+4" (+
|
---|
125 | ;;; (if 1 2 3) 4)) ("if a < b then b else a" (if
|
---|
126 | ;;; (< a b) b a)) ("if a and b then c and d else e
|
---|
127 | ;;; and f" (if (and a b) (and c d) (and e f))) ("if a
|
---|
128 | ;;; or b then c or d else e or f"
|
---|
129 | ;;; (if (or a b) (or c d) (or e f))) ("if a then (if
|
---|
130 | ;;; b then c else d) else e"
|
---|
131 | ;;; (if a (if b c d) e)) ("if a then (if b then c)
|
---|
132 | ;;; else d" (if a (when b c) d)) ("if a then b else
|
---|
133 | ;;; c" (if a b c)) ("if a then b" (when a b)) ("if a
|
---|
134 | ;;; then if b then c else d else e"
|
---|
135 | ;;; (if a (if b c d) e)) ("if a then if b then c else
|
---|
136 | ;;; d" (when a (if b c d))) ("if if a then b else c
|
---|
137 | ;;; then e" (when (if a b c) e)) ("if not a and not b
|
---|
138 | ;;; then c" (when (and (not a) (not b)) c)) ("if not
|
---|
139 | ;;; a then not b else not c and d"
|
---|
140 | ;;; (if (not a) (not b) (and (not c) d))) ("not a and
|
---|
141 | ;;; not b" (and (not a) (not b))) ("not a or not b"
|
---|
142 | ;;; (or (not a) (not b))) ("not a<b and not b<c" (and
|
---|
143 | ;;; (not (< a b)) (not (< b c)))) ("not a<b" (not (<
|
---|
144 | ;;; a b)))
|
---|
145 | ;;; ("a[i,k]*b[j,k]" (* (aref a i k) (aref b j k)))
|
---|
146 | ;;; ("foo(bar)=foo[bar,baz]"
|
---|
147 | ;;; (setf (foo bar) (aref foo bar baz)))
|
---|
148 | ;;; ("foo(bar,baz)" (foo bar baz)) ("foo[bar,baz]"
|
---|
149 | ;;; (aref foo bar baz)) ("foo[bar,baz]=barf"
|
---|
150 | ;;; (setf (aref foo bar baz) barf)) ("max = if a < b
|
---|
151 | ;;; then b else a" (setq max (if (< a b) b a))) ("a <
|
---|
152 | ;;; b < c" (< a b c)) ("a < b <= c"
|
---|
153 | ;;; (and (< a b) (<= b c))) ("a <= b <= c" (<= a b
|
---|
154 | ;;; c))
|
---|
155 | ;;; ("a <= b <= c" (<= a b c)) ("a!=b and b<c"
|
---|
156 | ;;; (and (not (= a b)) (< b c))) ("a!=b" (not (= a
|
---|
157 | ;;; b)))
|
---|
158 | ;;; ("a<b" (< a b)) ("a==b" (= a b)) ("a*b(c)+d"
|
---|
159 | ;;; (+ (* a (b c)) d)) ("a+b(c)*d" (+ a (* (b c) d)))
|
---|
160 | ;;; ("a+b(c)+d" (+ a (b c) d)) ("d+a*b(c)"
|
---|
161 | ;;; (+ d (* a (b c)))) ("+a+b" (+ a b)) ("-a+b" (+ (-
|
---|
162 | ;;; a) b))
|
---|
163 | ;;; ("-a-b" (+ (- a) (- b))) ("-a-b-c" (+ (- a) (- b)
|
---|
164 | ;;; (- c))) ("a*b/c" (/ (* a b) c)) ("a+b-c" (+ a b
|
---|
165 | ;;; (- c))) ("a-b-c" (- a b c)) ("a/b*c" (* (/ a b)
|
---|
166 | ;;; c))
|
---|
167 | ;;; ("a/b/c" (/ a b c)) ("/a/b" (/ (* a b))) ("a^b^c"
|
---|
168 | ;;; (expt a (expt b c))) ("a(d)^b^c" (expt (a d)
|
---|
169 | ;;; (expt b c))) ("a<b+c<d" (< a (+ b c) d))
|
---|
170 | ;;; ("1*~2+3" (+ (* 1 (lognot 2)) 3)) ("1+~2*3" (+ 1
|
---|
171 | ;;; (* (lognot 2) 3))) ("1+~2+3" (+ 1 (lognot 2) 3))
|
---|
172 | ;;; ("f(a)*=g(b)" (setf (f a) (* (f a) (g b))))
|
---|
173 | ;;; ("f(a)+=g(b)" (incf (f a) (g b))) ("f(a)-=g(b)"
|
---|
174 | ;;; (decf (f a) (g b))) ("f(a)/=g(b)" (setf (f a)
|
---|
175 | ;;; (/ (f a) (g b)))) ("a&b" (logand a b)) ("a^^b"
|
---|
176 | ;;; (logxor a b)) ("a|b" (logior a b)) ("a<<b"
|
---|
177 | ;;; (ash a b)) ("a>>b" (ash a (- b))) ("~a"
|
---|
178 | ;;; (lognot a)) ("a&&b" (and a b)) ("a||b" (or a b))
|
---|
179 | ;;; ("a%b" (mod a b)) ("x^2 ; the x coordinate +
|
---|
180 | ;;; y^2 ; the y coordinate" :error)
|
---|
181 | ;;; ("x^2 ; the x coordinate + y^2 ; the y
|
---|
182 | ;;; coordinate " (+ (expt x 2) (expt y 2)))
|
---|
183 | ;;; ("foo(bar,baz" :error) ("foo(bar,baz))"
|
---|
184 | ;;; (foo bar baz)) ("foo[bar,baz]]" :error)
|
---|
185 | ;;; ("[foo,bar]" :error) ("and a" :error)
|
---|
186 | ;;; ("< a" :error) ("=bar" :error) ("*bar" :error)
|
---|
187 | ;;; ("a not b" :error) ("a if b then c" :error)
|
---|
188 | ;;; ("" :error) (")a" :error) ("]a" :error)))
|
---|
189 | ;;;
|
---|
190 | ;;; TEST-INFIX (&optional (tests *test-cases*)) [FUNCTION]
|
---|
191 | ;;;
|
---|
192 | ;;; TEST-INFIX-CASE (string result) [FUNCTION]
|
---|
193 | ;;;
|
---|