Browse Source

fixed Ast.s_escape

Nicolas Cannasse 12 years ago
parent
commit
4852dd7373
3 changed files with 18 additions and 34 deletions
  1. 4 11
      ast.ml
  2. 1 10
      genas3.ml
  3. 13 13
      gencpp.ml

+ 4 - 11
ast.ml

@@ -454,24 +454,17 @@ let parse_path s =
 	| [] -> failwith "Invalid empty path"
 	| [] -> failwith "Invalid empty path"
 	| x :: l -> List.rev l, x
 	| x :: l -> List.rev l, x
 
 
-let s_escape s =
+let s_escape ?(hex=true) s =
 	let b = Buffer.create (String.length s) in
 	let b = Buffer.create (String.length s) in
-	let utf8 = ref false in
 	for i = 0 to (String.length s) - 1 do
 	for i = 0 to (String.length s) - 1 do
-		if !utf8 then begin
-			let c = s.[i] in
-			Buffer.add_char b c;
-			utf8 := int_of_char c >= 128;
-		end else match s.[i] with
+		match s.[i] with
 		| '\n' -> Buffer.add_string b "\\n"
 		| '\n' -> Buffer.add_string b "\\n"
 		| '\t' -> Buffer.add_string b "\\t"
 		| '\t' -> Buffer.add_string b "\\t"
 		| '\r' -> Buffer.add_string b "\\r"
 		| '\r' -> Buffer.add_string b "\\r"
 		| '"' -> Buffer.add_string b "\\\""
 		| '"' -> Buffer.add_string b "\\\""
 		| '\\' -> Buffer.add_string b "\\\\"
 		| '\\' -> Buffer.add_string b "\\\\"
-		| c when int_of_char c < 32 -> Buffer.add_string b (Printf.sprintf "\\x%.2X" (int_of_char c))
-		| c ->
-			if int_of_char c >= 128 then utf8 := true;
-			Buffer.add_char b c
+		| c when int_of_char c < 32 && hex -> Buffer.add_string b (Printf.sprintf "\\x%.2X" (int_of_char c))
+		| c -> Buffer.add_char b c
 	done;
 	done;
 	Buffer.contents b
 	Buffer.contents b
 
 

+ 1 - 10
genas3.ml

@@ -301,15 +301,6 @@ let handle_break ctx e =
 
 
 let this ctx = if ctx.in_value <> None then "$this" else "this"
 let this ctx = if ctx.in_value <> None then "$this" else "this"
 
 
-let escape_bin s =
-	let b = Buffer.create 0 in
-	for i = 0 to String.length s - 1 do
-		match Char.code (String.unsafe_get s i) with
-		| c when c < 32 -> Buffer.add_string b (Printf.sprintf "\\x%.2X" c)
-		| c -> Buffer.add_char b (Char.chr c)
-	done;
-	Buffer.contents b
-
 let generate_resources infos =
 let generate_resources infos =
 	if Hashtbl.length infos.com.resources <> 0 then begin
 	if Hashtbl.length infos.com.resources <> 0 then begin
 		let dir = (infos.com.file :: ["__res"]) in
 		let dir = (infos.com.file :: ["__res"]) in
@@ -347,7 +338,7 @@ let generate_resources infos =
 let gen_constant ctx p = function
 let gen_constant ctx p = function
 	| TInt i -> print ctx "%ld" i
 	| TInt i -> print ctx "%ld" i
 	| TFloat s -> spr ctx s
 	| TFloat s -> spr ctx s
-	| TString s -> print ctx "\"%s\"" (escape_bin (Ast.s_escape s))
+	| TString s -> print ctx "\"%s\"" (Ast.s_escape s)
 	| TBool b -> spr ctx (if b then "true" else "false")
 	| TBool b -> spr ctx (if b then "true" else "false")
 	| TNull -> spr ctx "null"
 	| TNull -> spr ctx "null"
 	| TThis -> spr ctx (this ctx)
 	| TThis -> spr ctx (this ctx)

+ 13 - 13
gencpp.ml

@@ -144,14 +144,14 @@ let make_base_directory dir =
 
 
 let new_source_file common_ctx base_dir sub_dir extension class_path =
 let new_source_file common_ctx base_dir sub_dir extension class_path =
 	let include_prefix = get_include_prefix common_ctx in
 	let include_prefix = get_include_prefix common_ctx in
-	let full_dir = 
+	let full_dir =
 	   if (sub_dir="include") && (include_prefix<>"") then begin
 	   if (sub_dir="include") && (include_prefix<>"") then begin
 		   let dir = base_dir ^ "/include/" ^ include_prefix ^ ( String.concat "/" (fst class_path) )  in
 		   let dir = base_dir ^ "/include/" ^ include_prefix ^ ( String.concat "/" (fst class_path) )  in
 			make_base_directory dir;
 			make_base_directory dir;
 			dir
 			dir
 		end else begin
 		end else begin
 			make_class_directories base_dir ( sub_dir :: (fst class_path));
 			make_class_directories base_dir ( sub_dir :: (fst class_path));
-			base_dir ^ "/" ^ sub_dir ^ "/" ^ ( String.concat "/" (fst class_path) ) 
+			base_dir ^ "/" ^ sub_dir ^ "/" ^ ( String.concat "/" (fst class_path) )
 		end
 		end
    in
    in
 	cached_source_writer common_ctx (full_dir ^ "/" ^ ((snd class_path) ^ extension));;
 	cached_source_writer common_ctx (full_dir ^ "/" ^ ((snd class_path) ^ extension));;
@@ -712,7 +712,7 @@ let escape_command s =
 
 
 
 
 let str s =
 let str s =
-	let escaped = Ast.s_escape s in
+	let escaped = Ast.s_escape ~hex:false s in
 		("HX_CSTRING(\"" ^ (special_to_hex escaped) ^ "\")")
 		("HX_CSTRING(\"" ^ (special_to_hex escaped) ^ "\")")
 ;;
 ;;
 
 
@@ -2031,7 +2031,7 @@ and gen_expression ctx retval expression =
 		end;
 		end;
 	| TBreak -> output "break"
 	| TBreak -> output "break"
 	| TContinue -> output "continue"
 	| TContinue -> output "continue"
-	| TThrow expression -> 
+	| TThrow expression ->
 	        output "HX_STACK_DO_THROW(";
 	        output "HX_STACK_DO_THROW(";
 			gen_expression ctx true expression;
 			gen_expression ctx true expression;
 			output ")";
 			output ")";
@@ -3223,7 +3223,7 @@ let generate_class_files common_ctx member_types super_deps constructor_deps cla
    | x -> x
    | x -> x
    in
    in
 
 
-   let generate_script_function isStatic field scriptName callName = 
+   let generate_script_function isStatic field scriptName callName =
 		match follow field.cf_type  with
 		match follow field.cf_type  with
 		| TFun (args,return_type) ->
 		| TFun (args,return_type) ->
          output_cpp ("\nstatic void " ^ scriptName ^ "(hx::CppiaCtx *ctx) {\n");
          output_cpp ("\nstatic void " ^ scriptName ^ "(hx::CppiaCtx *ctx) {\n");
@@ -3810,7 +3810,7 @@ let gen_extern_enum common_ctx enum_def file_info =
 	file#close
 	file#close
 ;;
 ;;
 
 
-let rec remove_parens expression = 
+let rec remove_parens expression =
    match expression.eexpr with
    match expression.eexpr with
    | TParenthesis e -> remove_parens e
    | TParenthesis e -> remove_parens e
    | TMeta(_,e) -> remove_parens e
    | TMeta(_,e) -> remove_parens e
@@ -3833,7 +3833,7 @@ let is_super expression =
 
 
 let is_assign_op op =
 let is_assign_op op =
    match op with
    match op with
-   | OpAssign 
+   | OpAssign
    | OpAssignOp _ -> true
    | OpAssignOp _ -> true
    | _ -> false
    | _ -> false
 ;;
 ;;
@@ -3896,7 +3896,7 @@ class script_writer common_ctx ctx filename =
    val identTable = Hashtbl.create 0
    val identTable = Hashtbl.create 0
    val fileTable = Hashtbl.create 0
    val fileTable = Hashtbl.create 0
    val identBuffer = Buffer.create 0
    val identBuffer = Buffer.create 0
-	method stringId name = 
+	method stringId name =
       try ( Hashtbl.find identTable name )
       try ( Hashtbl.find identTable name )
 	   with Not_found -> begin
 	   with Not_found -> begin
          let size = Hashtbl.length identTable in
          let size = Hashtbl.length identTable in
@@ -3908,7 +3908,7 @@ class script_writer common_ctx ctx filename =
 	method stringText name = (string_of_int (this#stringId name)) ^ " "
 	method stringText name = (string_of_int (this#stringId name)) ^ " "
    val typeTable = Hashtbl.create 0
    val typeTable = Hashtbl.create 0
    val typeBuffer = Buffer.create 0
    val typeBuffer = Buffer.create 0
-   method typeId name = 
+   method typeId name =
       try ( Hashtbl.find typeTable name )
       try ( Hashtbl.find typeTable name )
 	   with Not_found -> begin
 	   with Not_found -> begin
          let size = Hashtbl.length typeTable in
          let size = Hashtbl.length typeTable in
@@ -3931,7 +3931,7 @@ class script_writer common_ctx ctx filename =
    method instName clazz = this#write (this#instText clazz)
    method instName clazz = this#write (this#instText clazz)
    method enumText e = this#typeText (TEnum(e,[]))
    method enumText e = this#typeText (TEnum(e,[]))
    method enumName e = this#write (this#enumText e)
    method enumName e = this#write (this#enumText e)
-	method close = 
+	method close =
       let out_file = open_out_bin filename in
       let out_file = open_out_bin filename in
       output_string out_file "CPPIA\n";
       output_string out_file "CPPIA\n";
       let idents =  Buffer.contents identBuffer in
       let idents =  Buffer.contents identBuffer in
@@ -4010,7 +4010,7 @@ class script_writer common_ctx ctx filename =
         if (is_interface_type toType) && not (is_interface_type expr.etype) then begin
         if (is_interface_type toType) && not (is_interface_type expr.etype) then begin
            write_cast ("TOINTERFACE " ^ (this#typeText toType) ^ " " ^ (this#typeText expr.etype) )
            write_cast ("TOINTERFACE " ^ (this#typeText toType) ^ " " ^ (this#typeText expr.etype) )
         end else begin
         end else begin
-           let rec get_array_type t = 
+           let rec get_array_type t =
               match follow t with
               match follow t with
               | TInst ({cl_path=[],"Array"},[param]) ->
               | TInst ({cl_path=[],"Array"},[param]) ->
                   let typeName = type_string_suff "" param in
                   let typeName = type_string_suff "" param in
@@ -4027,7 +4027,7 @@ class script_writer common_ctx ctx filename =
               | _ -> ArrayNone
               | _ -> ArrayNone
            in
            in
            let get_array_expr_type expr =
            let get_array_expr_type expr =
-              if is_dynamic_in_cpp ctx expr then 
+              if is_dynamic_in_cpp ctx expr then
                  ArrayNone
                  ArrayNone
               else
               else
                  get_array_type expr.etype
                  get_array_type expr.etype
@@ -4209,7 +4209,7 @@ class script_writer common_ctx ctx filename =
                  ("methodName", { eexpr = (TConst (TString meth)) }) :: [] ) ->
                  ("methodName", { eexpr = (TConst (TString meth)) }) :: [] ) ->
             this#write ("POSINFO " ^ (this#stringText file) ^ (Printf.sprintf "%ld" line) ^ " " ^
             this#write ("POSINFO " ^ (this#stringText file) ^ (Printf.sprintf "%ld" line) ^ " " ^
                          (this#stringText class_name) ^ " " ^  (this#stringText meth))
                          (this#stringText class_name) ^ " " ^  (this#stringText meth))
- 
+
      | TObjectDecl values ->this#write ("OBJDEF " ^ (string_of_int (List.length values)));
      | TObjectDecl values ->this#write ("OBJDEF " ^ (string_of_int (List.length values)));
          this#write " ";
          this#write " ";
          List.iter (fun (name,_) -> this#write (this#stringText name)  ) values;
          List.iter (fun (name,_) -> this#write (this#stringText name)  ) values;