4223
|
1 #!../ploki
|
|
2 FOR main "> "
|
|
3 LET line @LEGS \EING
|
|
4 IF line ; ""
|
|
5 LET px @parse line
|
|
6 LET s @shiftws (px . 1)
|
|
7 IF s [ -1 : "\n"
|
|
8 LET s ]= -1
|
|
9 FI
|
|
10 IF @TYPE OF (px . 0) : "list"
|
|
11 IF s : ""
|
|
12 @eval (px . 0) _"
|
|
13 ELSE
|
|
14 "error: trailing garbage at --> \Vs
|
|
15 FI
|
|
16 ELSE
|
|
17 IF s : ""
|
|
18 LET s " at end of input"
|
|
19 ELSE
|
|
20 LET s " at --> \Vs"
|
|
21 FI
|
|
22 "error: \V(px . 0)\Vs
|
|
23 FI
|
|
24 NEXT main
|
|
25 FI
|
|
26 "EOF
|
|
27 KTHX
|
|
28
|
|
29 FOR shiftws LEET s \@
|
|
30 IF s ~ "^{s!+}"
|
|
31 KTHX s [ @+0
|
|
32 FI
|
|
33 KTHX s
|
|
34
|
|
35 FOR parse LEET s \@
|
|
36 LEET first @mult s
|
|
37 IF @TYPE OF (first . 0) ; "list"
|
|
38 KTHX first
|
|
39 FI
|
|
40 LET s first . 1
|
|
41 LEET op
|
|
42 LEET second
|
|
43 10 IF s ~ "^s!*{'+-'}"
|
|
44 LET op "b\V\0"
|
|
45 LET s [= @+0
|
|
46 LET second @mult s
|
|
47 IF @TYPE OF (second . 0) ; "list"
|
|
48 KTHX second
|
|
49 FI
|
|
50 LET s second . 1
|
|
51 LET first #<#<op (first . 0) (second . 0)#> s#>
|
|
52 GOFOR 10
|
|
53 FI
|
|
54 KTHX first
|
|
55
|
|
56 FOR mult LEET s \@
|
|
57 LEET first @pow s
|
|
58 IF @TYPE OF (first . 0) ; "list"
|
|
59 KTHX first
|
|
60 FI
|
|
61 LET s first . 1
|
|
62 LEET op
|
|
63 LEET second
|
|
64 10 IF s ~ "^s!*{'/%'|*![*!^]}"
|
|
65 LET op "b\V\0"
|
|
66 LET s [= @+0
|
|
67 LET second @pow s
|
|
68 IF @TYPE OF (second . 0) ; "list"
|
|
69 KTHX second
|
|
70 FI
|
|
71 LET s second . 1
|
|
72 LET first #<#<op (first . 0) (second . 0)#> s#>
|
|
73 GOFOR 10
|
|
74 FI
|
|
75 KTHX first
|
|
76
|
|
77 FOR pow LEET s \@
|
|
78 LEET first @term s
|
|
79 IF @TYPE OF (first . 0) ; "list"
|
|
80 KTHX first
|
|
81 FI
|
|
82 LET s first . 1
|
|
83 IF s ~ "^s!*{^!|*!*!}"
|
|
84 LET s [= @+0
|
|
85 LEET second @pow s
|
|
86 IF @TYPE OF (second . 0) ; "list"
|
|
87 KTHX second
|
|
88 FI
|
|
89 LET s second . 1
|
|
90 KTHX #<#<"b^" (first . 0) (second . 0)#> s#>
|
|
91 FI
|
|
92 KTHX first
|
|
93
|
|
94 FOR term LEET s \@
|
|
95 IF s ~ "^s!*(!{}"
|
|
96 LET s [= @+0
|
|
97 LEET tmp @parse s
|
|
98 IF @TYPE OF (tmp . 0) ; "list"
|
|
99 KTHX tmp
|
|
100 FI
|
|
101 LET s tmp . 1
|
|
102 IF s ~ "^s!*)!{}"
|
|
103 LET s [= @+0
|
|
104 KTHX #<(tmp . 0) s#>
|
|
105 FI
|
|
106 KTHX #<"`)' expected" s#>
|
|
107 FI
|
|
108 IF s ~ "^s!*{d!+(.!d!*)?|.!d!+}"
|
|
109 LET s [= @+0
|
|
110 KTHX #<#<"n" @NUM \0#> s#>
|
|
111 FI
|
|
112 IF s ~ "^s!*{'+-'|log|exp|a?(sin|cos|tan)}"
|
|
113 LEET op \0
|
|
114 LET s [= @+0
|
|
115 LEET tmp @pow s
|
|
116 IF @TYPE OF (tmp . 0) ; "list"
|
|
117 KTHX tmp
|
|
118 FI
|
|
119 KTHX #<#<"u\Vop" (tmp . 0)#> (tmp . 1)#>
|
|
120 FI
|
|
121 IF s ~ "^s!*pi{}"
|
|
122 LET s [= @+0
|
|
123 KTHX #<#<"n" \PI#> s#>
|
|
124 FI
|
|
125 IF s ~ "^s!*e{}"
|
|
126 LET s [= @+0
|
|
127 KTHX #<#<"n" \E#> s#>
|
|
128 FI
|
|
129 KTHX #<"invalid value" s#>
|
|
130
|
|
131 FOR eval LEET e \@
|
|
132 IF e . 0 : "n"
|
|
133 KTHX e . 1
|
|
134 FI
|
|
135 IF e . 0 . 0 : "u"
|
|
136 LEET right @eval (e . 1)
|
|
137 LEET op e . 0 [ 1
|
|
138 IF op : "+"
|
|
139 KTHX right
|
|
140 FI
|
|
141 IF op : "-"
|
|
142 KTHX @NEG right
|
|
143 FI
|
|
144 IF op : "log"
|
|
145 KTHX @LN right
|
|
146 FI
|
|
147 IF op : "exp"
|
|
148 KTHX \E ^ right
|
|
149 FI
|
|
150 IF op : "sin"
|
|
151 KTHX @SIN right
|
|
152 FI
|
|
153 IF op : "cos"
|
|
154 KTHX @COS right
|
|
155 FI
|
|
156 IF op : "tan"
|
|
157 KTHX @TAN right
|
|
158 FI
|
|
159 IF op : "asin"
|
|
160 KTHX @ASIN right
|
|
161 FI
|
|
162 IF op : "acos"
|
|
163 KTHX @ACOS right
|
|
164 FI
|
|
165 IF op : "atan"
|
|
166 KTHX @ATAN right
|
|
167 FI
|
|
168 FI
|
|
169 IF e . 0 . 0 : "b"
|
|
170 LEET left @eval (e . 1)
|
|
171 LEET right @eval (e . 2)
|
|
172 LEET op e . 0 . 1
|
|
173 IF op : "+"
|
|
174 KTHX left + right
|
|
175 FI
|
|
176 IF op : "-"
|
|
177 KTHX left - right
|
|
178 FI
|
|
179 IF op : "*"
|
|
180 KTHX left * right
|
|
181 FI
|
|
182 IF op : "/"
|
|
183 KTHX left / right
|
|
184 FI
|
|
185 IF op : "%"
|
|
186 KTHX left % right
|
|
187 FI
|
|
188 IF op : "^"
|
|
189 KTHX left ^ right
|
|
190 FI
|
|
191 FI
|
|
192 KTHX
|