support -safe-string

.merlin

@@ -4,3 +4,7 @@ S libs/**
 B libs/**
 B +threads
 PKG sedlex
+PKG extlib
+PKG camlzip
+PKG xml-light
+FLG -safe-string

Makefile

@@ -38,7 +38,7 @@ EXTLIB_INCLUDES=$(EXTLIB_LIBS:%=-I libs/%)
 ALL_INCLUDES=$(EXTLIB_INCLUDES) $(HAXE_INCLUDES)
 FINDLIB_PACKAGES=$(FINDLIB_LIBS:%=-package %)
 CFLAGS=
-ALL_CFLAGS=-bin-annot -thread -g -w -3 $(CFLAGS) $(ALL_INCLUDES) $(FINDLIB_PACKAGES)
+ALL_CFLAGS=-bin-annot -safe-string -thread -g -w -3 $(CFLAGS) $(ALL_INCLUDES) $(FINDLIB_PACKAGES)
 
 ifeq ($(BYTECODE),1)
 	TARGET_FLAG = bytecode
@@ -125,7 +125,7 @@ build_pass_3:
 	ocamlfind ocamldep -slash -native $(HAXE_INCLUDES) $(MODULES:%=%.ml) > Makefile.dependencies
 
 build_pass_4: $(MODULES:%=%.$(MODULE_EXT))
-	$(COMPILER) -linkpkg -o $(OUTPUT) $(NATIVE_LIBS) $(NATIVE_LIB_FLAG) $(LFLAGS) $(FINDLIB_PACKAGES) $(EXTLIB_INCLUDES) $(EXTLIB_LIBS:=.$(LIB_EXT)) $(MODULES:%=%.$(MODULE_EXT))
+	$(COMPILER) -safe-string -linkpkg -o $(OUTPUT) $(NATIVE_LIBS) $(NATIVE_LIB_FLAG) $(LFLAGS) $(FINDLIB_PACKAGES) $(EXTLIB_INCLUDES) $(EXTLIB_LIBS:=.$(LIB_EXT)) $(MODULES:%=%.$(MODULE_EXT))
 
 haxelib:
 	(cd $(CURDIR)/extra/haxelib_src && $(CURDIR)/$(OUTPUT) client.hxml && nekotools boot run.n)

src/compiler/server.ml

@@ -130,7 +130,7 @@ let ssend sock str =
 			let s = Unix.send sock str pos len [] in
 			loop (pos + s) (len - s)
 	in
-	loop 0 (String.length str)
+	loop 0 (Bytes.length str)
 
 let rec wait_loop process_params verbose accept =
 	Sys.catch_break false;
@@ -546,12 +546,12 @@ and init_wait_stdio() =
 	let berr = Buffer.create 0 in
 	let read = fun () ->
 		let len = IO.read_i32 chin in
-		IO.really_nread chin len
+		IO.really_nread_string chin len
 	in
 	let write = Buffer.add_string berr in
 	let close = fun() ->
 		IO.write_i32 cherr (Buffer.length berr);
-		IO.nwrite cherr (Buffer.contents berr);
+		IO.nwrite_string cherr (Buffer.contents berr);
 		IO.flush cherr
 	in
 	fun() ->
@@ -565,7 +565,7 @@ and init_wait_socket verbose host port =
 	if verbose then print_endline ("Waiting on " ^ host ^ ":" ^ string_of_int port);
 	Unix.listen sock 10;
 	let bufsize = 1024 in
-	let tmp = String.create bufsize in
+	let tmp = Bytes.create bufsize in
 	let accept() = (
 		let sin, _ = Unix.accept sock in
 		Unix.set_nonblock sin;
@@ -578,8 +578,8 @@ and init_wait_socket verbose host port =
 					failwith "Incomplete request"
 				else begin
 					if verbose then Printf.printf "Reading %d bytes\n" r;
-					Buffer.add_substring b tmp 0 r;
-					if tmp.[r-1] = '\000' then
+					Buffer.add_subbytes b tmp 0 r;
+					if Bytes.get tmp (r-1) = '\000' then
 						Buffer.sub b 0 (Buffer.length b - 1)
 					else
 						read_loop 0
@@ -594,7 +594,7 @@ and init_wait_socket verbose host port =
 				end
 		in
 		let read = fun() -> (let s = read_loop 0 in Unix.clear_nonblock sin; s) in
-		let write = ssend sin in
+		let write s = ssend sin (Bytes.unsafe_of_string s) in
 		let close() = Unix.close sin in
 		read, write, close
 	) in
@@ -604,7 +604,7 @@ and do_connect host port args =
 	let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
 	(try Unix.connect sock (Unix.ADDR_INET (Unix.inet_addr_of_string host,port)) with _ -> failwith ("Couldn't connect on " ^ host ^ ":" ^ string_of_int port));
 	let args = ("--cwd " ^ Unix.getcwd()) :: args in
-	ssend sock (String.concat "" (List.map (fun a -> a ^ "\n") args) ^ "\000");
+	ssend sock (Bytes.of_string (String.concat "" (List.map (fun a -> a ^ "\n") args) ^ "\000"));
 	let has_error = ref false in
 	let rec print line =
 		match (if line = "" then '\x00' else line.[0]) with
@@ -623,12 +623,12 @@ and do_connect host port args =
 		let lines = (match List.rev lines with "" :: l -> List.rev l | _ -> lines) in
 		List.iter print lines;
 	in
-	let tmp = String.create 1024 in
+	let tmp = Bytes.create 1024 in
 	let rec loop() =
 		let b = Unix.recv sock tmp 0 1024 [] in
-		Buffer.add_substring buf tmp 0 b;
+		Buffer.add_subbytes buf tmp 0 b;
 		if b > 0 then begin
-			if String.get tmp (b - 1) = '\n' then begin
+			if Bytes.get tmp (b - 1) = '\n' then begin
 				process();
 				Buffer.reset buf;
 			end;

src/generators/codegen.ml

@@ -515,7 +515,7 @@ let set_default ctx a c p =
 let bytes_serialize data =
 	let b64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" in
 	let tbl = Array.init (String.length b64) (fun i -> String.get b64 i) in
-	Base64.str_encode ~tbl data
+	Bytes.unsafe_to_string (Base64.str_encode ~tbl data)
 
 (*
 	Tells if the constructor might be called without any issue whatever its parameters

src/generators/genas3.ml

@@ -338,7 +338,7 @@ let generate_resources infos =
 		let dir = (infos.com.file :: ["__res"]) in
 		create_dir [] dir;
 		let add_resource name data =
-			let name = Base64.str_encode name in
+			let name = Bytes.unsafe_to_string (Base64.str_encode name) in
 			let ch = open_out_bin (String.concat "/" (dir @ [name])) in
 			output_string ch data;
 			close_out ch
@@ -353,7 +353,7 @@ let generate_resources infos =
 		Hashtbl.iter (fun name _ ->
 			let varname = ("v" ^ (string_of_int !k)) in
 			k := !k + 1;
-			print ctx "\t\t[Embed(source = \"__res/%s\", mimeType = \"application/octet-stream\")]\n" (Base64.str_encode name);
+			print ctx "\t\t[Embed(source = \"__res/%s\", mimeType = \"application/octet-stream\")]\n" (Bytes.unsafe_to_string (Base64.str_encode name));
 			print ctx "\t\tpublic static var %s:Class;\n" varname;
 			inits := ("list[\"" ^ Ast.s_escape name ^ "\"] = " ^ varname ^ ";") :: !inits;
 		) infos.com.resources;

src/generators/genhl.ml

@@ -3378,7 +3378,7 @@ let write_code ch code debug =
 				assert false
 	in
 
-	IO.nwrite ch "HLB";
+	IO.nwrite_string ch "HLB";
 	byte code.version;
 
 	let flags = ref 0 in

src/generators/genphp.ml

@@ -344,8 +344,7 @@ let s_ident_local n =
 	| _ -> n
 
 let create_directory com ldir =
- 	let atm_path = ref (String.create 0) in
- 	atm_path := com.file;
+ 	let atm_path = ref com.file in
  	if not (Sys.file_exists com.file) then (Unix.mkdir com.file 0o755);
  	(List.iter (fun p -> atm_path := !atm_path ^ "/" ^ p; if not (Sys.file_exists !atm_path) then (Unix.mkdir !atm_path 0o755);) ldir)
 

src/generators/genswf.ml

@@ -358,11 +358,11 @@ let build_swf9 com file swc =
 						| Png.ClTrueColor (Png.TBits8,Png.HaveAlpha) ->
 							let data = Extc.unzip (Png.data png) in
 							let raw_data = Png.filter png data in
-							let alpha = String.make (h.Png.png_width * h.Png.png_height) '\000' in
-							for i = 0 to String.length alpha do
-								String.unsafe_set alpha i (String.unsafe_get raw_data (i lsl 2));
+							let alpha = Bytes.make (h.Png.png_width * h.Png.png_height) '\000' in
+							for i = 0 to Bytes.length alpha do
+								Bytes.unsafe_set alpha i (String.unsafe_get raw_data (i lsl 2));
 							done;
-							Extc.zip alpha
+							Extc.zip (Bytes.unsafe_to_string alpha)
 						| _ -> abort "PNG file must contain 8 bit alpha channel" p2
 					) in
 					incr cid;
@@ -384,9 +384,9 @@ let build_swf9 com file swc =
 						| SWAV ->
 							(try
 								let i = IO.input_string data in
-								if IO.nread i 4 <> "RIFF" then raise Exit;
+								if IO.nread_string i 4 <> "RIFF" then raise Exit;
 								ignore(IO.nread i 4); (* size *)
-								if IO.nread i 4 <> "WAVE" || IO.nread i 4 <> "fmt " then raise Exit;
+								if IO.nread_string i 4 <> "WAVE" || IO.nread_string i 4 <> "fmt " then raise Exit;
 								let chunk_size = IO.read_i32 i in
 								if not (chunk_size = 0x10 || chunk_size = 0x12 || chunk_size = 0x40) then failwith ("Unsupported chunk size " ^ string_of_int chunk_size);
 								if IO.read_ui16 i <> 1 then failwith "Not a PCM file";
@@ -397,9 +397,9 @@ let build_swf9 com file swc =
 								ignore(IO.read_i16 i);
 								let bits = IO.read_ui16 i in
 								if chunk_size <> 0x10 then ignore(IO.nread i (chunk_size - 0x10));
-								if IO.nread i 4 <> "data" then raise Exit;
+								if IO.nread_string i 4 <> "data" then raise Exit;
 								let data_size = IO.read_i32 i in
-								let data = IO.nread i data_size in
+								let data = IO.nread_string i data_size in
 								make_flags 0 (chan = 1) freq bits, (data_size * 8 / (chan * bits)), data
 							with Exit | IO.No_more_input | IO.Overflow _ ->
 								abort "Invalid WAV file" p
@@ -418,7 +418,7 @@ let build_swf9 com file swc =
 										()
 									| 0x49 ->
 										(* ID3 *)
-										if IO.nread i 2 <> "D3" then raise Exit;
+										if IO.nread_string i 2 <> "D3" then raise Exit;
 										ignore(IO.read_ui16 i); (* version *)
 										ignore(IO.read_byte i); (* flags *)
 										let size = IO.read_byte i land 0x7F in
@@ -429,7 +429,7 @@ let build_swf9 com file swc =
 										read_frame()
 									| 0x54 ->
 										(* TAG and TAG+ *)
-										if IO.nread i 3 = "AG+" then ignore(IO.nread i 223) else ignore(IO.nread i 124);
+										if IO.nread_string i 3 = "AG+" then ignore(IO.nread i 223) else ignore(IO.nread i 124);
 										read_frame()
 									| 0xFF ->
 										let infos = IO.read_byte i in

src/generators/hlinterp.ml

@@ -240,10 +240,10 @@ let get_to_string ctx p =
 
 let set_i32 b p v =
 	try
-		String.set b p (char_of_int ((Int32.to_int v) land 0xFF));
-		String.set b (p+1) (char_of_int ((Int32.to_int (Int32.shift_right_logical v 8)) land 0xFF));
-		String.set b (p+2) (char_of_int ((Int32.to_int (Int32.shift_right_logical v 16)) land 0xFF));
-		String.set b (p+3) (char_of_int (Int32.to_int (Int32.shift_right_logical v 24)));
+		Bytes.set (Bytes.unsafe_of_string b) p (char_of_int ((Int32.to_int v) land 0xFF));
+		Bytes.set (Bytes.unsafe_of_string b) (p+1) (char_of_int ((Int32.to_int (Int32.shift_right_logical v 8)) land 0xFF));
+		Bytes.set (Bytes.unsafe_of_string b) (p+2) (char_of_int ((Int32.to_int (Int32.shift_right_logical v 16)) land 0xFF));
+		Bytes.set (Bytes.unsafe_of_string b) (p+3) (char_of_int (Int32.to_int (Int32.shift_right_logical v 24)));
 	with _ ->
 		error "Set outside of bytes bounds"
 
@@ -1014,13 +1014,13 @@ let interp ctx f args =
 			| _ -> assert false);
 		| OSetUI8 (r,p,v) ->
 			(match get r, get p, get v with
-			| VBytes b, VInt p, VInt v -> String.set b (Int32.to_int p) (char_of_int ((Int32.to_int v) land 0xFF))
+			| VBytes b, VInt p, VInt v -> Bytes.set (Bytes.unsafe_of_string b) (Int32.to_int p) (char_of_int ((Int32.to_int v) land 0xFF))
 			| _ -> assert false)
 		| OSetUI16 (r,p,v) ->
 			(match get r, get p, get v with
 			| VBytes b, VInt p, VInt v ->
-				String.set b (Int32.to_int p) (char_of_int ((Int32.to_int v) land 0xFF));
-				String.set b (Int32.to_int p + 1) (char_of_int (((Int32.to_int v) lsr 8) land 0xFF))
+				Bytes.set (Bytes.unsafe_of_string b) (Int32.to_int p) (char_of_int ((Int32.to_int v) land 0xFF));
+				Bytes.set (Bytes.unsafe_of_string b) (Int32.to_int p + 1) (char_of_int (((Int32.to_int v) lsr 8) land 0xFF))
 			| _ -> assert false)
 		| OSetMem (r,p,v) ->
 			(match get r, get p with
@@ -1234,7 +1234,7 @@ let load_native ctx lib name t =
 		(match name with
 		| "alloc_bytes" ->
 			(function
-			| [VInt i] -> VBytes (String.create (int i))
+			| [VInt i] -> VBytes (Bytes.unsafe_to_string (Bytes.create (int i)))
 			| _ -> assert false)
 		| "alloc_array" ->
 			(function
@@ -1265,7 +1265,7 @@ let load_native ctx lib name t =
 		| "bytes_blit" ->
 			(function
 			| [VBytes dst; VInt dp; VBytes src; VInt sp; VInt len] ->
-				String.blit src (int sp) dst (int dp) (int len);
+				String.blit src (int sp) (Bytes.unsafe_of_string dst) (int dp) (int len);
 				VUndef
 			| [(VBytes _ | VNull); VInt _; (VBytes _ | VNull); VInt _; VInt len] ->
 				if len = 0l then VUndef else error "bytes_blit to NULL bytes";
@@ -1868,7 +1868,7 @@ let load_native ctx lib name t =
 		| "bytes_fill" ->
 			(function
 			| [VBytes a; VInt pos; VInt len; VInt v] ->
-				String.fill a (int pos) (int len) (char_of_int ((int v) land 0xFF));
+				Bytes.fill (Bytes.unsafe_of_string a) (int pos) (int len) (char_of_int ((int v) land 0xFF));
 				VUndef
 			| _ -> assert false)
 		| "exception_stack" ->

src/generators/hlopt.ml

@@ -473,7 +473,7 @@ let optimize dump (f:fundecl) =
 	let set_op index op = f.code.(index) <- op in
 	let nop_count = ref 0 in
 	let set_nop index r = f.code.(index) <- (ONop r); incr nop_count in
-	let write str = match dump with None -> () | Some ch -> IO.nwrite ch (str ^ "\n") in
+	let write str = match dump with None -> () | Some ch -> IO.nwrite ch (Bytes.unsafe_of_string (str ^ "\n")) in
 
 	let blocks_pos, root = code_graph f in
 

src/macro/interp.ml

@@ -527,11 +527,11 @@ let builtins =
 		"sset", Fun3 (fun s p c ->
 			let c = char_of_int ((vint c) land 0xFF) in
 			try
-				String.set (vstring s) (vint p) c;
+				Bytes.set (Bytes.unsafe_of_string (vstring s)) (vint p) c;
 				VInt (int_of_char c)
 			with Invalid_argument _ -> VNull);
 		"sblit", Fun5 (fun dst dstp src p l ->
-			String.blit (vstring src) (vint p) (vstring dst) (vint dstp) (vint l);
+			String.blit (vstring src) (vint p) (Bytes.unsafe_of_string (vstring dst)) (vint dstp) (vint l);
 			VNull
 		);
 		"sfind", Fun3 (fun src pos pat ->
@@ -1036,7 +1036,7 @@ let std_lib =
 			| VString s, VString b ->
 				if String.length b <> 64 then assert false;
 				let tbl = Array.init 64 (String.unsafe_get b) in
-				VString (Base64.str_encode ~tbl s)
+				VString (Bytes.unsafe_to_string (Base64.str_encode ~tbl s))
 			| _ -> error()
 		);
 		"base_decode", Fun2 (fun s b ->
@@ -1044,7 +1044,7 @@ let std_lib =
 			let b = vstring b in
 			if String.length b <> 64 then assert false;
 			let tbl = Array.init 64 (String.unsafe_get b) in
-			VString (Base64.str_decode ~tbl:(Base64.make_decoding_table tbl) s)
+			VString (Base64.str_decode ~tbl:(Base64.make_decoding_table tbl) (Bytes.unsafe_of_string s))
 		);
 		"make_md5", Fun1 (fun s ->
 			VString (Digest.string (vstring s))
@@ -1171,13 +1171,13 @@ let std_lib =
 		(* file_name *)
 		"file_write", Fun4 (fun f s p l ->
 			match f, s, p, l with
-			| VAbstract (AFWrite f), VString s, VInt p, VInt l -> output f s p l; VInt l
+			| VAbstract (AFWrite f), VString s, VInt p, VInt l -> output_substring f s p l; VInt l
 			| _ -> error()
 		);
 		"file_read", Fun4 (fun f s p l ->
 			match f, s, p, l with
 			| VAbstract (AFRead (f,r)), VString s, VInt p, VInt l ->
-				let n = input f s p l in
+				let n = input f (Bytes.unsafe_of_string s) p l in
 				if n = 0 then begin
 					r := true;
 					exc (VArray [|VString "file_read"|]);
@@ -1249,26 +1249,26 @@ let std_lib =
 		"socket_send_char", Fun2 (fun s c ->
 			match s, c with
 			| VAbstract (ASocket s), VInt c when c >= 0 && c <= 255 ->
-				ignore(Unix.send s (String.make 1 (char_of_int c)) 0 1 []);
+				ignore(Unix.send s (Bytes.make 1 (char_of_int c)) 0 1 []);
 				VNull
 			| _ -> error()
 		);
 		"socket_send", Fun4 (fun s buf pos len ->
 			match s, buf, pos, len with
-			| VAbstract (ASocket s), VString buf, VInt pos, VInt len -> VInt (Unix.send s buf pos len [])
+			| VAbstract (ASocket s), VString buf, VInt pos, VInt len -> VInt (Unix.send s (Bytes.unsafe_of_string buf) pos len [])
 			| _ -> error()
 		);
 		"socket_recv", Fun4 (fun s buf pos len ->
 			match s, buf, pos, len with
-			| VAbstract (ASocket s), VString buf, VInt pos, VInt len -> VInt (Unix.recv s buf pos len [])
+			| VAbstract (ASocket s), VString buf, VInt pos, VInt len -> VInt (Unix.recv s (Bytes.unsafe_of_string buf) pos len [])
 			| _ -> error()
 		);
 		"socket_recv_char", Fun1 (fun s ->
 			match s with
 			| VAbstract (ASocket s) ->
-				let buf = String.make 1 '\000' in
+				let buf = Bytes.make 1 '\000' in
 				ignore(Unix.recv s buf 0 1 []);
-				VInt (int_of_char (String.unsafe_get buf 0))
+				VInt (int_of_char (Bytes.unsafe_get buf 0))
 			| _ -> error()
 		);
 		"socket_write", Fun2 (fun s str ->
@@ -1277,7 +1277,7 @@ let std_lib =
 				let pos = ref 0 in
 				let len = ref (String.length str) in
 				while !len > 0 do
-					let k = Unix.send s str (!pos) (!len) [] in
+					let k = Unix.send s (Bytes.unsafe_of_string str) (!pos) (!len) [] in
 					pos := !pos + k;
 					len := !len - k;
 				done;
@@ -1287,12 +1287,12 @@ let std_lib =
 		"socket_read", Fun1 (fun s ->
 			match s with
 			| VAbstract (ASocket s) ->
-				let tmp = String.make 1024 '\000' in
+				let tmp = Bytes.make 1024 '\000' in
 				let buf = Buffer.create 0 in
 				let rec loop() =
 					let k = (try Unix.recv s tmp 0 1024 [] with Unix_error _ -> 0) in
 					if k > 0 then begin
-						Buffer.add_substring buf tmp 0 k;
+						Buffer.add_subbytes buf tmp 0 k;
 						loop();
 					end
 				in
@@ -1775,7 +1775,7 @@ let z_lib =
 		"inflate_buffer", Fun5 (fun z src pos dst dpos ->
 			match z, src, pos, dst, dpos with
 			| VAbstract (AZipI z), VString src, VInt pos, VString dst, VInt dpos ->
-				let r = Extc.zlib_inflate z.z src pos (String.length src - pos) dst dpos (String.length dst - dpos) z.z_flush in
+				let r = Extc.zlib_inflate z.z src pos (String.length src - pos) (Bytes.unsafe_of_string dst) dpos (String.length dst - dpos) z.z_flush in
 				VObject (obj (hash_field (get_ctx())) [
 					"done", VBool r.Extc.z_finish;
 					"read", VInt r.Extc.z_read;
@@ -1786,7 +1786,7 @@ let z_lib =
 		"deflate_buffer", Fun5 (fun z src pos dst dpos ->
 			match z, src, pos, dst, dpos with
 			| VAbstract (AZipD z), VString src, VInt pos, VString dst, VInt dpos ->
-				let r = Extc.zlib_deflate z.z src pos (String.length src - pos) dst dpos (String.length dst - dpos) z.z_flush in
+				let r = Extc.zlib_deflate z.z src pos (String.length src - pos) (Bytes.unsafe_of_string dst) dpos (String.length dst - dpos) z.z_flush in
 				VObject (obj (hash_field (get_ctx())) [
 					"done", VBool r.Extc.z_finish;
 					"read", VInt r.Extc.z_read;