Browse Source

[js] preserve quoted field status (closes #3101)

- make parser prefix all fields quoted in syntax
- when unquoting distinguish between quoted and valid identifiers
- wrap structure field expression with `@:quotedField` to communicate quoted status
Simon Krajewski 10 years ago
parent
commit
d6b78afe6b
6 changed files with 55 additions and 14 deletions
  1. 1 0
      ast.ml
  2. 1 0
      common.ml
  3. 5 1
      genjs.ml
  4. 12 8
      parser.ml
  5. 26 0
      tests/optimization/src/TestJs.hx
  6. 10 5
      typer.ml

+ 1 - 0
ast.ml

@@ -128,6 +128,7 @@ module Meta = struct
 		| Protected
 		| Public
 		| PublicFields
+		| QuotedField
 		| ReadOnly
 		| RealPath
 		| Remove

+ 1 - 0
common.ml

@@ -447,6 +447,7 @@ module MetaInfo = struct
 		| Overload -> ":overload",("Allows the field to be called with different argument types",[HasParam "Function specification (no expression)";UsedOn TClassField])
 		| Public -> ":public",("Marks a class field as being public",[UsedOn TClassField])
 		| PublicFields -> ":publicFields",("Forces all class fields of inheriting classes to be public",[UsedOn TClass])
+		| QuotedField -> ":quotedField",("Used internally to mark structure fields which are quoted in syntax",[Internal])
 		| PrivateAccess -> ":privateAccess",("Allow private access to anything for the annotated expression",[UsedOn TExpr])
 		| Protected -> ":protected",("Marks a class field as being protected",[UsedOn TClassField])
 		| Property -> ":property",("Marks a property field to be compiled as a native C# property",[UsedOn TClassField;Platform Cs])

+ 5 - 1
genjs.ml

@@ -627,7 +627,11 @@ and gen_expr ctx e =
 		handle_break();
 	| TObjectDecl fields ->
 		spr ctx "{ ";
-		concat ctx ", " (fun (f,e) -> print ctx "%s : " (anon_field f); gen_value ctx e) fields;
+		concat ctx ", " (fun (f,e) -> (match e.eexpr with
+			| TMeta((Meta.QuotedField,_,_),e) -> print ctx "'%s' : " f;
+			| _ -> print ctx "%s : " (anon_field f));
+			gen_value ctx e
+		) fields;
 		spr ctx "}";
 		ctx.separator <- true
 	| TFor (v,it,e) ->

+ 12 - 8
parser.ml

@@ -50,7 +50,14 @@ let display_error : (error_msg -> pos -> unit) ref = ref (fun _ _ -> assert fals
 let quoted_ident_prefix = "@$__hx__"
 
 let quote_ident s =
-	try
+	quoted_ident_prefix ^ s
+
+let unquote_ident f =
+	let pf = quoted_ident_prefix in
+	let pflen = String.length pf in
+	let is_quoted = String.length f >= pflen && String.sub f 0 pflen = pf in
+	let s = if is_quoted then String.sub f pflen (String.length f - pflen) else f in
+	let is_valid = not is_quoted || try
 		for i = 0 to String.length s - 1 do
 			match String.unsafe_get s i with
 			| 'a'..'z' | 'A'..'Z' | '_' -> ()
@@ -58,14 +65,11 @@ let quote_ident s =
 			| _ -> raise Exit
 		done;
 		if Hashtbl.mem Lexer.keywords s then raise Exit;
-		s
+		true
 	with Exit ->
-		quoted_ident_prefix ^ s
-
-let unquote_ident f =
-	let pf = quoted_ident_prefix in
-	let pflen = String.length pf in
-	if String.length f >= pflen && String.sub f 0 pflen = pf then String.sub f pflen (String.length f - pflen), false else f, true
+		false
+	in
+	s,is_quoted,is_valid
 
 let cache = ref (DynArray.create())
 let last_doc = ref None

+ 26 - 0
tests/optimization/src/TestJs.hx

@@ -105,4 +105,30 @@ class TestJs {
 	}
 
 	static inline function verify(s1) return s1 == "foo";
+
+	@:js('
+		var object = { \'hello\' : "world"};
+		TestJs["use"](object);
+	')
+	static function testQuotedStructureFields1() {
+		var object = {
+			"hello": "world"
+		}
+		use(object);
+	}
+
+	@:js('
+		var object = { \'hello\' : "world", world : "hello", \'another\' : "quote"};
+		TestJs["use"](object);
+	')
+	static function testQuotedStructureFields2() {
+		var object = {
+			'hello': "world",
+			world: "hello",
+			"another": "quote"
+		}
+		use(object);
+	}
+
+	static function use<T>(t:T) { }
 }

+ 10 - 5
typer.ml

@@ -2893,15 +2893,19 @@ and type_expr ctx (e,p) (with_type:with_type) =
 			| _ -> None)
 		| _ -> None
 		) in
+		let wrap_quoted_meta e =
+			mk (TMeta((Meta.QuotedField,[],e.epos),e)) e.etype e.epos
+		in
 		(match a with
 		| None ->
 			let rec loop (l,acc) (f,e) =
-				let f,add = Parser.unquote_ident f in
+				let f,is_quoted,is_valid = Parser.unquote_ident f in
 				if PMap.mem f acc then error ("Duplicate field in object declaration : " ^ f) p;
 				let e = type_expr ctx e Value in
 				(match follow e.etype with TAbstract({a_path=[],"Void"},_) -> error "Fields of type Void are not allowed in structures" e.epos | _ -> ());
 				let cf = mk_field f e.etype e.epos in
-				((f,e) :: l, if add then begin
+				let e = if is_quoted then wrap_quoted_meta e else e in
+				((f,e) :: l, if is_valid then begin
 					if f.[0] = '$' then error "Field names starting with a dollar are not allowed" p;
 					PMap.add f cf acc
 				end else acc)
@@ -2914,7 +2918,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 			let fields = ref PMap.empty in
 			let extra_fields = ref [] in
 			let fl = List.map (fun (n, e) ->
-				let n,add = Parser.unquote_ident n in
+				let n,is_quoted,is_valid = Parser.unquote_ident n in
 				if PMap.mem n !fields then error ("Duplicate field in object declaration : " ^ n) p;
 				let e = try
 					let t = (match !dynamic_parameter with Some t -> t | None -> (PMap.find n a.a_fields).cf_type) in
@@ -2922,15 +2926,16 @@ and type_expr ctx (e,p) (with_type:with_type) =
 					let e = Codegen.AbstractCast.cast_or_unify ctx t e p in
 					(try type_eq EqStrict e.etype t; e with Unify_error _ -> mk (TCast (e,None)) t e.epos)
 				with Not_found ->
-					if add then
+					if is_valid then
 						extra_fields := n :: !extra_fields;
 					type_expr ctx e Value
 				in
-				if add then begin
+				if is_valid then begin
 					if n.[0] = '$' then error "Field names starting with a dollar are not allowed" p;
 					let cf = mk_field n e.etype e.epos in
 					fields := PMap.add n cf !fields;
 				end;
+				let e = if is_quoted then wrap_quoted_meta e else e in
 				(n,e)
 			) fl in
 			let t = (TAnon { a_fields = !fields; a_status = ref Const }) in