forked from metaeducation/ren-c
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathn-control.c
executable file
·1687 lines (1358 loc) · 51.6 KB
/
n-control.c
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
//
// File: %n-control.c
// Summary: "native functions for control flow"
// Section: natives
// Project: "Rebol 3 Interpreter and Run-time (Ren-C branch)"
// Homepage: https://github.com/metaeducation/ren-c/
//
//=////////////////////////////////////////////////////////////////////////=//
//
// Copyright 2012-2022 Ren-C Open Source Contributors
// Copyright 2012 REBOL Technologies
// REBOL is a trademark of REBOL Technologies
//
// See README.md and CREDITS.md for more information.
//
// Licensed under the Lesser GPL, Version 3.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// https://www.gnu.org/licenses/lgpl-3.0.html
//
//=////////////////////////////////////////////////////////////////////////=//
//
// Control constructs follow these rules:
//
// * If they do not run any branches, the construct will "return void". This
// will signal functions like ELSE and DIDN'T, much like the NULL state
// conveying soft failure does.
//
// (Note: `return VOID;` doesn't actually overwrite the contents of the
// output cell. This makes it possible for functions like ALL to skip
// over void results and let the previous evaluation "drop out".
// See %sys-void.h for more information about this mechanic.)
//
// * If a branch *does* run--and its evaluation happens to produce VOID or
// NULL, then special isotopes are returned: either a zero-lenght GROUP!
// isotope for void, or a BLANK! isotope for NULL. This way THEN runs
// instead of ELSE. Although this does mean there is some conflation of
// the results, the conflated values have properties that mostly align with
// what their intent was--so it works about as well as it can.
//
// (See %sys-bad-word.h for more details about isotopes.)
//
// * Zero-arity function values used as branches will be executed, and
// single-arity functions used as branches will also be executed--but passed
// the value of the triggering condition. Especially useful with lambda:
//
// >> if 1 < 2 [10 + 20] then x -> [print ["THEN got" x]]
// THEN got 30
//
// Isotopes of NULL, FALSE, and BLANK are decayed before being passed to the
// function, unless the argument is taken as a ^META parameter.
//
// (See Do_Branch_Throws() for supported ANY-BRANCH! types and behaviors.)
//
// * There is added checking that a literal block is not used as a condition,
// to catch common mistakes like `if [x = 10] [...]`.
//
#include "sys-core.h"
//
// Group_Branch_Executor: C
//
// To make it easier for anything that runs a branch, the double-evaluation in
// a GROUP! branch has its own executor. This means something like IF can
// push a frame with the branch executor which can complete and then run the
// evaluated-to branch.
//
// So the group branch executor is pushed with the feed of the GROUP! to run.
// It gives this feed to an Evaluator_Executor(), and then delegates to the
// branch returned as a result.
//
//////////////////////////////////////////////////////////////////////////////
//
// 1. The `with` parameter in continuations isn't required to be GC safe or
// even distinct from the output cell (see CONTINUE_CORE()). So whoever
// dispatched to the group branch executor could have passed a fleeting
// value pointer...hence it needs to be stored somewhere. So the group
// executor expects it to be preloaded into `out`...or that out be marked
// stale if it was END. It can then take advantage of the same flexibility
// to pass OUT as the with as well as the target when branch is in SPARE.
//
// 2. The Trampoline has some sanity checking asserts that try to stop you
// from making mistakes. Because this does something weird to use the
// OUT cell as `with` the FRAME_FLAG_BRANCH was taken off at the callsite.
//
Bounce Group_Branch_Executor(Frame(*) frame_)
{
if (THROWING)
return THROWN;
switch (STATE) {
case ST_GROUP_BRANCH_ENTRY_DONT_ERASE_OUT :
goto initial_entry;
case ST_GROUP_BRANCH_RUNNING_GROUP :
goto group_result_in_spare;
default : assert(false);
}
initial_entry: { //////////////////////////////////////////////////////////
Frame(*) evaluator = Make_Frame(
FRAME->feed,
((FRAME->flags.bits & (~ FLAG_STATE_BYTE(255))) // take out state 1
| FRAME_FLAG_BRANCH)
);
Push_Frame(SPARE, evaluator);
evaluator->executor = &Array_Executor;
Clear_Frame_Flag(FRAME, ALLOCATED_FEED);
FRAME->feed = TG_End_Feed; // feed consumed by subframe
STATE = ST_GROUP_BRANCH_RUNNING_GROUP;
return CATCH_CONTINUE_SUBFRAME(evaluator);
} group_result_in_spare: { //////////////////////////////////////////////////
if (ANY_GROUP(SPARE))
fail (Error_Bad_Branch_Type_Raw()); // stop infinite recursion (good?)
Value(const*) with = Is_Fresh(OUT) ? nullptr : OUT; // with here, see [1]
assert(Is_Frame_At_End(FRAME));
return DELEGATE_BRANCH(OUT, SPARE, with); // couldn't do (OUT, OUT, SPARE)
}}
//
// if: native [
//
// {When TO LOGIC! CONDITION is true, execute branch}
//
// return: "void if branch not run, otherwise branch result"
// [<opt> <void> any-value! logic!]
// condition [<opt> any-value! logic!]
// :branch "If arity-1 ACTION!, receives the evaluated condition"
// [any-branch!]
// ]
//
DECLARE_NATIVE(if)
//
// 1. It's a common mistake to write something like `if [1 > 2]` and be
// surprised that is considered "truthy" (as it's an unevaluated block).
// So Is_Conditional_False() notices a hidden bit on ARG(condition) that
// tells IF whether a BLOCK! argument is the product of an evaluation.
// (See CELL_FLAG_UNEVALUATED for more information on this feature.)
//
// 2. Evaluations must be performed through continuations, so IF can't be on
// the C function stack while the branch runs. Rather than asking to be
// called back after the evaluation so it can turn null into null isotopes
// and voids into none, it requests "branch semantics" so that the evaluator
// does that automatically. `delegate` means it doesn't need a callback.
{
INCLUDE_PARAMS_OF_IF;
Value(*) condition = ARG(condition);
Value(*) branch = ARG(branch);
if (Is_Conditional_False(condition)) // errors on literal block, see [1]
return VOID;
return DELEGATE_BRANCH(OUT, branch, condition); // no callback, see [2]
}
//
// either: native [
//
// {Choose a branch to execute, based on TO-LOGIC of the CONDITION value}
//
// return: [<opt> any-value!]
// "Returns null if either branch returns null (unlike IF...ELSE)"
// condition [<opt> any-value! logic!]
// :true-branch "If arity-1 ACTION!, receives the evaluated condition"
// [any-branch!]
// :false-branch
// [any-branch!]
// ]
//
DECLARE_NATIVE(either)
{
INCLUDE_PARAMS_OF_EITHER;
Value(*) condition = ARG(condition);
Value(*) branch = Is_Conditional_True(condition) // see [1] on IF native
? ARG(true_branch)
: ARG(false_branch);
return DELEGATE_BRANCH(OUT, branch, condition); // see [2] on IF native
}
//=//// "THENABLE" FACILITIES: LAZY THEN AND ELSE /////////////////////////=//
//
// The conventional sense of THEN and ELSE are tied to whether a result is
// "nothing" or not, where NULL and VOID are the nothing states.
//
// >> if false [<not run>]
// ; void
//
// >> if false [<not run>] else [print "ELSE triggered by voidness"]
// ELSE triggered by voidness
//
// But this mechanical notion is augmented by a methodization concept, which
// bears some similarity to "thenable" objects in JavaScript:
//
// https://stackoverflow.com/q/59492809/
//
// 1. The input is a ^META parameter in order to react to voids and tolerate
// isotopes. But we don't want to actually return a quoted version of the
// input if branches don't run, so unmeta them.
//
// 2. THEN and ELSE want to pass on contents of a multi-return pack to
// branches if applicable. But the decision on whether it's a THEN or
// ELSE case comes from the first parameter in the pack.
//
// 3. With the exception of ~[~null~]~ and ~[']~ when /DECAY is used, a "pack"
// (isotopic block) will always run a THEN and not an ELSE. If a function
// wants to tweak this, it needs to return a lazy object with customized
// then/else behavior that otherwise reifies to a pack.
//
// 4. A lazy object with a THEN or ELSE method should have that handled here.
// But if those methods aren't present, should it be reified or passed
// as-is to the THEN branch, which may be able to take it as ^META and
// not reify it?
//
// 5. It is legal for a lazy object to have both THEN and ELSE handlers.
// This is useful for instance if it wants to guarantee that at least one
// of the tests is done (e.g. if it would reify to an error if the usage
// did not demonstrate consciousness of the failure one way or another.)
//
// This means a THEN method might not want to run a branch at all, and
// instead run some code as a reaction to the knowledge that a THEN test
// was performed. Such cases should not be forced to a "branch was taken"
// result, so an exception is made for the THEN hook when both a THEN and
// ELSE hook are provided.
//
// 6. If only a THEN or an ELSE branch is received, then a desire for
// "full control" is not assumed, and it is safer to make sure they don't
// accidentally wind up returning something from a THEN which could
// itself trigger an ELSE (for instance).
//
enum {
ST_THENABLE_INITIAL_ENTRY = STATE_0,
ST_THENABLE_REIFYING_SPARE,
ST_THENABLE_RUNNING_BRANCH,
ST_THENABLE_REJECTING_INPUT
};
static Bounce Then_Else_Isotopic_Object_Helper(
Frame(*) frame_,
bool then // true when doing a THEN
){
INCLUDE_PARAMS_OF_THEN; // assume frame compatibility w/ELSE
Value(*) in = ARG(optional);
Value(*) branch = ARG(branch);
if (Is_Meta_Of_Nihil(in))
fail ("THEN/ELSE cannot operate on empty pack! input (e.g. NIHIL)");
Meta_Unquotify(in); // see [1]
if (Is_Raised(in)) { // definitional failure, skip
STATE = ST_THENABLE_REJECTING_INPUT;
return Copy_Cell(OUT, in);
}
if (not Is_Lazy(in)) // Packs run THEN, including ~[~null~]~ and ~[~]~, see [3]
goto test_not_lazy;
goto handle_lazy_object;
handle_lazy_object: { /////////////////////////////////////////////////////
option(Value(*)) then_hook = Select_Symbol_In_Context(in, Canon(THEN));
if (then_hook and Is_Void(unwrap(then_hook)))
then_hook = nullptr; // can be unset by Debranch_Output()
option(Value(*)) else_hook = Select_Symbol_In_Context(in, Canon(ELSE));
if (else_hook and Is_Void(unwrap(else_hook)))
else_hook = nullptr; // can be unset by Debranch_Output()
if (not then_hook and not else_hook) { // !!! should it always take THEN?
if (not Pushed_Decaying_Frame( // fails if no reify method, see [4]
SPARE,
in,
FRAME_FLAG_META_RESULT
)){
Copy_Cell(in, SPARE); // cheap reification... (e.g. quoted)
Meta_Unquotify(in); // see [1]
assert(STATE == ST_THENABLE_INITIAL_ENTRY);
assert(not Is_Isotope(in));
goto test_not_lazy;
}
STATE = ST_THENABLE_REIFYING_SPARE; // will call helper again
return CONTINUE_SUBFRAME(TOP_FRAME);
}
Value(*) hook;
if (then) {
if (not then_hook) {
STATE = ST_THENABLE_REJECTING_INPUT;
return Copy_Cell(OUT, in); // pass lazy object thru to ELSEs
}
hook = unwrap(then_hook);
}
else {
if (not else_hook) {
STATE = ST_THENABLE_REJECTING_INPUT;
return Copy_Cell(OUT, in); // pass lazy object thru to THENs (?)
}
hook = unwrap(else_hook);
}
STATE = ST_THENABLE_RUNNING_BRANCH;
if (then_hook and else_hook) // THEN is likely passthru if both
return DELEGATE(OUT, hook, branch); // not DELEGATE_BRANCH, see [5]
if (not IS_ACTION(hook)) // if not full control, assume must use BRANCH
fail ("non-ACTION! found in THEN or ELSE method of lazy object");
return DELEGATE_BRANCH(OUT, hook, branch); // BRANCH for safety, see [6]
} test_not_lazy: { //////////////////////////////////////////////////////////
assert(not Is_Lazy(in));
if (Is_Void(in) or (REF(decay) and Is_Heavy_Void(in))) {
if (then) {
STATE = ST_THENABLE_REJECTING_INPUT;
if (Is_Pack(in))
return Copy_Cell(OUT, in);
return VOID; // then of void, don't want to write to output cell
}
STATE = ST_THENABLE_RUNNING_BRANCH;
return DELEGATE_BRANCH(OUT, branch, in); // else of void
}
if (Is_Nulled(in) or (REF(decay) and Is_Heavy_Null(in))) {
if (then) {
STATE = ST_THENABLE_REJECTING_INPUT;
return Copy_Cell(OUT, in); // then of null, may be pack
}
STATE = ST_THENABLE_RUNNING_BRANCH;
return DELEGATE_BRANCH(OUT, branch, in); // else of null
}
if (not then) {
STATE = ST_THENABLE_REJECTING_INPUT;
return Copy_Cell(OUT, in); // passthru, see [4]
}
STATE = ST_THENABLE_RUNNING_BRANCH;
return DELEGATE_BRANCH(OUT, branch, in); // then branch, takes arg
}}
//
// did: native [
//
// {Synonym for NOT NULL? that is isotope tolerant (IF DID is prefix THEN)}
//
// return: [logic?]
// ^optional "Argument to test"
// [<opt> <void> <pack> any-value!]
// /decay "Pre-decay ~null~ isotope input to NULL"
// <local> branch ; for frame compatibility with THEN/ELSE/ALSO
// ]
//
DECLARE_NATIVE(did_1) // see TO-C-NAME for why the "_1" is needed
//
// DID exists as a complement to isotopes to help solve conflation of falsey
// values with conditional tests. One example:
//
// >> match [logic! integer!] false
// == ~false~ ; isotope
//
// >> if (match [logic! integer!] false) [print "Want this to run"]
// ** Error: We save you by not letting isotopes be conditionally tested
//
// >> did match [logic! integer!] false
// == ~true~ ; DID tolerates isotopes, returns false only on true NULL
//
// >> if (did match [logic! integer!] false) [print "Praise isotopes!"]
// Praise isotopes!
//
// By making routines that intend to return ANY-VALUE! (even falsey ones) on
// success return the falsey ones as isotopes, incorrect uses can be caught
// and guided to use DID or DIDN'T (or whatever they actually meant).
{
INCLUDE_PARAMS_OF_DID_1;
Value(*) in = ARG(optional);
USED(ARG(decay)); // used by helper
USED(ARG(branch));
switch (STATE) {
case ST_THENABLE_INITIAL_ENTRY :
goto initial_entry;
case ST_THENABLE_REIFYING_SPARE :
Copy_Cell(in, SPARE);
goto reifying_input; // multiple reifications may be needed
case ST_THENABLE_RUNNING_BRANCH :
goto return_true;
default :
assert(false);
}
initial_entry: { //////////////////////////////////////////////////////////
Quotify(Quasify(Init_Word(ARG(branch), Canon(DID_1))), 1); // see [1]
goto reifying_input;
} reifying_input: { /////////////////////////////////////////////////////////
bool then = true;
Bounce bounce = Then_Else_Isotopic_Object_Helper(frame_, then);
switch (STATE) {
case ST_THENABLE_REIFYING_SPARE: // needs another reify step
assert(bounce == BOUNCE_CONTINUE);
break;
case ST_THENABLE_REJECTING_INPUT:
assert(bounce == OUT);
bounce = Init_False(OUT);
break;
case ST_THENABLE_RUNNING_BRANCH:
if (bounce == OUT) // was a cheap branch, didn't need to run
goto return_true;
assert(bounce == BOUNCE_DELEGATE);
bounce = BOUNCE_CONTINUE; // let resolve code run, but we want TRUE
break;
default:
assert(false);
}
return bounce;
} return_true: { ////////////////////////////////////////////////////////////
return Init_True(OUT); // can't trust branch product, see [1]
}}
//
// didn't: native [
//
// {Synonym for NULL? that is isotope tolerant (IF DIDN'T is prefix ELSE)}
//
// return: [logic?]
// ^optional "Argument to test"
// [<opt> <void> any-value!]
// /decay "Pre-decay ~null~ isotope input to NULL"
// <local> branch ; for frame compatibility with THEN/ELSE/ALSO
// ]
//
DECLARE_NATIVE(didnt)
{
INCLUDE_PARAMS_OF_DIDNT;
Value(*) in = ARG(optional);
USED(ARG(decay)); // used by helper
USED(ARG(branch));
if (Is_Meta_Of_Void(in) or Is_Meta_Of_Null(in))
return Init_True(OUT);
if (REF(decay) and Is_Quasi_Null(in))
return Init_True(OUT);
return Init_False(OUT);
}
//
// then: enfix native [
//
// {If input is null, return null, otherwise evaluate the branch}
//
// return: "null if input is null, or branch result"
// [<opt> <void> any-value!]
// ^optional "<deferred argument> Run branch if this is not null"
// [<opt> <void> <fail> <pack> any-value!]
// /decay "Pre-decay ~null~ isotope input to NULL"
// :branch "If arity-1 ACTION!, receives value that triggered branch"
// [<unrun> any-branch!]
// ]
//
DECLARE_NATIVE(then) // see `tweak :then 'defer on` in %base-defs.r
{
INCLUDE_PARAMS_OF_THEN;
Value(*) in = ARG(optional);
Deactivate_If_Activation(ARG(branch));
USED(ARG(branch)); // used by helper
USED(ARG(decay));
switch (STATE) {
case ST_THENABLE_INITIAL_ENTRY :
goto reifying_input;
case ST_THENABLE_REIFYING_SPARE :
Copy_Cell(in, SPARE);
goto reifying_input;
default : assert(false);
}
reifying_input: { /////////////////////////////////////////////////////////
bool then = true;
Bounce bounce = Then_Else_Isotopic_Object_Helper(frame_, then);
return bounce;
}}
//
// else: enfix native [
//
// {If input is not null, return that value, otherwise evaluate the branch}
//
// return: "Input value if not null, or branch result"
// [<opt> <void> any-value!]
// ^optional "<deferred argument> Run branch if this is null"
// [<opt> <void> <fail> <pack> any-value!]
// /decay "Pre-decay ~null~ isotope input to NULL"
// :branch [<unrun> any-branch!]
// ]
//
DECLARE_NATIVE(else) // see `tweak :else 'defer on` in %base-defs.r
{
INCLUDE_PARAMS_OF_ELSE;
Value(*) in = ARG(optional);
Deactivate_If_Activation(ARG(branch));
USED(ARG(branch)); // used by helper
USED(ARG(decay));
switch (STATE) {
case ST_THENABLE_INITIAL_ENTRY :
goto reifying_input;
case ST_THENABLE_REIFYING_SPARE :
Copy_Cell(in, SPARE);
goto reifying_input;
default : assert(false);
}
reifying_input: { /////////////////////////////////////////////////////////
bool then = false;
Bounce bounce = Then_Else_Isotopic_Object_Helper(frame_, then);
return bounce;
}}
//
// also: enfix native [
//
// {For non-null input, evaluate and discard branch (like a pass-thru THEN)}
//
// return: "The same value as input, regardless of if branch runs"
// [<opt> <void> any-value!]
// ^optional "<deferred argument> Run branch if this is not null"
// [<opt> <void> <fail> <pack> any-value!]
// /decay "Pre-decay ~null~ isotope input to NULL"
// :branch "If arity-1 ACTION!, receives value that triggered branch"
// [<unrun> any-branch!]
// ]
//
DECLARE_NATIVE(also) // see `tweak :also 'defer on` in %base-defs.r
{
INCLUDE_PARAMS_OF_ALSO; // `then func [x] [(...) :x]` => `also [...]`
Value(*) in = ARG(optional);
Value(*) branch = ARG(branch);
Deactivate_If_Activation(ARG(branch));
enum {
ST_ALSO_INITIAL_ENTRY = STATE_0,
ST_ALSO_RUNNING_BRANCH
};
switch (STATE) {
case ST_ALSO_INITIAL_ENTRY: goto initial_entry;
case ST_ALSO_RUNNING_BRANCH: goto return_original_input;
default: assert(false);
}
initial_entry: { //////////////////////////////////////////////////////////
if (Is_Meta_Of_Nihil(in))
fail ("ALSO cannot operate on empty pack! input (e.g. NIHIL)");
if (Is_Meta_Of_Void(in))
return VOID; // telegraph invisible intent
if (Is_Meta_Of_Null(in))
return nullptr; // telegraph pure null
if (Is_Meta_Of_Raised(in)) { // definitional failure, skip
Copy_Cell(OUT, in);
Unquasify(OUT);
return Raisify(OUT);
}
if (REF(decay) and Is_Meta_Of_Heavy_Null(in))
return Init_Heavy_Null(OUT); // telegraph null isotope
STATE = ST_ALSO_RUNNING_BRANCH;
return CONTINUE(SPARE, branch, Meta_Unquotify(in));
} return_original_input: { //////////////////////////////////////////////////
return COPY(in); // in argument has already been Meta_Unquotify()'d
}}
//
// match: native [
//
// {Check value using tests (match types, TRUE or FALSE, or filter action)}
//
// return: "Input if it matched, NULL if it did not (isotope if falsey)"
// [<opt> any-value! logic!]
// test "Typeset or arity-1 filter function"
// [<opt> logic! action! block! type-word! type-group! type-block!]
// value [<opt> <void> any-value!]
// ]
//
DECLARE_NATIVE(match)
//
// Note: Ambitious ideas for the "MATCH dialect" are on hold, and this function
// just does some fairly simple matching:
//
// https://forum.rebol.info/t/time-to-meet-your-match-dialect/1009/5
{
INCLUDE_PARAMS_OF_MATCH;
Value(*) v = ARG(value);
Value(*) test = ARG(test);
if (Is_Nulled(test)) {
if (not Is_Nulled(v))
return nullptr;
}
else if (IS_LOGIC(test)) {
if (Is_Truthy(v) != VAL_LOGIC(test))
return nullptr;
}
else switch (VAL_TYPE(test)) {
case REB_ACTION: {
if (rebRunThrows(
SPARE, // <-- output cell
test, rebQ(v)
)){
return THROWN;
}
if (Is_Falsey(SPARE))
return nullptr;
break; }
case REB_PARAMETER:
case REB_BLOCK:
case REB_TYPE_WORD:
case REB_TYPE_GROUP:
case REB_TYPE_BLOCK:
if (not Typecheck_Value(test, SPECIFIED, v, SPECIFIED))
return nullptr;
break;
default:
fail (PARAM(test)); // all test types should be accounted for in switch
}
//=//// IF IT GOT THIS FAR WITHOUT RETURNING, THE TEST MATCHED /////////=//
// Falsey matched values return isotopes to show they did match, but to
// avoid misleading falseness of the result:
//
// >> value: false
// >> if match [integer! logic!] value [print "Won't run :-("]
// ; null <-- this would be a bad result!
//
// So successful matching of falsey values will give back ~false~,
// or ~null~ isotopes. This can be consciously turned back into their
// original values with DECAY, which happens automatically in assignments.
//
// >> match [<opt>] null
// == ~[~null~]~ ; isotope
//
// >> decay match [<opt>] null
// == ~null~
//
Copy_Cell(OUT, v); // Otherwise, input is the result
return BRANCHED(OUT);
}
#define FRAME_FLAG_ALL_VOIDS FRAME_FLAG_24
//
// all: native [
//
// {Short-circuiting variant of AND, using a block of expressions as input}
//
// return: "Product of last passing evaluation if all truthy, else null"
// [<opt> <void> any-value!]
// block "Block of expressions, @[block] will be treated inertly"
// [block! the-block!]
// /predicate "Test for whether an evaluation passes (default is DID)"
// [action!]
// <local> scratch
// ]
//
DECLARE_NATIVE(all)
//
// 1. Historically there has been controversy over what should be done about
// (all []) and (any []). Languages that have variadic short-circuiting
// AND + OR operations typically empty AND-ing is truthy while empty OR-ing
// is falsey.
//
// There are some reasonable intuitive arguments for that--*if* those are
// your only two choices. Because Ren-C has the option of voids, it's
// better to signal to the caller that nothing happened. For an example
// of how useful it is, see the loop wrapper FOR-BOTH. Other behaviors
// can be forced with (all [... null]) or (any [... true])
//
// 2. The predicate-running condition gets pushed over the "keepalive" stepper,
// but we don't want the stepper to take a step before coming back to us.
// Temporarily patch out the Evaluator_Executor() so we get control back
// without that intermediate step.
//
// 3. The only way a falsey evaluation should make it to the end is if a
// predicate let it pass. Don't want that to trip up `if all` so make it
// an isotope...but this way `(all/predicate [null] :not?) then [<runs>]`
{
INCLUDE_PARAMS_OF_ALL;
Value(*) block = ARG(block);
Value(*) predicate = ARG(predicate);
Value(*) scratch = ARG(scratch);
Value(*) condition; // will be found in OUT or scratch
enum {
ST_ALL_INITIAL_ENTRY = STATE_0,
ST_ALL_EVAL_STEP,
ST_ALL_PREDICATE
};
switch (STATE) {
case ST_ALL_INITIAL_ENTRY: goto initial_entry;
case ST_ALL_EVAL_STEP: goto eval_step_result_in_spare;
case ST_ALL_PREDICATE: goto predicate_result_in_scratch;
default: assert(false);
}
initial_entry: { //////////////////////////////////////////////////////////
if (VAL_LEN_AT(block) == 0)
return VOID;
assert(Not_Frame_Flag(FRAME, ALL_VOIDS));
Set_Frame_Flag(FRAME, ALL_VOIDS);
Flags flags = FRAME_FLAG_TRAMPOLINE_KEEPALIVE;
if (IS_THE_BLOCK(block))
flags |= EVAL_EXECUTOR_FLAG_NO_EVALUATIONS;
Frame(*) subframe = Make_Frame_At(block, flags);
Push_Frame(SPARE, subframe);
STATE = ST_ALL_EVAL_STEP;
return CONTINUE_SUBFRAME(subframe);
} eval_step_result_in_spare: { //////////////////////////////////////////////
if (Is_Void(SPARE) or Is_Nihil(SPARE)) { // (comment "hi") (if false [<a>])
if (Is_Frame_At_End(SUBFRAME))
goto reached_end;
assert(STATE == ST_ALL_EVAL_STEP);
Restart_Evaluator_Frame(SUBFRAME);
return CONTINUE_SUBFRAME(SUBFRAME);
}
Clear_Frame_Flag(FRAME, ALL_VOIDS);
Decay_If_Unstable(SPARE);
if (not Is_Nulled(predicate)) {
SUBFRAME->executor = &Just_Use_Out_Executor; // tunnel thru, see [2]
STATE = ST_ALL_PREDICATE;
return CONTINUE(scratch, predicate, SPARE);
}
condition = SPARE; // without predicate, `condition` is same as evaluation
goto process_condition;
} predicate_result_in_scratch: { ////////////////////////////////////////////
if (Is_Void(scratch)) // !!! Should void predicate results signal opt-out?
fail (Error_Bad_Void());
Isotopify_If_Falsey(SPARE); // predicates can approve "falseys", see [3]
SUBFRAME->executor = &Evaluator_Executor; // done tunneling, see [2]
STATE = ST_ALL_EVAL_STEP;
condition = scratch;
goto process_condition; // with predicate, `condition` is predicate result
} process_condition: { //////////////////////////////////////////////////////
if (Is_Falsey(condition)) {
Drop_Frame(SUBFRAME);
return nullptr;
}
goto update_out_from_spare;
} update_out_from_spare: { //////////////////////////////////////////////////
Move_Cell(OUT, SPARE); // leaves SPARE as fresh...good for next step
if (Is_Frame_At_End(SUBFRAME))
goto reached_end;
assert(STATE == ST_ALL_EVAL_STEP);
Restart_Evaluator_Frame(SUBFRAME);
return CONTINUE_SUBFRAME(SUBFRAME);
} reached_end: { ////////////////////////////////////////////////////////////
Drop_Frame(SUBFRAME);
if (Get_Frame_Flag(FRAME, ALL_VOIDS))
return VOID;
return BRANCHED(OUT);
}}
//
// any: native [
//
// {Short-circuiting version of OR, using a block of expressions as input}
//
// return: "First passing evaluative result, or null if none pass"
// [<opt> <void> any-value!]
// block "Block of expressions, @[block] will be treated inertly"
// [block! the-block!]
// /predicate "Test for whether an evaluation passes (default is DID)"
// [action!]
// ]
//
DECLARE_NATIVE(any)
//
// 1. Don't let ANY return something falsey, but using an isotope means that
// it can work with DID/THEN
//
// 2. See ALL[2]
//
// 3. See ALL[3]
{
INCLUDE_PARAMS_OF_ANY;
Value(*) predicate = ARG(predicate);
Value(*) block = ARG(block);
Value(*) condition; // could point to OUT or SPARE
enum {
ST_ANY_INITIAL_ENTRY = STATE_0,
ST_ANY_EVAL_STEP,
ST_ANY_PREDICATE
};
switch (STATE) {
case ST_ANY_INITIAL_ENTRY: goto initial_entry;
case ST_ANY_EVAL_STEP: goto eval_step_result_in_out;
case ST_ANY_PREDICATE: goto predicate_result_in_spare;
default: assert(false);
}
initial_entry: { //////////////////////////////////////////////////////////
if (VAL_LEN_AT(block) == 0)
return VOID;
assert(Not_Frame_Flag(FRAME, ALL_VOIDS));
Set_Frame_Flag(FRAME, ALL_VOIDS);
Flags flags = FRAME_FLAG_TRAMPOLINE_KEEPALIVE;
if (IS_THE_BLOCK(block))
flags |= EVAL_EXECUTOR_FLAG_NO_EVALUATIONS;
Frame(*) subframe = Make_Frame_At(block, flags);
Push_Frame(OUT, subframe);
STATE = ST_ANY_EVAL_STEP;
return CONTINUE_SUBFRAME(subframe);
} eval_step_result_in_out: { ////////////////////////////////////////////////
if (Is_Void(OUT) or Is_Nihil(OUT)) { // (comment "hi") (if false [<a>])
if (Is_Frame_At_End(SUBFRAME))
goto reached_end;
assert(STATE == ST_ANY_EVAL_STEP);
Restart_Evaluator_Frame(SUBFRAME);
return CONTINUE_SUBFRAME(SUBFRAME);
}
Clear_Frame_Flag(FRAME, ALL_VOIDS);
Decay_If_Unstable(OUT);
if (not Is_Nulled(predicate)) {
SUBFRAME->executor = &Just_Use_Out_Executor; // tunnel thru, see [2]
STATE = ST_ANY_PREDICATE;
return CONTINUE(SPARE, predicate, OUT);
}
condition = OUT;
goto process_condition;
} predicate_result_in_spare: { //////////////////////////////////////////////
if (Is_Void(SPARE)) // !!! Should void predicate results signal opt-out?
fail (Error_Bad_Void());
Isotopify_If_Falsey(OUT); // predicates can approve "falseys", see [3]
SUBFRAME->executor = &Evaluator_Executor; // done tunneling, see [2]
STATE = ST_ANY_EVAL_STEP;
condition = SPARE;
goto process_condition;
} process_condition: { //////////////////////////////////////////////////////
if (Is_Truthy(condition))
goto return_out;
if (Is_Frame_At_End(SUBFRAME))
goto reached_end;
assert(STATE == ST_ANY_EVAL_STEP);
Restart_Evaluator_Frame(SUBFRAME);
return CONTINUE_SUBFRAME(SUBFRAME);
} return_out: { /////////////////////////////////////////////////////////////
Drop_Frame(SUBFRAME);
return BRANCHED(OUT); // successful ANY returns the value
} reached_end: { ////////////////////////////////////////////////////////////
Drop_Frame(SUBFRAME);
if (Get_Frame_Flag(FRAME, ALL_VOIDS))
return VOID;
return nullptr; // reached end of input and found nothing to return
}}
//
// case: native [
//
// {Evaluates each condition, and when true, evaluates what follows it}
//
// return: "Last matched case evaluation, or null if no cases matched"
// [<opt> <void> any-value!]
// cases "Conditions followed by branches"