[1] | 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 | ;;;
|
---|