-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathdissect.ijs
17077 lines (15698 loc) · 804 KB
/
dissect.ijs
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
NB. Copyright (c) Henry H. Rich, 2012-2017. All rights reserved.
require 'format/printf'
locales =. 'dissect'&,&.> ('' ; ;: 'obj extendv monad dyad recursionpoint noun verb assign vandnm vandnmdyad fork hook allnouns righttoleft irregularops fitok powerexpansion insertexpansion adverseexpansion displaytwo selectshape each') , 'partition'&,&.> ''; ;: 'selector adverb conjunction'
NB. Clear definitions of old locales and create anew. This will remove hangover definitions. These locales can be small since they hold mostly verb-names
NB. The 2 1 gives the name-table sizes: 2 1 0 0 0 ...
NB. The dissectionlist thing is to preserve the list over reloads, for debugging. This is also its initialization
NB. Don't delete a locale that we have switched to, to prevent interaction unpleasantness
NB. 10 10 here is the starting position of the first window
3 : 'dissectionlist_dissect_ =: d [ ((cocreate ([ clear@:>))"0~ 2 1 {.~ #) y [ d =. (,:($0);10 10)&[^:(0=#) ".''dissectionlist_dissect_''' (coname'') -.~ locales
NB. DISSECTLEVEL is updated from time to time whenever there is a change to an external interface, indicating the dissect release level
NB. at the time of the change
DISSECTLEVEL_dissect_ =: 4 0
NB. CONFIGFILELEVEL is the current EC level of the config file
CONFIGFILELEVEL_dissect_ =: 2
NB. set ALLOWNONQTTOOLTIP to enable tooltips for J6 (they are always on in JQT). In J6 tooltips
NB. take over the timer interrupt
ALLOWNONQTTOOLTIP_dissect_ =: 1
NB. if any of the debugging switches is turned on, printf is required
NOCLEANUP_dissect_ =: 0 NB. set to 1 for debugging to allow postmortem
DEBPARSE_dissect_ =: 0 NB. set for parser printout
DEBTRAVDOWN_dissect_ =: 0 NB. set for travdown printout
DEBNOCATCH_dissect_ =: 0 NB. Set to allow debug to catch internal errors
DEBHLIGHT_dissect_ =: 0 NB. set for highlight printout
DEBSELECT_dissect_ =: 0 NB. set for selection printout incl opselin
DEBHLIGHT2_dissect_ =: 0 NB. set for highlight printout - pixel details
DEBVERB_dissect_ =: 0 NB. set for travdown printout
DEBLAYOUT_dissect_ =: 0 NB. display grid details
DEBROUTE_dissect_ =: 0 NB. display routing details
DEBGRAF_dissect_ =: 0 NB. display all drawn graphics
DEBOBJ_dissect_ =: 0 NB. display drawn-object details
DEBDOL_dissect_ =: 0 NB. display drawing details
DEBINHU_dissect_ =: 0 NB. display inheritu
DEBDOL2_dissect_ =: 0 NB. display drawing locales
DEBDOvn_dissect_ =: 0 NB. display object headers
DEBPICK_dissect_ =: 0 NB. display pick progress
DEBEXEGESIS_dissect_ =: 0 NB. display exegetic creation
DEBMOUSE_dissect_ =: 0 NB. display mouse events
DEBTIME_dissect_ =: 0 NB. Show elapsed times
DEBSCROLL_dissect_ =: 0 NB. Show scroll status
DEBROUTETABLES_dissect_ =: 0 NB. Audit routing tables for consistency
DEBSENTENCELOG_dissect_ =: 0 NB. Write sentence to file
SENTENCELOGFILE_dissect_ =: < jpath '~addons/debug/dissect/dissectlog.txt'
QP_dissect_ =: qprintf
SM_dissect_ =: smoutput
PR_dissect_ =: printf NB. So this code will lint with printf undefined
VB_dissect_ =: vbsprintf
edisp_dissect_ =: 3 : '(":errorcode) , ''('' , (errorcodenames{::~2+errorcode) , '')'''
Jenvirons_dissect_ =: 3 2 NB. default in case we remove an instance we didn't save
0 : 0
alltests_dissect_''
0!:2 ; <@(LF ,~ '3 : ''(i. 0 0) [ destroy__y 0 [ dissect_dissectisi_resize__y 0''^:(''''-:$) ' ,^:('dissect' +./@:E. ]) [: enparen_dissect_ 'NB.'&taketo);._2 runtests_dissect_
testsandbox_dissect_ 1
(3 ;< 'check';'no') testsandbox_dissect_ 2
)
alltests_dissect_ =: 3 : 0
stime =. 6!:1''
dly =: 10 NB. Time to recover from tests?
config_displayautoexpand2_dissect_ =: 0
displayshowcompmods_dissect_ =: 0
config_displayshowfillcalc_dissect_ =: 0
config_displayshowstealth_dissect_ =: 0
('Step 0:',LF) 1!:2 SENTENCELOGFILE_dissect_
0!:2 ; <@(LF ,~ '3 : ''(i. 0 0) [ destroy__y 0 [ dissect_dissectisi_resize__y 0''^:(''''-:$) ' ,^:('dissect' +./@:E. ]) [: enparen_dissect_ 'NB.'&taketo);._2 runtests_dissect_
'Time after step 0: %4.1f sec' PR_dissect_ stime -~ 6!:1''
6!:3 dly
config_displayautoexpand2_dissect_ =: 1
('Step 1:',LF) 1!:2 SENTENCELOGFILE_dissect_
0!:2 ; <@('/'&e. # LF ,~ '3 : ''(i. 0 0) [ destroy__y 0 [ dissect_dissectisi_resize__y 0''^:(''''-:$) ' ,^:('dissect' +./@:E. ]) [: enparen_dissect_ 'NB.'&taketo);._2 runtests_dissect_
'Time after step 1: %4.1f sec' PR_dissect_ stime -~ 6!:1''
6!:3 dly
config_displayautoexpand2_dissect_ =: 0
displayshowcompmods_dissect_ =: 1
('Step 2:',LF) 1!:2 SENTENCELOGFILE_dissect_
0!:2 ; <@(LF ,~ '3 : ''(i. 0 0) [ destroy__y 0 [ dissect_dissectisi_resize__y 0''^:(''''-:$) ' ,^:('dissect' +./@:E. ]) [: enparen_dissect_ 'NB.'&taketo);._2 runtests_dissect_
'Time after step 2: %4.1f sec' PR_dissect_ stime -~ 6!:1''
6!:3 dly
displayshowcompmods_dissect_ =: 0
config_displayshowfillcalc_dissect_ =: 1
('Step 3:',LF) 1!:2 SENTENCELOGFILE_dissect_
0!:2 ; <@(LF ,~ '3 : ''(i. 0 0) [ destroy__y 0 [ dissect_dissectisi_resize__y 0''^:(''''-:$) ' ,^:('dissect' +./@:E. ]) [: enparen_dissect_ 'NB.'&taketo);._2 ; ((#~ +./\ *. +./\.) ('$FILL$' +./@:E. ])@>) <;.2 runtests_dissect_
'Time after step 3: %4.1f sec' PR_dissect_ stime -~ 6!:1''
6!:3 dly
config_displayshowfillcalc_dissect_ =: 0
config_displayshowstealth_dissect_ =: 1
('Step 4:',LF) 1!:2 SENTENCELOGFILE_dissect_
0!:2 ; <@(LF ,~ '3 : ''(i. 0 0) [ destroy__y 0 [ dissect_dissectisi_resize__y 0''^:(''''-:$) ' ,^:('dissect' +./@:E. ]) [: enparen_dissect_ 'NB.'&taketo);._2 runtests_dissect_
'Time after step 4: %4.1f sec' PR_dissect_ stime -~ 6!:1''
config_displayshowstealth_dissect_ =: 0
)
0 : 0
traversebsp =: #@] }. (( (] , {:@[ + ({~ {.)~ <!.0 (1 { [))^:(0 <: {:@])~ ({~ {:) )^:_ ,&0.)^:(*@#@[)
bsptest =: ".;._2 (0 : 0)
0 1 2 NB. 0 coord0 > 1, 2 3
0 0 0
1 2 4 NB. 2 coord1 > 2, 4 5
0 0 _1 NB. 3 leaf
0 4 6 NB. 4 coord0 > 4, 6 7
1 6 8 NB. 5 coord0 > 6, 8 9
0 10 10 NB. 6 coord0>10, 10 11
0 0 _1 NB. 7 leaf
0 5 12 NB. 8 coord1>5, 12 13
0 0 _1 NB. 9 leaf
0 0 _1 NB. 10 leaf
0 0 _1 NB. 11 leaf
0 0 _1 NB. 12 leaf
0 0 _1 NB. 13 leaf
dissect 'bsptest traversebsp 2 2'
when run, right-click traversebsp: does not subdissect
dissect the sentence alone: localizes error to wrong block
)
NB. TODO
NB. If big verb is too big for stack, show ... at end
NB. Should put 'atom' as shape of selection when it is shown filled with ()?
NB. u :. v doesn't allow getting into u with right-click
NB. (,.4 3) toupper;.0 'abracadabra' should highlight the implied selection from the ;.0?
NB. dissect '25{.(,.~ <@>:@i.@#) ;({."#. <@(0&#`({.@{.(;,)<@}."1)@.(1<#))/. ])/:~~.,/(+,/:~@,)"0/~3^~1+i.100' slow
NB. Put type of value into highlight line
NB.
NB. Must add both other penalties when taking a turn? - no
NB. Adj penalties can cause a long route where a spread would help. But where to localize the spread?
NB. Think more about grayed-out words in the sentence
NB. Have a way to do selections from script, for testing
NB. ?work on Android, with wd 'activity'
NB. (1) 3&+&2 (5 6 7) shows ^: in the stack. Change the 1 and see duplicates too - if details enabled
NB. going to leave the ^:1 in to show what happened. Change ^: in stack to (^:)?
NB. fit value needs to be evaluated in its locale to get the value right (needed by /.) - if nonsdt, should come in on the right
NB. Enforce a recursion limit to help debug stack error - if original failed w/stack error?
NB. support u . v y
NB. support {::
NB. Add rank-calculus for primitives with known behavior?
NB. display:
NB. Unicode?
NB. dissect - 2d graphical single-sentence debugger
NB. the call is:
NB. [options] dissect [sentence]
NB. where sentence is a string to be executed. The sentence is parsed and modified so that every verb execution creates
NB. logging information about its input and outputs. Then the modified sentence is executed (in the same context as the original
NB. dissect verb), and then the results are displayed in 2d form. If sentence is omitted, the sentence from the last error is used.
NB.
NB. Options are (bitmask)[;(label options)] where
NB. bit 0 is 1 to use a sandbox for executing the sentence
NB. bit 1 is 1 to return the locale of the dissect window
NB. bit 2 is 1 to suppress assignment statements. They will not be executed and an error will result if an assigned name is referred to later.
NB. bit 3 is 1 if this call was from the J debugger. It changes the error messages if the assignments rule is violated.
NB.
NB. Label options are a table of (type);(string) where types are
NB. 'title' string is (fontchange)TABtitle fontchange is +-amount to increase over sentence size, title is text
NB. 'link' string is (fontchange)TABdisplay textTABlink text
NB. 'datasize' string is vpct hpct max size of noun, in % of screen (must be converted to numeric)
NB. 'check' string is 'all'=full comparison, shape'=shape and type only; 'error'=success/failure only; 'no'=no comparison (and don't execute the original sentence)
NB.
NB. If y is boxed, it should be a table ready for use in parse, i. e. nx3 where the first line gives
NB. options;locale;text of sentence
NB. and the remaining lines are the local names defined in the running explicit definition, as described in z458095869 below
NB.
NB. Result is a string containing an error message if a window couldn't be created, otherwise an empty string EXCEPT when the
NB. dissect locale was requested: in that case return it if it was created
dissect_z_ =: [: ([: display_dissect_ <@". :: (''"_)&.>)`nodisplay_dissect_@.(2=3!:0) [: parse_dissect_ ((0: : [) (([ ; 18!:5@(''"_) ; ]) , z458095869_dissectnopath_@(''"_)) getsentence_dissect_@])^:(0=L.@])
NB. The locale dissectnopath is used to find local names. Its path is empty. The locale contains only one name, z458095869
cocurrent 'dissectnopath'
copath ''
NB. The verb z458095869 returns a table of defined local names. It is a table of (name;(type from 4!:0);(5!:5 form of name))
z458095869 =: (([ ,. <"0@] ,. (".@[`(rankinv_dissect_@[)`(rankinv_dissect_@[)`(rankinv_dissect_@[))@.]&.>) (4!:0)) @ ((<'z458095869') -.~ 4!:1@i.@4:)
IFJA_z_ =: {. 0 ,~ ". 'IFJA_z_' NB. gl2 expects it
require 'strings gl2'
cocurrent 'dissect'
coinsert 'jgl2'
NB. The address of the jsoftware wiki
JWIKIURL =: 'http://code.jsoftware.com/wiki/'
defaultfonts =: (<"0 (12 12 14 8 10)) ,.~ (('Darwin';'Linux';'FreeBSD';'OpenBSD') i. <UNAME) { ".;._2 (0 : 0)
'"Courier"' ; '"Lucida Console"' ; '"Arial"' ; '"Arial"' ; '"Arial"' NB. Mac version
'"monospace"' ; '"Lucida Console"' ; '"Arial"' ; '"Arial"' ; '"Arial"' NB. Linux version
'"monospace"' ; '"Lucida Console"' ; '"Arial"' ; '"Arial"' ; '"Arial"' NB. FreeBSD version
'"monospace"' ; '"Lucida Console"' ; '"Arial"' ; '"Arial"' ; '"Arial"' NB. OpenBSD version
'"Courier New"' ; '"Lucida Console"' ; '"Arial"' ; '"Arial"' ; '"Arial"' NB. Version for all others
)
debscroll =: 3 : 0
QP '6!:1$0 y >coname$0 scrollingtype__COINSTANCE >scrollinglocale__COINSTANCE '
)
NB. lines beginning config_ are names that are initialized in the instance from the globals here
NB. the others are global, shared among running dissections
CONFIG =: 0 : 0
configfilelevel =: 0
tooltipctrl =: 0
fontchoices =: defaultfonts
tooltipdelayx =: 2 NB. tooltip delay
tooltipdetailx =: (1 {"1 TOOLTIPDETAILCHOICES) i. <'tutorial' NB. tooltip detail level
displayshowcompmods =: 0 NB. display full modified verb, not just modifier line
displayshowstructmods =: 0 NB. display a line for @ @: & etc
config_maxnoundisplaysizex =: 3 3
config_displayshowstealth =: 0
config_displayautoexpand2 =: 0 NB. Automatically show u/ on 2 items as dyad
config_displayshowfillcalc =: 0 NB. Make a rankstack mark when fill-cell is used
config_displayprecisionx =: 2 NB. default display precision
displayshowtipoftheday =: 1 NB. Display a tip at startup
)
NB. Read & apply config file. Run in dissect locale.
loadconfig =: 3 : 0
try.
NB. Define the defaults first, in case config format has changed
cfile =. CONFIG , 1!:1 <jpath '~config/dissect.ijs'
catch.
cfile =. CONFIG , 'configfilelevel =: _1' , LF
end.
NB. Remove CR, force LF termination
cfile =. LF ,~^:(~: {:) cfile -. CR,TAB
0!:0 cfile
NB. If the config file was downlevel, here is where we take action
select. configfilelevel
case. _1 do.
NB. no config file - keep defaults
case. 0 do.
NB. config file, but created before levels assigned
tooltipdetailx =: 2 + tooltipdetailx NB. we added 'none' & 'one line' options
displayshowcompmods =: {. ". 'displaycompmods' NB. we renamed this
displayshowstructmods =: {. ". 'displaystructmods' NB. we renamed this
NB. Default the font for the status line
fontchoices =: fontchoices , (#fontchoices) }. defaultfonts
case. 1 do.
NB. Downlevel config file
tooltipdetailx =: (tooltipdetailx > 0) + tooltipdetailx NB. we added 'one line' option
NB. Default the font for the status line
fontchoices =: fontchoices , (#fontchoices) }. defaultfonts
case. do.
NB. current level - that's OK
end.
0 0$0
)
NB. Write current settings to config file. Called in the instance that we want to save
saveconfig =: 3 : 0
NB. Save the config file with the current level
configfilelevel =: CONFIGFILELEVEL
NB. Get the variable names we want to save under
cnames =. {.@;:;._2 CONFIG
NB. Get the name to save from - same with config removed, so we get the instance value
inames =. ('config_' (#@[ }. ])^:([ -: #@[ {. ]) ])&.> cnames
NB. create log string
cdata =. ; cnames <@(LF ,~ >@[ , ' =: ' , 5!:5@])"0 inames
try.
cdata 1!:2 <jpath '~config/dissect.ijs'
catch.
wdinfo 'Error creating config file';'Unable to write config file'
end.
0 0$0
)
NB. Apply config variables to the current instance. Called in the instance locale.
NB. If y is not empty, it is the table of input options. We override the config file with them
applyconfig =: 3 : 0
inames =. a: -.~ (#~ 'config_' -: 7&{.)&.>@{.@;:;._2 CONFIG
NB. All names starting config_ become instance names losing the config_
(7 }.&.> inames) =: ".&.> inames
if. #y do.
if. (#y) > dsx =. ({."1 y) i. <'datasize' do.
NB. Input options specify the max display sizes, use it
maxnoundisplaysizex =: (}:MAXNOUNPCTCHOICES) I. 2 ($,) 0 ". (dsx,1) {:: y
end.
end.
NB.?lintonly tooltipdelayx =: tooltipdetailx =: displayshowcompmods =: displayshowstructmods =: 0
NB.?lintonly maxnoundisplaysizex =: 0 0 [ displayshowstealth =: displayautoexpand2 =: displayshowfillcalc =: displayprecisionx =: =: displayshowtipoftheday =: 0
0 0$0
NB.?lintsaveglobals
)
NB. Apply config setting to form - must wait until form exists.
setformconfig =: 3 : 0
NB. We have to set the form after loading the values
('fmmaxnounsizey' , ": MAXNOUNPCTCHOICES {~ 0 { maxnoundisplaysizex) wdsetvalue '1'
('fmmaxnounsizex' , ": MAXNOUNPCTCHOICES {~ 1 { maxnoundisplaysizex) wdsetvalue '1'
('fmtooltipdelay' , TOOLTIPDELAYCHOICES {::~ <0 ,~ tooltipdelayx) wdsetvalue '1'
('fmtooltipdetail' , TOOLTIPDETAILCHOICES {::~ <0 ,~ tooltipdetailx) wdsetvalue '1'
maxnoundisplayfrac =: 0.01 * maxnoundisplaysizex { MAXNOUNPCTCHOICES
('fmprec' , ": displayprecision =: DISPLAYPRECCHOICES {~ displayprecisionx) wdsetvalue '1'
calccfms fontchoices
NB. The rest of the form settings are performed each traversal
NB.?lintsaveglobals
)
dissectinstance =: 0$a:
defstring =: 'start of traversal'"_ NB. for debugging only
NB. Handle special inputs: 0=last error, 1=clipboard, others pass through unchanged (numeric 2 will be a quiet return)
getsentence =: (' ' takeafter LF (i:~ }. ]) [: }:^:(LF={:) (13!:12)@(''"_))`(LF (>:@i:~ }. ]) LF , [: }:^:(LF={:) CR -.~ [: wd 'clippaste'"_)`]@.((0;1) i. <)
NB. Maximum line length that we will try to display in a grid cell
MAXSENTENCEWIDTH =: 0.5 NB. max frac of screenwidth that we allow for sentence display
ifdefined =: 0 <: [: 4!:0 < NB. true if name defined in path
ifinlocale =: < e. (0 1 2 3) 4!:1~ {. NB. true if name defined in current locale
NB. ******************* code for function keys ******************
finddissectline =: (3 : 0) :. (smoutput^:(*@# *. 2 = 3!:0))
NB.?lintonly WinText_jqtide_ =: '3 + 5' [ WinSelect_jqtide_ =: 0 0
NB. y tells what kind of run: 0=line under cursor, 1=last error, 2=clipboard
select. y
case. 0 do.
NB. fs is a character index; if window contains non-ASCII, convert to unicode
ft =. 7 u: WinText_jqtide_
fs =. WinSelect_jqtide_
NB. If a single value is selected, take the whole line; otherwise the selected region
if. 1 < # ~. fs do.
sentence =. 8 u: (-~/\ fs) (];.0~ ,.)~ ft
else.
NB. Select sentence - but find the part between control words
pref =. 8 u: (LF taketo&.|. ({.fs) {. ft) NB. The line before the cursor, in UTF-8
line =. pref , 8 u: LF taketo ({.fs) }. ft NB. The whole line
try.
words =. ;: line NB. convert to words
catch.
smoutput 'cannot dissect: ' , ((<:13!:11'') {:: 9!:8 '') , ' in sentence'
2 return. NB. causes quiet return from parse
end.
NB. For each word, calc number of nonblanks from begin line to end of word
wordnb =. +/\ +/@:~:&' '@> words
prefnb =. +/@:~:&' ' pref NB. number of nonblanks in prefix
NB. Get mask of control words
cwx =. words I.@:e. ,&'.'&.> controlwords
NB. Get the index of the control-word containing the cursor: the frets are the beginning of each cw,
NB. so that cursor just before the first char of a cw indicates the previous cw; cursor in cw means following sentence
currcwx =. (cwx { 0 , wordnb) I. prefnb
NB. Get #nonblanks before the beginning of the cursor cw. We have a list of starting nb counts, prepending 0 for start of line
bgnnb =. currcwx { 0 , cwx { wordnb
NB. Get #nonblanks to the end of the cursor cw. 0,wordnb is a list of ENDING nb counts; we add one for the end-of-line
endnb =. currcwx { (cwx { 0 , wordnb) , {: wordnb
if. bgnnb < endnb do.
NB. Convert nonblank counts to char counts by indexing the user's nonblanks
NB. This indexes the beginning char & the end char
be =. (+/\@:~:&' ' line) i. (>:bgnnb),endnb
NB. Extract from beginning to before end+1
sentence =. line (];.0~ ,.) -~/\ 0 1 + be
else. sentence =. '' NB. No nonblanks in selected region
end.
end.
NB. If user selected all blanks, give a message and use a sentence of 2 to create quiet return from parse
if. sentence +./@:~: ' ' do.
sentence
else.
smoutput 'nothing to dissect'
2 NB. this will cause quiet return from parse
end.
case. 1 do.
0 NB. 0 means 'last error'
case. 2 do.
1 NB. 1 means 'clipboard'
case. do.
'' NB. Will give usage message
end.
)
NB. ********************** from here on is devoted to parsing J sentences ***************
NB.
NB. Parsing stuff, copied from trace.ijs
NB. sdt means self-defining term: a number or string rather than a name or a result
(x) =: 2^i.#x =. ;:'noun verb adv conj lpar rpar asgn name mark sdt'
any =: _1
avn =: adv + verb + noun
cavn =: conj + adv + verb + noun
edge =: mark + asgn + lpar
invvalences =: invmonad+invdyad
x =. ,: (edge, verb, noun, any ); 0 1 1 0; '0 Monad'
x =. x, ((edge+avn), verb, verb, noun ); 0 0 1 1; '1 Monad'
x =. x, ((edge+avn), noun, verb, noun ); 0 1 1 1; '2 Dyad'
x =. x, ((edge+avn), (verb+noun),adv, any ); 0 1 1 0; '3 Adverb'
x =. x, ((edge+avn), (verb+noun),conj, verb+noun); 0 1 1 1; '4 Conj'
x =. x, ((edge+avn), (verb+noun),verb, verb ); 0 1 1 1; '5 Trident'
x =. x, (edge, cavn, cavn, any ); 0 1 1 0; '6 Bident'
x =. x, ((name+noun),asgn, cavn, any ); 1 1 1 0; '7 Is'
x =. x, (lpar, cavn, rpar, any ); 1 1 1 0; '8 Paren'
PTpatterns =: >0{"1 x NB. parse table - patterns
PTsubj =: >1{"1 x NB. "subject to" masks
PTactions =: 2{"1 x NB. actions
bwand =: 17 b. NB. bitwise and
bwor =: 23 b. NB. bitwise or
bwxor =: 22 b. NB. bitwise XOR
bwlsl =: 33 b. NB. logical left shift
enclosing =: ([: > [: {. [) , ] , [: > [: {: [
prespace =: ,~ e.&'.:'@{. $ ' '"_
NB. preface a space to a word beginning with . or :
isname =: ({: e. '.:'"_) < {. e. (a.{~,(i.26)+/65 97)"_
NB. 1 iff a string y from the result of ;: is is a name
NB. y is a value, result is 1 if it looks like a gerund
isar =: 0:`((1:`((2 = #) *. (2 = 3!:0@>@{.))`0:)@.(2 32 i. 3!:0)@>)@.(32=3!:0)"0
isgerund =: [: +./ isar
class =: 3 : 0 NB. the class of the word represented by string y
if. y-:mark do. mark return. end.
if. isname y do. name return. end.
if. 10>i =. (;:'=: =. ( ) m n u v x y')i.<y do.
i{asgn,asgn,lpar,rpar,6#name return.
end.
(4!:0 <'x' [ ".'x =. ',y){noun,adv,conj,verb
)
NB. *** end of copied stuff
NB. Other utilities
NB. result is 1 if y is empty
isempty =: 0 e. $
NB. Result is 1 if y is numeric type (regardless of empty)
isnumtype =: 1 4 8 16 64 128 1024 4092 8192 16384 e.~ 3!:0
NB. Result is 1 if y is numeric or empty
isnumeric =: isnumtype@[^:(0=]) isempty
NB. Result is 0 if y is nonnumeric, 1 is numeric noninteger, 2 if integer (after conversion)
isinteger =: (+ 9&o. -: <.)~^:] isnumeric
NB. *** end of utilities
NB. possible starting variables, in name;type;value form
startvbls =: 'xymunv' (,@[ ; '' ;~ ])"0 noun,noun,noun,(verb+sideeff),noun,(verb+sideeff)
enparen =: '(' , (' ' #~ '.:' e.~ {.) , ,&')'
NB. y is an AR. Result is string form. But if the result is more than 50 chars, we
NB. return empty; if more than 20 chars, we return the first 20
ARtostring =: 3 : 0"0
y =. y 5!:0
y =. 5!:5 <'y'
if. 50 < #y do.
' ... '
elseif. 20 < #y do.
enparen (20{.y),'...'
elseif. do.
enparen y
end.
)
NB. y is name;<<locale to look in
NB. y may have object names appended
NB. Result is simplename;locale the name was found in; empty if not found
findnameloc =: 3 : 0
'name loc' =. y
NB. If there are object names, resolve them in loc and replace loc with
NB. the result
if. '__' +./@:E. name do.
NB.?lintonly loc =. <'dissectobj'
cocurrent loc
loc =. ('__' takeafter name)~
name =. '__' taketo name
end.
NB.?lintonly loc =. <'dissectverb'
NB. Follow search path starting in loc, and stop when the name is encountered
ret =. ''
for_l. loc , 18!:2 loc do.
NB.?lintonly l =. <'dissectverb'
cocurrent l
if. (<name) e. ({. name) (4!:1) 0 1 2 3 do. ret =. name ; l break. end.
end.
ret
)
NB. called after error. y is the ARs of the operands that were executed
NB. x is 1 (default 1) to include J error info - use only if there has been an error
postmortem =: 3 : 0
1 postmortem y
:
if. x do.
s =. LF,((<:13!:11''){::9!:8'')
else. s =. ''
end.
s,LF, ; <@ARtostring y
)
parse =: 3 : (('catch.';'catchd.') stringreplace^:DEBNOCATCH_dissect_ 0 : 0) NB. called in dissect locale
QP^:DEBTIME'startparse=?6!:1'''' '
NB. dissectinstance should be empty when parse is called. parse will then allocate the instance and run the parse,
NB. which ends by executing the parsed verb. display/nodisplay is then called to display the instance.
NB.
NB. If dissectinstance is nonempty here, it means that the parsed verb is attempting a recursion into dissect, which we must
NB. intercept. We return empty, which will cause nodisplay to be called for the recursion. nodisplay will
NB. clear dissectinstance, so that display for the original dissect call will find no dissectinstance, which it
NB. interprets as a recursion request, exiting with an appropriate message and everything reset.
if. #dissectinstance do. '' return. end. NB. Return empty... which will bypass display
dissectinstance =: '' conew 'dissect' NB. global because must persist over return to user environment
errormessage =: ''
try.
parsemain__dissectinstance y
catch.
NB. Unexpected error (not set by failmsg)
smoutput > (errnum =. <:13!:11'') { 9!:8'' NB. string form of emsg
smoutput 13!:12''
'error during parsing'
catcht.
errormessage
end.
NB.?lintsaveglobals
)
NB. Signal failure of the parse. y is the error message
NB. We keep it in the main dissect locale for ease, since it is valid only over the parse
failmsg =: 3 : 0
errormessage_dissect_ =: y
throw.
smoutput 'Throw was not caught!'
13!:8 (1)
)
saveJenvirons =: 3 : 0 NB. called in the instance locale. creates the instance name 'wdtimer'
NB. We save the locale sizes and the sys_timer status. If this is not QT, we define sys_timer_z_
NB. but only if sys_timer_base_ is not defined; and we delete it when we restore
NB. Make the timer check only when starting the first instance
NB. If a timer was NOT created because of earlier sys_timer, stub out wdtimer in the instance;
NB. otherwise allow it to go through to the definition in dissect locale
if. ALLOWNONQTTOOLTIP *. -. IFQT do.
if. 0 = #a: -.~ {."1 dissectionlist_dissect_ do.
if. 0 > 4!:0 <'sys_timer_base_' do.
sys_timer_z_ =: sys_timer_dissect_ NB.?lintonly =: 0:
end.
end.
NB. If somebody else's timer is present, disable our use of it
if. 3 = 4!:0 <'sys_timer_z_' do. if. (<'sys_timer_dissect_') -.@-: 5!:1 <'sys_timer_z_' do. wdtimer =: ] end. end.
end.
Jenvirons =: (9!:38 '')
NB.?lintsaveglobals
)
NB. Restore on any return to immediate mode.
NB. If we are returning after the last destroy, we also restore the timer.
NB. This makes sure we leave the user in his original state always
restoreJenvirons =: 3 : 0 NB. called AFTER removing instance from the list
9!:39 Jenvirons
if. (0 = #a: -.~ {."1 dissectionlist_dissect_) *. (ALLOWNONQTTOOLTIP *. -. IFQT) do.
if. 3 = 4!:0 <'sys_timer_z_' do. if. (<'sys_timer_dissect_') -: 5!:1 <'sys_timer_z_' do.
NB. If we created a timer, remove it
4!:55 <'sys_timer_z_'
end. end.
end.
0 0$0
)
CASCADEOFFSET =: 20 20 NB. Amount to offset a new window-level from the last previous window-level
NB. Initialization
create =: 3 : 0
NB. Save the initial environment BEFORE we indicate instance running
saveJenvirons''
slottouse =. ({."1 dissectionlist_dissect_) i. a:
if. slottouse = #dissectionlist_dissect_ do.
NB. new window position.
NB. Figure out the initial position for the new window. It is at a cascade offset from the
NB. position of the last window. We have to ask the window its position, since we don't
NB. get an event for a pmove
lastparent =. (<_1 0) { dissectionlist_dissect_
NB.?lintonly lastparent =. <'dissect'
NB.?lintmsgsoff
wd 'psel ' , winhwnd__lastparent
NB.?lintmsgson
try.
initpos =. CASCADEOFFSET + 1 0 { 0 ". wdqform''
dissectionlist_dissect_ =: dissectionlist_dissect_ , ($0);initpos
catch.
NB. error reading form position for last slot. It must have failed before the form started.
NB. close it and reuse its slot and initial position
destroy__lastparent 1
slottouse =. <: slottouse
end.
end.
dissectionlist_dissect_ =: (coname'') (<slottouse,0)} dissectionlist_dissect_
objtable =: 0$a: NB. list of parse objects
ticket =: 0 NB. sequential log number
loggingallowed =: 1 NB. allow logging
debuglocs =: 0$a: NB. List of locales created by expanding tacit names from this window
NB. Variables used to control hovering in this window
hoverinitloc =: $0 NB. Init no hover active
sentencehovertok =: $0 NB. token # we are hovering over, if any
blockhoverloc =: 0$a: NB. locale we are hovering over, if any
NB. Create the name we use to get to the instance - in this locale it points to itself
COINSTANCE =: coname''
winhwnd =: '' NB. Init to no window
NB. Use lightweight locales - we use less than 100 entries usually
9!:39 (1) 1} 9!:38 ''
NB. For nodes that do not have a parallel path (i. e. all but forks and &), this locale will
NB. be the predecessor locale, and will not signal an error
errorcode =: 0
NB. Because of debug irregularities, we execute debug out of a different event from
NB. the one that started it. The presence of startdebuglocale on mbrup indicates that we need to execute it
startdebuginfo =: 0$a:
NB.?lintsaveglobals
)
NB. Add new object to the list of objects
NB. We make the newest object first to solve a subtle problem: certain locales (like assignments) coinsert an
NB. existing locale to resolve undefined names. If a locale in the path is destroyed, it will make names
NB. like codestroy unresolvable. So, we order the locales here to be destroyed in the opposite order of creation.
newobj =: 3 : 0
objtable =: y , objtable
)
NB. Utility to create rank,invertible flags for a verbname
NB. y is name of a verb, visible in current context
NB. result is 5!:5 value of name
rankinv =: 5!:5@:<
NB. anything beginning with one of these words and ending with . is a control word
controlwords =: ;: 'assert break continue for goto label if do else elseif end return select case fcase throw try catch catchd catcht while whilst'
NB. for each line, find control words; then recollect sentences between control words; then
NB. append the line number of the line. run all the blocks together. This deletes empty sentences, too
NB. For multiple blocks on the same line (caused by control words), give them fractional parts to
NB. distinguish them
NB. Verb, returning 1 if a word is a control word
iscw =: ('NB.' -: 3 {. >) +. e.&controlwords@(('_'&taketo)@}:&.>) *. ('.'={:)@> NB. verb, applied to boxed word. Any remaining comment must be a lint directive
NB. **** verbs to create nodes. DO NOT USE CONEW because it doesn't set COCREATOR properly
NB. Create a verb node. y is (string form of the verb[;display form]);(token number)[;(one-line def)]
NB. if display form is not given, string form is not boxed
NB. x is locale to use for COCREATOR (if omitted, we must be calling from the main instance, just use its name)
NB. Result is result from create which is type;locale;token #
createverb =: 3 : 0
(coname'') createverb y
:
NB. If the primitive is known, use its locale
nobj =. conew (0 { y) (#@] ('dissectprim' , ":@])`('dissectverb'"_)@.= i.&1@:((e.>)"0)) dissectprimindex
NB.?lintonly nobj =. <'dissectobj'
COCREATOR__nobj =: x
create__nobj y
)
NB. Create a noun node. y is (string form of the verb[;display form]);(token number);value
NB. if display form is not given, string form is not boxed
NB. x is locale to use for COCREATOR (if omitted, we must be calling from the main instance, just use its name)
NB. Result is result from create which is type;locale;token #)
createnoun =: 3 : 0
(coname'') createnoun y
:
nobj =. conew 'dissectnoun'
COCREATOR__nobj =: x
create__nobj y
)
NB. Adverb. u is 1 to assign COCREATOR (used only when called outside the main instance)
NB. Create a modifier node. y is whatever is needed by the modifier
NB. for normal nodes, (string form of the verb[;display form]);(token number)
NB. if display form is not given, string form is not boxed
NB. x is locale to create.
NB. Result is result from create which is (type;locale;token #)
createmodifier =: 1 : 0
:
nobj =. conew >x
NB.?lintonly nobj =. <'dissectobj' [ COCREATOR =. ''
if. m do. COCREATOR__nobj =: COCREATOR end.
create__nobj y
)
NB. Routine to parse and execute a block
NB. inparms is the environment:
NB. table of local variables (name;type from 4!:0;ranks if verb)
NB. the first line of the table is special: it's options;locale;sentence to execute
NB. giving the locale in which the verb will execute
NB. Result is the boxed string form of the instrumented sentence, ready to execute;
NB. or a string containing an error message. If result is a string, processing ceases
NB. As a side effect, many objects are created indicating the parse structure
NB. In paticular, resultroot is the boxed locale of the sentence result.
NB. If there is an error, resultroot is empty
NB. Options: bit 0 is 'sandbox', in which case we create an explicit definition to run the
NB. sentence in, and define all the user names in it, before running it
NB. bit 1 is 'return locale', which returns boxed locale (an atom) if there is no error
NB. bit 2 is 'noassign' which neuters assignments (useful in debug)
NB. bit 3 is 'debug', reserved for future use
parsemain =: 3 : 0 NB. runs in object locale
defnames =: }. y NB. table of names
'options loc sentence' =. {. y
NB. Convert the options to keyword;value form.
NB. We must do this first because destroy uses dispoptions, so dispoptions must be properly defined
NB. before any failure is detected
NB. If the options is unboxed, box it.
if. 2 > #$ dispoptions =: boxopen options do.
NB. Options are a list or atom. See if first one is numeric
if. 1 4 8 16 e.~ 3!:0 numopt =. {.!.0 > {. dispoptions do.
NB. Old numeric form. Convert the number to a table of options.
transopt =. (2 2 2 2 #: numopt) # (;: 'fromdebugger noassignment returnobject sandbox') ,. <1
NB. Append the other options if there are any
if. 1 < #dispoptions do.
dispoptions =: transopt , ({."1 transopt) subkl _2 ]\^:(2 > #@$@]) 1 {:: dispoptions
else. dispoptions =: transopt
end.
else.
NB. List of options, but no numeric. Convert to table
dispoptions =: _2 ]\ dispoptions
end.
end.
NB. Audit the options for validity
if. #badopts =. ({."1 dispoptions) -. ;: 'fromdebugger noassignment returnobject sandbox check title link datasize parent' do.
failmsg 'Invalid options: ' , ;:^:_1 badopts return.
end.
binopts =. dispoptions #~ ({."1 dispoptions) e. ;: 'fromdebugger noassignment returnobject sandbox'
if. 1 e. emask =. ({:"1 binopts) -.@e. 0;1 do.
failmsg 'Invalid value for option: ' , ;:^:_1 emask # {."1 binopts return.
end.
if. (<'all' qopt 'check') -.@e. ;:'all shape error no' do.
failmsg 'Invalid value for ''check'' option.' return.
end.
NB. The numeric atom 2 is used by finddissectline to create a quiet return of an empty string
if. 2 -: sentence do. '' return. end.
if. (2 ~: 3!:0 sentence) +. (1 < #$sentence) do.
failmsg 'The sentence to be dissected must be a string.' return.
end.
NB. The returnobject flag must be in dissect locale so that display can get to it
returnobject_dissect_ =: qopt 'returnobject'
NB. Break the input into words. If there is an error, fail. Discard any comment
NB. Discard anything past the first LF, and remove CR
sentence =. CR -.~ ({.~ i.&LF) sentence
if. DEBSENTENCELOG do. (sentence,LF) 1!:3 SENTENCELOGFILE end.
try. queue =. ;: sentence catch. queue =. 0$a: end.
NB. If the last word is a comment, delete it
if. #queue do. NB. following fails on no words
NB. Get mask of words to discard: discard leading control words, or anything starting with a control word after a non-control
dischdtl =. (*./\ ,: [: +./\ 0 , (2) </\ ]) iscw queue
if. (('.:' -.@e.~ {:) *. 'NB.' -: }:) 4 {. _1 {:: queue do. dischdtl =. 1 (<1 _1)} dischdtl end.
NB. Get the sentence in the form the user gave it, by deleting the nonblank characters corresponding
NB. to the discarded words.
ndiscardshdtl =. dischdtl (#@(-.&' ')@;@#)"1 queue
NB. Make sure the queue matches the tokens that have been selected for processing
queue =. ;: usersentence =: ' ' (-@(i.&0@:= |.) }. i.&0@:= }. ]) sentence ((}.~ {.) }.~ -@{:@]) ndiscardshdtl i.~"0 1 (0) ,. (+/\ ,: +/\@|.) ' ' ~: sentence
end.
NB.?lintonly usersentence =: ''
NB. If the sentence is empty, abort
if. 0 = #queue do.
failmsg 'Usage: dissect ''sentence''',LF,LF,'Try dissect ''0'' to see example screen' return.
end.
NB. Append an end-of-queue mark to the sentence, and initialize the stack.
NB. The stack is type;value;tokennums where value is the locale of the object producing the result, for verb and noun;
NB. or the string form, for a modifier. Tokennums are the input token numbers that contribute to the item
queue =. mark ; queue
stack =. 4 2 $ mark;''
NB. In case of parse failure, we remember whether we executed a user modifier. If we did, our assumption that it produced
NB. a verb may have caused the failure, and we give a suitably couched error message
usermodifierencountered =: 0
NB. Process the sentence through the stack
while. do.
NB. If the stack contains an executable combination, execute it
NB. If part of the execution has unknown value, produce an unknown result, of type 'noun' for verb executions,
NB. and 'verb' for modifier executions
select.
NB.?lintonly stack =. (verb,verb,verb,noun,4$mark);"0 1 '';''
if. (#PTpatterns) > pline =. 1 1 1 1 i.~ * PTpatterns bwand"1 ,>4 1{.stack do.
exeblock =. (subj =. pline{PTsubj) # 4 {. stack NB. the executable part
exetypes =. > subj # , 4 1 {. stack NB. the corresponding types
end.
NB.?lintonly exeblock =. 3 3$<'' [ exetypes =. 0 0 0 [ subj =. 0 1 1 1
QP^:DEBPARSE'pline exetypes exeblock stack '
pline
case. 0;1 do. NB. monad
NB. If the sentence is going to create a noun result, a monad/dyad must be followed by rpar, mark, or conj.
NB. Anything else would fail or produce an adverb. If we detect anything else, we fail, localizing the error
NB. to between the y operand and the following token
if. ((<:sdt) bwand (< 0 ,~ 3+pline) {:: stack) -.@e. mark,rpar,conj do.
etype =. 'Syntax error: execution of monad not at the end'
failmsg etype , LF , 'Error snippet: ' , ;:^:_1 (<: /:~ ; (< 2 ;~ 1 2 3 + pline) { stack) { ;: sentence NB. Decr tok #s for leading mark in queue
return.
end.
NB. Create a monad execution block for the operands, and put that on the stack
stack =. ((subj i. 1){.stack),('dissectmonad' 0 createmodifier exeblock),((>:subj i: 1)}. stack)
case. 2 do. NB. dyad
NB. Verify followed by rpar/mask, as for monad exe
if. ((<:sdt) bwand (< 4 0) {:: stack) -.@e. mark,rpar,conj do.
etype =. 'Syntax error: execution of dyad not at the end'
failmsg etype , LF , 'Error snippet: ' , ;:^:_1 (<: /:~ ; (< 2 3 4;2) { stack) { ;: sentence NB. Decr tok #s for leading mark in queue
return.
end.
NB. Create a dyad execution block for the operands, and put that on the stack
stack =. ((subj i. 1){.stack),('dissectdyad' 0 createmodifier exeblock),((>:subj i: 1)}. stack)
case. 3;4 do. NB. adverb/conjunction execution
stack =. ((subj i. 1){.stack),(execmod exeblock),((>:subj i: 1)}. stack)
case. 5 do. NB. Trident N V V or V V V
NB. Create a trident execution block for the operands, and put that on the stack
stack =. ((subj i. 1){.stack),('dissectfork' 0 createmodifier exeblock),((>:subj i: 1)}. stack)
case. 6 do. NB. bident A A, C VN, VN C, V V and errors like N N, C C, etc
NB.?lintonly exetypes =. 0 0 [ exeblock =. '';'';''
if. bwand/ verb , exetypes do. NB. V V
stack =. ((subj i. 1){.stack),('dissecthook' 0 createmodifier exeblock),((>:subj i: 1)}. stack)
elseif. (bwand/ adv , exetypes) +. (conj = +/ conj bwand exetypes) do. NB. A A, C VN, NV C
NB. This becomes an adverb type. The value is the exeblock, which will be executed later
stack =. ((subj i. 1){.stack),(adv;exeblock;(< /:~ ; 2 {"1 exeblock)),((>:subj i: 1)}. stack)
elseif. do.
etype =. 'Syntax error: invalid sequence ' , ;:^:_1 ('Verb';'Adverb';'Conjunction';'Noun') {~ 1 i.~"1 * exetypes bwand/ (verb,adv,conj)
failmsg etype , LF , 'Error snippet: ' , ;:^:_1 (<: /:~ ; 2 {"1 exeblock) { ;: sentence NB. Decr tok #s for leading mark in queue
return.
end.
case. 7 do. NB. assignment
NB. See if we can analyze the assignment. If so, add to the name table.
NB. If the assignment is not a noun value, ignore it with a warning
if. 0 = noun bwand 2 { exetypes do.
failmsg 'Undissectable sentence: non-noun assignment not supported'
rname =. 0$a:
return.
NB. See if it's a simple assignment to a name
elseif. name = 0 { exetypes do.
rname =. (<0 1) { exeblock NB. boxed name
NB. If the assignment is an AR assignment, ignore it with a warning
elseif. (sdt+noun) ([ -: bwand) 0 { exetypes do.
rname =. (<0 1) {:: exeblock NB. locale of sdt
NB.?lintonly op_dissectnoun_ =: '' [ rname =. <'dissectnoun'
if. 2 = 3!:0 lvalue =. ". op__rname do. NB.?lintonly [ lvalue =. ''
if. '`' = {. lvalue do.
failmsg 'Undissectable sentence: AR assignment to ' , lvalue , ' not supported'
rname =. 0$a:
return.
else.
rname =. ;: :: (a:$~0:) lvalue
end.
else.
failmsg 'Undissectable sentence: invalid assignment'
return.
end.
NB. If the assignment is to a variable name, we can do nothing with it
elseif. do.
rname =. 0$a:
end.
NB. If the assignment is one we can handle, we will have one or more names. In that case, create an
NB. assignment block on the stack
stack =. ((subj i. 1){.stack),('dissectassign' 0 createmodifier exeblock;qopt 'noassignment'),((>:subj i: 1)}. stack)
NB. We would like to preserve the value of the unhandleable assignment, but we can't, because
NB. We need an assignment node to account for the assignment tokens, and we can't get a value for the
NB. modifier because it might be complex (a train). If we try to push the assignment tokens into
NB. the rvalue, it would have to be able to handle them, which we're not ready to do since they would be
NB. out of order. So, we lose the value of the assignment (kludge)
NB. Otherwise, we have to ignore it. We can't produce an assignment block, because we don't know what
NB. value to put into the executed sentence. So we just ignore the assignment, leaving
NB. the rvalue on the stack. We will leave the assignment tokkens out of the display too, since we
NB. don't process them
NB. rname has the list of names that we should define. If this is a global assignment,
NB. append the locale name to each name that doesn't contain a locative
if. (<'=:') -: (<1 1) { exeblock do. rname =. (('_',(>loc),'_') ,~ ])^:('__'&(+./@:E.) +: '_' = {:)&.> rname end.
NB. We can't deal with assignments to object locatives since we track only the part of speech, not the value, at parse time
if. +./ elocs =. '__'&(+./@:E.)@> rname do.
NB. We used to give a warning but that's probably doing too much
NB. smoutput 'Assignment to object locatives not supported: ' , ;:^:_1 elocs # rname
rname =. (-. elocs) # rname
end.
NB. Define the names, as nouns (J nameclass 0).
defnames =: (rname ,"0 1 ((0+256*qopt 'noassignment');'')) , defnames
case. 8 do. NB. ( x ) - but remember the token numbers of the parens
if. (noun+verb) bwand 1 { exetypes do.
NB. If the stackop is a verb or noun, it has a locale & we should install the tokens there
insideop =. (<1 1) {:: stack
NB.?lintmsgsoff
tokensource__insideop =: tokensource__insideop , ; (<0 2;2) { stack
NB.?lintmsgson
end.
NB. Also remember the tokens in the exeblock. If the word is a modifier, they will
NB. eventually be added into a locale. In any case, they will be around in case of error
stack =. (< ; (<0 1 2;2) { stack) (<1 2)} stack
NB. Remove () from the stack
stack =. (<<<0 2) { stack
NB. If the stack did not have an executable combination, bring the next word onto the stack.
case. do. NB. no executable fragment
if. 0 = #queue do. pline =. _1 break. end. NB. This is how we end the sentence, with pline set as a flag
qend =. > qendb =. {: queue
queue =. }: queue
NB. If this is the last word in the queue, it's the mark, keep it
if. mark = qend do.
stack =. (mark;'';(#queue)) , stack
NB. If this is an assignment statement, and the new word is a name, this is where we detect that.
NB. We stack the bare name as the value
elseif. (asgn = (<0 0) {:: stack) *. isname qend do.
stack =. (name;qend;(#queue)) , stack
NB. If punctuation, keep it
elseif. qendb e. ;:'() =. =:' do.
stack =. ((qend;(#queue)) ;~ (lpar,rpar,2#asgn) {~ (;:'() =. =:') i. qendb) , stack
NB. If self-defining term, create a noun block for it, mark as sdt. String, number, a. a: _.
elseif. (qend e. ;:'a. a: _.') +. (':' ~: {: qend) *. ({. qend) e. '''_0123456789' do.
try.
stack =. stack ,~ (<sdt+noun) 0} createnoun qend;'';(#queue);<".qend
catch.
NB. Any error must be an ill-formed token
failmsg ((<:13!:11'') {:: 9!:8 '') , ': ' , qend
end.
elseif. isname qend do.
NB. Name. Resolve the name to find part of speech.
NB. split the name into (global part),(object locative). If the name is absolute (ending in _),
NB. Make that the entire object locative, so that we look it up in case it has been directly assigned earlier
NB. in the sentence
if. '__' +./@:E. qend do.
'glopart objloc' =. (({. ; 2 }. }.)~ '__'&(i:&1@:E.)) qend
else.
'glopart objloc' =. '';qend
end.
NB. Look up the (object locative)/(simple name) [depending on whether there is an
NB. object locative] in the local name table, resolving to type;value/rank if found
if. (<objloc) e. {."1 defnames do.
'objtype objval' =. 1 2 { (({."1 defnames) i. <objloc) { defnames
gloc =. objval
elseif. (<objloc =. objloc , '_' , (>loc) , '_') e. {."1 defnames do.
NB. not found as a local, but it may have been assigned in this sentence as a global. If so,
NB. use that value
'objtype objval' =. 1 2 { (({."1 defnames) i. <objloc) { defnames
gloc =. objval
elseif. do.
NB. Nothing found in local table - set to resolve the whole thing globally
gloc =. loc
glopart =. qend
end.
NB. Now we have resolved any local that we are going to use. If there was one, it is in
NB. objtype/objval. But a global search may still be needed: if there was
NB. an object locative, or if the local search failed. This search will start in locale gloc.
NB. This search, if performed, must succeed, and we will convert the result to a type/(rank if verb)
if. #glopart do. NB. If was not resolved in table either as (simple, or immed locative)
NB. First, see if this global name was assigned in this sentence. If so, use that value
if. (<objloc =. glopart , '_' , (>gloc) , '_') e. {."1 defnames do.
NB. Name is in our local table. Use that
'objtype objval' =. 1 2 { (({."1 defnames) i. objloc) { defnames
else.
savloc =. coname''
NB.?lintonly savloc =. <'dissect'
NB.?lintmsgsoff
cocurrent gloc
NB.?lintmsgson
NB. Get the value: the value itelf for a noun; the linear rep for others
select. objtype =. 4!:0 :: _2: <glopart
case. 0 do.
objval =. ". glopart
case. 1;2;3 do.
objval =. rankinv_dissect_ f. glopart
case. do.
objtype =. _1
end.
cocurrent savloc
end.
end.
NB. Now objtype/objval are set. If the name is a noun or verb, create a locale for it
NB.?lintonly 'objtype objval' =. 0;0 0 0 0
select. objtype
case. 0 do.
ntypeval =. createnoun qend;qend;(#queue);<objval NB. Keep name, and save name for display
case. 1 do.
NB. adverb: handle the special code (currently only &.>)
NB. If the value of the user name matches special code, expand it on the stack
select. objval
case. '&.>' do.
NB. Create an adverb containing the &.>, with correct tokens. We have to put the single
NB. adverb on the stack, rather than conj+verb, to avoid a parse error (if we had
NB. N0 V1 N2 on the stack, A N V N would execute the dyad but C V N V N would not and would
NB. eventually execute verb N0 erroneously)
ntypeval =. adv ; ((conj;'&.';(#queue)) ,: createverb (,'>');(0$0)) ; $0
case. '"_' do.
NB. Create an adverb containing the "_, with correct tokens. We have to put the single
NB. adverb on the stack, rather than conj verb, to avoid a parse error (if we had
NB. N0 V1 N2 on the stack, A N V N would execute the dyad but C V N V N would not and would
NB. eventually execute verb N0 erroneously
ntypeval =. adv ; ((conj;(,'"');(#queue)) ,: createnoun (,'_');'';(0$0);_) ; $0
case. do.
NB. If the value of the user name matches a supported primitive, replace the name by the supported value
ntypeval =. adv;(((<objval) +./@:((e.>)"0) dissectprimindex) {:: qend;objval);(#queue)
end.