Remove near|far split and rename (Get|Set)Memory

ml-proto/README.md

@@ -128,10 +128,10 @@ type expr =
   | GetParam of var                     (* read parameter
   | GetLocal of var                     (* read local variable
   | SetLocal of var * expr              (* write local variable
-  | GetGlobal of var                    (* read global variable
-  | SetGlobal of var * expr             (* write global variable
-  | GetMemory of memop * expr           (* read memory address
-  | SetMemory of memop * expr * expr    (* write memory address
+  | LoadGlobal of var                   (* read global variable
+  | StoreGlobal of var * expr           (* write global variable
+  | Load of memop * expr                (* read memory address
+  | Store of memop * expr * expr        (* write memory address
   | Const of value                      (* constant
   | Unary of unop * expr                (* unary arithmetic operator
   | Binary of binop * expr * expr       (* binary arithmetic operator

ml-proto/src/ast.ml

@@ -60,8 +60,7 @@ type binop = (Int32Op.binop, Int64Op.binop, Float32Op.binop, Float64Op.binop) op
 type relop = (Int32Op.relop, Int64Op.relop, Float32Op.relop, Float64Op.relop) op
 type cvt = (Int32Op.cvt, Int64Op.cvt, Float32Op.cvt, Float64Op.cvt) op
 
-type dist = Near | Far
-type memop = {dist : dist; align : Memory.alignment; mem : Memory.mem_type}
+type memop = {align : Memory.alignment; mem : Memory.mem_type}
 
 
 (* Expressions *)
@@ -84,10 +83,10 @@ and expr' =
   | Destruct of var list * expr
   | GetLocal of var
   | SetLocal of var * expr
-  | GetGlobal of var
-  | SetGlobal of var * expr
-  | GetMemory of memop * expr
-  | SetMemory of memop * expr * expr
+  | LoadGlobal of var
+  | StoreGlobal of var * expr
+  | Load of memop * expr
+  | Store of memop * expr * expr
   | Const of literal
   | Unary of unop * expr
   | Binary of binop * expr * expr

ml-proto/src/check.ml

@@ -55,10 +55,6 @@ let nary = List.map (fun ty -> [ty])
 
 (* Type Synthesis *)
 
-let type_dist = function
-  | Near -> Int32Type
-  | Far -> Int64Type
-
 let type_mem = function
   | Memory.SInt8Mem -> Int32Type
   | Memory.SInt16Mem -> Int32Type
@@ -185,19 +181,19 @@ let rec check_expr c ts e =
     check_expr c [local c x] e1;
     check_type [] ts e.at
 
-  | GetGlobal x ->
+  | LoadGlobal x ->
     check_type [global c x] ts e.at
 
-  | SetGlobal (x, e1) ->
+  | StoreGlobal (x, e1) ->
     check_expr c [global c x] e1;
     check_type [] ts e.at
 
-  | GetMemory (memop, e1) ->
-    check_expr c [type_dist memop.dist] e1;
+  | Load (memop, e1) ->
+    check_expr c [Int32Type] e1;
     check_type [type_mem memop.mem] ts e.at
 
-  | SetMemory (memop, e1, e2) ->
-    check_expr c [type_dist memop.dist] e1;
+  | Store (memop, e1, e2) ->
+    check_expr c [Int32Type] e1;
     check_expr c [type_mem memop.mem] e2;
     check_type [] ts e.at
 

ml-proto/src/eval.ml

@@ -155,20 +155,20 @@ let rec eval_expr c e =
     local c x := v1;
     []
 
-  | GetGlobal x ->
+  | LoadGlobal x ->
     [!(global c x)]
 
-  | SetGlobal (x, e1) ->
+  | StoreGlobal (x, e1) ->
     let v1 = unary (eval_expr c e1) e1.at in
     global c x := v1;
     []
 
-  | GetMemory ({align; mem; _}, e1) ->
+  | Load ({align; mem; _}, e1) ->
     let v1 = unary (eval_expr c e1) e1.at in
     (try [Memory.load c.modul.memory align (Memory.address_of_value v1) mem]
     with exn -> memory_error e.at exn)
 
-  | SetMemory ({align; mem; _}, e1, e2) ->
+  | Store ({align; mem; _}, e1, e2) ->
     let v1 = unary (eval_expr c e1) e1.at in
     let v2 = unary (eval_expr c e2) e2.at in
     (try Memory.store c.modul.memory align (Memory.address_of_value v1) mem v2

ml-proto/src/lexer.mll

@@ -80,16 +80,12 @@ let floatop t f32 f64 =
   | "f64" -> Values.Float64 f64
   | _ -> assert false
 
-let memop d a s t =
-  let dist = match d with
-    | "near" -> Near
-    | "far" -> Far
-    | _ -> assert false
-  and align = match a with
+let memop a s t =
+  let align = match a with
     | "" -> Memory.Aligned
     | "unaligned" -> Memory.Unaligned
     | _ -> assert false
-  in {dist; align; mem = mem_type s t}
+  in {align; mem = mem_type s t}
 }
 
 
@@ -114,7 +110,6 @@ let nxx = ixx | fxx
 let mixx = "i" ("8" | "16" | "32" | "64")
 let mfxx = "f" ("32" | "64")
 let sign = "s" | "u"
-let dist = "near" | "far"
 let align = "" | "unaligned"
 
 rule token = parse
@@ -147,15 +142,16 @@ rule token = parse
 
   | "getlocal" { GETLOCAL }
   | "setlocal" { SETLOCAL }
-  | "getglobal" { GETGLOBAL }
-  | "setglobal" { SETGLOBAL }
-
-  | "get"(dist as d)(align as a)(sign as s)"."(mixx as t)
-    { GETMEMORY (memop d a s t) }
-  | "set"(dist as d)(align as a)(sign as s)"."(mixx as t)
-    { SETMEMORY (memop d a s t) }
-  | "get"(dist as d)(align as a)"."(mfxx as t) { GETMEMORY (memop d a ' ' t) }
-  | "set"(dist as d)(align as a)"."(mfxx as t) { SETMEMORY (memop d a ' ' t) }
+
+  | "load_global" { LOADGLOBAL }
+  | "store_global" { STOREGLOBAL }
+
+  | "load"(align as a)(sign as s)"."(mixx as t)
+    { LOAD (memop a s t) }
+  | "store"(align as a)(sign as s)"."(mixx as t)
+    { STORE (memop a s t) }
+  | "load"(align as a)"."(mfxx as t) { LOAD (memop a ' ' t) }
+  | "store"(align as a)"."(mfxx as t) { STORE (memop a ' ' t) }
 
   | "const."(nxx as t) { CONST (value_type t) }
   | "switch."(nxx as t) { SWITCH (value_type t) }

ml-proto/src/memory.ml

@@ -78,7 +78,6 @@ open Values
 
 let address_of_value = function
   | Int32 i -> Int32.to_int i
-  | Int64 i -> Int64.to_int i
   | _ -> raise Address
 
 

ml-proto/src/parser.mly

@@ -95,7 +95,7 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
 %token INT FLOAT TEXT VAR TYPE LPAR RPAR
 %token NOP BLOCK IF LOOP LABEL BREAK SWITCH CASE FALLTHRU
 %token CALL DISPATCH RETURN DESTRUCT
-%token GETLOCAL SETLOCAL GETGLOBAL SETGLOBAL GETMEMORY SETMEMORY
+%token GETLOCAL SETLOCAL LOADGLOBAL STOREGLOBAL LOAD STORE
 %token CONST UNARY BINARY COMPARE CONVERT
 %token FUNC PARAM RESULT LOCAL MODULE MEMORY SEGMENT GLOBAL IMPORT EXPORT TABLE
 %token ASSERTINVALID INVOKE ASSERTEQ
@@ -112,8 +112,8 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
 %token<Ast.binop> BINARY
 %token<Ast.relop> COMPARE
 %token<Ast.cvt> CONVERT
-%token<Ast.memop> GETMEMORY
-%token<Ast.memop> SETMEMORY
+%token<Ast.memop> LOAD
+%token<Ast.memop> STORE
 
 %start script
 %type<Script.script> script
@@ -175,10 +175,10 @@ oper :
   | DESTRUCT var_list expr { fun c -> Destruct ($2 c local, $3 c) }
   | GETLOCAL var { fun c -> GetLocal ($2 c local) }
   | SETLOCAL var expr { fun c -> SetLocal ($2 c local, $3 c) }
-  | GETGLOBAL var { fun c -> GetGlobal ($2 c global) }
-  | SETGLOBAL var expr { fun c -> SetGlobal ($2 c global, $3 c) }
-  | GETMEMORY expr { fun c -> GetMemory ($1, $2 c) }
-  | SETMEMORY expr expr { fun c -> SetMemory ($1, $2 c, $3 c) }
+  | LOADGLOBAL var { fun c -> LoadGlobal ($2 c global) }
+  | STOREGLOBAL var expr { fun c -> StoreGlobal ($2 c global, $3 c) }
+  | LOAD expr { fun c -> Load ($1, $2 c) }
+  | STORE expr expr { fun c -> Store ($1, $2 c, $3 c) }
   | CONST literal { fun c -> Const (literal (ati 2) $2 $1) }
   | UNARY expr { fun c -> Unary ($1, $2 c) }
   | BINARY expr expr { fun c -> Binary ($1, $2 c, $3 c) }

ml-proto/test/forward.wasm

@@ -12,7 +12,7 @@
   )
 
   (func $odd (param $n i32) (result i32)
-    (setglobal $scratch (getlocal $n))
+    (store_global $scratch (getlocal $n))
     (if (eq.i32 (getlocal $n) (const.i32 0))
       (const.i32 0)
       (call $even (sub.i32 (getlocal $n) (const.i32 1)))

ml-proto/test/memory.wasm

@@ -33,12 +33,12 @@
   (func $data (result i32)
     (and.i32
       (and.i32
-        (eq.i32 (getnearu.i8 (const.i32 0)) (const.i32 65))
-        (eq.i32 (getfaru.i8 (const.i64 3)) (const.i32 167))
+        (eq.i32 (loadu.i8 (const.i32 0)) (const.i32 65))
+        (eq.i32 (loadu.i8 (const.i32 3)) (const.i32 167))
       )
       (and.i32
-        (eq.i32 (getnearu.i8 (const.i32 20)) (const.i32 87))
-        (eq.i32 (getfaru.i8 (const.i64 23)) (const.i32 77))
+        (eq.i32 (loadu.i8 (const.i32 20)) (const.i32 87))
+        (eq.i32 (loadu.i8 (const.i32 23)) (const.i32 77))
       )
     )
   )
@@ -54,8 +54,8 @@
           (break)
         )
         (setlocal 2 (mul.i32 (getlocal 0) (const.i32 4)))
-        (setnears.i32 (getlocal 2) (getlocal 0))
-        (setlocal 1 (getnears.i32 (getlocal 2)))
+        (stores.i32 (getlocal 2) (getlocal 0))
+        (setlocal 1 (loads.i32 (getlocal 2)))
         (if
           (neq.i32 (getlocal 0) (getlocal 1))
           (return (const.i32 0))
@@ -77,8 +77,8 @@
           (break)
         )
         (setlocal 2 (converts.i32.f64 (getlocal 0)))
-        (setnearunaligned.f64 (getlocal 0) (getlocal 2))
-        (setlocal 1 (getnearunaligned.f64 (getlocal 0)))
+        (storeunaligned.f64 (getlocal 0) (getlocal 2))
+        (setlocal 1 (loadunaligned.f64 (getlocal 0)))
         (if
           (neq.f64 (getlocal 2) (getlocal 1))
           (return (const.i32 0))
@@ -91,14 +91,14 @@
 
   ;; Memory cast
   (func $cast (result f64)
-    (setnears.i64 (const.i32 8) (const.i64 -12345))
+    (stores.i64 (const.i32 8) (const.i64 -12345))
     (if
-      (eq.f64 (getnear.f64 (const.i32 8)) (cast.i64.f64 (const.i64 -12345)))
+      (eq.f64 (load.f64 (const.i32 8)) (cast.i64.f64 (const.i64 -12345)))
       (return (const.f64 0))
     )
-    (setfarunaligneds.i64 (const.i64 9) (const.i64 0))
-    (setfarunaligneds.i16 (const.i64 15) (const.i32 16453))
-    (return (getnearunaligned.f64 (const.i32 9)))
+    (storeunaligneds.i64 (const.i32 9) (const.i64 0))
+    (storeunaligneds.i16 (const.i32 15) (const.i32 16453))
+    (return (loadunaligned.f64 (const.i32 9)))
   )
 
   (export "data" $data)