Leverage intrinsics in eval/typecheck

This takes the next step after having intrinsics, to actually
bypassing the frame building mechanics in order to use them in
some limited scenarios.

Those scenarios are non-enfix dispatch in the evaluator by WORD!,
as well as in the typechecking.

src/boot/errors.r

@@ -152,6 +152,9 @@ Script: [
     phase-expect-arg:
         [:arg1 {internal phase expects} :arg2 {for its} :arg3 {argument}]
 
+    no-logic-typecheck: [:arg1 {must return LOGIC? to use in typechecking}]
+    no-arg-typecheck:   [:arg1 {must take an argument to use in typechecking}]
+
     invalid-type:       [:arg1 {type is not allowed here}]
     invalid-op:         [{invalid operator:} :arg1]
     no-op-arg:          [:arg1 {operator is missing an argument}]

src/core/c-error.c

@@ -1174,6 +1174,35 @@ Context(*) Error_Phase_Arg_Type(
 }
 
 
+//
+//  Error_No_Logic_Typecheck: C
+//
+Context(*) Error_No_Logic_Typecheck(option(Symbol(const*)) label)
+{
+    DECLARE_LOCAL (name);
+    if (label)
+        Init_Word(name, unwrap(label));
+    else
+        Init_Nulled(name);
+
+    return Error_No_Logic_Typecheck_Raw(name);
+}
+
+
+//
+//  Error_No_Arg_Typecheck: C
+//
+Context(*) Error_No_Arg_Typecheck(option(Symbol(const*)) label)
+{
+    DECLARE_LOCAL (name);
+    if (label)
+        Init_Word(name, unwrap(label));
+    else
+        Init_Nulled(name);
+
+    return Error_No_Arg_Typecheck_Raw(name);
+}
+
 //
 //  Error_Bad_Argless_Refine: C
 //

src/core/evaluator/c-eval.c

@@ -354,6 +354,22 @@ Bounce Evaluator_Executor(Frame(*) f)
         f_current_gotten = nullptr;  // !!! allow/require to be passe in?
         goto evaluate; }
 
+      intrinsic_in_scratch_arg_in_spare:
+      case ST_EVALUATOR_CALCULATING_INTRINSIC_ARG : {
+        Action(*) action = VAL_ACTION(SCRATCH);
+        Intrinsic* intrinsic = Extract_Intrinsic(action);
+        REBPAR* param = ACT_PARAM(action, 2);
+
+        if (VAL_PARAM_CLASS(param) == PARAM_CLASS_META)
+            Meta_Quotify(SPARE);
+        if (not Typecheck_Coerce_Argument(param, SPARE)) {
+            option(Symbol(const*)) label = VAL_ACTION_LABEL(SCRATCH);
+            const REBKEY* key = ACT_KEY(action, 2);
+            fail (Error_Arg_Type(label, key, param, SPARE));
+        }
+        (*intrinsic)(OUT, SPARE);
+        goto finished; }
+
       case REB_GROUP :
       case REB_GET_GROUP :
       case REB_META_GROUP :
@@ -719,6 +735,28 @@ Bounce Evaluator_Executor(Frame(*) f)
             else
                 enfixed = Get_Action_Flag(action, ENFIXED);
 
+            if (
+                not enfixed  // too rare a case for intrinsic optimization
+                and ACT_DISPATCHER(action) == &Intrinsic_Dispatcher
+                and Not_Frame_At_End(f)  // can't do <end>, fallthru to error
+                and not SPORADICALLY(10)  // debug build bypass every 10th call
+            ){
+                Copy_Cell(SCRATCH, unwrap(f_current_gotten));
+                INIT_VAL_ACTION_LABEL(SCRATCH, label);  // use the word
+                REBPAR* param = ACT_PARAM(action, 2);
+                Flags flags = 0;
+                if (VAL_PARAM_CLASS(param) == PARAM_CLASS_META)
+                    flags |= FRAME_FLAG_FAILURE_RESULT_OK;
+
+                if (Did_Init_Inert_Optimize_Complete(SPARE, f->feed, &flags))
+                    goto intrinsic_in_scratch_arg_in_spare;
+
+                Frame(*) subframe = Make_Frame(f->feed, flags);
+                Push_Frame(SPARE, subframe);
+                STATE = ST_EVALUATOR_CALCULATING_INTRINSIC_ARG;
+                return CATCH_CONTINUE_SUBFRAME(subframe);
+            }
+
             Frame(*) subframe = Make_Action_Subframe(f);
             Push_Frame(OUT, subframe);
             Push_Action(subframe, action, binding);

src/core/evaluator/c-trampoline.c

@@ -477,6 +477,19 @@ bool Trampoline_With_Top_As_Root_Throws(void)
         return false;
 
   #if DEBUG_FANCY_PANIC
+    if (r == BOUNCE_CONTINUE)
+        printf("R is BOUNCE_CONTINUE\n");
+    else if (r == BOUNCE_DELEGATE)
+        printf("R is BOUNCE_DELEGATE\n");
+    else if (r == BOUNCE_REDO_CHECKED)
+        printf("R is BOUNCE_REDO_CHECKED\n");
+    else if (r == BOUNCE_REDO_UNCHECKED)
+        printf("R is BOUNCE_REDO_UNCHECKED\n");
+    else if (r == BOUNCE_SUSPEND)
+        printf("R is BOUNCE_SUSPEND\n");
+    else
+        printf("R is something unknown\n");
+
     Dump_Stack(root);
   #endif
 

src/core/functionals/c-typechecker.c

@@ -187,13 +187,14 @@ bool Typecheck_Value(
     }
 
     for (; item != tail; ++item) {
-        //
+        option(Symbol(const*)) label = nullptr;  // so goto doesn't cross
+
         // !!! Ultimately, we'll enable literal comparison for quoted/quasi
         // items.  For the moment just try quasi-words for isotopes.
         //
         if (IS_QUASI(item)) {
             if (HEART_BYTE(item) == REB_VOID) {
-                if (Is_Quasi_Void(item))
+                if (Is_None(v))
                     goto test_succeeded;
                 goto test_failed;
             }
@@ -211,6 +212,7 @@ bool Typecheck_Value(
         enum Reb_Kind kind;
         Cell(const*) test;
         if (IS_WORD(item)) {
+            label = VAL_WORD_SYMBOL(item);
             test = Lookup_Word_May_Fail(item, tests_specifier);
             kind = VAL_TYPE(test);  // e.g. TYPE-BLOCK! <> BLOCK!
         }
@@ -232,28 +234,6 @@ bool Typecheck_Value(
           case REB_ACTION: {
             Action(*) action = VAL_ACTION(test);
 
-            // NULL? and VOID? do not have type specs on their argument,
-            // because if they did they would have to mention <opt> and <void>
-            // and this would lead to an infinite recursion if called here.
-            //
-            // But we still speedup the checking to avoid needing a function
-            // call.  This could be generalized, where typecheckers are
-            // associated with internal function pointers for testing...so
-            // no actual frame needed to be built for any arity-1 and
-            // logic-returning native.
-
-            if (action == VAL_ACTION(Lib(NULL_Q))) {
-                if (Is_Nulled(v))
-                    goto test_succeeded;
-                goto test_failed;
-            }
-
-            if (action == VAL_ACTION(Lib(VOID_Q))) {
-                if (Is_Void(v))
-                    goto test_succeeded;
-                goto test_failed;
-            }
-
             // Here we speedup the typeset checking.  It may be that the
             // acceleration could be unified with a function pointer method
             // if we are willing to make functions for checking each typeset
@@ -289,6 +269,26 @@ bool Typecheck_Value(
                 goto test_failed;
             }
 
+            if (ACT_DISPATCHER(action) == &Intrinsic_Dispatcher) {
+                Intrinsic* intrinsic = Extract_Intrinsic(action);
+
+                REBPAR* param = ACT_PARAM(action, 2);
+                DECLARE_LOCAL (arg);
+                Derelativize(arg, v, v_specifier);
+                if (VAL_PARAM_CLASS(param) == PARAM_CLASS_META)
+                    Meta_Quotify(arg);
+                if (not Typecheck_Coerce_Argument(param, arg))
+                    goto test_failed;
+
+                DECLARE_LOCAL (out);
+                (*intrinsic)(out, arg);
+                if (not IS_LOGIC(out))
+                    fail (Error_No_Logic_Typecheck(label));
+                if (VAL_LOGIC(out))
+                    goto test_succeeded;
+                goto test_failed;
+            }
+
             Flags flags = 0;
             Frame(*) f = Make_End_Frame(
                 FLAG_STATE_BYTE(ST_ACTION_TYPECHECKING) | flags
@@ -309,7 +309,7 @@ bool Typecheck_Value(
 
             arg = First_Unspecialized_Arg(&param, f);
             if (not arg)
-                fail ("Type predicate doesn't take an argument");
+                fail (Error_No_Arg_Typecheck(label));  // must take argument
 
             Derelativize(arg, v, v_specifier);  // do not decay, see [4]
 
@@ -331,7 +331,7 @@ bool Typecheck_Value(
             Drop_Frame(f);
 
             if (not IS_LOGIC(spare))
-                fail ("Type Predicates Must Return LOGIC!");
+                fail (Error_No_Logic_Typecheck(label));
 
             if (not VAL_LOGIC(spare))
                 goto test_failed;
@@ -471,8 +471,8 @@ bool Typecheck_Coerce_Argument(
         if (Is_Raised(arg))
             goto return_false;
 
-        if (Is_Nihil(arg))
-            goto return_false;  // can't decay
+        if (Is_Pack(arg) and Is_Pack_Undecayable(arg))
+            goto return_false;  // nihil or unstable isotope in first slot
 
         if (Is_Isotope(arg) and Is_Isotope_Unstable(arg)) {
             Decay_If_Unstable(arg);

src/include/sys-eval.h

@@ -119,7 +119,8 @@ enum {
     // easy use in the "hot" frame header location.
 
     ST_EVALUATOR_LOOKING_AHEAD = 100,
-    ST_EVALUATOR_REEVALUATING
+    ST_EVALUATOR_REEVALUATING,
+    ST_EVALUATOR_CALCULATING_INTRINSIC_ARG
 };
 
 // Some array executions wish to vaporize if all contents vaporize

src/include/sys-throw.h

@@ -128,7 +128,11 @@ inline static Value(*) Decay_If_Unstable(Value(*) v) {
         if (Trampoline_With_Top_As_Root_Throws())
             fail (Error_No_Catch_For_Throw(TOP_FRAME));
         Drop_Frame(TOP_FRAME);
-        return v;
+
+        // fall through in case result is pack or raised
+        // (should this iterate?)
+
+        assert(not Is_Lazy(v));
     }
 
     if (Is_Pack(v)) {  // iterate until result is not multi-return, see [1]
@@ -151,3 +155,22 @@ inline static Value(*) Decay_If_Unstable(Value(*) v) {
 
     return v;
 }
+
+// Packs with unstable isotopes in their first cell (or nihil) are not able
+// to be decayed.  Type checking has to be aware of this, and know that such
+// packs shouldn't raise errors.
+//
+inline static bool Is_Pack_Undecayable(Value(*) pack)
+{
+    assert(Is_Pack(pack));
+    if (Is_Nihil(pack))
+        return true;
+    Cell(const*) at = VAL_ARRAY_AT(nullptr, pack);
+    if (Is_Meta_Of_Raised(at))
+        return true;
+    if (Is_Meta_Of_Pack(at))
+        return true;
+    if (Is_Meta_Of_Lazy(at))
+        return true;
+    return false;
+}