shoney/writeonce
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

feat: iteration 36 tasks 2-3 — grammar, checker, emit lowering

Browse source 
- ast: unop Not, binop BAnd/BOr/BXor/Shl/Shr
- parser: | ^ join additive, & << >> join multiplicative (Go rungs);
  not joins unary (Lua placement); ladder doc updated
- compound assigns claim the dead +=/-= tokens plus *= /= %= —
  parse-time sugar via rewind-and-reparse, fresh ids by construction
- types: bitwise Int-only both sides, not Bool-only (WO-E201 family);
  literal shift count outside 0..63 rejected as new WO-E223;
  confident-typ knows bitwise=Int, not=Bool
- emit: op_band..op_shr 42..46; not lowers on existing EQ vs zero
- woc-test 543/0 unchanged; scratch smoke parses/typechecks clean

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
shoney.arickathil 2026-08-22 21:29:47 +02:00
parent 53e24b8591
commit 3d75196121
5 changed files with 206 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
compiler/src/ast.ml
View file

@ -146,7 +146,13 @@ type field = {
spells out the token; it is the only unclaimed binary-shaped token
left, and Lua's `..` is the same design (concat binds looser than
`+`/`-`, tighter than comparison — this ladder's ordering). *)
type unop = Neg
(* iteration 36: `Not` is boolean negation, the keyword `not` (a word
like and/or, never `!`). Bool-only operand (types.ml), lowered on the
existing WOP_EQ against a zero constant — no new opcode, the same
doctrine And/Or's comment below records for the short-circuit pair. *)
type unop =
| Neg
| Not
(* `And`/`Or` (haxe-parity Task 2): real keywords, spelled as words, not
`&&`/`||` — the spec amendment's own wording. `Bool`-typed operands
@ -170,6 +176,18 @@ type binop =
| Ge
| And
| Or
(* iteration 36: the five Int bitwise operators (story 36's settled
decisions). Precedence copies Go's C-trap fix: BAnd/Shl/Shr sit on
the multiplicative rung, BOr/BXor on the additive rung — both above
comparison, so `x & mask == 0` groups the AND first. Int-only
operands (types.ml); Shr is arithmetic (sign-extending); a count
outside 0..63 traps WO_T_SHIFT at run time and a literal count is
rejected at compile time. *)
| BAnd
| BOr
| BXor
| Shl
| Shr
type expr = {
id : int;

6
compiler/src/dump.ml
View file

@ -211,6 +211,11 @@ let binop_str : Ast.binop -> string = function
| Ast.Ge -> ">="
| Ast.And -> "and"
| Ast.Or -> "or"
| Ast.BAnd -> "&"
| Ast.BOr -> "|"
| Ast.BXor -> "^"
| Ast.Shl -> "<<"
| Ast.Shr -> ">>"
(* Raw token span shared by both DbStub renderings below: a statement-
position DbStub (dump_stmt) and an expression-position one nested
@ -239,6 +244,7 @@ let rec expr_str (e : Ast.expr) : string =
| Ast.Call (callee, args) ->
Printf.sprintf "%s(%s)" (expr_str callee) (String.concat ", " (List.map expr_str args))
| Ast.Unary (Ast.Neg, operand) -> "-" ^ expr_str operand
| Ast.Unary (Ast.Not, operand) -> "not " ^ expr_str operand
| Ast.Binary (op, l, r) -> Printf.sprintf "%s %s %s" (expr_str l) (binop_str op) (expr_str r)
| Ast.Ctor (name, fields) ->
Printf.sprintf "%s { %s }" name

29
compiler/src/emit.ml
View file

@ -186,6 +186,15 @@ let op_fneg = 38
let op_feq = 39
let op_flt = 40
let op_fle = 41
(* iteration 36: the Int bitwise ops (.wob v6). SHR is arithmetic
(sign-extending); a shift count outside 0..63 traps WO_T_SHIFT —
literal counts never get this far (types.ml rejects them). *)
let op_band = 42
let op_bor = 43
let op_bxor = 44
let op_shl = 45
let op_shr = 46
let op_concat = 8
let op_eq = 9
let op_lt = 10
@ -1195,10 +1204,14 @@ let rec ty_of_expr (p : pctx) (f : fstate) (e : Ast.expr) : Ast.field_ty option
| _ -> None))
| _ -> None)
| Unary (Neg, o) -> ty_of_expr p f o
| Unary (Not, _) -> Some (Scalar "Bool")
| Binary (op, l, _) -> (
match op with
| Concat -> Some (Scalar "Text")
| Eq | Ne | Lt | Le | Gt | Ge | And | Or -> Some (Scalar "Bool")
(* iteration 36: bitwise is Int-only (types.ml enforces), so the
result is always Int — no Float twin to derive through `l`. *)
| BAnd | BOr | BXor | Shl | Shr -> Some (Scalar "Int")
| Add | Sub | Mul | Div | Mod -> ( match ty_of_expr p f l with Some t -> Some t | None -> Some (Scalar "Int")))
| Ctor (cn, _) -> Some (Scalar cn)
(* arc: a spawn's value is the typed actor address (a scalar word) *)
@ -1876,6 +1889,14 @@ let rec emit_expr (p : pctx) (f : fstate) (v : views) ~(dst : int) ?expected (e
`-x` on an infinity gives the other infinity. Integer NEG on f64 bits
would produce a different number entirely. *)
put f (ins_abc (if is_float p f o then op_fneg else op_neg) dst b 0)
| Unary (Not, o) ->
(* iteration 36: no NOT opcode — Bool is 0/1, so `not x` is
`x == 0` on the existing EQ, the same lowering `!=` already
uses for its final flip. *)
let b = emit_operand p f v o in
let z = alloc_temp p f e.pos in
put f (ins_abx op_loadk z (check_bx p f e.pos "constant" (const_int p 0)));
put f (ins_abc op_eq dst b z)
| Binary (op, l, r) -> emit_binary p f v ~dst op l r
| Ctor (cn, fields) -> emit_ctor p f v ~dst e cn fields
| Spawn (cn, fields) ->
@ -2154,6 +2175,14 @@ and emit_binary (p : pctx) (f : fstate) (v : views) ~(dst : int) (op : Ast.binop
put f (ins_abc op_div q a b);
put f (ins_abc op_mul q q b);
put f (ins_abc op_sub dst a q)
(* iteration 36: Int-only (types.ml enforced), one instruction each —
no Float twin exists to select and no nil/text special case can
reach here. *)
| BAnd -> simple op_band
| BOr -> simple op_bor
| BXor -> simple op_bxor
| Shl -> simple op_shl
| Shr -> simple op_shr
(* haxe-parity Task 3: compare-and-jump chain on the existing EQ/EQS/
JZ/JMP opcodes — no new opcode, per the brief. The subject is

80
compiler/src/parser.ml
View file

@ -591,13 +591,23 @@ let parse_sig_head (st : state) : sig_head =
and and (haxe-parity Task 2)
comparison == != < <= > >=
concat ..
additive + -
multiplicative * / %
unary minus -x
additive + - | ^ (| ^ iteration 36)
multiplicative * / % & << >> (& << >> iteration 36)
unary -x not x (not iteration 36)
postfix a.b a(b) a[b]
primary literals, idents, `(expr)`, constructor literals,
select-as-expression (DbStub)
Iteration 36 slots the five bitwise operators into the EXISTING
additive/multiplicative rungs exactly where Go's table puts them
(token.go's Precedence: | ^ with + -, & << >> with * / %) — above
comparison, so `x & mask == 0` groups the AND first (C parses that
the other way; Go fixed the trap, this grammar copies the fix), and
shifts bind tighter than `+` so `1 << 4 + 1` is `(1 << 4) + 1`.
`not` joins the unary level (Lua's placement): `not a == b` groups
`(not a) == b`. Expression-position `|` is Token.Pipe reused — the
union-declaration use parses in the type grammar, never here.
This ordering matches Lua's (concat binds looser than +/-, tighter
than comparison) — see ast.ml's module doc for why `..`/Concat is
this task's own addition, not a straight rt port. `and`/`or` sit
@ -867,9 +877,15 @@ and parse_additive (st : state) : Ast.expr =
let continue_ = ref true in
while !continue_ do
match peek st with
| (Token.Plus | Token.Dash) as k ->
| (Token.Plus | Token.Dash | Token.Pipe | Token.Caret) as k ->
let pos = peek_pos st in
let op = if k = Token.Plus then Ast.Add else Ast.Sub in
let op =
match k with
| Token.Plus -> Ast.Add
| Token.Dash -> Ast.Sub
| Token.Pipe -> Ast.BOr
| _ -> Ast.BXor
in
let id = fresh_id st in
ignore (advance st);
let rhs = parse_multiplicative st in
@ -883,9 +899,17 @@ and parse_multiplicative (st : state) : Ast.expr =
let continue_ = ref true in
while !continue_ do
match peek st with
| (Token.Star | Token.Slash | Token.Percent) as k ->
| (Token.Star | Token.Slash | Token.Percent | Token.Amp | Token.Shl | Token.Shr) as k ->
let pos = peek_pos st in
let op = match k with Token.Star -> Ast.Mul | Token.Slash -> Ast.Div | _ -> Ast.Mod in
let op =
match k with
| Token.Star -> Ast.Mul
| Token.Slash -> Ast.Div
| Token.Percent -> Ast.Mod
| Token.Amp -> Ast.BAnd
| Token.Shl -> Ast.Shl
| _ -> Ast.Shr
in
let id = fresh_id st in
ignore (advance st);
let rhs = parse_unary st in
@ -913,6 +937,12 @@ and parse_unary (st : state) : Ast.expr =
ignore (advance st);
let operand = parse_unary st in
{ Ast.id; pos; kind = Ast.Unary (Ast.Neg, operand) }
| Token.KwNot ->
let pos = peek_pos st in
let id = fresh_id st in
ignore (advance st);
let operand = parse_unary st in
{ Ast.id; pos; kind = Ast.Unary (Ast.Not, operand) }
| _ -> parse_as st (parse_postfix st)
and parse_postfix (st : state) : Ast.expr =
@ -1485,6 +1515,7 @@ and parse_stmt (st : state) : Ast.stmt =
| _ ->
let pos = peek_pos st in
let id = fresh_id st in
let start_tok = st.pos in
let e = parse_expr st in
if accept st Token.Eq then begin
let value = parse_expr st in
@ -1492,6 +1523,41 @@ and parse_stmt (st : state) : Ast.stmt =
{ Ast.s_id = id; s_pos = pos; s_kind = Ast.Assign { target = e; value } }
end
else begin
(* iteration 36: compound assigns, parse-time sugar — `x += e` IS
`x = x + e`, including an index expression evaluating twice,
exactly as the written-out form would (the story's documented
contract). The value's left operand is the SAME place parsed a
second time by rewinding st.pos to the statement start: no
expression rung consumes a compound token, so the re-parse
stops exactly where the first one did, and every re-parsed
node draws a fresh id — the owner/emit passes see two honest
reads, never one node in two roles. +=/-= existed as tokens
since haxe-parity Task 2 but no rule ever consumed them (the
dead-token defect story 36 records); this claims all five. *)
let compound_op =
match peek st with
| Token.PlusEq -> Some Ast.Add
| Token.MinusEq -> Some Ast.Sub
| Token.StarEq -> Some Ast.Mul
| Token.SlashEq -> Some Ast.Div
| Token.PercentEq -> Some Ast.Mod
| _ -> None
in
match compound_op with
| Some op ->
let op_pos = peek_pos st in
ignore (advance st);
let after_op = st.pos in
st.pos <- start_tok;
let lhs_again = parse_expr st in
st.pos <- after_op;
let rhs = parse_expr st in
end_of_stmt st;
let value =
{ Ast.id = fresh_id st; pos = op_pos; kind = Ast.Binary (op, lhs_again, rhs) }
in
{ Ast.s_id = id; s_pos = pos; s_kind = Ast.Assign { target = e; value } }
| None ->
end_of_stmt st;
{ Ast.s_id = id; s_pos = pos; s_kind = Ast.ExprStmt e }
end

77
compiler/src/types.ml
View file

@ -461,6 +461,10 @@ let unused_use_code = Diag.warning_prefix ^ "202" (* WO-W202 *)
let unknown_type_name_code = Diag.types_prefix ^ "25" (* WO-E225 *)
(* iteration 36: a LITERAL shift count outside 0..63 — rejected here so
the WO_T_SHIFT run-time trap only ever fires on variable counts. *)
let shift_count_code = Diag.types_prefix ^ "23" (* WO-E223 *)
(* haxe-parity Task 3, review fix (Critical 1). `default` is moved to
the *end* of the lowering order regardless of where it sits in the
source (Ast.switch_lowering_order) -- so a `case` arm written after
@ -1381,6 +1385,12 @@ let typecheck_program ~file ~(module_of : string -> string)
this arm every interpolated value looked underivable and every check
built on confident types silently skipped it. *)
| Binary (Concat, _, _) -> Some (TScalar "Text")
(* iteration 36: bitwise is confidently Int and `not` confidently
Bool for the same reason the comparison arm above is Bool — the
operator's own meaning, not a guess (Int-only/Bool-only operands
are enforced in typecheck_expr's own arms). *)
| Binary ((BAnd | BOr | BXor | Shl | Shr), _, _) -> Some (TScalar "Int")
| Unary (Not, _) -> Some (TScalar "Bool")
| Interp _ ->
(* An interpolation always *produces* Text by construction
(emit.ml decides, per-segment, whether the embedded value
@ -1729,6 +1739,25 @@ let typecheck_program ~file ~(module_of : string -> string)
check_builtin_call ~file collector name e.pos args confident_types)
| _ -> ());
{ typ = TScalar "Int"; is_nil = false }
| Unary (Not, operand) ->
(* iteration 36: Bool-only, no truthiness — the same confident-
type contract the and/or arms below use, and the same WO-E201
wording, so `not` reads as the third member of that family. *)
let res = typecheck_expr env cenv operand in
(match confident_typ cenv operand with
| None -> ()
| Some t ->
(if is_nullable t || res.is_nil then e211 operand.pos (expr_label operand));
if unwrap_nullable t <> TScalar "Bool" then
Diag.Collector.add collector
(Diag.error ~code:type_mismatch_code ~file ~line:operand.pos.line
~col:operand.pos.col
~message:
(Printf.sprintf
"`not` operand must be `Bool`, got `%s` -- no truthiness in this language"
(typ_label t))
()));
{ typ = TScalar "Bool"; is_nil = false }
| Unary (_, operand) -> typecheck_expr env cenv operand
| Binary ((And | Or) as op, left, right) ->
(* haxe-parity Task 2: `Bool`-typed operands only, no truthiness
@ -1857,6 +1886,54 @@ let typecheck_program ~file ~(module_of : string -> string)
if op = Mod then mod_on_float cenv e.pos left right;
{ typ = (match confident_typ cenv left with Some t -> t | None -> TScalar "Int");
is_nil = false }
| Binary (((BAnd | BOr | BXor | Shl | Shr) as op), left, right) ->
(* iteration 36: bitwise is Int-only on BOTH sides — no Float
twin exists (nothing like FADD to fall back to), so a Float
or Text operand would lower to a garbage word operation with
no diagnostic. Reported off confident types, the same
stay-silent-when-underivable contract as every check above. *)
let lres = typecheck_expr env cenv left in
let rres = typecheck_expr env cenv right in
if is_nullable lres.typ || lres.is_nil then e211 left.pos (expr_label left);
if is_nullable rres.typ || rres.is_nil then e211 right.pos (expr_label right);
let opname =
match op with BAnd -> "&" | BOr -> "|" | BXor -> "^" | Shl -> "<<" | _ -> ">>"
in
let check_int_operand (operand : expr) =
match confident_typ cenv operand with
| None -> ()
| Some t ->
if unwrap_nullable t <> TScalar "Int" then
Diag.Collector.add collector
(Diag.error ~code:type_mismatch_code ~file ~line:operand.pos.line
~col:operand.pos.col
~message:
(Printf.sprintf "`%s` operand must be `Int`, got `%s` -- bitwise is Int-only"
opname (typ_label t))
())
in
check_int_operand left;
check_int_operand right;
(* a LITERAL count outside 0..63 can never be right — reject it
here (WO-E223) so the WO_T_SHIFT trap is variable-count-only.
A negative literal arrives as Unary(Neg, IntLit). *)
(match op with
| Shl | Shr ->
let out_of_range =
match right.kind with
| IntLit n -> n < 0 || n > 63
| Unary (Neg, { kind = IntLit n; _ }) -> n > 0
| _ -> false
in
if out_of_range then
Diag.Collector.add collector
(Diag.error ~code:shift_count_code ~file ~line:right.pos.line
~col:right.pos.col
~message:
(Printf.sprintf "shift count is out of range 0..63 for `%s`" opname)
())
| _ -> ());
{ typ = TScalar "Int"; is_nil = false }
| Binary (((Lt | Le | Gt | Ge) as op), left, right) ->
let lres = typecheck_expr env cenv left in
let rres = typecheck_expr env cenv right in