Implementation for primitives about strings.

src/riscv_generate.ml

@@ -69,6 +69,14 @@ let nameof (x: Mtype.t) = match x with
 
 let remove_space = String.map (fun c -> if c = ' ' then '_' else c)
 
+let revert_optimized_option_type = function 
+| Mtype.T_optimized_option { elem } -> 
+    (match elem with 
+    | Mtype.T_char | T_bool | T_unit | T_byte -> Mtype.T_int
+    | Mtype.T_int | T_uint -> Mtype.T_int64
+    | _ -> failwith (Printf.sprintf "riscv_generate.ml: bad optimized_option type %s in revert" (Mtype.to_string elem)))
+| otherwise -> otherwise
+
 (** Push the correct sequence of instruction based on primitives. *)
 let deal_with_prim tac rd (prim: Primitive.prim) args =
   let die () =
@@ -139,6 +147,7 @@ let deal_with_prim tac rd (prim: Primitive.prim) args =
       (* But convert is where we must take some action *)
       else
         let arg = List.hd args in 
+        let arg = { arg with ty = revert_optimized_option_type arg.ty } in
         (match from, to_ with
         | I32, U8 | U32, U8 ->
             (* Discard higher bits by masking them away *)
@@ -526,13 +535,18 @@ let deal_with_prim tac rd (prim: Primitive.prim) args =
       Vec.push tac (CallExtern { rd; fn = "puts"; args })
   | Pnot -> 
       Vec.push tac (Not { rd; rs1 = List.hd args })
+  | Pstringequal -> 
+      let cmp_res = new_temp Mtype.T_int in
+      let zero = new_temp Mtype.T_bytes in
+      Vec.push tac (CallExtern { rd = cmp_res; fn = "strcmp"; args });
+      Vec.push tac (AssignInt64 { rd = zero; imm = 0L });
+      Vec.push tac (Eq { rd; rs1 = cmp_res; rs2 = zero });
   (* | Primitive.Pccall { func_name = "";_} -> _
   | Primitive.Praise -> _
   | Primitive.Punreachable -> _
   | Primitive.Pcatch -> _
   | Primitive.Psequand -> _
   | Primitive.Psequor -> _
-  | Primitive.Pstringequal -> _
   | Primitive.Pclosure_to_extern_ref -> _
   | Primitive.Pnull_string_extern -> _
   | Primitive.Perror_to_string -> _
@@ -1156,7 +1170,7 @@ let rec do_convert tac (expr: Mcore.expr) =
       (* Choose which place to jump to *)
       let jtable = new_temp Mtype.T_bytes in
       let ptr_sz = new_temp Mtype.T_int in
-      let off = new_temp Mtype.T_bytes in
+      let off = new_temp Mtype.T_int in
       let altered = new_temp Mtype.T_bytes in
       let target = new_temp Mtype.T_bytes in
 
@@ -1244,6 +1258,7 @@ let rec do_convert tac (expr: Mcore.expr) =
         let values =
           List.map (fun (t, _) -> 
             match t with
+            | Constant.C_bool b -> Bool.to_int b
             | Constant.C_int { v } -> Int32.to_int v
             | Constant.C_char v -> Uchar.to_int v
             | _ -> failwith "TODO: unsupported switch constant type"
@@ -1254,7 +1269,7 @@ let rec do_convert tac (expr: Mcore.expr) =
         let mn = List.fold_left (fun mn x -> min mn x) 2147483647 values in
 
         (* Sparse values, convert to if-else *)
-        if mx - mn >= 256 then (
+        if mx - mn >= 256 || len < 16 then (
           let ifexit = new_label "match_ifexit_" in
           List.iter2 (fun x (_, expr) ->
             let equal = new_temp Mtype.T_bool in

src/riscv_opt_gather.ml

@@ -3,23 +3,24 @@ open Riscv_opt
 open Riscv_ssa
 
 let opt tac =
-  let out_noopt = Printf.sprintf "%s-no-opt.ssa" !Driver_config.Linkcore_Opt.output_file in
-  Basic_io.write out_noopt (String.concat "\n" (List.map Riscv_ssa.to_string tac));
+  Riscv_ssa.write_to_file "-no-opt.ssa" tac;
 
   List.iter (fun top -> match top with
   | FnDecl { fn; args } -> Hashtbl.add params fn args
   | _ -> ()) tac;
 
   iter_fn2 build_cfg tac;
   let ssa = Riscv_tac2ssa.ssa_of_tac tac in
-
+
+  Riscv_ssa.write_to_file "-opt0.ssa" ssa;
+
   for i = 1 to 3 do
+    Riscv_ssa.write_to_file (Printf.sprintf "-opt%d.ssa" i) ssa;
     Riscv_opt_inline.inline ssa;
     Riscv_opt_peephole.peephole ssa;
     Riscv_opt_escape.lower_malloc ssa;
   done;
 
   let s = map_fn ssa_of_cfg ssa in
-  let out = Printf.sprintf "%s.ssa" !Driver_config.Linkcore_Opt.output_file in
-  Basic_io.write out (String.concat "\n" (List.map Riscv_ssa.to_string s));
+  write_to_file ".ssa" s;
   s

src/riscv_ssa.ml

@@ -253,7 +253,7 @@ let rec sizeof ty =
 
   (* Optimized option uses special values to indicate None for integer types *)
   (* So the size is equal to the underlying integer type *)
-  | Mtype.T_optimized_option { elem } -> sizeof elem
+  (* | Mtype.T_optimized_option { elem } -> sizeof elem *)
 
   (* Same size as the underlying type *)
   | Mtype.T_maybe_uninit x -> sizeof x
@@ -266,15 +266,15 @@ let rec sizeof ty =
 (** Emits SSA form. We choose a less human-readable form to facilitate verifier. *)
 let to_string t =
   let rtype op ({ rd; rs1; rs2 }: r_type) =
-    Printf.sprintf "%s %s %s %s" op rd.name rs1.name rs2.name
+    Printf.sprintf "%s %s:%s %s:%s %s:%s" op rd.name (Mtype.to_string rd.ty) rs1.name (Mtype.to_string rs1.ty) rs2.name (Mtype.to_string rs2.ty)
   in
 
   let r2type op ({ rd; rs1; }: r2_type) =
-    Printf.sprintf "%s %s %s" op rd.name rs1.name
+    Printf.sprintf "%s %s:%s %s:%s" op rd.name (Mtype.to_string rd.ty) rs1.name (Mtype.to_string rs1.ty)
   in
 
   let itype op ({ rd; rs; imm } : i_type) =
-    Printf.sprintf "%s %s %s %d" op rd.name rs.name imm
+    Printf.sprintf "%s %s:%s %s:%s %d" op rd.name (Mtype.to_string rd.ty) rs.name (Mtype.to_string rs.ty) imm
   in
 
   (* Deals with signedness: signed or unsigned *)
@@ -283,15 +283,15 @@ let to_string t =
     let width = (match rd.ty with
     | T_uint | T_uint64 -> "u"
     | _ -> "") in
-    Printf.sprintf "%s%s %s %s %s" op width rd.name rs1.name rs2.name
+    Printf.sprintf "%s%s %s:%s %s:%s %s:%s" op width rd.name (Mtype.to_string rd.ty) rs1.name (Mtype.to_string rs1.ty) rs2.name (Mtype.to_string rs2.ty)
   in
 
   (* Deals with width: 32 or 64 bit *)
   let rtypew op ({ rd; rs1; rs2 }: r_type) =
     let width = (match rd.ty with
     | T_int | T_uint -> "w"
     | _ -> "") in
-    Printf.sprintf "%s%s %s %s %s" op width rd.name rs1.name rs2.name
+    Printf.sprintf "%s%s %s:%s %s:%s %s:%s" op width rd.name (Mtype.to_string rd.ty) rs1.name (Mtype.to_string rs1.ty) rs2.name (Mtype.to_string rs2.ty)
   in
 
   (* Deals with both width and signedness *)
@@ -301,14 +301,14 @@ let to_string t =
     | T_uint -> "uw"
     | T_uint64 -> "u"
     | _ -> "") in
-    Printf.sprintf "%s%s %s %s %s" op width rd.name rs1.name rs2.name
+    Printf.sprintf "%s%s %s:%s %s:%s %s:%s" op width rd.name (Mtype.to_string rd.ty) rs1.name (Mtype.to_string rs1.ty) rs2.name (Mtype.to_string rs2.ty)
   in
 
   let itypew op ({ rd; rs; imm }: i_type) =
     let width = (match rd.ty with
     | T_int | T_uint -> "w"
     | _ -> "") in
-    Printf.sprintf "%s%s %s %s %d" op width rd.name rs.name imm
+    Printf.sprintf "%s%s %s:%s %s:%s %d" op width rd.name (Mtype.to_string rd.ty) rs.name (Mtype.to_string rs.ty) imm
   in
 
   (* Dedicated for slt *)
@@ -319,7 +319,7 @@ let to_string t =
     | T_int -> "sltiw"
     | T_uint64 -> "sltiuw"
     | _ -> "") in
-    Printf.sprintf "%s %s %s %d" width rd.name rs.name imm
+    Printf.sprintf "%s %s:%s %s:%s %d" width rd.name (Mtype.to_string rd.ty) rs.name (Mtype.to_string rs.ty) imm
   in
 
   (* Similarly, `srl` and `sra` are instructions where `rs` matters rather than `rd` *)
@@ -328,7 +328,7 @@ let to_string t =
     let width = (match rs.ty with
     | T_uint | T_int -> "w"
     | _ -> "") in
-    Printf.sprintf "%s%s %s %s %d" op width rd.name rs.name imm
+    Printf.sprintf "%s%s %s:%s %s:%s %d" op width rd.name (Mtype.to_string rd.ty) rs.name (Mtype.to_string rs.ty) imm
   in
 
   let die x =
@@ -555,4 +555,8 @@ let new_temp ty =
 let new_label prefix =
   let name = prefix ^ Int.to_string !slot in
   slot := !slot + 1;
-  name
+  name
+
+let write_to_file file_postfix ssa = 
+  let out_noopt = Printf.sprintf "%s%s" !Driver_config.Linkcore_Opt.output_file file_postfix in
+  Basic_io.write out_noopt (String.concat "\n" (List.map to_string ssa));

src/riscv_virtasm_generate.ml

@@ -46,7 +46,7 @@ let slot_v v =
 
 (** Terminator and body are output arguments *)
 let convert_single name body terminator (inst: Riscv_ssa.t) =
-  let die msg = failwith (Printf.sprintf "riscv_virtasm_generate.ml: %s" msg) in
+  let die msg = failwith (Printf.sprintf "riscv_virtasm_generate.ml: %s. Complete SSA instruction: %s" msg (Riscv_ssa.to_string inst)) in
 
   let rslot ({ rd; rs1; rs2 }: Riscv_ssa.r_type) =
     ({
@@ -86,6 +86,13 @@ let convert_single name body terminator (inst: Riscv_ssa.t) =
       | T_uint -> Vec.push body (Inst.Subw r); Vec.push body (Zextw { rd = r.rd; rs = r.rd })
       | _ -> Vec.push body (Inst.Sub r))
 
+  | Neg ({rd ; rs1}) ->
+      let r = ({ rd = slot_v rd; rs1 = Slot.Reg Zero ; rs2 = slot_v rs1}: Slots.r_slot) in
+      (match rd.ty with 
+      | T_int -> Vec.push body (Inst.Subw r); Vec.push body (Zextw { rd = r.rd; rs = r.rd })
+      | T_int64 -> Vec.push body (Inst.Sub r)
+      | _ -> die (Printf.sprintf "neg: unexpected type %s" (Mtype.to_string rd.ty)))
+
   | Mul ({ rd; rs1; rs2 } as x) ->
       let r = rslot x in
       (match rd.ty with
@@ -153,8 +160,8 @@ let convert_single name body terminator (inst: Riscv_ssa.t) =
   | Srai ({ rd; rs; imm }) ->
       let r = ({ rd = slot_v rd; rs1 = slot_v rs; imm } : Slots.i_slot) in
       (match rs.ty with
-      | T_int -> Vec.push body (Inst.Sraiw r)
-      | T_int64 -> Vec.push body (Inst.Srai r)
+      | T_int | T_uint -> Vec.push body (Inst.Sraiw r)
+      | T_int64 | T_uint64 -> Vec.push body (Inst.Srai r)
       | _ -> die (Printf.sprintf "srai: unexpected type %s" (Mtype.to_string rs.ty)))
 
   | Srli ({ rd; rs; imm }) ->
@@ -259,8 +266,8 @@ let convert_single name body terminator (inst: Riscv_ssa.t) =
         imm
       }: Slots.i_slot) in
       Vec.push body (match rs.ty with 
-      | T_int -> Inst.Sltiw r
-      | T_int64 -> Inst.Slti r
+      | T_int | T_uint -> Inst.Sltiw r
+      | T_int64 | T_uint64 -> Inst.Slti r
       | _ -> die (Printf.sprintf "slti: unexpected type %s" (Mtype.to_string rs.ty)))
 
   | Not { rd; rs1 } -> 
@@ -366,7 +373,14 @@ let convert_single name body terminator (inst: Riscv_ssa.t) =
 
   | Jump label ->
       terminator := Term.J (label_of label)
-  (* | Neg -> _
+  | JumpIndirect { rs; possibilities } -> (* TODO: Optimizations on possibilities *)
+      terminator := Term.Jalr {
+        rd = Slot.Reg Zero;
+        rs1 = slot_v rs;
+        offset = 0;
+      };
+  (* Floating point instructions *)
+  (* 
   | FAdd -> _
   | FSub -> _
   | FMul -> _
@@ -379,7 +393,6 @@ let convert_single name body terminator (inst: Riscv_ssa.t) =
   | FNeq -> _
   | FNeg -> _
   | AssignFP -> _
-  | JumpIndirect -> _
   | FnDecl -> _
   | GlobalVarDecl -> _
   | ExtArray _ -> _ *)

test.py

@@ -23,6 +23,7 @@ def __exit__(self, exc_type, exc_value, traceback):
 parser.add_argument("-v", "--verbose", action="store_true", help="on rebuild, makes interpreter output detailed values")
 parser.add_argument("-c", "--compile-only", action="store_true", help="compile without executing tests")
 parser.add_argument("-t", "--test", type=str, help="execute this test case only")
+parser.add_argument("--gcc", action="store_true", help="use gcc instead of clang++")
 
 args = parser.parse_args()
 
@@ -57,7 +58,10 @@ def try_remove(path):
 if args.build and not args.wasm:
     print("Building SSA interpreter...")
     os.makedirs("test/build", exist_ok=True)
-    os.system(f"clang++ -std=c++20 {verbose} test/interpreter.cpp -Wall -g -o test/build/interpreter")
+    if args.gcc:
+        os.system(f"g++ -std=c++20 {verbose} test/interpreter.cpp -Wall -g -o test/build/interpreter")
+    else:
+        os.system(f"clang++ -std=c++20 {verbose} test/interpreter.cpp -Wall -g -o test/build/interpreter")
     print("Done.")
     exit(0)
 
@@ -102,6 +106,11 @@ def try_remove(path):
             if diff == 0:
                 print("Passed.")
             else:
+                print("Failed.")
+                print("Expected output:")
+                os.system(f"cat src/{src}/{src}.ans")
+                print("Actual output:")
+                os.system(f"cat build/output.txt")
                 success = False
 
 exit(not success)

test/interpreter.cpp

@@ -308,6 +308,11 @@ int64_t interpret(std::string label) {
                     continue;
                 }
 
+                if (args[2] == "strcmp") {
+                    VAL(1) = (int64_t) strcmp((char*) VAL(3), (char*) VAL(4));
+                    continue;
+                }
+
                 if (args[2] == "memset") {
                     memset((void*) VAL(3), VAL(4), VAL(5));
                     VAL(1) = unit;

test/src/string01/string01.ans

@@ -0,0 +1 @@
+5

test/src/string01/string01.mbt

@@ -0,0 +1,4 @@
+fn main {
+  let x = "hello"
+  println(x.length())
+}

test/src/string02/string02.ans

@@ -0,0 +1,4 @@
+false
+true
+false
+true

test/src/string02/string02.mbt

@@ -0,0 +1,9 @@
+fn main {
+  let x = "hello"
+  let y = "world"
+  let z = "hello"
+  println(x == y)
+  println(x == z)
+  println(x == y)
+  println(x == x)
+}