added [key => val] shorthand for Map initialization (fixed issue #960)

ast.ml

@@ -332,6 +332,7 @@ type binop =
 	| OpMod
 	| OpAssignOp of binop
 	| OpInterval
+	| OpArrow
 
 type unop =
 	| Increment
@@ -668,6 +669,7 @@ let rec s_binop = function
 	| OpMod -> "%"
 	| OpAssignOp op -> s_binop op ^ "="
 	| OpInterval -> "..."
+	| OpArrow -> "=>"
 
 let s_unop = function
 	| Increment -> "++"
@@ -844,6 +846,7 @@ let reify in_macro =
 		| OpMod -> op "OpMod"
 		| OpAssignOp o -> mk_enum "Binop" "OpAssignOp" [to_binop o p] p
 		| OpInterval -> op "OpInterval"
+		| OpArrow -> op "OpArrow"
 	in
 	let to_string s p =
 		let len = String.length s in

gencommon.ml

@@ -2085,7 +2085,7 @@ struct
               { e with eexpr = TBinop(op, mk_cast gen.gcon.basic.tbool (run e1), mk_cast gen.gcon.basic.tbool (run e2)) }
             | OpAnd | OpOr | OpXor | OpShl | OpShr | OpUShr | OpMod ->
               { e with eexpr = TBinop(op, mk_cast gen.gcon.basic.tint (run e1), mk_cast gen.gcon.basic.tint (run e2)) }
-            | OpAssign | OpAssignOp _ | OpInterval -> assert false)
+            | OpAssign | OpAssignOp _ | OpInterval | OpArrow -> assert false)
         | TUnop (Increment as op, flag, e1)
         | TUnop (Decrement as op, flag, e1) when should_change e ->
           (*

genswf8.ml

@@ -829,7 +829,7 @@ and gen_binop ctx retval op e1 e2 =
 		write ctx APop;
 		gen_expr ctx true e2;
 		jump_end()
-	| OpInterval ->
+	| OpInterval | OpArrow ->
 		(* handled by typer *)
 		assert false
 

genswf9.ml

@@ -1666,7 +1666,7 @@ and gen_binop ctx retval op e1 e2 t p =
 		gen_op A3OLt
 	| OpLte ->
 		gen_op A3OLte
-	| OpInterval ->
+	| OpInterval | OpArrow ->
 		assert false
 
 and gen_expr ctx retval e =

interp.ml

@@ -3499,6 +3499,7 @@ let rec encode_binop op =
 	| OpMod -> 19, []
 	| OpAssignOp op -> 20, [encode_binop op]
 	| OpInterval -> 21, []
+	| OpArrow -> 22, []
 	in
 	enc_enum IBinop tag pl
 
@@ -3777,6 +3778,7 @@ let rec decode_op op =
 	| 19, [] -> OpMod
 	| 20, [op] -> OpAssignOp (decode_op op)
 	| 21, [] -> OpInterval
+	| 22,[] -> OpArrow
 	| _ -> raise Invalid_expr
 
 let decode_unop op =

lexer.mll

@@ -236,6 +236,7 @@ and token = parse
 	| "<<" { mk lexbuf (Binop OpShl) }
 	| "->" { mk lexbuf Arrow }
 	| "..." { mk lexbuf (Binop OpInterval) }
+	| "=>" { mk lexbuf (Binop OpArrow)}
 	| "!" { mk lexbuf (Unop Not) }
 	| "<" { mk lexbuf (Binop OpLt) }
 	| ">" { mk lexbuf (Binop OpGt) }

optimizer.ml

@@ -577,8 +577,9 @@ let standard_precedence op =
 	| OpInterval -> 13, right (* haxe specific *)
 	| OpBoolAnd -> 14, left
 	| OpBoolOr -> 15, left
-	| OpAssignOp OpAssign -> 16, right (* mimics ?: *)
-	| OpAssign | OpAssignOp _ -> 17, right
+	| OpArrow -> 16, left
+	| OpAssignOp OpAssign -> 17, right (* mimics ?: *)
+	| OpAssign | OpAssignOp _ -> 18, right
 
 let rec need_parent e =
 	match e.eexpr with

parser.ml

@@ -90,7 +90,8 @@ let precedence op =
 	| OpInterval -> 6, left
 	| OpBoolAnd -> 7, left
 	| OpBoolOr -> 8, left
-	| OpAssign | OpAssignOp _ -> 9, right
+	| OpArrow -> 9, left
+	| OpAssign | OpAssignOp _ -> 10, right
 
 let is_not_assign = function
 	| OpAssign | OpAssignOp _ -> false

std/haxe/macro/Expr.hx

@@ -66,6 +66,7 @@ enum Binop {
 	OpMod;
 	OpAssignOp( op : Binop );
 	OpInterval;
+	OpArrow;
 }
 
 

std/haxe/macro/Printer.hx

@@ -64,6 +64,7 @@ class Printer {
 		case OpUShr: ">>>";
 		case OpMod: "%";
 		case OpInterval: "...";
+		case OpArrow: "=>";
 		case OpAssignOp(op):
 			printBinop(op)
 			+ "=";

tests/unit/TestType.hx

@@ -685,6 +685,38 @@ class TestType extends Test {
 			var s:String = z;
 		}));
 	}
+	
+	function testOpArrow() {
+		var m = new Map<Int,Int>();
+		var map = [1 => 2, 3 => 4];
+		typedAs(map, m);
+		t(Std.is(map, haxe.ds.IntMap));
+		eq(map.get(1), 2);
+		eq(map.get(3), 4);
+		
+		var m = new Map<String,Int>();
+		var map = ["1" => 2, "3" => 4];
+		typedAs(map, m);
+		t(Std.is(map, haxe.ds.StringMap));
+		eq(map.get("1"), 2);
+		eq(map.get("3"), 4);
+		
+		var a = new unit.MyAbstract.ClassWithHashCode(1);
+		var b = new unit.MyAbstract.ClassWithHashCode(2);
+		var m = new Map<unit.MyAbstract.ClassWithHashCode,Int>();
+		var map = [a => 2, b => 4];
+		typedAs(map, m);
+		t(Std.is(map, haxe.ds.IntMap));
+		eq(map.get(a), 2);
+		eq(map.get(b), 4);
+		
+		// duplicate key
+		t(typeError([1 => 2, 1 => 3]));
+		// key unification
+		t(typeError([1 => 2, "1" => 2]));
+		// value unification
+		t(typeError([1 => 2, 1 => "2"]));
+	}
 
 	function testAbstractGeneric() {
 		var map = new Map();
@@ -702,7 +734,7 @@ class TestType extends Test {
 		map.set(b, "bar");
 		eq(map.get(a), "foo");
 		eq(map.get(b), "bar");
-		t(Std.is(map, haxe.ds.HashMap));
+		t(Std.is(map, haxe.ds.IntMap));
 
 		//var map = new unit.MyAbstract.MyMap();
 		//map.set(new haxe.Template("foo"), 99);

typer.ml

@@ -1482,6 +1482,8 @@ let rec type_binop ctx op e1 e2 is_assign_op p =
 		unify ctx e1.etype tint e1.epos;
 		unify ctx e2.etype tint e2.epos;
 		mk (TNew ((match t with TInst (c,[]) -> c | _ -> assert false),[],[e1;e2])) t p
+	| OpArrow ->
+		error "Unexpected =>" p
 	| OpAssign
 	| OpAssignOp _ ->
 		assert false
@@ -2183,6 +2185,43 @@ and type_expr ctx (e,p) (with_type:with_type) =
 			efor;
 			mk (TLocal v) v.v_type p;
 		]) v.v_type p
+	| EArrayDecl ((EBinop(OpArrow,_,_),_) as e1 :: el) ->
+		let keys = Hashtbl.create 0 in
+		let tkey,tval = mk_mono(),mk_mono() in
+		let type_arrow e1 e2 =
+			let e1 = type_expr ctx e1 (WithType tkey) in
+			try
+				let p = Hashtbl.find keys e1.eexpr in
+				display_error ctx "Duplicate key" e1.epos;
+				error "Previously defined here" p
+			with Not_found ->
+				Hashtbl.add keys e1.eexpr e1.epos;
+				unify ctx e1.etype tkey e1.epos;
+				let e2 = type_expr ctx e2 (WithType tval) in
+				unify ctx e2.etype tval e2.epos;
+				e1,e2
+		in
+		let m = Typeload.load_module ctx ([],"Map") null_pos in
+		let a,c = match m.m_types with
+			| (TAbstractDecl ({a_impl = Some c} as a)) :: _ -> a,c
+			| _ -> assert false
+		in
+		let tmap = TAbstract(a,[tkey;tval]) in
+		let cf = PMap.find "set" c.cl_statics in
+		let el = e1 :: el in
+		let v = gen_local ctx tmap in
+		let ev = mk (TLocal v) tmap p in
+		let ef = mk (TField(ev,FInstance(c,cf))) (tfun [tkey;tval] ctx.t.tvoid) p in
+		let el = ev :: List.fold_left (fun acc e -> match fst e with
+			| EBinop(OpArrow,e1,e2) ->
+				let e1,e2 = type_arrow e1 e2 in
+				(make_call ctx ef [e1;e2] ctx.com.basic.tvoid p) :: acc
+			| _ ->
+				error "Expected a => b" (snd e)
+		) [] el in
+		let enew = mk (TNew(c,[tkey;tval],[])) tmap p in
+		let el = (mk (TVars [v,Some enew]) t_dynamic p) :: (List.rev el) in
+		mk (TBlock el) enew.etype p
 	| EArrayDecl el ->
 		let tp = (match with_type with
 		| WithType t | WithTypeResume t ->