diff --git a/lib/check.ml b/lib/check.ml index 84dd80ba..fc987993 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4573,14 +4573,14 @@ module Found = Ephemeron.K1.Make (struct let mismatch_found : Types.t Found.t = Found.create 16 let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr = - let need sym ty = rt loc ty sym [ e ] in + let need sym ty = rt loc ty sym [ e; here loc ] in match want with - | Types.Float Types.F64 -> need "flan_dyn_need_f64" dyn_f64 + | Types.Float Types.F64 -> need "flan_dyn_need_f64_at" dyn_f64 | Types.Bool -> (* The ABI answers an [int32_t]; [bool] is an [i1]. The narrowing is the language's own cast and cannot fail — the runtime already decided the value was a bool, so what comes back is 0 or 1. *) - widen loc Types.Bool (need "flan_dyn_need_bool" (Types.Int Types.I32)) + widen loc Types.Bool (need "flan_dyn_need_bool_at" (Types.Int Types.I32)) (* Only a dyn char: an int is a number until (char n) converts it. *) | Types.Char -> rt loc Types.Char "flan_dyn_need_char" [ e; here loc ] (* Any integer width, checked at run time at this site (TODO.org, "Dyn @@ -9856,8 +9856,14 @@ and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) = in (* (the dyn nil) is a dyn value that holds nil, not the literal: at a typed want it traps at run time as any dyn holding nil does, where a bare nil - is refused ([is_nil_lit] sees through nothing, so the [Do] hides it). *) - let r = if is_nil_lit r && ty = Types.Dyn then mk loc Types.Dyn (Tast.Do [ r ]) else r in + is refused. (the dyn 1) is likewise a dyn, not a literal that brings + nothing dyn to an operator ([no_bare_nil]). [is_nil_lit] and + [boxed_literal] see through nothing, so the [Do] hides both. *) + let r = + if ty = Types.Dyn && (is_nil_lit r || boxed_literal r <> None) then + mk loc Types.Dyn (Tast.Do [ r ]) + else r + in expect ctx loc ~want r (* [f] run for its answer alone: whatever it wrote into the context is put diff --git a/lib/emit.ml b/lib/emit.ml index d18cb4c3..c519af35 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5149,6 +5149,8 @@ declare ptr @flan_dev_literal(ptr, i64) declare i64 @flan_dyn_need_i64(i64) declare double @flan_dyn_need_f64(i64) declare i32 @flan_dyn_need_bool(i64) +declare double @flan_dyn_need_f64_at(i64, ptr, i64) +declare i32 @flan_dyn_need_bool_at(i64, ptr, i64) declare i32 @flan_dyn_need_i32(i64, ptr, i64) declare i64 @flan_dyn_need_int(i64, i32, ptr, i64) declare i64 @flan_dyn_int_of(i64) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 455bff6e..78a91b30 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -2817,11 +2817,14 @@ int64_t flan_dyn_need_i64(flan_dyn v) { * makes rather than a surprise somebody meets. Softening the check here is the * option not to take: this function sees a tag and nothing else, so it could * not tell (g 1) from (g (length xs)). */ -double flan_dyn_need_f64(flan_dyn v) { +/* The _at forms trap at the site the checker hands over; the plain ones are + * for C callers that have none. */ +double flan_dyn_need_f64_at(flan_dyn v, const uint8_t *loc, int64_t loclen) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_FLOAT) - trap1(NULL, 0, TYPE_TRAP, "f64", "a float was wanted", v); + trap1(loc, loclen, TYPE_TRAP, "f64", "a float was wanted", v); return dyn_num_value(v); } +double flan_dyn_need_f64(flan_dyn v) { return flan_dyn_need_f64_at(v, NULL, 0); } static const char *an(const char *w); /* forward: "a" or "an" */ @@ -2914,11 +2917,12 @@ uint32_t flan_dyn_need_char(flan_dyn v, const uint8_t *loc, int64_t loclen) { flan_trap((const uint8_t *)"DynType", 7); } -uint8_t flan_dyn_need_bool(flan_dyn v) { +uint8_t flan_dyn_need_bool_at(flan_dyn v, const uint8_t *loc, int64_t loclen) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL) - trap1(NULL, 0, TYPE_TRAP, "bool", "a bool was wanted", v); + trap1(loc, loclen, TYPE_TRAP, "bool", "a bool was wanted", v); return (uint8_t)(dyn_payload(v) ? 1 : 0); } +uint8_t flan_dyn_need_bool(flan_dyn v) { return flan_dyn_need_bool_at(v, NULL, 0); } /* ── A numeric cast opening a box ─────────────────────────────────────── * diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index bfb8c85d..d938545c 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -306,6 +306,9 @@ void flan_dyn_emit_watch(flan_dyn v); int64_t flan_dyn_need_i64(flan_dyn v); double flan_dyn_need_f64(flan_dyn v); uint8_t flan_dyn_need_bool(flan_dyn v); +/* The same, trapping at the site [loc] names. */ +double flan_dyn_need_f64_at(flan_dyn v, const uint8_t *loc, int64_t loclen); +uint8_t flan_dyn_need_bool_at(flan_dyn v, const uint8_t *loc, int64_t loclen); /* For a typed integer of width [kind], 0..7 for i8 u8 i16 u16 i32 u32 i64 * u64: an int in range, or a char's code point where it fits (ASCII only * into a byte), as an i64 the caller narrows. Anything else traps at [loc]. diff --git a/test/programs/dyn-crossing.flan b/test/programs/dyn-crossing.flan index def9fecb..f4f61684 100644 --- a/test/programs/dyn-crossing.flan +++ b/test/programs/dyn-crossing.flan @@ -60,7 +60,7 @@ (let [r (the i32 0)] (when (= a "nil-want-first") (set r (+ (the dyn nil) 1 2))) (when (= a "nil-want-last") (set r (+ 1 2 (the dyn nil)))) - (set r (+ r (at-i32 a))) + (set r (+ r (at-i32 a))) (the-literal a) (println r))))) 0) @@ -79,3 +79,16 @@ (= a "i32-nil-mid") (+ 1 none 1) (= a "i32-nil-last") (+ 1 1 none) :else 0))) + +;; (the dyn ) is a dyn like any other: beside nil it traps at run +;; time, as a dyn bound to a name does. And opening one at f64 or bool names +;; its site. +(defn the-literal [a str] () + (let [x (the f64 0.0) + b false] + (when (= a "lit-int") (println (+ (the dyn 1) nil))) + (when (= a "lit-float") (println (+ (the dyn 1.5) nil))) + (when (= a "lit-bool") (println (+ (the dyn true) nil))) + (when (= a "lit-let") (let [d (the dyn 1)] (println (+ d nil)))) + (when (= a "want-f64") (set x (the dyn 3)) (println x)) + (when (= a "want-bool") (set b (the dyn 3)) (println b)))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index c10ec35e..6cb47fec 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5708,7 +5708,15 @@ level "1" "big-shift", "77:25", too_wide "4294967294"; "i32-nil-first", "78:29", "dyn +: nil and int, and it takes two numbers — (+ nil 1)"; "i32-nil-mid", "79:27", "dyn +: int and nil, and it takes two numbers — (+ 1 nil)"; - "i32-nil-last", "80:28", "dyn +: int and nil, and it takes two numbers — (+ 2 nil)" ] + "i32-nil-last", "80:28", "dyn +: int and nil, and it takes two numbers — (+ 2 nil)"; + (* (the dyn ) beside nil traps as a named dyn does, and an + f64 or bool opening names its site. *) + "lit-int", "89:36", "dyn +: int and nil, and it takes two numbers — (+ 1 nil)"; + "lit-float", "90:38", "dyn +: float and nil, and it takes two numbers — (+ 1.5 nil)"; + "lit-bool", "91:37", "dyn +: bool and nil, and it takes two numbers — (+ true nil)"; + "lit-let", "92:57", "dyn +: int and nil, and it takes two numbers — (+ 1 nil)"; + "want-f64", "93:35", "dyn f64: int, and a float was wanted — (f64 3)"; + "want-bool", "94:36", "dyn bool: int, and a bool was wanted — (bool 3)" ] in List.iter (fun x86 -> diff --git a/test/test_flan.ml b/test/test_flan.ml index 836e7433..9154491e 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -2103,6 +2103,10 @@ let () = "(defn f [p dyn] i32 (+ 1 2 p (the dyn nil)))\n\ (defn g [] i32 (let [r (the i32 0)] (set r (+ (the dyn nil) 1 2)) r))\n\ (defn main [] i32 (println (< 1 2 (the dyn nil))) 0)"; + accepts "nil beside (the dyn ) is left to the run time" + "(defn main [] i32\n\ + (println (+ (the dyn 1) nil) (+ (the dyn 1.5) nil) (+ (the dyn true) nil)\n\ + (< (the dyn 1) nil) (min 2 (the dyn 1.5) nil)) 0)"; accepts "nil beside a real dyn in a fold is left to the run time" "(defn f [p dyn] dyn (+ 1 2 p nil))\n(defn main [] i32 0)"; (* An operand past the pair asked on its own terms records nothing: the