From 255367c6dc7cd0237bbeae5333dc39b9c6a31101 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 09:07:10 +0700 Subject: [PATCH] (+ a b c) and the rest of the operators that fold Arithmetic, min/max and the three bitwise combining operators take two operands or more now and fold left, which is what the examples were already writing. The first pair still goes through `binary`, so the rule about which side decides the type is unchanged for every call that was already legal, and each operand after it is checked against that type. min and max fold their own way: every step puts both sides in slots, the accumulated pick included, so three operands are two nested lets and each is still evaluated exactly once. Reusing the previous `if` as an operand of the next would have copied everything inside it. Three things stay at two operands, each for its own reason. A chain of remainders is not something anyone writes on purpose; a chain of shifts would pass two counts that are each legal for the width and still shift the value away entirely. And a single operand is refused rather than guessed: there is no unary minus in this language -- the prelude writes every negation as (- 0 n) -- and no reciprocal, so both say so and name the form to write instead. --- lib/check.ml | 101 ++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 88 insertions(+), 13 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index e2f7faa..3a1c640 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -1027,20 +1027,73 @@ and arity loc name n args = fail loc "%s takes %d argument%s, given %d" name n (if n = 1 then "" else "s") (List.length args) +(* The operators that fold: [+ - * /], [min]/[max] and the three bitwise + combining operators all take two operands or more, and mean the same thing + applied left to right. [%] and the shifts are not in that set — a chain of + remainders or of shifts has no reading a reader would agree on in advance, + so there the arity error is the useful answer. + + Two is the floor, and the two missing cases are refused rather than + invented. Zero operands would have to mean an identity element, 0 for + and + 1 for *, and a sum with no terms in it is a typo far more often than it is + an intent. One operand would have to mean negation for [-] and reciprocal + for [/], and this language has no unary minus anywhere: the prelude writes + every negation as [(- 0 n)] or [(- 0.0 x)], and [(- x)] meaning something + else than the [-] two lines above it is a rule a reader has to carry rather + than see. *) +and fold_arity loc name args = + match args with + | _ :: _ :: _ -> () + | [ _ ] when String.equal name "-" -> + fail loc + "- takes two arguments or more, given 1 — there is no unary minus; \ + write (- 0 x) to negate, which is what the prelude does" + | [ _ ] when String.equal name "/" -> + fail loc + "/ takes two arguments or more, given 1 — there is no reciprocal; \ + write (/ 1.0 x)" + | _ -> + fail loc "%s takes two arguments or more, given %d" name (List.length args) + +(* The first two operands decide the type — [binary] picks which of them is + allowed to, and that decision is not re-made per pair — and every operand + after them is checked against it. *) +and fold_left_prim ctx ~want loc name p ok what args = + let x, y, rest = + match args with x :: y :: rest -> x, y, rest | _ -> assert false + in + let a, b = binary ctx name loc ~want:(numeric_want want) [ x; y ] in + if not (ok a.Tast.ty) then + fail loc "%s takes %s, found %s" name what (Types.to_string a.Tast.ty); + let ty = a.Tast.ty in + let acc = + List.fold_left + (fun acc arg -> + mk loc ty (Tast.Prim (p, [ acc; check ctx ~want:ty arg ]))) + (mk loc ty (Tast.Prim (p, [ a; b ]))) + rest + in + expect loc ~want acc + and named_call ctx ~want loc name args = let prim p ty args = expect loc ~want (mk loc ty (Tast.Prim (p, args))) in match name with (* ── arithmetic and comparison ─────────────────────────────────── *) - | "+" | "-" | "*" | "/" | "%" -> + | "+" | "-" | "*" | "/" -> let p = match name with | "+" -> Tast.Add | "-" -> Tast.Sub | "*" -> Tast.Mul - | "/" -> Tast.Div | _ -> Tast.Rem + | _ -> Tast.Div in + fold_arity loc name args; + fold_left_prim ctx ~want loc name p Types.is_numeric "numbers" args + (* Remainder stays at two: (% a b c) is (% (% a b) c), which is a thing + nobody writes on purpose. *) + | "%" -> arity loc name 2 args; let a, b = binary ctx name loc ~want:(numeric_want want) args in if not (Types.is_numeric a.Tast.ty) then fail loc "%s takes numbers, found %s" name (Types.to_string a.Tast.ty); - prim p a.Tast.ty [ a; b ] + prim Tast.Rem a.Tast.ty [ a; b ] | "=" | "!=" | "<" | "<=" | ">" | ">=" -> let p = match name with | "=" -> Tast.Eq | "!=" -> Tast.Ne | "<" -> Tast.Lt @@ -1058,11 +1111,19 @@ and named_call ctx ~want loc name args = prim Tast.Not Types.Bool [ check ctx ~want:Types.Bool (List.hd args) ] (* Bitwise operators are integers-only, and the shift count has the same type as the value shifted — there is no implicit widening anywhere else either. *) - | "bit-and" | "bit-or" | "bit-xor" | "<<" | ">>" -> + | "bit-and" | "bit-or" | "bit-xor" -> let p = match name with | "bit-and" -> Tast.BitAnd | "bit-or" -> Tast.BitOr - | "bit-xor" -> Tast.BitXor | "<<" -> Tast.Shl | _ -> Tast.Shr + | _ -> Tast.BitXor in + fold_arity loc name args; + fold_left_prim ctx ~want loc name p + (function Types.Int _ -> true | _ -> false) "integers" args + (* The shifts stay at two, and not only because a shift chain reads badly: + each count would be checked against the same width below, so (<< x 30 30) + would pass two legal shifts and still shift the value away entirely. *) + | "<<" | ">>" -> + let p = if String.equal name "<<" then Tast.Shl else Tast.Shr in arity loc name 2 args; let a, b = binary ctx name loc ~want:(numeric_want want) args in (match a.Tast.ty with @@ -1084,20 +1145,34 @@ and named_call ctx ~want loc name args = | _ -> ()); prim p a.Tast.ty [ a; b ] (* (min a b) and (max a b) evaluate each operand once — hence the slots — - because a min over two calls must not call either of them twice. *) + because a min over two calls must not call either of them twice. + + Which is also why this one does not go through [fold_left_prim]: there is + no Prim to fold, and the pair it folds is a whole comparison. Each step + puts *both* of its sides in slots, the accumulated pick included, so the + three-operand form is two nested lets and still exactly one evaluation of + each operand — where reusing the previous [If] as an operand of the next + would have duplicated everything inside it. *) | "min" | "max" -> - arity loc name 2 args; - let a, b = binary ctx name loc ~want:(numeric_want want) args in + fold_arity loc name args; + let x, y, rest = + match args with x :: y :: rest -> x, y, rest | _ -> assert false + in + let a, b = binary ctx name loc ~want:(numeric_want want) [ x; y ] in if not (Types.is_numeric a.Tast.ty) then fail loc "%s takes numbers, found %s" name (Types.to_string a.Tast.ty); let ty = a.Tast.ty in - let sa = fresh_slot ctx ty and sb = fresh_slot ctx ty in - let la = mk loc ty (Tast.Local sa) and lb = mk loc ty (Tast.Local sb) in let cmp = if String.equal name "min" then Tast.Lt else Tast.Gt in - let pick = mk loc Types.Bool (Tast.Prim (cmp, [ la; lb ])) in + let pick a b = + let sa = fresh_slot ctx ty and sb = fresh_slot ctx ty in + let la = mk loc ty (Tast.Local sa) and lb = mk loc ty (Tast.Local sb) in + let test = mk loc Types.Bool (Tast.Prim (cmp, [ la; lb ])) in + mk loc ty (Tast.Let ([ (sa, a); (sb, b) ], + [ mk loc ty (Tast.If (test, la, lb)) ])) + in expect loc ~want - (mk loc ty (Tast.Let ([ (sa, a); (sb, b) ], - [ mk loc ty (Tast.If (pick, la, lb)) ]))) + (List.fold_left (fun acc arg -> pick acc (check ctx ~want:ty arg)) + (pick a b) rest) (* (zeroed) is the all-bytes-zero value of whatever it is being stored into, so it only means anything where a type is expected of it. *) | "zeroed" ->