Text iteration

src/prelude.ml

@@ -31,7 +31,10 @@ class revrange(x : Nat, y : Nat) {
   next() : ?Nat { if (i <= y) null else {i -= 1; ?i} };
 };
 
+func charToText(c : Char) : Text = (prim "Char->Text" : Char -> Text) c;
+
 func printInt(x : Int) { (prim "printInt" : Int -> ()) x };
+func printChar(x : Char) { print (charToText x) };
 func print(x : Text) { (prim "print" : Text -> ()) x };
 
 // Hashing
@@ -61,6 +64,7 @@ func word64ToInt(n : Word64) : Int = (prim "Word64->Int" : Word64 -> Int) n;
 
 func charToWord32(c : Char) : Word32 = (prim "Char->Word32" : Char -> Word32) c;
 func word32ToChar(w : Word32) : Char = (prim "Word32->Char" : Word32 -> Char) w;
+func decodeUTF8(s : Text) : (Word32, Char) = (prim "decodeUTF8" : Text -> (Word32, Char)) s;
 
 // Exotic bitwise operations
 func shrsWord8(w : Word8, amount : Word8) : Word8 = (prim "shrs8" : (Word8, Word8) -> Word8) (w, amount);
@@ -254,8 +258,25 @@ let prim = function
                       | Word64 y -> Word64 (Word64.and_ y (Word64.shl 1L  (as_word64 a)))
                       | _ -> failwith "btst")
 
+  | "Char->Text" -> fun v k -> let str = match as_char v with
+                                          | c when c <= 0o177 -> String.make 1 (Char.chr c)
+                                          | code -> Wasm.Utf8.encode [code]
+                               in k (Text str)
   | "print" -> fun v k -> Printf.printf "%s%!" (as_text v); k unit
   | "printInt" -> fun v k -> Printf.printf "%d%!" (Int.to_int (as_int v)); k unit
+  | "decodeUTF8" -> fun v k ->
+                    let s = as_text v in
+                    let take_and_mask bits offset = Int32.(logand (sub (shift_left 1l bits) 1l) (of_int (Char.code s.[offset]))) in
+                    let classify_utf8_leader =
+                      Int32.(function
+                          | ch when logand ch (lognot 0b01111111l) = 0b00000000l -> [take_and_mask 7]
+                          | ch when logand ch (lognot 0b00011111l) = 0b11000000l -> [take_and_mask 5; take_and_mask 6]
+                          | ch when logand ch (lognot 0b00001111l) = 0b11100000l -> [take_and_mask 4; take_and_mask 6; take_and_mask 6]
+                          | ch when logand ch (lognot 0b00000111l) = 0b11110000l -> [take_and_mask 3; take_and_mask 6; take_and_mask 6; take_and_mask 6]
+                          | _ -> failwith "decodeUTF8") in
+                    let nobbles = List.mapi (fun i f -> f i) (classify_utf8_leader (Int32.of_int (Char.code s.[0]))) in
+                    let code = List.fold_left Int32.(fun acc nobble -> logor (shift_left acc 6) nobble) 0l nobbles
+                    in k (Tup [Word32 (Int32.of_int (List.length nobbles)); Char (Int32.to_int code)])
   | "@serialize" -> fun v k -> k (Serialized v)
   | "@deserialize" -> fun v k -> k (as_serialized v)
   | "Array.init" -> fun v k ->

src/type.ml

@@ -101,6 +101,12 @@ let array_obj t =
   | Mut t' -> Obj (Object Local, List.sort compare_field (mut t'))
   | t -> Obj (Object Local, List.sort compare_field (immut t))
 
+let text_obj =
+  let immut =
+    [ {lab = "chars"; typ = Func (Local, Returns, [], [], [iter_obj (Prim Char)])};
+      {lab = "len";  typ = Func (Local, Returns, [], [], [Prim Nat])};
+    ] in
+  Obj (Object Local, List.sort compare_field immut)
 
 (* Shifting *)
 
@@ -278,6 +284,7 @@ let as_prim_sub p t = match promote t with
 let rec as_obj_sub lab t = match promote t with
   | Obj (s, tfs) -> s, tfs
   | Array t -> as_obj_sub lab (array_obj t)
+  | Prim Text -> as_obj_sub lab text_obj
   | Non -> Object Sharable, [{lab; typ = Non}]
   | _ -> invalid "as_obj_sub"
 let as_array_sub t = match promote t with

src/value.ml

@@ -298,7 +298,21 @@ let obj_of_array a =
 
   Env.from_list ["get", get; "set", set; "len", len; "keys", keys; "vals", vals]
 
-let as_obj = function Obj ve -> ve | Array a -> obj_of_array a | _ -> invalid "as_obj"
+let obj_of_text t =
+  let chars = local_func 0 1 @@ fun v k ->
+    as_unit v;
+    let i = ref 0 in
+    let s = Wasm.Utf8.decode t in
+    let next = local_func 0 1 @@ fun v k' ->
+        if !i = List.length s then k' Null else
+          let v = Opt (Char (List.nth s !i)) in incr i; k' v
+    in k (Obj (Env.singleton "next" next)) in
+  let len = local_func 0 1 @@ fun v k ->
+    as_unit v; k (Int (Nat.of_int (List.length (Wasm.Utf8.decode t)))) in
+
+  Env.from_list ["chars", chars; "len", len]
+
+let as_obj = function Obj ve -> ve | Array a -> obj_of_array a | Text t -> obj_of_text t | _ -> invalid "as_obj"
 let as_func = function Func (cc, f) -> cc, f | _ -> invalid "as_func"
 let as_async = function Async a -> a | _ -> invalid "as_async"
 let as_mut = function Mut r -> r | _ -> invalid "as_mut"

test/run-dfinity/ok/array-out-of-bounds.dvm-run.ok

@@ -1,2 +1,2 @@
-W, hypervisor: calling func$92 failed with trap message: Uncaught RuntimeError: unreachable
 W, hypervisor: calling func$98 failed with trap message: Uncaught RuntimeError: unreachable
+W, hypervisor: calling func$104 failed with trap message: Uncaught RuntimeError: unreachable

test/run-dfinity/ok/nary-async.wasm.stderr.ok

@@ -1,5 +1,5 @@
 deserialize: T/77
-prelude:103.1-128.2: internal error, File "compile.ml", line 2477, characters 21-27: Assertion failed
+prelude:107.1-132.2: internal error, File "compile.ml", line 2693, characters 21-27: Assertion failed
 
 Last environment:
 @new_async = func
@@ -10,6 +10,7 @@ btstWord16 = func
 btstWord32 = func
 btstWord64 = func
 btstWord8 = func
+charToText = func
 charToWord32 = func
 clzWord16 = func
 clzWord32 = func
@@ -19,6 +20,7 @@ ctzWord16 = func
 ctzWord32 = func
 ctzWord64 = func
 ctzWord8 = func
+decodeUTF8 = func
 hashInt = func
 ignore = func
 intToWord16 = func
@@ -34,6 +36,7 @@ popcntWord32 = func
 popcntWord64 = func
 popcntWord8 = func
 print = func
+printChar = func
 printInt = func
 range = func
 revrange = func

test/run-dfinity/ok/overflow.dvm-run.ok

@@ -1,5 +1,5 @@
-W, hypervisor: calling func$104 failed with trap message: Uncaught RuntimeError: unreachable
 W, hypervisor: calling func$110 failed with trap message: Uncaught RuntimeError: unreachable
+W, hypervisor: calling func$116 failed with trap message: Uncaught RuntimeError: unreachable
 This is reachable.
 This is reachable.
 This is reachable.

test/run/conversions.as

@@ -157,4 +157,11 @@ assert(charToWord32 '\u{10ffff}' == (0x10FFFF : Word32));
     roundtrip 100000;
     roundtrip 1000000;
     roundtrip 0x10FFFF;  // largest code point
-}
+};
+
+
+// Char <--> Text
+
+assert(charToText 'П' == "П");
+func snd((a : Word32, b : Char)) : Char = b;
+assert(snd (decodeUTF8 "П") =='П');

test/run/ok/text-iter.run-ir.ok

@@ -0,0 +1,20 @@
+via `print`:
+hello world!
+
+via iteration and `printChar`: #1
+hello world!
+
+via iteration and `printChar`: #2
+1:'h' 2:'e' 3:'l' 4:'l' 5:'o' 6:' ' 7:'w' 8:'o' 9:'r' 10:'l' 11:'d' 12:'!' 13:'
+' 
+via iteration and `printChar` (Unicode): #3
+1:'П' 2:'р' 3:'и' 4:'в' 5:'е' 6:'т' 7:'с' 8:'т' 9:'в' 10:'у' 11:'ю' 12:',' 13:' ' 14:'м' 15:'и' 16:'р' 17:'!' 18:'
+' 
+via iteration and `printChar` (Unicode): #4
+1:'🙈' 2:'🎸' 3:'😋' 
+Приветствую, мир!
+
+2
+П
+4
+🙈

test/run/ok/text-iter.run-low.ok

@@ -0,0 +1,20 @@
+via `print`:
+hello world!
+
+via iteration and `printChar`: #1
+hello world!
+
+via iteration and `printChar`: #2
+1:'h' 2:'e' 3:'l' 4:'l' 5:'o' 6:' ' 7:'w' 8:'o' 9:'r' 10:'l' 11:'d' 12:'!' 13:'
+' 
+via iteration and `printChar` (Unicode): #3
+1:'П' 2:'р' 3:'и' 4:'в' 5:'е' 6:'т' 7:'с' 8:'т' 9:'в' 10:'у' 11:'ю' 12:',' 13:' ' 14:'м' 15:'и' 16:'р' 17:'!' 18:'
+' 
+via iteration and `printChar` (Unicode): #4
+1:'🙈' 2:'🎸' 3:'😋' 
+Приветствую, мир!
+
+2
+П
+4
+🙈

test/run/ok/text-iter.run.ok

@@ -0,0 +1,20 @@
+via `print`:
+hello world!
+
+via iteration and `printChar`: #1
+hello world!
+
+via iteration and `printChar`: #2
+1:'h' 2:'e' 3:'l' 4:'l' 5:'o' 6:' ' 7:'w' 8:'o' 9:'r' 10:'l' 11:'d' 12:'!' 13:'
+' 
+via iteration and `printChar` (Unicode): #3
+1:'П' 2:'р' 3:'и' 4:'в' 5:'е' 6:'т' 7:'с' 8:'т' 9:'в' 10:'у' 11:'ю' 12:',' 13:' ' 14:'м' 15:'и' 16:'р' 17:'!' 18:'
+' 
+via iteration and `printChar` (Unicode): #4
+1:'🙈' 2:'🎸' 3:'😋' 
+Приветствую, мир!
+
+2
+П
+4
+🙈

test/run/ok/text-iter.wasm-run.ok

@@ -0,0 +1 @@
+_out/text-iter.wasm:0x___: runtime trap: unreachable executed

test/run/text-iter.as

@@ -0,0 +1,72 @@
+let s = "hello world!\n";
+
+print "via `print`:\n";
+print s;
+print "\n";
+
+print "via iteration and `printChar`: #1\n";
+for (a in s.chars()) {
+  printChar a;
+};
+print "\n";
+
+print "via iteration and `printChar`: #2\n";
+var x = 0;
+for (a in s.chars()) {
+  x += 1;
+  printInt x;
+  print ":";
+  printChar '\'';
+  printChar a;
+  printChar '\'';
+  print " ";
+};
+print "\n";
+
+let russian = "Приветствую, мир!\n";
+assert(russian.len() == 18);
+
+print "via iteration and `printChar` (Unicode): #3\n";
+x := 0;
+for (a in russian.chars()) {
+  x += 1;
+  printInt x;
+  print ":";
+  printChar '\'';
+  printChar a;
+  printChar '\'';
+  print " ";
+};
+print "\n";
+assert(x == 18);
+
+let emojis = "🙈🎸😋";
+assert(emojis.len() == 3);
+
+print "via iteration and `printChar` (Unicode): #4\n";
+x := 0;
+for (a in emojis.chars()) {
+  x += 1;
+  printInt x;
+  print ":";
+  printChar '\'';
+  printChar a;
+  printChar '\'';
+  print " ";
+};
+print "\n";
+assert(x == 3);
+
+{
+    let (len, c) = decodeUTF8 russian;
+    print russian; print "\n";
+    printInt (word32ToInt len); print "\n";
+    printChar c; print "\n";
+};
+
+{
+    let (len, c) = decodeUTF8 emojis;
+    assert ((len == (4 : Word32)) and (c == '\u{1f648}'));
+    printInt (word32ToInt len); print "\n";
+    printChar c; print "\n";
+};