From daed039331420b6e50fdb2598bddacea651a9588 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 19 Sep 2026 19:56:36 +0700 Subject: [PATCH] =?UTF-8?q?Typed=20=3D=20and=20!=3D=20grow=20strings=20?= =?UTF-8?q?=E2=80=94=20M2=20queue=20item=205?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Types.is_equatable splits from is_comparable: a string answers equal? now, bytewise, but still answers no to ordered? — there is no collation the language has picked, so < and friends keep the refusal they had. The comparison itself is one new runtime entry point, flan_str_eq (runtime/flan_rt.c), length-mismatch and same-pointer fast paths ahead of the memcmp, called identically from both backends: emit.ml pulls a string's ptr and length out of the %slice SSA value and calls it directly in the Eq/Ne arm; x86.ml adds an arm ahead of the generic scalar comparison that reaches it through call_native, flipping the answer for != the same way Not already flips a bool. test_flan.ml covers the checker side directly and through a generic instantiated at string, including the two different ways ordered? and equal? fail at that type. test/programs/string-eq.flan is the survey program — same pointer, differing lengths, equal content at distinct addresses (a literal against a fresh heap string), a difference in the last byte, and the empty-string cases — with acceptance rows for LLVM, -O0 and --x86 in test_acceptance.ml. --- lib/check.ml | 19 +++++++++++------ lib/emit.ml | 28 +++++++++++++++++++++++++ lib/types.ml | 13 ++++++++---- lib/x86.ml | 16 +++++++++++++++ runtime/flan_rt.c | 24 ++++++++++++++++++++++ test/programs/string-eq.flan | 40 ++++++++++++++++++++++++++++++++++++ test/test_acceptance.ml | 14 +++++++++++++ test/test_flan.ml | 33 +++++++++++++++++++++++++++-- 8 files changed, 175 insertions(+), 12 deletions(-) create mode 100644 test/programs/string-eq.flan diff --git a/lib/check.ml b/lib/check.ml index 5b91e41..a2d4dc5 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3788,10 +3788,16 @@ and named_call ctx ~want loc name args = in expect loc ~want r end else begin - (* [=] and [!=] admit one type [<] does not: a handle, which is a pair of - numbers in one word and where "the same entity" is the question the - type exists to answer. Ordering handles would order a slot index, which - is a free-list artefact and means nothing. *) + (* [=] and [!=] admit types [<] does not. A handle is one: a pair of + numbers in one word and where being the same entity is the question the + type exists to answer — ordering handles would order a slot index, + which is a free-list artefact and means nothing. A string is the other, + and for the opposite reason: being the same entity is not the question + at all, being the same bytes is, and that has a true answer with no + ordering attached — plan.org, Types calls out an ordering as a + collation the language has not picked. Backend codegen (emit.ml, + x86.ml) has a [Types.String] case in the [Eq]/[Ne] arm and nowhere + else. *) let ok = match name with | "=" | "!=" -> Types.is_equatable a.Tast.ty @@ -5697,8 +5703,9 @@ let builtins : (string * string * string) list = "Remainder, and it stays at two operands: (% a b c) would mean \ (% (% a b) c), which is a thing nobody writes on purpose."); ("=", "= [equal? equal?] bool", - "Equality. It admits one type < does not — a handle, where \"the same \ - entity\" is the question the type exists to answer."); + "Equality. It admits two types < does not: a handle, where \"the same \ + entity\" is the question the type exists to answer, and a string, \ + compared bytewise by content rather than ordered."); ("!=", "!= [equal? equal?] bool", "Inequality, over everything = accepts."); ("<", "< [ordered? ordered?] bool", diff --git a/lib/emit.ml b/lib/emit.ml index a59cf2c..52b941b 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -2134,6 +2134,30 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) = location. Signed, because a member may be declared negative. *) | Types.Enum _ -> ins f "%s = icmp %s %s %s, %s" t (icmp_op true p) (ll x.Tast.ty) a b + (* A string is ptr+len at this boundary, not a machine word, so there is + no [icmp] to reach for — the comparison itself is [flan_str_eq] + (runtime/flan_rt.c), bytewise with a length and a same-pointer fast + path. [check.ml] only ever builds [Eq]/[Ne] here: [<] and friends are + refused on a string before a Tast node exists (Types.is_comparable + says no), so the [failwith] below is unreachable except as a checker + bug, and stays as the same tripwire the Enum case above already is. *) + | Types.String -> + let ap = fresh f in + ins f "%s = extractvalue %%slice %s, 0" ap a; + let al = fresh f in + ins f "%s = extractvalue %%slice %s, 1" al a; + let bp = fresh f in + ins f "%s = extractvalue %%slice %s, 0" bp b; + let bl = fresh f in + ins f "%s = extractvalue %%slice %s, 1" bl b; + let r = fresh f in + ins f "%s = call i8 @flan_str_eq(ptr %s, i64 %s, ptr %s, i64 %s)" + r ap al bp bl; + let cc = match p with + | Tast.Eq -> "ne" | Tast.Ne -> "eq" + | _ -> failwith ("comparison on " ^ Types.to_string x.Tast.ty) + in + ins f "%s = icmp %s i8 %s, 0" t cc r | t' -> failwith ("comparison on " ^ Types.to_string t')); t | (Tast.BitAnd | Tast.BitOr | Tast.BitXor | Tast.Shl | Tast.Shr), [ x; y ] -> @@ -3078,6 +3102,10 @@ declare i64 @flan_key_hash_flat(ptr, i64, i64) declare i8 @flan_key_eq_flat(ptr, ptr, i64) declare i64 @flan_key_hash_str(ptr, i64, i64) declare i8 @flan_key_eq_str(ptr, ptr, i64) +; Typed (= a b) / (!= a b) on two strings: ptr+len apiece, not the address of +; a slice the way the key pair above takes them, because that is the shape a +; [Types.String] operand is already in at this call site. +declare i8 @flan_str_eq(ptr, i64, ptr, i64) declare i64 @flan_hash_combine(i64, i64) ; The filesystem. flan_file_read is not here: nothing Flan emits calls it — ; only flan_slurp_into does, from C — and flan_slurp_into is runtime glue diff --git a/lib/types.ml b/lib/types.ml index a780fa2..88c59cc 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -160,12 +160,17 @@ let rec keyable = function | Named _ -> true (* [Check] decides, by walking the fields *) | _ -> false -(* Ordering and equality are defined on machine types and on nothing else at - milestone 2 — strings, structs and slices have no built-in [=], because an - unconstrained type supports only what every type supports (plan.org, Types). *) +(* Ordering is defined on machine types and on nothing else — structs and + slices have no built-in [<], because an unconstrained type supports only + what every type supports (plan.org, Types). A string has no ordering + either: there is no true answer to whether one string is less than another + until the language picks a collation, and byte order is not it. *) let is_comparable = function Enum _ -> true | t -> is_numeric t -let is_equatable = is_comparable +(* Equality admits one type ordering does not: a string, grown in by the M2 + queue's item 5 — bytewise, by content and not by address, so two + separately built strings with the same bytes are equal. *) +let is_equatable = function String -> true | t -> is_comparable t (* [Never] is the type of an expression that does not produce a value: return, an early-returning `some`, exit. It fits anywhere, and that is the only diff --git a/lib/x86.ml b/lib/x86.ml index 2526aab..59b2c8c 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -2756,6 +2756,22 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst = | _ -> unsupported "arithmetic"); store_loc f ~reg:rax dst t end + (* A string is ptr+len, not a scalar the generic arm below can load into a + register and [cmp_rr] — the comparison itself is [flan_str_eq] + (runtime/flan_rt.c), the same bytewise-with-fast-paths routine + [emit.ml] calls. [classify_c] already explodes a [Types.String] + argument to ptr+len for the C boundary, so this is an ordinary + [call_native]; only the sense of the answer needs flipping for [!=], + the same [xor 1] the [Tast.Not] arm below uses on a bool. [check.ml] + never builds [<] and friends on a string (Types.is_comparable says no), + so this arm only ever sees [Eq] or [Ne]. *) + | (Tast.Eq | Tast.Ne), [ a; b ] when a.Tast.ty = Types.String -> + call_native f ~sym:"flan_str_eq" ~args:[ a; b ] ~rty:(Types.Int Types.I8) dst; + if p = Tast.Ne then begin + load_loc f ~reg:rax dst Types.Bool; + grp1_imm f.b ~ext:6 ~dst:rax 1; + store_loc f ~reg:rax dst Types.Bool + end | _, [ a; b ] when is_cmp p -> let la = eval f a in let lb = eval f b in diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 89952a1..c2f8c60 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -1947,6 +1947,30 @@ int8_t flan_eq_str(const void *a, const void *b, int64_t size, void *xfer) { return flan_key_eq_str(a, b, size); } +/* The typed (= a b) / (!= a b) entry point for two strings — M2 queue item 5. + * [flan_key_eq_str] above is the same comparison, but shaped for the Map key + * table: it takes two addresses of a [flan_slice] and ignores [size]. This one + * takes a slice apart into its own two words, because that is what a typed + * string is at the LLVM and x86 boundaries (both explode a [String] argument + * to ptr+len rather than passing the two-word struct itself, the way every + * other runtime entry point that takes one does). + * + * Length first, then the same-pointer check: two slices can share a base + * pointer and disagree in length — a slice and the prefix it was cut from — + * so pointer equality alone would answer wrong on that pair, and has to come + * after the lengths have already been found equal. The zero-length return + * guards the [memcmp] below: [memcmp(NULL, NULL, 0)] is technically undefined + * even though every real implementation treats it as a no-op, and a 0-length + * string built from a null pointer is not a hypothetical here — the empty + * string literal is one. */ +int8_t flan_str_eq(const uint8_t *ap, int64_t alen, + const uint8_t *bp, int64_t blen) { + if (alen != blen) return 0; + if (ap == bp) return 1; + if (alen == 0) return 1; + return (int8_t)(memcmp(ap, bp, (size_t)alen) == 0); +} + /* Combining, for a key type the compiler does emit a function for: a struct * with padding (whose padding bytes are indeterminate and must not be hashed) * or one with a string field (whose bytes are elsewhere). The emitted function diff --git a/test/programs/string-eq.flan b/test/programs/string-eq.flan new file mode 100644 index 0000000..162907e --- /dev/null +++ b/test/programs/string-eq.flan @@ -0,0 +1,40 @@ +;;;; M2 queue item 5: typed = and != grow strings. Bytewise, with a +;;;; length-mismatch fast path and a same-pointer fast path ahead of the byte +;;;; loop (runtime/flan_rt.c, flan_str_eq). Ordering stays refused on a +;;;; string -- that half is tested in test_flan.ml, because a program that +;;;; wrote (< "a" "b") would not compile and so cannot be a row here. + +(defn main [] i32 + ;; Same pointer: one local read twice is the same two words, ptr and len + ;; both, and the fast path answers before a single byte is looked at. + (let [s "same"] + (println (= s s)) ; true + (println (!= s s))) ; false + + ;; Differing lengths: the length check alone settles it, and never reaches + ;; the byte loop -- a common prefix would be no evidence otherwise. + (println (= "abc" "ab")) ; false + (println (!= "abc" "ab")) ; true + + ;; Equal contents, distinct pointers. "abc" the literal lives in the + ;; read-only data section; to-lower of "ABC" is a fresh heap allocation, + ;; so this pair shares no address and the same-pointer fast path cannot + ;; fire -- what answers here is the byte loop, or the length check first + ;; ruling nothing out since both are three bytes. + (let [heap (to-lower (bytes "ABC"))] + (let [h (string (as-slice heap))] + (println (= "abc" h)) ; true + (println (!= "abc" h))) + (free heap)) + + ;; A one-byte difference at the end, so the length check cannot rule it + ;; out and the byte loop has to run to the last byte before it can answer. + (println (= "abd" "abc")) ; false + + ;; Empty strings: the length check's zero case, which the runtime helper + ;; also uses to skip a memcmp that would otherwise read through a null + ;; pointer -- two empty string literals, and empty against non-empty. + (println (= "" "")) ; true + (println (= "" "a")) ; false + (println (= "a" "")) ; false + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 642516a..0745afc 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -946,6 +946,20 @@ let () = strings_out; outputs ~dev:true "string building, dev" "programs/strings.flan" strings_out; + (* Typed = and != on strings -- M2 queue item 5. Bytewise, with a + length-mismatch fast path and a same-pointer fast path ahead of the + byte loop (runtime/flan_rt.c, flan_str_eq), on both backends. Ordering + stays refused on a string, which is a checker test (test_flan.ml) and + not a row here: a program that ordered two string literals would not + compile. *) + let string_eq_out = + "true\nfalse\nfalse\ntrue\ntrue\nfalse\nfalse\ntrue\nfalse\nfalse\n" + in + outputs "string equality" "programs/string-eq.flan" string_eq_out; + outputs ~opt:"-O0" "string equality, -O0" "programs/string-eq.flan" + string_eq_out; + outputs ~x86:true "string equality, --x86" "programs/string-eq.flan" + string_eq_out; (* format-f64, the first number formatter a caller can steer. The three lines that would ship wrong are pinned deliberately: 0.999995 at five places, where the rounded fraction equals the scale and is the next diff --git a/test/test_flan.ml b/test/test_flan.ml index 70e4460..8788786 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1105,8 +1105,19 @@ let () = main_at "a wrong main return type points at main" "(defn main [] bool true)"; (* ── Unconstrained operators, and everything past milestone 2 ──── *) - rejects_check "no built-in = on strings" - "(defn f [] bool (= \"a\" \"b\"))" ~needle:"no built-in comparison"; + (* M2 queue item 5: typed = and != grow strings, bytewise. Ordering does + not — there is no collation the language has picked, so < stays + refused with the message it already had. *) + accepts "typed = on strings" "(defn f [] bool (= \"a\" \"b\"))"; + accepts "typed != on strings" "(defn f [] bool (!= \"a\" \"b\"))"; + rejects_check "no built-in < on strings" + "(defn f [] bool (< \"a\" \"b\"))" ~needle:"no built-in comparison"; + rejects_check "no built-in <= on strings" + "(defn f [] bool (<= \"a\" \"b\"))" ~needle:"no built-in comparison"; + rejects_check "no built-in > on strings" + "(defn f [] bool (> \"a\" \"b\"))" ~needle:"no built-in comparison"; + rejects_check "no built-in >= on strings" + "(defn f [] bool (>= \"a\" \"b\"))" ~needle:"no built-in comparison"; (* (Vec T) is built. What is still refused is the arity: one element type, and a near-miss there would otherwise resolve to a type variable and come back as generics. *) @@ -2768,6 +2779,24 @@ let () = ~needle:"is not a type variable of f" "(defn f [a i32] i32 {:where (ordered? $t)} a)"; + (* A generic monomorphises by rechecking its body at the concrete type + (instantiate re-walks the AST, it does not substitute into an + already-built Tast), so [equal? $t] instantiated at string reaches the + same [check.ml] arm the direct = on two string literals above does. + [ordered? $t] never gets that far at string: [instantiate] checks the + {:where} clause itself against the concrete type before the body is + rechecked at all, so the refusal is the predicate one, not [<]'s + no-built-in-comparison message — that one is for a string written + directly in an ordering, where there is no predicate in between to catch + it first. *) + accepts "equal? $t instantiated at string" + "(defn same [a $t b $t] bool {:where (equal? $t)} (= a b)) \ + (defn f [] bool (same \"a\" \"b\"))"; + rejects_check "ordered? $t instantiated at string" + ~needle:"does not answer ordered?" + "(defn less [a $t b $t] bool {:where (ordered? $t)} (< a b)) \ + (defn f [] bool (less \"a\" \"b\"))"; + (* Everything copies since the second repeal, so a double use of a binding needs no clause at all — and [copyable?] itself is gone, refused the way any unknown predicate is, which is this pin's job to remember. *)