Default integer inference to native width

src/lib/ast/analysis.ml

@@ -23,8 +23,9 @@ module Pipeline = struct
     cleaned : Core.parsed_program;
   }
 
-  let run_analyses ?(check_asserts = true) core =
-    let typing = Typing.run core in
+  let run_analyses ?(check_asserts = true) ?(target_profile = default_target_profile)
+      core =
+    let typing = Typing.run ~target_profile core in
     let assert_result =
       if check_asserts then Assert.run typing
       else ({ program = typing.program; diagnostics = [] } : Assert.result)
@@ -76,8 +77,8 @@ module Pipeline = struct
     result.typing.diagnostics @ result.verify.diagnostics @ result.semantic.diagnostics
     @ result.asserts.diagnostics @ result.purity.diagnostics @ result.ownership.diagnostics
 
-  let run_core core =
-    let initial = run_analyses ~check_asserts:false core in
+  let run_core ?(target_profile = default_target_profile) core =
+    let initial = run_analyses ~check_asserts:false ~target_profile core in
     if has_errors (analysis_diagnostics initial) then initial
     else
       let specialized = Specialize.run initial.typing in
@@ -90,13 +91,16 @@ module Pipeline = struct
               diagnostics = initial.typing.diagnostics @ specialized.diagnostics;
             };
         }
-      else run_analyses specialized.program
+      else run_analyses ~target_profile specialized.program
 
-  let run_cst ?(search_dirs = []) ?sysroot ?import_text_resolver parsed =
+  let run_cst ?(search_dirs = []) ?sysroot ?import_text_resolver
+      ?(target_profile = default_target_profile) parsed =
     let expanded =
       Imports.expand_cst ~search_dirs ?sysroot ?import_text_resolver parsed
     in
-    let result = run_core (Convert.core_of_expanded_cst expanded.parsed) in
+    let result =
+      run_core ~target_profile (Convert.core_of_expanded_cst expanded.parsed)
+    in
     let typing =
       {
         result.typing with

src/lib/ast/analysis_specialize.ml

@@ -465,7 +465,8 @@ module Specialize = struct
         inst.template.value.params.value.params inst.param_types
     in
     let temp_typed, _body_result =
-      Typing.analyze_function_body state.typed.program
+      Typing.analyze_function_body
+        ~target_profile:state.typed.target_profile state.typed.program
         ~active_specializations:[ function_id inst.template ]
         ~param_bindings inst.template
     in

src/lib/ast/analysis_types.ml

@@ -35,6 +35,17 @@ type integer_shape = {
   signedness : signedness option;
 }
 
+type target_profile = {
+  native_integer_bits : int;
+  c_integer_bits : int;
+}
+
+let default_target_profile =
+  {
+    native_integer_bits = Sys.word_size;
+    c_integer_bits = min 32 Sys.word_size;
+  }
+
 type metavar = {
   classes : type_class list;
   constant : constant_value option;
@@ -111,6 +122,7 @@ type typing_result = {
   program : Core.parsed_program;
   annotations : annotations;
   diagnostics : diagnostic list;
+  target_profile : target_profile;
 }
 
 type semantic_result = { diagnostics : diagnostic list }
@@ -288,6 +300,19 @@ let smallest_integer_type loc value =
   if value >= 0 then numeric_type loc Unsigned (exact_integer_bits value)
   else numeric_type loc Signed (exact_integer_bits value)
 
+let integer_fits signedness bits value =
+  if bits <= 0 then false
+  else
+    match signedness with
+    | Signed ->
+        if bits >= Sys.int_size then true
+        else
+          let magnitude = 1 lsl (bits - 1) in
+          value >= -magnitude && value <= magnitude - 1
+    | Unsigned ->
+        value >= 0
+        && (bits >= Sys.int_size || value <= (1 lsl bits) - 1)
+
 let equal_list eq a b =
   let rec loop xs ys =
     match (xs, ys) with
@@ -473,6 +498,39 @@ let combine_matrix_kind (left : mat_type) (right : mat_type) =
    linear algebra libraries impractical. *)
 let resolved_arithmetic_binary_result op left right =
   match (op, left, right) with
+  (* TODO: Provide a strict-mode escape hatch before broadening implicit
+     variable-to-variable widening. Literal operands are checked against the
+     other operand first and never widen an operation merely to fit a value. *)
+  | ( Core.Add | Core.Subtract | Core.Multiply | Core.Divide | Core.Modulo
+    | Core.LeftShift | Core.RightShift | Core.BitwiseAnd | Core.BitwiseOr
+    | Core.BitwiseXor ),
+    ResolvedInt (left_signedness, left_bits),
+    ResolvedInt (right_signedness, right_bits)
+    when left_signedness = right_signedness ->
+      Some (ResolvedInt (left_signedness, max left_bits right_bits))
+  | ( Core.Add | Core.Subtract | Core.Multiply | Core.Divide | Core.Modulo
+    | Core.LeftShift | Core.RightShift | Core.BitwiseAnd | Core.BitwiseOr
+    | Core.BitwiseXor ),
+    ResolvedInt (Signed, signed_bits),
+    ResolvedInt (Unsigned, unsigned_bits)
+  | ( Core.Add | Core.Subtract | Core.Multiply | Core.Divide | Core.Modulo
+    | Core.LeftShift | Core.RightShift | Core.BitwiseAnd | Core.BitwiseOr
+    | Core.BitwiseXor ),
+    ResolvedInt (Unsigned, unsigned_bits),
+    ResolvedInt (Signed, signed_bits)
+    when signed_bits > unsigned_bits ->
+      Some (ResolvedInt (Signed, signed_bits))
+  | (Core.Add | Core.Subtract | Core.Multiply | Core.Divide | Core.Modulo),
+    ResolvedFloat,
+    ResolvedFloat ->
+      Some ResolvedFloat
+  | (Core.Add | Core.Subtract | Core.Multiply | Core.Divide | Core.Modulo),
+    ResolvedInt _,
+    ResolvedFloat
+  | (Core.Add | Core.Subtract | Core.Multiply | Core.Divide | Core.Modulo),
+    ResolvedFloat,
+    ResolvedInt _ ->
+      Some ResolvedFloat
   | ( Core.Add | Core.Subtract | Core.Multiply | Core.Divide | Core.Modulo ),
     ResolvedVec left,
     ResolvedVec right
@@ -753,7 +811,7 @@ let wider_numeric_type loc (left : Core.haven_type) (right : Core.haven_type) =
         | Signed, _ | _, Signed -> Signed
         | Unsigned, Unsigned -> Unsigned
       in
-      numeric_type loc signedness (max 32 (max a.bits b.bits))
+      numeric_type loc signedness (max a.bits b.bits)
   | _ -> left
 
 let lookup_named_type type_env name = String_map.find_opt name type_env