saucisse

src/concrete_global.ml

@@ -8,7 +8,7 @@ type t =
   { mutable value : Concrete_value.t
   ; label : string option
   ; mut : mut
-  ; typ : simplified val_type
+  ; typ : saucisse val_type
   }
 
 let value g = g.value

src/concrete_global.mli

@@ -6,13 +6,13 @@ type t =
   { mutable value : Concrete_value.t
   ; label : string option
   ; mut : mut
-  ; typ : simplified val_type
+  ; typ : saucisse val_type
   }
 
 val value : t -> Concrete_value.t
 
 val set_value : t -> Concrete_value.t -> unit
 
-val typ : t -> simplified val_type
+val typ : t -> saucisse val_type
 
 val mut : t -> mut

src/concrete_value.ml

@@ -77,6 +77,7 @@ struct
   (*   | Extern (Extern_func (t, _f)) -> extern_type t *)
 end
 
+(* TODO: move this to a concrete_func.ml module *)
 module Func = struct
   include
     Make_extern_func
@@ -119,7 +120,7 @@ type t =
   | Ref of ref_value
 
 (* TODO: make a new kind of instr for this *)
-let of_instr (i : simplified instr) : t =
+let of_instr (i : simplified_const instr) : t =
   match i with
   | I32_const c -> I32 c
   | I64_const c -> I64 c

src/concrete_value.mli

@@ -35,13 +35,13 @@ type t =
 
 val cast_ref : externref -> 'a Type.Id.t -> 'a option
 
-val of_instr : simplified instr -> t
+val of_instr : simplified_const instr -> t
 
 val to_instr : t -> simplified instr
 
 val ref_null' : simplified heap_type -> ref_value
 
-val ref_null : simplified heap_type -> t
+val ref_null : _ heap_type -> t
 
 val ref_func : Func.t -> t
 

src/interpret_functor_intf.ml

@@ -96,7 +96,7 @@ module type P = sig
 
     val mut : global -> Types.mut
 
-    val typ : global -> simplified val_type
+    val typ : global -> saucisse val_type
   end
 
   module Table : sig

src/link.ml

@@ -7,17 +7,11 @@ open Syntax
 module StringMap = Map.Make (String)
 module StringSet = Set.Make (String)
 
-type global = Concrete_global.t
-
-type table = Concrete_table.t
-
-type func = Concrete_value.Func.t
-
 type exports =
-  { globals : global StringMap.t
+  { globals : Concrete_global.t StringMap.t
   ; memories : Concrete_memory.t StringMap.t
-  ; tables : table StringMap.t
-  ; functions : func StringMap.t
+  ; tables : Concrete_table.t StringMap.t
+  ; functions : Concrete_value.Func.t StringMap.t
   ; defined_names : StringSet.t
   }
 
@@ -61,8 +55,8 @@ let load_from_module ls f (import : _ Imported.t) =
       else Error "unknown import"
     | v -> Ok v )
 
-let load_global (ls : 'f state) (import : simplified global_type Imported.t) :
-  global Result.t =
+let load_global (ls : 'f state) (import : saucisse global_type Imported.t) :
+  Concrete_global.t Result.t =
   let* global = load_from_module ls (fun (e : exports) -> e.globals) import in
   let* () =
     match (fst import.desc, global.mut) with
@@ -101,7 +95,7 @@ module Eval_const = struct
          | _ -> assert false )
 
   (* TODO: simplified+const instr *)
-  let instr env stack instr =
+  let instr env stack (instr : simplified_const instr) =
     match instr with
     | I32_const n -> ok @@ Stack.push_i32 stack n
     | I64_const n -> ok @@ Stack.push_i64 stack n
@@ -131,7 +125,6 @@ module Eval_const = struct
     | Ref_i31 ->
       (* TODO *)
       ok stack
-    | _ -> assert false
 
   (* TODO: simplified+const expr *)
   let expr env e : Concrete_value.t Result.t =
@@ -144,13 +137,12 @@ module Eval_const = struct
 end
 
 let eval_global ls env
-  (global : (Simplified.global, simplified global_type) Runtime.t) :
-  global Result.t =
+  (global : (Simplified.global, saucisse global_type) Runtime.t) : Concrete_global.t Result.t =
   match global with
   | Local global ->
     let* value = Eval_const.expr env global.init in
     let mut, typ = global.typ in
-    let global : global = { value; label = global.id; mut; typ } in
+    let global : Concrete_global.t = { value; label = global.id; mut; typ } in
     Ok global
   | Imported import -> load_global ls import
 
@@ -212,7 +204,7 @@ let table_types_are_compatible (import, (t1 : simplified ref_type))
   limit_is_included ~import ~imported && t1 = t2
 
 let load_table (ls : 'f state) (import : simplified table_type Imported.t) :
-  table Result.t =
+  Concrete_table.t Result.t =
   let typ : simplified table_type = import.desc in
   let* t = load_from_module ls (fun (e : exports) -> e.tables) import in
   if table_types_are_compatible typ (t.limits, t.typ) then Ok t
@@ -221,7 +213,7 @@ let load_table (ls : 'f state) (import : simplified table_type Imported.t) :
       import.modul import.name pp_table_type typ pp_table_type (t.limits, t.typ)
 
 let eval_table ls (table : (_, simplified table_type) Runtime.t) :
-  table Result.t =
+  Concrete_table.t Result.t =
   match table with
   | Local (label, table_type) -> ok @@ Concrete_table.init ?label table_type
   | Imported import -> load_table ls import
@@ -244,7 +236,7 @@ let func_types_are_compatible a b =
   remove_param a = remove_param b
 
 let load_func (ls : 'f state) (import : simplified block_type Imported.t) :
-  func Result.t =
+  Concrete_value.Func.t Result.t =
   let (Bt_raw ((None | Some _), typ)) = import.desc in
   let* func = load_from_module ls (fun (e : exports) -> e.functions) import in
   let type' =
@@ -257,7 +249,7 @@ let load_func (ls : 'f state) (import : simplified block_type Imported.t) :
   if func_types_are_compatible typ type' then Ok func
   else Error "incompatible import type (Link.load_func)"
 
-let eval_func ls (finished_env : Link_env.t') func : func Result.t =
+let eval_func ls (finished_env : Link_env.t') func : Concrete_value.Func.t Result.t =
   match func with
   | Runtime.Local func -> ok @@ Concrete_value.Func.wasm func finished_env
   | Imported import -> load_func ls import

src/rewrite.ml

@@ -6,7 +6,7 @@ open Types
 open Syntax
 
 let find msg (named : 'a Named.t) (indice : text indice option) :
-  simplified indice Result.t =
+  < string_id : no ; .. > indice Result.t =
   match indice with
   | None -> error_s "%s" msg
   | Some indice -> (
@@ -364,8 +364,8 @@ let rewrite_expr (modul : Assigned.t) (locals : simplified param list)
 
 (* TODO: simplified+const expr/list *)
 let rewrite_const_expr (modul : Assigned.t) (expr : text expr) :
-  simplified expr Result.t =
-  let const_instr (instr : text instr) : simplified instr Result.t =
+  simplified_const expr Result.t =
+  let const_instr (instr : text instr) : simplified_const instr Result.t =
     match instr with
     | Global_get id -> begin
       let* idx, mut = find_global modul ~imported_only:true (Some id) in

src/simplified.ml

@@ -20,15 +20,14 @@ type exports =
   }
 
 type global =
-  { typ : simplified global_type (* TODO: init : simplified+const expr*)
-  ; init : simplified expr
+  { typ : saucisse global_type
+  ; init : simplified_const expr
   ; id : string option
   }
 
 type data_mode =
   | Data_passive
-  (* TODO: Data_active simplified+const expr*)
-  | Data_active of int option * simplified expr
+  | Data_active of int option * simplified_const expr
 
 type data =
   { id : string option
@@ -38,14 +37,13 @@ type data =
 
 type elem_mode =
   | Elem_passive
-  (* TODO: Elem_active simplified+const expr*)
-  | Elem_active of int option * simplified expr
+  | Elem_active of int option * simplified_const expr
   | Elem_declarative
 
 type elem =
   { id : string option
-  ; typ : simplified ref_type (* TODO: init : simplified+const expr*)
-  ; init : simplified expr list
+  ; typ : < string_id : no; raw_bt : no > ref_type
+  ; init : simplified_const expr list
   ; mode : elem_mode
   }
 
@@ -54,8 +52,8 @@ type modul =
   ; global : (global, simplified global_type) Runtime.t Named.t
   ; table : (simplified table, simplified table_type) Runtime.t Named.t
   ; mem : (mem, limits) Runtime.t Named.t
-  ; func : (simplified func, simplified block_type) Runtime.t Named.t
-      (* TODO: switch to func_type *)
+  ; (* TODO: switch to func_type *)
+  func : (simplified func, simplified block_type) Runtime.t Named.t
   ; elem : elem Named.t
   ; data : data Named.t
   ; exports : exports

src/simplified_types.mli

@@ -6,7 +6,7 @@ val equal_func_types : simplified func_type -> simplified func_type -> bool
 
 val convert_val_type : tbl -> text val_type -> simplified val_type Result.t
 
-val convert_heap_type : tbl -> text heap_type -> simplified heap_type Result.t
+val convert_heap_type : tbl -> < string_id : yes; .. > heap_type -> < string_id : no ; .. > heap_type Result.t
 
 val convert_func_type : tbl -> text func_type -> simplified func_type Result.t