-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathaaa_PLS.bas
More file actions
2114 lines (2085 loc) · 112 KB
/
aaa_PLS.bas
File metadata and controls
2114 lines (2085 loc) · 112 KB
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
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Rem 0001 <!DOCTYPE html>
Rem 0002 <html>
Rem 0003 <head>
Rem 0004 " <meta charset=""utf-8"" />"
Rem 0005 " <title>EmuLisp Console</title>"
Rem 0006 " <meta name=""generator"" content=""BBEdit 9.6"" />"
Rem 0007 " <style type=""text/css"" title=""text/css"">"
Rem 0008 body {
Rem 0009 " margin: 12px 16px 0 16px;"
Rem 0010 " background-color: #f0ecd0;"
Rem 0011 }
Rem 0012 div#head {
Rem 0013 " white-space: nowrap;"
Rem 0014 }
Rem 0015 span#presentation {
Rem 0016 " border: 1px solid gray;"
Rem 0017 " border-radius: 4px;"
Rem 0018 " padding: 4px 12px 4px 12px;"
Rem 0019 " font: 15px Optima;"
Rem 0020 " background-color: white;"
Rem 0021 }
Rem 0022 span#presentation em {
Rem 0023 " font-size: 18px;"
Rem 0024 }
Rem 0025 img#infosymbol {
Rem 0026 " position: relative;"
Rem 0027 " top: 5px;"
Rem 0028 " margin: 0 0 0 8px;"
Rem 0029 " cursor: pointer;"
Rem 0030 }
Rem 0031 div#main {
Rem 0032 " position: relative;"
Rem 0033 " top: 7px;"
Rem 0034 }
Rem 0035 div#dcons {
Rem 0036 " width: 520px;"
Rem 0037 }
Rem 0038 div#log {
Rem 0039 " margin: 0;"
Rem 0040 " width: 101.3%;"
Rem 0041 " border: 1px solid gray;"
Rem 0042 " border-bottom: none;"
Rem 0043 " overflow: auto;"
Rem 0044 " background-color: white;"
Rem 0045 }
Rem 0046 div#log pre {
Rem 0047 " margin: 0 1px 0 1px;"
Rem 0048 " padding: 2px 2px 2px 4px;"
Rem 0049 }
Rem 0050 pre.oldcode {
Rem 0051 " background-color: #f0f5f7;"
Rem 0052 " cursor: pointer;"
Rem 0053 }
Rem 0054 pre.filedrop {
Rem 0055 " border-left: 4px solid #c0c5c7;"
Rem 0056 " background-color: #f0f5f7;"
Rem 0057 }
Rem 0058 pre.print {
Rem 0059 " background-color: #def;"
Rem 0060 }
Rem 0061 pre.println {
Rem 0062 " background-color: #def;"
Rem 0063 " border-bottom: 1px solid #bcf;"
Rem 0064 }
Rem 0065 pre.result {
Rem 0066 " background-color: #dfd;"
Rem 0067 " border-bottom: 1px solid #9b9;"
Rem 0068 }
Rem 0069 pre.warning {
Rem 0070 " border-left: 4px solid #db3;"
Rem 0071 " background-color: #ffa;"
Rem 0072 }
Rem 0073 pre.error {
Rem 0074 " border-left: 4px solid #f33;"
Rem 0075 " background-color: #fdd;"
Rem 0076 }
Rem 0077 textarea#newcode {
Rem 0078 " margin: 0 0 4px 0;"
Rem 0079 " width: inherit;"
Rem 0080 " border: 1px solid gray;"
Rem 0081 " padding: 2px 0 0 6px;"
Rem 0082 " font: inherit;"
Rem 0083 }
Rem 0084 span#version {
Rem 0085 " margin-left: 8px;"
Rem 0086 " font: italic 11px Arial, sans-serif;"
Rem 0087 }
Rem 0088 div#dcons span#controls {
Rem 0089 " float: right;"
Rem 0090 }
Rem 0091 div#dcons span#controls span {
Rem 0092 " margin: 0;"
Rem 0093 " border: 1px solid gray;"
Rem 0094 " padding: 2px 4px 2px 4px;"
Rem 0095 " font: 14px monospace;"
Rem 0096 " background-color: white;"
Rem 0097 }
Rem 0098 div#dcons span#controls .nosymbol {
Rem 0099 " color: black;"
Rem 0100 " cursor: text;"
Rem 0101 }
Rem 0102 div#dcons span#controls .builtin {
Rem 0103 " color: #00e;"
Rem 0104 " cursor: pointer;"
Rem 0105 }
Rem 0106 div#dcons span#controls .othersymbol {
Rem 0107 " color: #00e;"
Rem 0108 " cursor: pointer;"
Rem 0109 " background-color: #def;"
Rem 0110 }
Rem 0111 div#dcons input[type='button'] {
Rem 0112 }
Rem 0113 div#monitor {
Rem 0114 " position: absolute;"
Rem 0115 " top: 0;"
Rem 0116 " left: 534px;"
Rem 0117 " font: 15px Optima;"
Rem 0118 }
Rem 0119 div#monitor input[type='text'] {
Rem 0120 " margin: 0 0 4px 0;"
Rem 0121 " width: 300px;"
Rem 0122 " font: 15px monospace;"
Rem 0123 }
Rem 0124 canvas#monView {
Rem 0125 " border: 1px solid gray;"
Rem 0126 " background-color: white;"
Rem 0127 }
Rem 0128 div#prefs {
Rem 0129 " visibility: hidden;"
Rem 0130 " position: absolute;"
Rem 0131 " top: 46px;"
Rem 0132 " left: 160px;"
Rem 0133 " border: 2px ridge #999;"
Rem 0134 " background-color: white;"
Rem 0135 " -moz-box-shadow: 4px 4px 8px rgba(0,0,0,0.3);"
Rem 0136 " -webkit-box-shadow: 4px 4px 8px rgba(0,0,0,0.3);"
Rem 0137 " box-shadow: 4px 4px 8px rgba(0,0,0,0.3);"
Rem 0138 " padding: 0 0 2px 0;"
Rem 0139 " font: 14px Optima;"
Rem 0140 }
Rem 0141 p.paneHead {
Rem 0142 " margin: 0 0 8px 0;"
Rem 0143 " border-bottom: 1px solid #bbb;"
Rem 0144 " background-color: #ddd;"
Rem 0145 " padding: 0 0 1px 0;"
Rem 0146 }
Rem 0147 span.closebox {
Rem 0148 " position: relative;"
Rem 0149 " margin: 0;"
Rem 0150 " left: 92%;"
Rem 0151 " border: 1px solid #999;"
Rem 0152 " background-color: #f9f9f9;"
Rem 0153 " padding: 0 3px 0 3px;"
Rem 0154 " text-align: center;"
Rem 0155 " font: 10px Arial, sans-serif;"
Rem 0156 " cursor: default;"
Rem 0157 }
Rem 0158 span.closebox:hover {
Rem 0159 " color: #d22;"
Rem 0160 }
Rem 0161 p.pref {
Rem 0162 " margin: 0 16px 8px 14px;"
Rem 0163 }
Rem 0164 div#prefs input[type='checkbox'] {
Rem 0165 " margin: 0 6px 0 0;"
Rem 0166 }
Rem 0167 div#prefs input[type='text'] {
Rem 0168 " background-color: #ffd;"
Rem 0169 " padding-left: 2px;"
Rem 0170 }
Rem 0171
Rem 0172 "/* below are the following script sections (in one script tag)"
Rem 0173 " <script src=""http://folk.uio.no/jkleiser/pico/emuLisp/src/core.js"" type=""text/javascript""></script>"
Rem 0174 <script src="http://folk.uio.no/jkleiser/pico/emuLisp/src/js.js" type="text/javascript"></script>
Rem 0175 */
Rem 0176
Rem 0177
Rem 0178 " </style>"
Rem 0179
Rem 0180 " <script src=""http://folk.uio.no/jkleiser/pico/emuLisp/src/js.js"" type=""text/javascript""></script>"
Rem 0181
Rem 0182 <script type="text/javascript">
Rem 0183 /* 26nov10jk
Rem 0184 * (c) Jon Kleiser
Rem 0185 * http://folk.uio.no/jkleiser/pico/emuLisp/src/core.js
Rem 0186 */
Rem 0187 var BOXNAT_EXP = "Boxed native object expected",
Rem 0188 " BOOL_EXP = ""Boolean expected"", CELL_EXP = ""Cell expected"", LIST_EXP = ""List expected"","
Rem 0189 " NUM_EXP = ""Number expected"", SYM_EXP = ""Symbol expected"", VAR_EXP = ""Variable expected"","
Rem 0190 " EXEC_OR_NUM_EXP = ""Executable or Number expected"","
Rem 0191 " BAD_ARG = ""Bad argument"", BAD_DOT = ""Bad dotted pair"", BAD_INPUT = ""Bad input"", DIV_0 = ""Div/0"","
Rem 0192 " NOT_MAK = ""Not making"", PROT_SYM = ""Protected symbol"", UNDEF = ""Undefined"","
Rem 0193 " JS_CTORNAME_EXP = ""Constructor name expected"", JS_RESERVED = ""Reserved word"";"
Rem 0194
Rem 0195 function getFileSync(fileUrl) {
Rem 0196 " var req = new XMLHttpRequest();"
Rem 0197 " req.open(""GET"", fileUrl, false); // synchronous"
Rem 0198 " req.overrideMimeType(""text/plain; charset=utf-8"");"
Rem 0199 " req.send(null);"
Rem 0200 " if (req.status == 0) {"
Rem 0201 " return req.responseText;"
Rem 0202 " }"
Rem 0203 " throw new Error(""XMLHttpRequest status: "" + req.status);"
Rem 0204 }
Rem 0205
Rem 0206 var NILTYPE = 0, NUMBERTYPE = 1, SYMBOLTYPE = 2, CELLTYPE = 3, TRUETYPE = 4;
Rem 0207
Rem 0208 Number.prototype.TYPEVAL = NUMBERTYPE;
Rem 0209
Rem 0210 function lispToStr(x) {
Rem 0211 " //if (!confirm(""lispToStr: "" + x.toString() + "", "" + x.TYPEVAL)) throw new Error(""lispToStr aborted"");"
Rem 0212 " return x.toString();"
Rem 0213 }
Rem 0214
Rem 0215 function unknown(x) {
Rem 0216 " if (!confirm(""Unknown Lisp type: "" + x)) throw new Error(""unknown aborted"");"
Rem 0217 " return ""???"";"
Rem 0218 }
Rem 0219
Rem 0220 function valueToStr(x) {
Rem 0221 " //if (!confirm(""valueToStr "" + lispToStr(x))) throw new Error(""valueToStr aborted"");"
Rem 0222 " return (x instanceof Number) ? x.toString() :"
Rem 0223 " (x instanceof Symbol) ? x.toValueString() :"
Rem 0224 " (x instanceof Cell) ? x.toValueString() : unknown(x);"
Rem 0225 }
Rem 0226
Rem 0227 function Cell(car, cdr) {
Rem 0228 " this.car = car;"
Rem 0229 " this.cdr = cdr;"
Rem 0230 }
Rem 0231
Rem 0232 Cell.prototype.TYPEVAL = CELLTYPE;
Rem 0233
Rem 0234 Cell.prototype.getVal = function() {
Rem 0235 " return this.car;"
Rem 0236 }
Rem 0237
Rem 0238 Cell.prototype.setVal = function(val) {
Rem 0239 " this.car = val;"
Rem 0240 }
Rem 0241
Rem 0242 Cell.prototype.toString = function() {
Rem 0243 " if (this.car === QUOTE) return ""'"" + lispToStr(this.cdr);"
Rem 0244 " var arr = [], c = this;"
Rem 0245 " do {"
Rem 0246 " arr.push(lispToStr(c.car));"
Rem 0247 " c = c.cdr;"
Rem 0248 " //if (!confirm(""Cell.toString: "" + lispToStr(c.car))) throw new Error(""Cell.toString aborted"");"
Rem 0249 " if (c === this) { arr.push("".""); c = NIL; } // why didn't break work here?"
Rem 0250 " } while (c instanceof Cell);"
Rem 0251 " if (c !== NIL) {"
Rem 0252 " arr.push(""."", lispToStr(c)); // last Cell was dotted"
Rem 0253 " }"
Rem 0254 " return ""("" + arr.join("" "") + "")"";"
Rem 0255 }
Rem 0256
Rem 0257 Cell.prototype.toValueString = function() {
Rem 0258 " var str = """", c = this;"
Rem 0259 " do {"
Rem 0260 " str += valueToStr(c.car);"
Rem 0261 " c = c.cdr;"
Rem 0262 " } while (c instanceof Cell);"
Rem 0263 " if (c !== NIL) {"
Rem 0264 " str += valueToStr(c); // last Cell was dotted"
Rem 0265 " }"
Rem 0266 " return str;"
Rem 0267 }
Rem 0268
Rem 0269 function Symbol(name, val) {
Rem 0270 " this.name = name;"
Rem 0271 " this.trans = false;"
Rem 0272 " this.cdr = (val === undefined) ? NIL : val;"
Rem 0273 " this.props = NIL;"
Rem 0274 }
Rem 0275
Rem 0276 function newTransSymbol(name) {
Rem 0277 " var ts = new Symbol(name);"
Rem 0278 " ts.trans = true;"
Rem 0279 " ts.cdr = ts;"
Rem 0280 " return ts;"
Rem 0281 }
Rem 0282
Rem 0283 // Creates and returns a new anonymous symbol
Rem 0284 function box(val) {
Rem 0285 " var ts = new Symbol(null, val);"
Rem 0286 " ts.trans = true;"
Rem 0287 " return ts;"
Rem 0288 }
Rem 0289
Rem 0290 function boxNativeObject(obj) {
Rem 0291 " var ts = newTransSymbol(null);"
Rem 0292 " ts.obj = obj;"
Rem 0293 " return ts;"
Rem 0294 }
Rem 0295
Rem 0296 Symbol.prototype.TYPEVAL = SYMBOLTYPE;
Rem 0297
Rem 0298 Symbol.prototype.getVal = function() {
Rem 0299 " return this.cdr;"
Rem 0300 }
Rem 0301
Rem 0302 Symbol.prototype.valueOf = function() {
Rem 0303 " return this.name;"
Rem 0304 }
Rem 0305
Rem 0306 Symbol.prototype.setVal = function(val) {
Rem 0307 " if (this.lock) throw new Error(newErrMsg(PROT_SYM, this));"
Rem 0308 " this.cdr = val;"
Rem 0309 }
Rem 0310
Rem 0311 // Internal symbol names can consist of any printable (non-whitespace) character,
Rem 0312 "// except for the following meta characters: "" ' ( ) , [ ] ` ~ { }"
Rem 0313 // It is possible, though, to include these special characters into symbol names
Rem 0314 // by escaping them with a backslash '\'.
Rem 0315 Symbol.prototype.escName = function() {
Rem 0316 " var eName = this.name.replace(/\\/g, ""\\\\"");"
Rem 0317 " eName = eName.replace(/\^/g, ""Error! Hyperlink reference not valid."");"
Rem 0318 " eName = eName.replace(/\t/g, ""^I"");"
Rem 0319 " eName = eName.replace(/\r/g, ""^M"");"
Rem 0320 " eName = eName.replace(/\n/g, ""^J"");"
Rem 0321 " //if (eName != this.name) alert(""Symbol.escName: "" + this.name + "" -> "" + eName);"
Rem 0322 " return eName;"
Rem 0323 }
Rem 0324
Rem 0325 Symbol.prototype.noName = function() {
Rem 0326 " return (this.obj !== undefined) ? ""$"" + typeof this.obj : ""$*"";"
Rem 0327 }
Rem 0328
Rem 0329 Symbol.prototype.toString = function() {
Rem 0330 " return this.trans ? (this.name != null) ? ('""' + this.escName() + '""') : this.noName() : this.name;"
Rem 0331 }
Rem 0332
Rem 0333 Symbol.prototype.toValueString = function() {
Rem 0334 " return (this === NIL) ? """" : (this.name != null) ? this.name : this.noName();"
Rem 0335 }
Rem 0336
Rem 0337 Symbol.prototype.pushValue = function(val) {
Rem 0338 " if (this.stack === undefined) this.stack = [];"
Rem 0339 " this.stack.push(this.cdr);"
Rem 0340 " this.cdr = val;"
Rem 0341 }
Rem 0342
Rem 0343 Symbol.prototype.popValue = function() {
Rem 0344 " var pv = this.cdr;"
Rem 0345 " this.cdr = this.stack.pop();"
Rem 0346 " //if (this.stack.length === 0) delete this.stack;"
Rem 0347 " return pv;"
Rem 0348 }
Rem 0349
Rem 0350 function getSymbol(name, editMode) {
Rem 0351 " if (name in gEmptyObj) throw new Error(newErrMsg(JS_RESERVED, name));"
Rem 0352 " var s = gSym[name];"
Rem 0353 " if (s === undefined) {"
Rem 0354 " s = new Symbol(name, NIL);"
Rem 0355 " if (! editMode) gSym[name] = s;"
Rem 0356 " }"
Rem 0357 " return s;"
Rem 0358 }
Rem 0359
Rem 0360 function setSymbolValue(s, val) {
Rem 0361 " if (!(s instanceof Symbol)) throw new Error(newErrMsg(VAR_EXP, s));"
Rem 0362 " s.setVal(val);"
Rem 0363 }
Rem 0364
Rem 0365 function Source(text, chars) {
Rem 0366 " this.src = text;"
Rem 0367 " // character limitation for symbols"
Rem 0368 " if (chars instanceof Symbol) {"
Rem 0369 " this.charset = chars.valueOf();"
Rem 0370 " } else if (typeof chars == ""string"") {"
Rem 0371 " //alert(""Source2: "" + chars);"
Rem 0372 " this.charset = chars;"
Rem 0373 " }"
Rem 0374 " this.pos = 0;"
Rem 0375 " this.trace = null;"
Rem 0376 }
Rem 0377
Rem 0378 Source.prototype.CLOSEPAREN = -1;
Rem 0379 Source.prototype.CLOSESYM = -2;
Rem 0380 Source.prototype.QUOTE2 = -3;
Rem 0381 Source.prototype.EOF = null;
Rem 0382
Rem 0383 Source.prototype.unescMap = {I: "\t", i: "\t", J: "\n", j: "\n", M: "\r", m: "\r"};
Rem 0384
Rem 0385 Source.prototype.getNextSignificantChar = function() {
Rem 0386 " while (this.pos < this.src.length) {"
Rem 0387 " while (this.src.charAt(this.pos) == ""#"") {"
Rem 0388 " var ch;"
Rem 0389 " do { ch = this.src.charAt(this.pos++); } while ((ch != ""\n"") && (this.pos < this.src.length));"
Rem 0390 " }"
Rem 0391 " if (this.src.charAt(this.pos) == ""\\"") this.pos++;"
Rem 0392 " if ("" \t\r\n"".indexOf(this.src.charAt(this.pos)) == -1) return this.src.charAt(this.pos++);"
Rem 0393 " this.pos++;"
Rem 0394 " }"
Rem 0395 " return this.EOF;"
Rem 0396 }
Rem 0397
Rem 0398 Source.prototype.getNextStringChar = function() {
Rem 0399 " while (this.pos < this.src.length) {"
Rem 0400 " var ch = this.src.charAt(this.pos++);"
Rem 0401 " if (ch == ""\"""") return this.QUOTE2;"
Rem 0402 " if (ch == ""\\"") return this.src.charAt(this.pos++);"
Rem 0403 " if (ch != ""^"") return ch;"
Rem 0404 " ch = this.unescMap[this.src.charAt(this.pos++)];"
Rem 0405 " if (ch != null) return ch;"
Rem 0406 " }"
Rem 0407 " return this.EOF;"
Rem 0408 }
Rem 0409
Rem 0410 Source.prototype.getNextSymbolChar = function() {
Rem 0411 " if ("" \t\r\n('\"""".indexOf(this.src.charAt(this.pos)) >= 0) return this.CLOSESYM;"
Rem 0412 " var ch = this.src.charAt(this.pos++);"
Rem 0413 " if (ch == "")"") return this.CLOSEPAREN;"
Rem 0414 " if (ch == ""\\"") return this.src.charAt(this.pos++);"
Rem 0415 " return ch;"
Rem 0416 }
Rem 0417
Rem 0418 Source.prototype.withTrace = function() {
Rem 0419 " this.trace = [];"
Rem 0420 " return this;"
Rem 0421 }
Rem 0422
Rem 0423 Source.prototype.traceItemEnd = function(item) {
Rem 0424 " if (this.trace) this.trace.push({item: item, endPos: this.pos});"
Rem 0425 }
Rem 0426
Rem 0427 Source.prototype.getItemBeforePos = function(endPos) {
Rem 0428 " for (var i=this.trace.length-1; i>=0; i--) {"
Rem 0429 " var t = this.trace[i];"
Rem 0430 " if ((t.endPos - t.item.toString().length) <= endPos) return {item: t.item, tInd: i};"
Rem 0431 " }"
Rem 0432 " return null;"
Rem 0433 }
Rem 0434
Rem 0435 Source.prototype.getSymbolBeforePos = function(endPos) {
Rem 0436 " for (var i=this.trace.length-1; i>=0; i--) {"
Rem 0437 " var t = this.trace[i];"
Rem 0438 " if (((t.endPos - t.item.toString().length) <= endPos) &&"
Rem 0439 " (t.item instanceof Symbol) && gSym[t.item.name]) return {item: t.item, tInd: i};"
Rem 0440 " }"
Rem 0441 " return null;"
Rem 0442 }
Rem 0443
Rem 0444 "var NIL = new Symbol(""NIL""); NIL.car = NIL; NIL.cdr = NIL; NIL.props = NIL;"
Rem 0445 " NIL.lock = true; NIL.TYPEVAL = NILTYPE; NIL.bool = false;"
Rem 0446 "var T = new Symbol(""T""); T.cdr = T; T.lock = true; T.TYPEVAL = TRUETYPE; T.bool = true;"
Rem 0447 var A1 = new Symbol("@", NIL), A2 = new Symbol("@@", NIL), A3 = new Symbol("@@@", NIL);
Rem 0448 var ZERO = new Number(0), ONE = new Number(1);
Rem 0449 "var gSym = {NIL: NIL, T: T, ""@"": A1, ""@@"": A2, ""@@@"": A3}; // dictionary/index for internal symbols"
Rem 0450 "var gTrans = {}; // dictionary/index for transient symbols (strings)"
Rem 0451 var gEmptyObj = {};
Rem 0452 var gParseCache = {};
Rem 0453 "var mk = []; // 'make' stack"
Rem 0454 var evFrames = NIL;
Rem 0455 var gTrcIndent = "";
Rem 0456 var startupMillis = (new Date()).getTime();
Rem 0457
Rem 0458 function mkNew() { mk.unshift({h: NIL, t: NIL}); }
Rem 0459 function linkc(c) {
Rem 0460 " if (mk.length === 0) throw new Error(newErrMsg(NOT_MAK));"
Rem 0461 " c = (c !== NIL) ? evalArgs(c) : new Cell(NIL, NIL);"
Rem 0462 " if (mk[0].h === NIL) { mk[0].h = c; } else { mk[0].t.cdr = c; }"
Rem 0463 " while (c.cdr !== NIL) { c = c.cdr; }; mk[0].t = c; return c.car;"
Rem 0464 }
Rem 0465 function link(x) {
Rem 0466 " if (mk.length === 0) throw new Error(newErrMsg(NOT_MAK));"
Rem 0467 " var c = new Cell(x, NIL);"
Rem 0468 " if (mk[0].h === NIL) { mk[0].h = c; } else { mk[0].t.cdr = c; }"
Rem 0469 " mk[0].t = c; return x;"
Rem 0470 }
Rem 0471 function mkResult() { return mk.shift().h; }
Rem 0472
Rem 0473 function getString(str, editMode) {
Rem 0474 " var s = (str in gEmptyObj) ? undefined : gTrans[str];"
Rem 0475 " if (s === undefined) {"
Rem 0476 " s = newTransSymbol(str);"
Rem 0477 " if (! (editMode || (str in gEmptyObj))) gTrans[str] = s;"
Rem 0478 " }"
Rem 0479 " return s;"
Rem 0480 }
Rem 0481
Rem 0482 function newErrMsg(msg, badValue) {
Rem 0483 " getSymbol(""*Msg"").setVal(newTransSymbol(msg));"
Rem 0484 " return (badValue === undefined) ? msg : lispToStr(badValue) + "" -- "" + msg;"
Rem 0485 }
Rem 0486
Rem 0487 function deFn(name, jsFn) {
Rem 0488 " if (name in gEmptyObj) throw new Error(newErrMsg(JS_RESERVED, name));"
Rem 0489 " var sym = new Symbol(name, jsFn);"
Rem 0490 " gSym[name] = sym;"
Rem 0491 }
Rem 0492
Rem 0493 function aTrue(val) { if (val !== NIL) { A1.pushValue(val); return true; } else return false; }
Rem 0494
Rem 0495 function aPop(val) { A1.popValue(); return val; }
Rem 0496
Rem 0497 function car(c) { if (c.car) return c.car; else throw new Error(newErrMsg(LIST_EXP)); }
Rem 0498 function cdr(c) { if ((c instanceof Cell) || (c === NIL)) return c.cdr;
Rem 0499 " else throw new Error(newErrMsg(LIST_EXP)); }"
Rem 0500
Rem 0501 function numeric(val) {
Rem 0502 " if (val instanceof Number) return val;"
Rem 0503 " throw new Error(newErrMsg(NUM_EXP, val));"
Rem 0504 }
Rem 0505
Rem 0506 function nth(lst, n) {
Rem 0507 " if (lst instanceof Cell) {"
Rem 0508 " if (n <= 0) return NIL;"
Rem 0509 " while ((lst !== NIL) && (--n > 0)) { lst = lst.cdr; }"
Rem 0510 " }"
Rem 0511 " return lst;"
Rem 0512 }
Rem 0513
Rem 0514 function getAlg(c) {
Rem 0515 " //alert(""getAlg: "" + lispToStr(c));"
Rem 0516 " var s = c.car; c = c.cdr;"
Rem 0517 " while (c instanceof Cell) {"
Rem 0518 " var k = c.car;"
Rem 0519 " if (s instanceof Symbol) {"
Rem 0520 " if (eqVal(k, ZERO)) {"
Rem 0521 " s = s.getVal();"
Rem 0522 " } else {"
Rem 0523 " var pLst = s.props, p = NIL, pk, pv;"
Rem 0524 " while (pLst !== NIL) {"
Rem 0525 " var pc = pLst.car;"
Rem 0526 " if (pc instanceof Cell) { pk = pc.cdr; pv = pc.car; } else { pk = pc; pv = T; }"
Rem 0527 //if (!confirm("getAlg: " + lispToStr(pc) + ", " + lispToStr(pk) + ", " + lispToStr(pv))) throw new Error("getAlg aborted");
Rem 0528 " if (pk === k) { p = pv; break; }"
Rem 0529 " pLst = pLst.cdr;"
Rem 0530 " }"
Rem 0531 " s = p; // the symbol or list to use in the next step"
Rem 0532 " }"
Rem 0533 " } else if (s instanceof Cell) {"
Rem 0534 " if (k instanceof Number) {"
Rem 0535 " if (k >= 0) {"
Rem 0536 " s = nth(s, k).car;"
Rem 0537 " } else {"
Rem 0538 " do { s = s.cdr; } while ((s !== NIL) && (++k < 0));"
Rem 0539 " }"
Rem 0540 " }"
Rem 0541 " } else throw new Error(newErrMsg(SYM_EXP));"
Rem 0542 " c = c.cdr;"
Rem 0543 " }"
Rem 0544 " return s;"
Rem 0545 }
Rem 0546
Rem 0547 function prog(c) {
Rem 0548 " var v = NIL; while (c instanceof Cell) { v = evalLisp(c.car); c = c.cdr; }; return v;"
Rem 0549 }
Rem 0550
Rem 0551 function iter(c) {
Rem 0552 " var v = NIL;"
Rem 0553 " while (c instanceof Cell) {"
Rem 0554 " var cv = c.car, cond = false, cMatch = false;"
Rem 0555 " if (cv instanceof Cell) {"
Rem 0556 " if (cond = (cv.car === NIL)) {"
Rem 0557 " cMatch = (evalLisp(cv.cdr.car) === NIL);"
Rem 0558 " } else if (cond = (cv.car === T)) {"
Rem 0559 " cMatch = aTrue(evalLisp(cv.cdr.car));"
Rem 0560 " }"
Rem 0561 " }"
Rem 0562 " if (cond) {"
Rem 0563 " if (cMatch) {"
Rem 0564 " v = prog(cv.cdr.cdr);"
Rem 0565 " if (cv.car === T) aPop(v);"
Rem 0566 " return {v: v, m: true};"
Rem 0567 " }"
Rem 0568 " } else v = evalLisp(cv);"
Rem 0569 " c = c.cdr;"
Rem 0570 " }"
Rem 0571 " return {v: v, m: false};"
Rem 0572 }
Rem 0573
Rem 0574 function div(c, divFn) {
Rem 0575 " var t = evalLisp(c.car);"
Rem 0576 " if (t === NIL) return NIL;"
Rem 0577 " t = numeric(t);"
Rem 0578 " while (c.cdr !== NIL) {"
Rem 0579 " c = c.cdr;"
Rem 0580 " var v = evalLisp(c.car); if (v === NIL) return NIL;"
Rem 0581 " if (numeric(v) == 0) throw new Error(newErrMsg(DIV_0));"
Rem 0582 " t = divFn(t, v);"
Rem 0583 " }"
Rem 0584 " return new Number(t);"
Rem 0585 }
Rem 0586
Rem 0587 function eqVal(a, b) {
Rem 0588 " //alert(""eqVal() "" + a + "", "" + b);"
Rem 0589 " if (a.TYPEVAL === b.TYPEVAL) {"
Rem 0590 " if (a === b) return true;"
Rem 0591 " if (a.TYPEVAL === CELLTYPE) {"
Rem 0592 " return eqVal(a.car, b.car) ? eqVal(a.cdr, b.cdr) : false;"
Rem 0593 " }"
Rem 0594 " return (a.valueOf() == b.valueOf()); // Number or Symbol"
Rem 0595 " }"
Rem 0596 " return false;"
Rem 0597 }
Rem 0598
Rem 0599 function ltVal(a, b) {
Rem 0600 " if (a.TYPEVAL === b.TYPEVAL) {"
Rem 0601 " if (a === b) return false;"
Rem 0602 " if (a.TYPEVAL === CELLTYPE) {"
Rem 0603 " return eqVal(a.car, b.car) ? ltVal(a.cdr, b.cdr) : ltVal(a.car, b.car);"
Rem 0604 " }"
Rem 0605 " return a.valueOf() < b.valueOf(); // Number or Symbol"
Rem 0606 " }"
Rem 0607 " return a.TYPEVAL < b.TYPEVAL;"
Rem 0608 }
Rem 0609
Rem 0610 function idxLookup(owner, v) {
Rem 0611 " var tree = owner.getVal();"
Rem 0612 " if (tree === NIL) return NIL;"
Rem 0613 " while (!eqVal(v, tree.car)) {"
Rem 0614 " if (tree.cdr === NIL) return NIL;"
Rem 0615 " if (ltVal(v, tree.car)) return idxLookup(tree.cdr, v);"
Rem 0616 " tree = tree.cdr;"
Rem 0617 " if (tree.cdr === NIL) return NIL;"
Rem 0618 " tree = tree.cdr;"
Rem 0619 " }"
Rem 0620 " return tree;"
Rem 0621 }
Rem 0622
Rem 0623 function idxInsert(owner, v) {
Rem 0624 " var tree = owner.getVal();"
Rem 0625 " if (tree === NIL) { owner.setVal(new Cell(v, NIL)); return NIL; }"
Rem 0626 " while (!eqVal(v, tree.car)) {"
Rem 0627 " if (tree.cdr === NIL) tree.cdr = new Cell(NIL, NIL);"
Rem 0628 " if (ltVal(v, tree.car)) return idxInsert(tree.cdr, v);"
Rem 0629 " tree = tree.cdr;"
Rem 0630 " if (tree.cdr === NIL) { tree.cdr = new Cell(v, NIL); return NIL; }"
Rem 0631 " tree = tree.cdr;"
Rem 0632 " //if (!confirm(""idxInsert: "" + lispToStr(tree))) throw new Error(""idxInsert aborted"");"
Rem 0633 " }"
Rem 0634 " return tree;"
Rem 0635 }
Rem 0636
Rem 0637 function idxDelete(owner, v) {
Rem 0638 " var tree = owner.getVal(), pre = NIL;"
Rem 0639 " if (tree === NIL) return NIL;"
Rem 0640 " while (!eqVal(v, tree.car)) {"
Rem 0641 " if (tree.cdr === NIL) return NIL;"
Rem 0642 " if (ltVal(v, tree.car)) return idxDelete(tree.cdr, v);"
Rem 0643 " pre = tree; tree = tree.cdr;"
Rem 0644 " if (tree.cdr === NIL) return NIL;"
Rem 0645 " pre = tree; tree = tree.cdr;"
Rem 0646 " //if (!confirm(""idxDelete: "" + lispToStr(tree))) throw new Error(""idxDelete aborted"");"
Rem 0647 " }"
Rem 0648 " // tree.car is the value to delete"
Rem 0649 " //var bbc = null; // cell with ""big brother"" to replace tree.car, if needed"
Rem 0650 " if (tree.cdr.car !== NIL) {"
Rem 0651 " // There are lesser values that need a new ""big brother""."
Rem 0652 " if (tree.cdr.cdr !== NIL) {"
Rem 0653 " var pbc = tree.cdr, bbc = pbc.cdr;"
Rem 0654 " if (bbc.cdr.car !== NIL) {"
Rem 0655 " // There are several ""big brother"" candidates, get the smallest ..."
Rem 0656 " do { pbc = bbc; bbc = bbc.cdr.car; } while (bbc.cdr.car !== NIL);"
Rem 0657 " pbc.cdr.car = NIL; // brother's old cell replaced by NIL"
Rem 0658 " } else {"
Rem 0659 " // Only one candidate. Cut it and following NIL from list ..."
Rem 0660 " pbc.cdr = pbc.cdr.cdr.cdr;"
Rem 0661 " }"
Rem 0662 " //alert(""idxDelete: "" + lispToStr(bbc));"
Rem 0663 " tree.car = bbc.car; // value to delete replaced by ""big brother"""
Rem 0664 " } else {"
Rem 0665 " // Must promote lesser values"
Rem 0666 " if (pre === NIL) {"
Rem 0667 " owner.setVal(tree.cdr.car);"
Rem 0668 " } else {"
Rem 0669 " pre.cdr = tree.cdr.car;"
Rem 0670 " }"
Rem 0671 " }"
Rem 0672 " } else {"
Rem 0673 " // No lesser values following value to delete"
Rem 0674 " if (pre === NIL) {"
Rem 0675 " owner.setVal(tree.cdr.cdr);"
Rem 0676 " } else {"
Rem 0677 " pre.cdr = tree.cdr.cdr;"
Rem 0678 " }"
Rem 0679 " }"
Rem 0680 " return tree;"
Rem 0681 }
Rem 0682
Rem 0683 function idxLinkSorted(tree) {
Rem 0684 " while (tree !== NIL)"
Rem 0685 " { idxLinkSorted(tree.cdr.car); link(tree.car); tree = tree.cdr.cdr; }"
Rem 0686 }
Rem 0687
Rem 0688 /*
Rem 0689 * If 'evaluate' is true, each top level expression will be evaluated, and the result
Rem 0690 * of the last evaluation ('evRes') will be returned. A top level NIL or equivalent
Rem 0691 * will terminate further parsing.
Rem 0692 * If 'evaluate' is false/undefined, the source at the current level will be parsed,
Rem 0693 * and a corresponding tree of cells will be returned (through the 'cdr' at the bottom).
Rem 0694 * If 'editMode' is true, parsed symbols will not be inserted into the dictionaries.
Rem 0695 */
Rem 0696 function parseList(src, evaluate, editMode) {
Rem 0697 " var ch, s, dotPos = 0, quotes = 0, items = [], cdr = NIL, evRes = NIL, circEnd = null;"
Rem 0698 " do {"
Rem 0699 " ch = src.getNextSignificantChar();"
Rem 0700 " if (ch == ""'"") {"
Rem 0701 " quotes++;"
Rem 0702 " } else if (ch == "")"") {"
Rem 0703 " break;"
Rem 0704 " } else if ((ch == ""."") && (items.length > 0)) {"
Rem 0705 " if (dotPos > 0) throw new Error(newErrMsg(BAD_DOT,"
Rem 0706 " ""("" + lispToStr(items[items.length-1]) + "" . \\.)""));"
Rem 0707 " dotPos = items.length;"
Rem 0708 " } else if (ch !== src.EOF) {"
Rem 0709 " var item;"
Rem 0710 " if (ch == ""("") {"
Rem 0711 " var tmp = parseList(src, false, editMode);"
Rem 0712 " if (evaluate && (tmp !== NIL)) evRes = evalLisp(tmp);"
Rem 0713 " item = tmp;"
Rem 0714 " } else if (ch == ""\"""") {"
Rem 0715 " s = """";"
Rem 0716 " while (typeof (ch = src.getNextStringChar()) == ""string"") s += ch;"
Rem 0717 " item = (s == """") ? NIL : getString(s, editMode);"
Rem 0718 " src.traceItemEnd(item); // in case we would like to know item's position"
Rem 0719 " } else {"
Rem 0720 " s = ch;"
Rem 0721 " while (typeof (ch = src.getNextSymbolChar()) == ""string"") s += ch;"
Rem 0722 " item = isNaN(s) ? getSymbol(s, editMode) : new Number(s);"
Rem 0723 " src.traceItemEnd(item); // in case we would like to know item's position"
Rem 0724 " }"
Rem 0725 " if (evaluate && (item === NIL)) return evRes;"
Rem 0726 " if ((dotPos > 0) && (items.length > dotPos)) throw new Error(newErrMsg(BAD_DOT));"
Rem 0727 " // TODO: provide a 'badValue' param for newErrMsg(BAD_DOT) above. Case: (1 (2 3) . 4 5)"
Rem 0728 " while (quotes > 0) { item = new Cell(QUOTE, item); quotes--; }"
Rem 0729 " items.push(item);"
Rem 0730 " }"
Rem 0731 " } while ((ch !== src.CLOSEPAREN) && (ch !== src.EOF));"
Rem 0732 " if (evaluate) return evRes;"
Rem 0733 " if (dotPos > 0) {"
Rem 0734 " if (dotPos == items.length) {"
Rem 0735 " cdr = new Cell(items.pop(), cdr);"
Rem 0736 " circEnd = cdr; // last cell in circular (x y z .) notation"
Rem 0737 " } else { cdr = items.pop(); } // normal dot notation"
Rem 0738 " }"
Rem 0739 " while (items.length > 0) cdr = new Cell(items.pop(), cdr);"
Rem 0740 " if (circEnd != null) circEnd.cdr = cdr;"
Rem 0741 " return cdr;"
Rem 0742 }
Rem 0743
Rem 0744 function cachedTextParse(str) {
Rem 0745 " var lst = gParseCache[str];"
Rem 0746 " if (lst === undefined) {"
Rem 0747 " lst = parseList(new Source(str));"
Rem 0748 " gParseCache[str] = lst;"
Rem 0749 " }"
Rem 0750 " return lst;"
Rem 0751 }
Rem 0752
Rem 0753 function unevalArgs(lst) {
Rem 0754 " // Putting elements of lst into anonymous symbols"
Rem 0755 " mkNew(); while (lst !== NIL) { link(box(lst.car)); lst = lst.cdr; }"
Rem 0756 " return mkResult();"
Rem 0757 }
Rem 0758
Rem 0759 function applyFn(rawFn, lst, more) {
Rem 0760 " if (more !== NIL) {"
Rem 0761 " mkNew(); do { link(evalLisp(more.car)); more = more.cdr; } while (more !== NIL);"
Rem 0762 " mk[0].t.cdr = lst; lst = mkResult();"
Rem 0763 " }"
Rem 0764 " var fn = evalLisp(rawFn); if (! (fn instanceof Symbol)) fn = box(fn);"
Rem 0765 " return evalLisp(new Cell(fn, unevalArgs(lst)));"
Rem 0766 }
Rem 0767
Rem 0768 deFn("apply", function(c) { return applyFn(c.car, evalLisp(c.cdr.car), c.cdr.cdr); });
Rem 0769 deFn("arg", function(c) { var n = 0, f = evFrames.car;
Rem 0770 " if (c !== NIL) {"
Rem 0771 " n = Math.round(numeric(evalLisp(c.car))); if (n < 1) return NIL;"
Rem 0772 " }"
Rem 0773 " while (n-- > 0) f = f.cdr;"
Rem 0774 " return f.car;"
Rem 0775 });
Rem 0776 deFn("args", function(c) { return (evFrames.car.cdr === NIL) ? NIL : T; });
Rem 0777 deFn("bench", function(c) { var t0 = (new Date()).getTime(), r = prog(c);
Rem 0778 " _stdPrint(((new Date()).getTime() - t0) / 1000 + "" sec\n""); return r;"
Rem 0779 });
Rem 0780 deFn("box", function(c) { return box(evalLisp(c.car)); });
Rem 0781 deFn("caar", function(c) { return car(car(evalLisp(c.car))); });
Rem 0782 deFn("caddr", function(c) { return car(cdr(cdr(evalLisp(c.car)))); });
Rem 0783 deFn("cadr", function(c) { return car(cdr(evalLisp(c.car))); });
Rem 0784 deFn("car", function(c) { return car(evalLisp(c.car)); });
Rem 0785 deFn("cdar", function(c) { return cdr(car(evalLisp(c.car))); });
Rem 0786 deFn("cddr", function(c) { return cdr(cdr(evalLisp(c.car))); });
Rem 0787 deFn("cdr", function(c) { return cdr(evalLisp(c.car)); });
Rem 0788 deFn("chop", function(c) { var cv = evalLisp(c.car);
Rem 0789 " if ((cv === NIL) || (cv instanceof Cell)) return cv;"
Rem 0790 " var s = (cv instanceof Symbol) ? cv.valueOf() : cv.toString();"
Rem 0791 " if (s === null) return NIL;"
Rem 0792 " var arr = s.split(""""), v = NIL;"
Rem 0793 " while (arr.length > 0) v = new Cell(newTransSymbol(arr.pop()), v);"
Rem 0794 " return v;"
Rem 0795 });
Rem 0796 deFn("cond", function(c) {
Rem 0797 " while (c.car instanceof Cell) {"
Rem 0798 " if (aTrue(evalLisp(c.car.car))) return aPop(prog(c.car.cdr));"
Rem 0799 " c = c.cdr;"
Rem 0800 " }"
Rem 0801 " return NIL;"
Rem 0802 });
Rem 0803 deFn("cons", function(c) { var r = new Cell(evalLisp(c.car), evalLisp(c.cdr.car)), t = r;
Rem 0804 " c = c.cdr.cdr;"
Rem 0805 " while (c !== NIL) { var d = new Cell(t.cdr, evalLisp(c.car)); t.cdr = d; t = d; c = c.cdr; }"
Rem 0806 " return r;"
Rem 0807 });
Rem 0808 deFn("de", function(c) { var old = c.car.getVal();
Rem 0809 " setSymbolValue(c.car, c.cdr);"
Rem 0810 " if ((old !== NIL) && !eqVal(c.cdr, old)) _warn(""# "" + c.car.valueOf() + "" redefined"");"
Rem 0811 " return c.car;"
Rem 0812 });
Rem 0813 deFn("dec", function(c) {
Rem 0814 " if (c === NIL) return NIL;"
Rem 0815 " var ns = evalLisp(c.car);"
Rem 0816 " if (ns instanceof Number) return new Number(ns - 1);"
Rem 0817 " var v = new Number(ns.getVal() - ((c.cdr !== NIL) ? numeric(evalLisp(c.cdr.car)) : 1));"
Rem 0818 " ns.setVal(v); return v;"
Rem 0819 });
Rem 0820 deFn("delete", function(c) { var a = evalLisp(c.car), lst = evalLisp(c.cdr.car);
Rem 0821 " if (!(lst instanceof Cell)) return lst;"
Rem 0822 " if (eqVal(a, lst.car)) return lst.cdr;"
Rem 0823 " mkNew(); link(lst.car); lst = lst.cdr;"
Rem 0824 " while (lst instanceof Cell) {"
Rem 0825 " if (eqVal(a, lst.car)) { mk[0].t.cdr = lst.cdr; return mkResult(); }"
Rem 0826 " link(lst.car); lst = lst.cdr;"
Rem 0827 " }"
Rem 0828 " mk[0].t.cdr = lst; // taking care of dotted tail"
Rem 0829 " return mkResult();"
Rem 0830 });
Rem 0831 deFn("do", function(c) {
Rem 0832 " var n = evalLisp(c.car);"
Rem 0833 " if (n === NIL) return NIL;"
Rem 0834 " var step = 1, b = c.cdr, v = NIL;"
Rem 0835 " if (n === T) { n = 1; step = 0; }"
Rem 0836 " for (var i=1; i<=n; i+=step) {"
Rem 0837 " var r = iter(b); v = r.v; if (r.m) break;"
Rem 0838 " }"
Rem 0839 " return v;"
Rem 0840 });
Rem 0841 "deFn(""eval"", function(c) { return evalLisp(evalLisp(c.car)); }); // TODO: binding env. offset cnt"
Rem 0842 deFn("fin", function(c) { c = evalLisp(c.car); while (c instanceof Cell) { c = c.cdr; }; return c; });
Rem 0843 deFn("for", function(c) {
Rem 0844 " var s = null, s2 = null, v = NIL;"
Rem 0845 " if (c.car instanceof Symbol) {"
Rem 0846 " s = c.car;"
Rem 0847 " } else if (c.car.cdr instanceof Symbol) {"
Rem 0848 " s2 = c.car.car; s = c.car.cdr;"
Rem 0849 " }"
Rem 0850 " if (s != null) {"
Rem 0851 " s.pushValue(NIL); if (s2 != null) s2.pushValue(ZERO);"
Rem 0852 " var nl = evalLisp(c.cdr.car), b = c.cdr.cdr, i = 0;"
Rem 0853 " if (nl instanceof Number) {"
Rem 0854 " //alert(""for: 1st form""); // (for I 3 (js:confirm I))"
Rem 0855 " while (++i <= nl) {"
Rem 0856 " s.setVal(new Number(i));"
Rem 0857 " var r = iter(b); v = r.v; if (r.m) break;"
Rem 0858 " }"
Rem 0859 " } else {"
Rem 0860 " //alert(""for: 2nd form""); // (for (I . X) (22 33 44) (js:confirm (+ I X)) (+ I X))"
Rem 0861 " while (nl instanceof Cell) {"
Rem 0862 " s.setVal(nl.car); if (s2 != null) s2.setVal(new Number(++i));"
Rem 0863 " var r = iter(b); v = r.v; if (r.m) break;"
Rem 0864 " nl = nl.cdr;"
Rem 0865 " }"
Rem 0866 " }"
Rem 0867 " } else {"
Rem 0868 " //alert(""for: 3rd form"");"
Rem 0869 " if (c.car.car instanceof Symbol) {"
Rem 0870 " s = c.car.car;"
Rem 0871 " } else {"
Rem 0872 " s2 = c.car.car.car; s = c.car.car.cdr;"
Rem 0873 " }"
Rem 0874 " s.pushValue(evalLisp(c.car.cdr.car)); if (s2 != null) s2.pushValue(ZERO);"
Rem 0875 " var a2p = c.car.cdr.cdr, a2 = a2p.car, b = c.cdr, i = 0;"
Rem 0876 " var p = (a2p.cdr instanceof Cell) ? a2p.cdr.car : null;"
Rem 0877 " while (evalLisp(a2) !== NIL) {"
Rem 0878 " if (s2 != null) s2.setVal(new Number(++i));"
Rem 0879 " var r = iter(b); v = r.v; if (r.m) break;"
Rem 0880 " if (p != null) s.setVal(evalLisp(p));"
Rem 0881 " }"
Rem 0882 " }"
Rem 0883 " s.popValue(); if (s2 != null) s2.popValue();"
Rem 0884 " return v;"
Rem 0885 });
Rem 0886 deFn("get", function(c) { return getAlg(evalArgs(c)); });
Rem 0887 deFn("getl", function(c) { var s = getAlg(evalArgs(c));
Rem 0888 " if (s instanceof Symbol) return s.props;"
Rem 0889 " throw new Error(newErrMsg(SYM_EXP, s));"
Rem 0890 });
Rem 0891 deFn("idx", function(c) { var s = evalLisp(c.car);
Rem 0892 " if (!(s instanceof Symbol)) return NIL;"
Rem 0893 " if (c.cdr === NIL) { mkNew(); idxLinkSorted(s.getVal()); return mkResult(); }"
Rem 0894 " var a = evalLisp(c.cdr.car);"
Rem 0895 " if (c.cdr.cdr === NIL) return idxLookup(s, a);"
Rem 0896 " return (evalLisp(c.cdr.cdr.car) === NIL) ? idxDelete(s, a) : idxInsert(s, a);"
Rem 0897 });
Rem 0898 deFn("if", function(c) { return aTrue(evalLisp(c.car)) ? aPop(evalLisp(c.cdr.car)) : prog(c.cdr.cdr); });
Rem 0899 deFn("ifn", function(c) { return aTrue(evalLisp(c.car)) ? aPop(prog(c.cdr.cdr)) : evalLisp(c.cdr.car); });
Rem 0900 deFn("inc", function(c) {
Rem 0901 " if (c === NIL) return NIL;"
Rem 0902 " var ns = evalLisp(c.car);"
Rem 0903 " if (ns instanceof Number) return new Number(ns + 1);"
Rem 0904 " var v = new Number(ns.getVal() + ((c.cdr !== NIL) ? numeric(evalLisp(c.cdr.car)) : 1));"
Rem 0905 " ns.setVal(v); return v;"
Rem 0906 });
Rem 0907 deFn("length", function(c) { var cv = evalLisp(c.car), v = 0;
Rem 0908 " if (cv instanceof Number) { v = cv.toString().length; }"
Rem 0909 " else if (cv instanceof Symbol) { v = cv.lock ? cv.toValueString().length :"
Rem 0910 " (cv.name === null) ? 0 : cv.name.length; }"
Rem 0911 " else if (cv instanceof Cell) { var cs = cv;"
Rem 0912 " while (cs !== NIL) { v++; cs = cs.cdr; if (cs === cv) return T; }}"
Rem 0913 " return new Number(v);"
Rem 0914 });
Rem 0915 deFn("let", function(c) {
Rem 0916 " var symArr = [], p = c.cdr;"
Rem 0917 " if (c.car instanceof Symbol) {"
Rem 0918 " if (c.car !== NIL) {"
Rem 0919 " c.car.pushValue(evalLisp(c.cdr.car)); symArr.push(c.car); p = c.cdr.cdr;"
Rem 0920 " }"
Rem 0921 " } else if (c.car instanceof Cell) {"
Rem 0922 " var sv = c.car;"
Rem 0923 " while (sv !== NIL) {"
Rem 0924 " sv.car.pushValue(evalLisp(sv.cdr.car)); symArr.push(sv.car); sv = sv.cdr.cdr;"
Rem 0925 " }"
Rem 0926 " }"
Rem 0927 " var v = prog(p);"
Rem 0928 " while (symArr.length > 0) { symArr.pop().popValue(); }"
Rem 0929 " return v;"
Rem 0930 });
Rem 0931 deFn("link", linkc);
Rem 0932 deFn("list", function(c) { return (c !== NIL) ? evalArgs(c) : new Cell(NIL, NIL); });
Rem 0933 deFn("load", function(c) { var r = NIL;
Rem 0934 " while (c instanceof Cell) {"
Rem 0935 " var cv = evalLisp(c.car);"
Rem 0936 " if (cv instanceof Symbol) {"
Rem 0937 " var f = cv.toValueString();"
Rem 0938 " if (f.charAt(0) == ""-"") {"
Rem 0939 " r = parseList(new Source(""("" + f.substring(1) + "")""), true);"
Rem 0940 " } else {"
Rem 0941 " r = (f.match(/\.js$/)) ? loadJavaScript(f) : loadLisp(f);"
Rem 0942 " }"
Rem 0943 " }"
Rem 0944 " c = c.cdr;"
Rem 0945 " }"
Rem 0946 " return r;"
Rem 0947 });
Rem 0948 deFn("loop", function(c) {
Rem 0949 " var v = NIL; while (true) { var r = iter(c); v = r.v; if (r.m) break; }; return v;"
Rem 0950 });
Rem 0951 deFn("make", function(c) { mkNew(); prog(c); return mkResult(); });
Rem 0952 deFn("mapc", function(c) { var r = NIL, fn = evalLisp(c.car), ci = evalArgs(c.cdr);
Rem 0953 " if (! (fn instanceof Symbol)) fn = box(fn);"
Rem 0954 " while (ci.car !== NIL) { var cj = ci; mkNew();"
Rem 0955 " while (cj !== NIL) { link(cj.car.car); cj.car = cj.car.cdr; cj = cj.cdr; }"
Rem 0956 " r = evalLisp(new Cell(fn, unevalArgs(mkResult())));"
Rem 0957 " }"
Rem 0958 " return r;"
Rem 0959 });
Rem 0960 deFn("mapcar", function(c) { var fn = evalLisp(c.car), ci = evalArgs(c.cdr);
Rem 0961 " if (! (fn instanceof Symbol)) fn = box(fn);"
Rem 0962 " mkNew();"
Rem 0963 " while (ci.car !== NIL) { var cj = ci; mkNew();"
Rem 0964 " //if (!confirm(lispToStr(cj))) throw new Error(""mapcar aborted"");"
Rem 0965 " while (cj !== NIL) { link(cj.car.car); cj.car = cj.car.cdr; cj = cj.cdr; }"
Rem 0966 " link(evalLisp(new Cell(fn, unevalArgs(mkResult()))));"
Rem 0967 " }"
Rem 0968 " return mkResult();"
Rem 0969 });
Rem 0970 deFn("next", function(c) { evFrames.car = evFrames.car.cdr; return evFrames.car.car; });
Rem 0971 deFn("not", function(c) { return (evalLisp(c.car) === NIL) ? T : NIL; });
Rem 0972 deFn("nth", function(c) { var lst = evalArgs(c); c = lst.cdr;
Rem 0973 " do { lst = nth(lst.car, numeric(c.car)); c = c.cdr; } while(c !== NIL); return lst; });"
Rem 0974 // pack has no support for circular lists, same as in PicoLisp
Rem 0975 deFn("pack", function(c) { return (c !== NIL) ? newTransSymbol(valueToStr(evalArgs(c))) : NIL; });
Rem 0976 deFn("pass", function(c) { return applyFn(c.car, evFrames.car.cdr, c.cdr); });
Rem 0977 deFn("pop", function(c) { var cv = evalLisp(c.car);
Rem 0978 " if (cv.getVal) {"
Rem 0979 " var v = cv.getVal();"
Rem 0980 " if (v instanceof Cell) { cv.setVal(v.cdr); return v.car; }"
Rem 0981 " if (v === NIL) return NIL;"
Rem 0982 " if (cv instanceof Cell) return cv.car;"
Rem 0983 " }"
Rem 0984 " throw new Error(newErrMsg(VAR_EXP, cv));"
Rem 0985 });
Rem 0986 deFn("prin", function(c) {
Rem 0987 " c = evalArgs(c); _stdPrint(c.toValueString());"
Rem 0988 " while (c.cdr !== NIL) { c = c.cdr; }; return c.car;"
Rem 0989 });
Rem 0990 deFn("prinl", function(c) {
Rem 0991 " c = evalArgs(c); _stdPrint(c.toValueString() + ""\n"");"
Rem 0992 " while (c.cdr !== NIL) { c = c.cdr; }; return c.car;"
Rem 0993 });
Rem 0994
Rem 0995 function printx(c, x) { var arr = [];
Rem 0996 " c = evalArgs(c); arr.push(lispToStr(c.car));"
Rem 0997 " while (c.cdr !== NIL) { c = c.cdr; arr.push(lispToStr(c.car)); }"
Rem 0998 " _stdPrint(arr.join("" "") + x); return c.car;"
Rem 0999 }
Rem 1000