Syntactic sugar for strings

Author: vouillon

compiler/bin-wasmoo_util/tests/cram.t

@@ -144,3 +144,35 @@ Wrong type
   File "-", line 1, characters 14-16:
   Expected a boolean but this is a string.
   [1]
+
+Bad strings
+
+  $ echo '(@string)' | wasmoo_util pp
+  File "-", line 1, characters 8-9:
+  Expecting an id or a string.
+  [1]
+
+  $ echo '(@string a "b")' | wasmoo_util pp
+  File "-", line 1, characters 9-10:
+  Expecting an id
+  [1]
+
+  $ echo '(@string $a b)' | wasmoo_util pp
+  File "-", line 1, characters 12-13:
+  Expecting a string
+  [1]
+
+  $ echo '(@string $bad "\u{1F600}")' | wasmoo_util pp
+  File "-", line 1, characters 14-25:
+  Unicode escape sequences are not supported.
+  [1]
+
+  $ echo '(@string a)' | wasmoo_util pp
+  File "-", line 1, characters 9-10:
+  Expecting a string
+  [1]
+
+  $ echo '(@string a b c)' | wasmoo_util pp
+  File "-", line 1, characters 13-14:
+  Expecting a closing parenthesis.
+  [1]

compiler/bin-wasmoo_util/tests/tests.expected

@@ -65,3 +65,10 @@
                                 (4 1 1) < (4 2 0)  
                                 (4 1 1) < (5 0 1)  
 
+
+;; strings
+(global $s (ref eq) (array.new_fixed $string 4 (i32.const 97) (i32.const 98) (i32.const 99) (i32.const 100)))
+(array.new_fixed $string 4 (i32.const 97) (i32.const 98) (i32.const 99) (i32.const 100))
+(array.new_fixed $string 4 (i32.const 92) (i32.const 39) (i32.const 40) (i32.const 10))
+                  (array.new_fixed $string 4 (i32.const 97) (i32.const 98) (i32.const 99) (i32.const 100))  
+                         (array.new_fixed $string 4 (i32.const 97) (i32.const 98) (i32.const 99) (i32.const 100))  

compiler/bin-wasmoo_util/tests/tests.txt

@@ -65,3 +65,10 @@
 (@if (< (4 1 1) (4 2 0)) (@then (4 1 1) < (4 2 0)))
 (@if (< (4 1 1) (5 0 1)) (@then (4 1 1) < (5 0 1)))
 (@if (< (4 1 1) (3 2 1)) (@then (4 1 1) < (3 2 1)))
+
+;; strings
+(@string $s "abcd")
+(@string "abcd")
+(@string "\\\'\28\n")
+(@if (and) (@then (@string "abcd")))
+(@if (or) (@then) (@else (@string "abcd")))

compiler/lib-wasm/wat_preprocess.ml

@@ -237,12 +237,20 @@ let parse_string loc s =
            , Printf.sprintf "Unicode escape sequences are not supported.\n" ))
   | Some s -> s
 
+let is_string s = String.length s > 0 && Char.equal s.[0] '"'
+
 let is_keyword s =
   let lexbuf = Sedlexing.Utf8.from_string s in
   match%sedlex lexbuf with
   | keyword, eof -> true
   | _ -> false
 
+let is_id s =
+  let lexbuf = Sedlexing.Utf8.from_string s in
+  match%sedlex lexbuf with
+  | id, eof -> true
+  | _ -> false
+
 (****)
 
 module StringMap = Map.Make (String)
@@ -370,6 +378,14 @@ let skip st (pos' : pos) =
   Buffer.add_string st.buf (String.make (max 0 cols) ' ');
   st.pos <- pos'
 
+let insert st s =
+  Buffer.add_string st.buf s;
+  let n = String.length s in
+  st.pos <-
+    { loc = { st.pos.loc with pos_cnum = st.pos.loc.pos_cnum + n }
+    ; byte_loc = st.pos.byte_loc - 1
+    }
+
 let pred_position { loc; byte_loc } =
   { loc = { loc with pos_cnum = loc.pos_cnum - 1 }; byte_loc = byte_loc - 1 }
 
@@ -456,6 +472,50 @@ and rewrite st elt =
            ( position_of_loc loc
            , Printf.sprintf "Unexpected %s clause. Maybe you forgot a parenthesis.\n" nm
            ))
+  | { desc =
+        List
+          [ { desc = Atom "@string"; _ }
+          ; { desc = Atom name; loc = loc_name }
+          ; { desc = Atom value; loc = loc_value }
+          ]
+    ; loc = pos, pos'
+    } ->
+      if not (is_id name) then raise (Error (position_of_loc loc_name, "Expecting an id"));
+      if not (is_string value)
+      then raise (Error (position_of_loc loc_value, "Expecting a string"));
+      let s = parse_string loc_value value in
+      write st pos;
+      insert
+        st
+        (Format.asprintf
+           "(global %s (ref eq) (array.new_fixed $string %d%a))"
+           name
+           (String.length s)
+           (fun f s ->
+             String.iter ~f:(fun c -> Format.fprintf f " (i32.const %d)" (Char.code c)) s)
+           s);
+      skip st pos'
+  | { desc = List [ { desc = Atom "@string"; _ }; { desc = Atom value; loc = loc_value } ]
+    ; loc = pos, pos'
+    } ->
+      if not (is_string value)
+      then raise (Error (position_of_loc loc_value, "Expecting a string"));
+      let s = parse_string loc_value value in
+      write st pos;
+      insert
+        st
+        (Format.asprintf
+           "(array.new_fixed $string %d%a)"
+           (String.length s)
+           (fun f s ->
+             String.iter ~f:(fun c -> Format.fprintf f " (i32.const %d)" (Char.code c)) s)
+           s);
+      skip st pos'
+  | { desc = List [ { desc = Atom "@string"; loc = _, pos } ]; loc = _, pos' } ->
+      raise (Error ((pos.loc, pos'.loc), Printf.sprintf "Expecting an id or a string.\n"))
+  | { desc = List ({ desc = Atom "@string"; _ } :: _ :: _ :: { loc; _ } :: _); _ } ->
+      raise
+        (Error (position_of_loc loc, Printf.sprintf "Expecting a closing parenthesis.\n"))
   | { desc = List l; _ } -> rewrite_list st l
   | _ -> ()
 

manual/wasm_runtime.wiki

@@ -60,6 +60,8 @@ To form conditional expressions, the following operators are available:
 - comparisons: {{{=}}}, {{{>}}}, {{{>=}}}, {{{<}}}, {{{<=}}}, {{{<>}}};
 - boolean operators: {{{and}}}, {{{or}}}, {{{not}}}
 
+It also provides some syntactic sugar to write strings. The expression{{{(@string "ab")}}} is expanded into {{{(array.new_fixed $string 2 (i32.const 97) (i32.const 98))}}}. The statement {{{(@string $s "ab")}}} is an abbreviatiation for {{{(global $s (ref eq) (@string "ab"))}}}.
+
 == Implementing primitives ==
 
 You define a primitive by exporting a Wasm function with parameters and return value of type {{{(ref eq)}}}.