Restructure array builtins

Prepend array builtins with `__` and export well-named aliases in the
array module. Add one new `__unsafe_array_set_length` builtin function

lib/builtin.ml

@@ -27,6 +27,7 @@ type t =
   | Array_drop_back
   | Array_data
   | Unsafe_array_create
+  | Unsafe_array_set_length
   | Unsafe_nullptr
   | Assert
   | Copy
@@ -102,10 +103,10 @@ let tbl =
         ( [ { p with pt = Tarray (Qvar "0") }; { p with pt = Tint } ],
           Qvar "0",
           Simple ),
-      "array-get" );
+      "__array_get" );
     ( Array_length,
       Tfun ([ { p with pt = Tarray (Qvar "0") } ], Tint, Simple),
-      "array-length" );
+      "__array_length" );
     ( Array_push,
       Tfun
         ( [
@@ -114,16 +115,22 @@ let tbl =
           ],
           Tunit,
           Simple ),
-      "array-push" );
+      "__array_push" );
     ( Array_drop_back,
       Tfun ([ { pt = Tarray (Qvar "0"); pattr = Dmut } ], Tunit, Simple),
-      "array-drop-back" );
+      "__array_drop_back" );
     ( Array_data,
       Tfun ([ { p with pt = Tarray (Qvar "0") } ], Traw_ptr (Qvar "0"), Simple),
-      "array-data" );
+      "__array_data" );
     ( Unsafe_array_create,
       Tfun ([ { p with pt = Tint } ], Tarray (Qvar "0"), Simple),
       "__unsafe_array_create" );
+    ( Unsafe_array_set_length,
+      Tfun
+        ( [ { pt = Tarray (Qvar "0"); pattr = Dmut }; { p with pt = Tint } ],
+          Tunit,
+          Simple ),
+      "__unsafe_array_set_length" );
     (Unsafe_nullptr, Tfun ([], Traw_ptr Tu8, Simple), "__unsafe_nullptr");
     (Assert, Tfun ([ { p with pt = Tbool } ], Tunit, Simple), "assert");
     (Copy, Tfun ([ { p with pt = Qvar "0" } ], Qvar "0", Simple), "copy");
@@ -152,12 +159,13 @@ let of_string = function
   | "u8_to_int" -> Some U8_to_int
   | "not" -> Some Not
   | "mod" -> Some Mod
-  | "array-get" -> Some Array_get
-  | "array-length" -> Some Array_length
-  | "array-push" -> Some Array_push
-  | "array-drop-back" -> Some Array_drop_back
-  | "array-data" -> Some Array_data
+  | "__array_get" -> Some Array_get
+  | "__array_length" -> Some Array_length
+  | "__array_push" -> Some Array_push
+  | "__array_drop_back" -> Some Array_drop_back
+  | "__array_data" -> Some Array_data
   | "__unsafe_array_create" -> Some Unsafe_array_create
+  | "__unsafe_array_set_length" -> Some Unsafe_array_set_length
   | "__unsafe_nullptr" -> Some Unsafe_nullptr
   | "assert" -> Some Assert
   | "copy" | "__copy" ->

lib/codegen/arr.ml

@@ -199,8 +199,9 @@ struct
       Llvm.build_bitcast arr.value (Llvm.pointer_type int_t) "" builder
     in
     let value = Llvm.build_gep int_ptr [| ci 0 |] "len" builder in
+    let value = Llvm.build_load value "" builder in
 
-    { value; typ = Tint; lltyp = int_t; kind = Ptr }
+    { value; typ = Tint; lltyp = int_t; kind = Imm }
 
   let grow orig =
     let call = modify_arr_fn Grow orig in
@@ -368,6 +369,19 @@ struct
 
     { value = arr; typ; lltyp; kind = Ptr }
 
+  let unsafe_array_set_length args =
+    let arr, sz =
+      match args with
+      | [ arr; sz ] -> (bring_default_var arr, bring_default sz)
+      | _ -> failwith "Internal Error: Arity mismatch in builtin"
+    in
+    let int_ptr =
+      Llvm.build_bitcast arr.value (Llvm.pointer_type int_t) "" builder
+    in
+    let dst = Llvm.build_gep int_ptr [| ci 0 |] "len" builder in
+    ignore (Llvm.build_store sz dst builder);
+    { dummy_fn_value with lltyp = unit_t }
+
   let gen_functions () =
     Hashtbl.iter
       (fun _ (kind, v, ft) ->

lib/codegen/arr_intf.ml

@@ -18,6 +18,7 @@ module type S = sig
   val unsafe_array_create :
     param -> llvar list -> typ -> Monomorph_tree.alloca -> llvar
 
+  val unsafe_array_set_length : llvar list -> llvar
   val item_type_head_size : typ -> typ * Llvm.lltype * int * int
 
   val iter_array_children :

lib/codegen/codegen.ml

@@ -618,6 +618,7 @@ end = struct
     | Array_drop_back -> array_drop_back param args
     | Array_data -> array_data args
     | Unsafe_array_create -> unsafe_array_create param args fnc.ret allocref
+    | Unsafe_array_set_length -> unsafe_array_set_length args
     | Unsafe_nullptr ->
         let value = Llvm.const_null voidptr_t in
         { value; typ = Traw_ptr Tunit; lltyp = voidptr_t; kind = Const }
@@ -1159,6 +1160,9 @@ let has_init_code tree =
         | None -> failwith "Internal Error: global value not found")
     | Mfunction (_, _, cont, _) -> aux cont.expr
     | Mconst Unit -> false
+    | Mbind (_, _, cont) ->
+        (* Bind itself does not need init *)
+        aux cont.expr
     | _ -> true
   in
   aux Monomorph_tree.(tree.expr)

lib/parser.mly

@@ -280,6 +280,8 @@ stmt:
 
 %inline sexp_let:
   | Def; sexp_decl; pexpr = passed_expr { Let($loc, $2, pexpr ) }
+  /* Allow toplevel defs to alias builtins (to give them a better name) */
+  | Def; sexp_decl; pexpr = Builtin_id { Let($loc, $2, {pattr = Dnorm; pexpr = Var($loc(pexpr), pexpr)}) }
 
 sexp_decl:
   | parens(sexp_decl_typed) { $1 }
@@ -329,7 +331,7 @@ sexp_expr:
   | ident { Var (fst $1, snd $1) }
   | e = sexp_expr; f = Accessor {Field ($loc, e, f)}
   | e = sexp_expr; Ldotbrack; i = sexp_expr; Rbrack
-    {App ($loc, Var ($loc, "array-get"),
+    {App ($loc, Var ($loc, "__array_get"),
           [{apass = Dnorm; aloc = $loc(e); aexpr = e};
            {apass = Dnorm; aloc = $loc(i); aexpr = i}])}
   | parens(lets) { $1 }

lib/syntax_errors.messages

@@ -486,7 +486,7 @@ prog: Lpar Def Int Wildcard
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-prog: Lpar Let Lbrack Kebab_id Ampersand Wildcard
+prog: Lpar Let Lbrack Kebab_id Builtin_id
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
@@ -814,6 +814,10 @@ prog: Lpar Def Kebab_id Exclamation False Wildcard
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
+prog: Lpar Def Kebab_id Builtin_id Wildcard
+
+Expecting ')'
+
 prog: Lpar Def Kebab_id Ampersand Ampersand Wildcard
 
 <YOUR SYNTAX ERROR MESSAGE HERE>

lib/typing/exclusivity.ml

@@ -584,10 +584,10 @@ let rec check_tree env mut ((bpart, special) as bdata) tree hist =
       ({ tree with expr }, v, hs)
   | App
       {
-        callee = { expr = Var ("array-get", _); _ } as callee;
+        callee = { expr = Var ("__array_get", _); _ } as callee;
         args = [ arr; idx ];
       } ->
-      (* Special case for array-get *)
+      (* Special case for __array_get *)
       (* Partial moves for arrays are not yet supported in monomorph_tree, so we
          do not allow them as a temporary workaround *)
       let callee, b, hs = check_tree env Uread no_bdata callee hist in

lib/typing/typing.ml

@@ -496,25 +496,24 @@ let rec param_funcs_as_closures = function
 let convert_simple_lit loc typ expr =
   { typ; expr = Const expr; attr = { no_attr with const = true }; loc }
 
-let rec builtins_hack callee args =
+let builtins_hack callee args =
   (* return of __unsafe_ptr_get should be marked mut, otherwise it won't be copied
      correctly later in codegen. *)
-  (* NOTE is_temporary is monomorph_tree also needs to be updated *)
-  match callee with
-  | Ast.Var (_, id) -> (
+  let mut =
+    match args with
+    (* We only care about the first arg, ie the array *)
+    | (_, _, mut) :: _ -> mut
+    | _ -> false
+  in
+  match Typed_tree.follow_expr callee.expr with
+  | Some (Var (id, None)) -> (
       match id with
       | "__unsafe_ptr_get" -> { no_attr with mut = true }
-      | "array-get" | "array-data" | "array-length" ->
-          let mut =
-            match args with
-            (* We only care about the first arg, ie the array *)
-            | (_, _, mut) :: _ -> mut
-            | _ -> false
-          in
-          { no_attr with mut }
+      | "__array_get" | "__array_data" -> { no_attr with mut }
       | _ -> no_attr)
-  | Let_e (__, _, _, cont) -> builtins_hack cont args
-  | _ -> no_attr
+  | Some (Var (id, Some (Path.Pid "array"))) -> (
+      match id with "data" -> { no_attr with mut } | _ -> no_attr)
+  | Some _ | None -> no_attr
 
 let fold_decl cont (id, e) = { cont with expr = Bind (id, e, cont) }
 
@@ -902,7 +901,7 @@ end = struct
     in
     let targs = List.map2 apply args_t typed_exprs in
 
-    let attr = builtins_hack e1 typed_exprs in
+    let attr = builtins_hack callee typed_exprs in
 
     (* Extract the returning type from the callee, because it's properly
        generalized and linked. This way, everything in a function body should be

std/array.smu

@@ -1,53 +1,58 @@
+(def data __array_data)
+(def drop-back __array_drop_back)
+(def length __array_length)
+(def push __array_push)
+
 (defn iter [arr f]
   (defn inner [i]
-    (if (= i (array-length arr))
+    (if (= i (length arr))
       ()
       (do
-        (f (array-get arr i))
+        (f arr.[i])
         (inner (+ i 1)))))
   (inner 0))
 
 (defn iteri [arr f]
   (defn inner [i]
-    (if (= i (array-length arr))
+    (if (= i (length arr))
       ()
       (do
-        (f i (array-get arr i))
+        (f i arr.[i])
         (inner (+ i 1)))))
   (inner 0))
 
 (defn fold [arr f init!]
   (defn inner [i acc!]
-    (if (= i (array-length arr))
+    (if (= i (length arr))
       acc
-      (let [acc (f !acc (array-get arr i))]
+      (let [acc (f !acc arr.[i])]
         (inner (+ i 1) !acc))))
   (inner 0 !init))
 
 (defn foldi [arr f init!]
   (defn inner [i acc!]
-    (if (= i (array-length arr))
+    (if (= i (length arr))
       acc
-      (let [acc (f i !acc (array-get arr i))]
+      (let [acc (f i !acc arr.[i])]
         (inner (+ i 1) !acc))))
   (inner 0 !init))
 
 (defn map [arr f]
-  (def ret& (__unsafe_array_create (array-length arr)))
-  (set &(array-length ret) 0)
+  (def ret& (__unsafe_array_create (length arr)))
+  (__unsafe_array_set_length &ret 0)
   -- TODO reserve
   (defn inner [ret! i]
     (def ret& !ret)
-    (if (= i (array-length arr))
+    (if (= i (length arr))
       ret
       (do
-        (array-push &ret !(f (array-get arr i)))
+        (push &ret !(f arr.[i]))
         (inner !ret (+ i 1)))))
   (inner !ret 0))
 
 (defn swap-items [arr& i j]
   (if (= i j)
     ()
-    (let [tmp! (__unsafe_ptr_get (array-data arr) i)]
-      (__unsafe_ptr_set &(array-data arr) i !(__unsafe_ptr_get (array-data arr) j))
-      (__unsafe_ptr_set  &(array-data arr) j !tmp))))
+    (let [tmp! (__unsafe_ptr_get (data arr) i)]
+      (__unsafe_ptr_set &(data arr) i !(__unsafe_ptr_get (data arr) j))
+      (__unsafe_ptr_set &(data arr) j !tmp))))