Fold the constant folder over as many operands as the checker does
defconst's folder matched a call of exactly two arguments, so once arithmetic went n-ary a length written (* 2 3 4) type-checked as an expression and was then refused as "not a compile-time integer constant" -- a form that looks constant, is constant, and was told it was not. Same left fold, same operators, and % stays at two because it does in the checker.
This commit is contained in:
parent
1898be6cb0
commit
387ceb7a2e
31
lib/check.ml
31
lib/check.ml
@ -1507,17 +1507,26 @@ let rec const_int env (e : Ast.expr) : int64 option =
|
||||
| Ast.Int n -> Some n
|
||||
| Ast.Byte b -> Some (Int64.of_int b)
|
||||
| Ast.Var n -> Hashtbl.find_opt env.consts n
|
||||
| Ast.Call ({ Ast.e = Ast.Var op; _ }, [ x; y ]) ->
|
||||
(match const_int env x, const_int env y with
|
||||
| Some a, Some b ->
|
||||
(match op with
|
||||
| "+" -> Some (Int64.add a b)
|
||||
| "-" -> Some (Int64.sub a b)
|
||||
| "*" -> Some (Int64.mul a b)
|
||||
| "/" when b <> 0L -> Some (Int64.div a b)
|
||||
| "%" when b <> 0L -> Some (Int64.rem a b)
|
||||
| _ -> None)
|
||||
| _ -> None)
|
||||
(* Left to right over any number of operands, because that is how the
|
||||
checker reads the same form: an array length that type-checks as a
|
||||
product of three literals and is then not a constant would be a
|
||||
distinction with nothing behind it. [%] is still two, as it is there. *)
|
||||
| Ast.Call ({ Ast.e = Ast.Var op; _ }, x :: y :: rest) ->
|
||||
let step a b =
|
||||
match op with
|
||||
| "+" -> Some (Int64.add a b)
|
||||
| "-" -> Some (Int64.sub a b)
|
||||
| "*" -> Some (Int64.mul a b)
|
||||
| "/" when b <> 0L -> Some (Int64.div a b)
|
||||
| "%" when b <> 0L && rest = [] -> Some (Int64.rem a b)
|
||||
| _ -> None
|
||||
in
|
||||
List.fold_left
|
||||
(fun acc e ->
|
||||
match acc, const_int env e with
|
||||
| Some a, Some b -> step a b
|
||||
| _ -> None)
|
||||
(const_int env x) (y :: rest)
|
||||
| _ -> None
|
||||
|
||||
let collect env (decls : Ast.decl list) =
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user