1(* 2 Polymorphic methods are now available in the main branch. 3 Enjoy. 4*) 5 6(* Tests for explicit polymorphism *) 7open StdLabels;; 8 9type 'a t = { t : 'a };; 10type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b };; 11let f l = { fold = List.fold_left l };; 12(f [1;2;3]).fold ~f:(+) ~init:0;; 13[%%expect {| 14type 'a t = { t : 'a; } 15type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b; } 16val f : 'a list -> 'a fold = <fun> 17- : int = 6 18|}];; 19 20class ['b] ilist l = object 21 val l = l 22 method add x = {< l = x :: l >} 23 method fold : 'a. f:('a -> 'b -> 'a) -> init:'a -> 'a = 24 List.fold_left l 25end 26;; 27[%%expect {| 28class ['b] ilist : 29 'b list -> 30 object ('c) 31 val l : 'b list 32 method add : 'b -> 'c 33 method fold : f:('a -> 'b -> 'a) -> init:'a -> 'a 34 end 35|}];; 36 37class virtual ['a] vlist = object (_ : 'self) 38 method virtual add : 'a -> 'self 39 method virtual fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b 40end 41;; 42[%%expect {| 43class virtual ['a] vlist : 44 object ('c) 45 method virtual add : 'a -> 'c 46 method virtual fold : f:('b -> 'a -> 'b) -> init:'b -> 'b 47 end 48|}];; 49 50class ilist2 l = object 51 inherit [int] vlist 52 val l = l 53 method add x = {< l = x :: l >} 54 method fold = List.fold_left l 55end 56;; 57[%%expect {| 58class ilist2 : 59 int list -> 60 object ('a) 61 val l : int list 62 method add : int -> 'a 63 method fold : f:('b -> int -> 'b) -> init:'b -> 'b 64 end 65|}];; 66 67let ilist2 l = object 68 inherit [_] vlist 69 val l = l 70 method add x = {< l = x :: l >} 71 method fold = List.fold_left l 72end 73;; 74[%%expect {| 75val ilist2 : 'a list -> 'a vlist = <fun> 76|}];; 77 78class ['a] ilist3 l = object 79 inherit ['a] vlist 80 val l = l 81 method add x = {< l = x :: l >} 82 method fold = List.fold_left l 83end 84;; 85[%%expect {| 86class ['a] ilist3 : 87 'a list -> 88 object ('c) 89 val l : 'a list 90 method add : 'a -> 'c 91 method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b 92 end 93|}];; 94 95class ['a] ilist4 (l : 'a list) = object 96 val l = l 97 method virtual add : _ 98 method add x = {< l = x :: l >} 99 method virtual fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b 100 method fold = List.fold_left l 101end 102;; 103[%%expect {| 104class ['a] ilist4 : 105 'a list -> 106 object ('c) 107 val l : 'a list 108 method add : 'a -> 'c 109 method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b 110 end 111|}];; 112 113class ['a] ilist5 (l : 'a list) = object (self) 114 val l = l 115 method add x = {< l = x :: l >} 116 method virtual fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b 117 method virtual fold2 : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b 118 method fold2 ~f ~init = self#fold ~f ~init:(self#fold ~f ~init) 119 method fold = List.fold_left l 120end 121;; 122[%%expect {| 123class ['a] ilist5 : 124 'a list -> 125 object ('c) 126 val l : 'a list 127 method add : 'a -> 'c 128 method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b 129 method fold2 : f:('b -> 'a -> 'b) -> init:'b -> 'b 130 end 131|}];; 132 133class ['a] ilist6 l = object (self) 134 inherit ['a] vlist 135 val l = l 136 method add x = {< l = x :: l >} 137 method virtual fold2 : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b 138 method fold2 ~f ~init = self#fold ~f ~init:(self#fold ~f ~init) 139 method fold = List.fold_left l 140end 141;; 142[%%expect {| 143class ['a] ilist6 : 144 'a list -> 145 object ('c) 146 val l : 'a list 147 method add : 'a -> 'c 148 method fold : f:('b -> 'a -> 'b) -> init:'b -> 'b 149 method fold2 : f:('b -> 'a -> 'b) -> init:'b -> 'b 150 end 151|}];; 152 153class virtual ['a] olist = object 154 method virtual fold : 'c. f:('a -> 'c -> 'c) -> init:'c -> 'c 155end 156;; 157[%%expect {| 158class virtual ['a] olist : 159 object method virtual fold : f:('a -> 'c -> 'c) -> init:'c -> 'c end 160|}];; 161 162class ['a] onil = object 163 inherit ['a] olist 164 method fold ~f ~init = init 165end 166;; 167[%%expect {| 168class ['a] onil : 169 object method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c end 170|}];; 171 172class ['a] ocons ~hd ~tl = object (_ : 'b) 173 inherit ['a] olist 174 val hd : 'a = hd 175 val tl : 'a olist = tl 176 method fold ~f ~init = f hd (tl#fold ~f ~init) 177end 178;; 179[%%expect {| 180class ['a] ocons : 181 hd:'a -> 182 tl:'a olist -> 183 object 184 val hd : 'a 185 val tl : 'a olist 186 method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c 187 end 188|}];; 189 190class ['a] ostream ~hd ~tl = object (_ : 'b) 191 inherit ['a] olist 192 val hd : 'a = hd 193 val tl : _ #olist = (tl : 'a ostream) 194 method fold ~f ~init = f hd (tl#fold ~f ~init) 195 method empty = false 196end 197;; 198[%%expect {| 199class ['a] ostream : 200 hd:'a -> 201 tl:'a ostream -> 202 object 203 val hd : 'a 204 val tl : < empty : bool; fold : 'c. f:('a -> 'c -> 'c) -> init:'c -> 'c > 205 method empty : bool 206 method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c 207 end 208|}];; 209 210class ['a] ostream1 ~hd ~tl = object (self : 'b) 211 inherit ['a] olist 212 val hd = hd 213 val tl : 'b = tl 214 method hd = hd 215 method tl = tl 216 method fold ~f ~init = 217 self#tl#fold ~f ~init:(f self#hd init) 218end 219[%%expect {| 220class ['a] ostream1 : 221 hd:'a -> 222 tl:'b -> 223 object ('b) 224 val hd : 'a 225 val tl : 'b 226 method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c 227 method hd : 'a 228 method tl : 'b 229 end 230|}, Principal{| 231Line _, characters 4-16: 232Warning 18: this use of a polymorphic method is not principal. 233class ['a] ostream1 : 234 hd:'a -> 235 tl:'b -> 236 object ('b) 237 val hd : 'a 238 val tl : 'b 239 method fold : f:('a -> 'c -> 'c) -> init:'c -> 'c 240 method hd : 'a 241 method tl : 'b 242 end 243|}];; 244 245class vari = object 246 method virtual m : 'a. ([< `A|`B|`C] as 'a) -> int 247 method m = function `A -> 1 | `B|`C -> 0 248end 249;; 250[%%expect {| 251class vari : object method m : [< `A | `B | `C ] -> int end 252|}];; 253 254class vari = object 255 method m : 'a. ([< `A|`B|`C] as 'a) -> int = function `A -> 1 | `B|`C -> 0 256end 257;; 258[%%expect {| 259class vari : object method m : [< `A | `B | `C ] -> int end 260|}];; 261 262module V = 263 struct 264 type v = [`A | `B | `C] 265 let m : [< v] -> int = function `A -> 1 | #v -> 0 266 end 267;; 268[%%expect {| 269module V : sig type v = [ `A | `B | `C ] val m : [< v ] -> int end 270|}];; 271 272class varj = object 273 method virtual m : 'a. ([< V.v] as 'a) -> int 274 method m = V.m 275end 276;; 277[%%expect {| 278class varj : object method m : [< V.v ] -> int end 279|}];; 280 281 282module type T = sig 283 class vari : object method m : 'a. ([< `A | `B | `C] as 'a) -> int end 284end 285;; 286[%%expect {| 287module type T = 288 sig class vari : object method m : [< `A | `B | `C ] -> int end end 289|}];; 290 291module M0 = struct 292 class vari = object 293 method virtual m : 'a. ([< `A|`B|`C] as 'a) -> int 294 method m = function `A -> 1 | `B|`C -> 0 295 end 296end 297;; 298[%%expect {| 299module M0 : 300 sig class vari : object method m : [< `A | `B | `C ] -> int end end 301|}];; 302 303module M : T = M0 304;; 305[%%expect {| 306module M : T 307|}];; 308 309let v = new M.vari;; 310[%%expect {| 311val v : M.vari = <obj> 312|}];; 313 314v#m `A;; 315[%%expect {| 316- : int = 1 317|}];; 318 319 320class point ~x ~y = object 321 val x : int = x 322 val y : int = y 323 method x = x 324 method y = y 325end 326;; 327[%%expect {| 328class point : 329 x:int -> 330 y:int -> object val x : int val y : int method x : int method y : int end 331|}];; 332 333class color_point ~x ~y ~color = object 334 inherit point ~x ~y 335 val color : string = color 336 method color = color 337end 338;; 339[%%expect {| 340class color_point : 341 x:int -> 342 y:int -> 343 color:string -> 344 object 345 val color : string 346 val x : int 347 val y : int 348 method color : string 349 method x : int 350 method y : int 351 end 352|}];; 353 354class circle (p : #point) ~r = object 355 val p = (p :> point) 356 val r = r 357 method virtual distance : 'a. (#point as 'a) -> float 358 method distance p' = 359 let dx = p#x - p'#x and dy = p#y - p'#y in 360 let d = sqrt (float (dx * dx + dy * dy)) -. float r in 361 if d < 0. then 0. else d 362end 363;; 364[%%expect {| 365class circle : 366 #point -> 367 r:int -> 368 object val p : point val r : int method distance : #point -> float end 369|}];; 370 371let p0 = new point ~x:3 ~y:5 372let p1 = new point ~x:10 ~y:13 373let cp = new color_point ~x:12 ~y:(-5) ~color:"green" 374let c = new circle p0 ~r:2 375let d = floor (c#distance cp) 376;; 377let f (x : < m : 'a. 'a -> 'a >) = (x : < m : 'b. 'b -> 'b >) 378;; 379let f (x : < m : 'a. 'a -> 'a list >) = (x : < m : 'b. 'b -> 'c >) 380;; 381[%%expect {| 382val p0 : point = <obj> 383val p1 : point = <obj> 384val cp : color_point = <obj> 385val c : circle = <obj> 386val d : float = 11. 387val f : < m : 'a. 'a -> 'a > -> < m : 'b. 'b -> 'b > = <fun> 388Line _, characters 41-42: 389Error: This expression has type < m : 'b. 'b -> 'b list > 390 but an expression was expected of type < m : 'b. 'b -> 'c > 391 The universal variable 'b would escape its scope 392|}];; 393 394class id = object 395 method virtual id : 'a. 'a -> 'a 396 method id x = x 397end 398;; 399[%%expect {| 400class id : object method id : 'a -> 'a end 401|}];; 402 403class type id_spec = object 404 method id : 'a -> 'a 405end 406;; 407[%%expect {| 408class type id_spec = object method id : 'a -> 'a end 409|}];; 410 411class id_impl = object (_ : #id_spec) 412 method id x = x 413end 414;; 415[%%expect {| 416class id_impl : object method id : 'a -> 'a end 417|}];; 418 419class a = object 420 method m = (new b : id_spec)#id true 421end 422and b = object (_ : #id_spec) 423 method id x = x 424end 425;; 426[%%expect {| 427class a : object method m : bool end 428and b : object method id : 'a -> 'a end 429|}];; 430 431 432class ['a] id1 = object 433 method virtual id : 'b. 'b -> 'a 434 method id x = x 435end 436;; 437[%%expect {| 438Line _, characters 12-17: 439Error: This method has type 'a -> 'a which is less general than 'b. 'b -> 'a 440|}];; 441 442class id2 (x : 'a) = object 443 method virtual id : 'b. 'b -> 'a 444 method id x = x 445end 446;; 447[%%expect {| 448Line _, characters 12-17: 449Error: This method has type 'a -> 'a which is less general than 'b. 'b -> 'a 450|}];; 451 452class id3 x = object 453 val x = x 454 method virtual id : 'a. 'a -> 'a 455 method id _ = x 456end 457;; 458[%%expect {| 459Line _, characters 12-17: 460Error: This method has type 'b -> 'b which is less general than 'a. 'a -> 'a 461|}];; 462 463class id4 () = object 464 val mutable r = None 465 method virtual id : 'a. 'a -> 'a 466 method id x = 467 match r with 468 None -> r <- Some x; x 469 | Some y -> y 470end 471;; 472[%%expect {| 473Line _, characters 12-79: 474Error: This method has type 'b -> 'b which is less general than 'a. 'a -> 'a 475|}];; 476 477class c = object 478 method virtual m : 'a 'b. 'a -> 'b -> 'a 479 method m x y = x 480end 481;; 482[%%expect {| 483class c : object method m : 'a -> 'b -> 'a end 484|}];; 485 486 487let f1 (f : id) = f#id 1, f#id true 488;; 489let f2 f = (f : id)#id 1, (f : id)#id true 490;; 491let f3 f = f#id 1, f#id true 492;; 493let f4 f = ignore(f : id); f#id 1, f#id true 494;; 495[%%expect {| 496val f1 : id -> int * bool = <fun> 497val f2 : id -> int * bool = <fun> 498Line _, characters 24-28: 499Error: This expression has type bool but an expression was expected of type 500 int 501|}];; 502 503class c = object 504 method virtual m : 'a. (#id as 'a) -> int * bool 505 method m (f : #id) = f#id 1, f#id true 506end 507;; 508[%%expect {| 509class c : object method m : #id -> int * bool end 510|}];; 511 512 513class id2 = object (_ : 'b) 514 method virtual id : 'a. 'a -> 'a 515 method id x = x 516 method mono (x : int) = x 517end 518;; 519let app = new c #m (new id2) 520;; 521type 'a foo = 'a foo list 522;; 523[%%expect {| 524class id2 : object method id : 'a -> 'a method mono : int -> int end 525val app : int * bool = (1, true) 526Line _, characters 0-25: 527Error: The type abbreviation foo is cyclic 528|}];; 529 530class ['a] bar (x : 'a) = object end 531;; 532type 'a foo = 'a foo bar 533;; 534[%%expect {| 535class ['a] bar : 'a -> object end 536type 'a foo = 'a foo bar 537|}];; 538 539fun x -> (x : < m : 'a. 'a * 'b > as 'b)#m;; 540fun x -> (x : < m : 'a. 'b * 'a list> as 'b)#m;; 541let f x = (x : < m : 'a. 'b * (< n : 'a; .. > as 'a) > as 'b)#m;; 542fun (x : < p : 'a. < m : 'a ; n : 'b ; .. > as 'a > as 'b) -> x#p;; 543fun (x : <m:'a. 'a * <p:'b. 'b * 'c * 'd> as 'c> as 'd) -> x#m;; 544(* printer is wrong on the next (no official syntax) *) 545fun (x : <m:'a.<p:'a;..> >) -> x#m;; 546[%%expect {| 547- : (< m : 'a. 'a * 'b > as 'b) -> 'c * 'b = <fun> 548- : (< m : 'a. 'b * 'a list > as 'b) -> 'b * 'c list = <fun> 549val f : 550 (< m : 'b. 'a * (< n : 'b; .. > as 'b) > as 'a) -> 551 'a * (< n : 'c; .. > as 'c) = <fun> 552- : (< p : 'b. < m : 'b; n : 'a; .. > as 'b > as 'a) -> 553 (< m : 'c; n : 'a; .. > as 'c) 554= <fun> 555- : (< m : 'a. 'a * < p : 'b. 'b * 'd * 'c > as 'd > as 'c) -> 556 ('f * < p : 'b. 'b * 'e * 'c > as 'e) 557= <fun> 558- : < m : 'a. < p : 'a; .. > as 'b > -> 'b = <fun> 559|}, Principal{| 560- : (< m : 'a. 'a * 'b > as 'b) -> 'c * (< m : 'a. 'a * 'd > as 'd) = <fun> 561- : (< m : 'a. 'b * 'a list > as 'b) -> 562 (< m : 'a. 'c * 'a list > as 'c) * 'd list 563= <fun> 564val f : 565 (< m : 'b. 'a * (< n : 'b; .. > as 'b) > as 'a) -> 566 (< m : 'd. 'c * (< n : 'd; .. > as 'd) > as 'c) * (< n : 'e; .. > as 'e) = 567 <fun> 568- : (< p : 'b. < m : 'b; n : 'a; .. > as 'b > as 'a) -> 569 (< m : 'c; n : < p : 'e. < m : 'e; n : 'd; .. > as 'e > as 'd; .. > as 'c) 570= <fun> 571- : (< m : 'a. 'a * < p : 'b. 'b * 'd * 'c > as 'd > as 'c) -> 572 ('f * 573 < p : 'b. 574 'b * 'e * 575 (< m : 'a. 'a * < p : 'b0. 'b0 * 'h * 'g > as 'h > as 'g) > 576 as 'e) 577= <fun> 578- : < m : 'a. < p : 'a; .. > as 'b > -> 'b = <fun> 579|}];; 580 581type sum = T of < id: 'a. 'a -> 'a > ;; 582fun (T x) -> x#id;; 583[%%expect {| 584type sum = T of < id : 'a. 'a -> 'a > 585- : sum -> 'a -> 'a = <fun> 586|}];; 587 588type record = { r: < id: 'a. 'a -> 'a > } ;; 589fun x -> x.r#id;; 590fun {r=x} -> x#id;; 591[%%expect {| 592type record = { r : < id : 'a. 'a -> 'a >; } 593- : record -> 'a -> 'a = <fun> 594- : record -> 'a -> 'a = <fun> 595|}];; 596 597class myself = object (self) 598 method self : 'a. 'a -> 'b = fun _ -> self 599end;; 600[%%expect {| 601class myself : object ('b) method self : 'a -> 'b end 602|}];; 603 604class number = object (self : 'self) 605 val num = 0 606 method num = num 607 method succ = {< num = num + 1 >} 608 method prev = 609 self#switch ~zero:(fun () -> failwith "zero") ~prev:(fun x -> x) 610 method switch : 'a. zero:(unit -> 'a) -> prev:('self -> 'a) -> 'a = 611 fun ~zero ~prev -> 612 if num = 0 then zero () else prev {< num = num - 1 >} 613end 614;; 615[%%expect {| 616class number : 617 object ('b) 618 val num : int 619 method num : int 620 method prev : 'b 621 method succ : 'b 622 method switch : zero:(unit -> 'a) -> prev:('b -> 'a) -> 'a 623 end 624|}];; 625 626let id x = x 627;; 628class c = object 629 method id : 'a. 'a -> 'a = id 630end 631;; 632class c' = object 633 inherit c 634 method id = id 635end 636;; 637class d = object 638 inherit c as c 639 val mutable count = 0 640 method id x = count <- count+1; x 641 method count = count 642 method old : 'a. 'a -> 'a = c#id 643end 644;; 645class ['a] olist l = object 646 val l = l 647 method fold : 'b. f:('a -> 'b -> 'b) -> init:'b -> 'b 648 = List.fold_right l 649 method cons a = {< l = a :: l >} 650end 651;; 652let sum (l : 'a #olist) = l#fold ~f:(fun x acc -> x+acc) ~init:0 653;; 654let count (l : 'a #olist) = l#fold ~f:(fun _ acc -> acc+1) ~init:0 655;; 656let append (l : 'a #olist) (l' : 'b #olist) = 657 l#fold ~init:l' ~f:(fun x acc -> acc#cons x) 658;; 659[%%expect {| 660val id : 'a -> 'a = <fun> 661class c : object method id : 'a -> 'a end 662class c' : object method id : 'a -> 'a end 663class d : 664 object 665 val mutable count : int 666 method count : int 667 method id : 'a -> 'a 668 method old : 'a -> 'a 669 end 670class ['a] olist : 671 'a list -> 672 object ('c) 673 val l : 'a list 674 method cons : 'a -> 'c 675 method fold : f:('a -> 'b -> 'b) -> init:'b -> 'b 676 end 677val sum : int #olist -> int = <fun> 678val count : 'a #olist -> int = <fun> 679val append : 'a #olist -> ('a #olist as 'b) -> 'b = <fun> 680|}];; 681 682type 'a t = unit 683;; 684class o = object method x : 'a. ([> `A] as 'a) t -> unit = fun _ -> () end 685;; 686[%%expect {| 687type 'a t = unit 688class o : object method x : [> `A ] t -> unit end 689|}];; 690 691class c = object method m = new d () end and d ?(x=0) () = object end;; 692class d ?(x=0) () = object end and c = object method m = new d () end;; 693[%%expect {| 694class c : object method m : d end 695and d : ?x:int -> unit -> object end 696class d : ?x:int -> unit -> object end 697and c : object method m : d end 698|}];; 699 700class type numeral = object method fold : ('a -> 'a) -> 'a -> 'a end 701class zero = object (_ : #numeral) method fold f x = x end 702class next (n : #numeral) = 703 object (_ : #numeral) method fold f x = n#fold f (f x) end 704;; 705[%%expect {| 706class type numeral = object method fold : ('a -> 'a) -> 'a -> 'a end 707class zero : object method fold : ('a -> 'a) -> 'a -> 'a end 708class next : #numeral -> object method fold : ('a -> 'a) -> 'a -> 'a end 709|}];; 710 711class type node_type = object 712 method as_variant : [> `Node of node_type] 713end;; 714class node : node_type = object (self) 715 method as_variant : 'a. [> `Node of node_type] as 'a 716 = `Node (self :> node_type) 717end;; 718class node = object (self : #node_type) 719 method as_variant = `Node (self :> node_type) 720end;; 721[%%expect {| 722class type node_type = object method as_variant : [> `Node of node_type ] end 723class node : node_type 724class node : object method as_variant : [> `Node of node_type ] end 725|}];; 726 727type bad = {bad : 'a. 'a option ref};; 728let bad = {bad = ref None};; 729type bad2 = {mutable bad2 : 'a. 'a option ref option};; 730let bad2 = {bad2 = None};; 731bad2.bad2 <- Some (ref None);; 732[%%expect {| 733type bad = { bad : 'a. 'a option ref; } 734Line _, characters 17-25: 735Error: This field value has type 'b option ref which is less general than 736 'a. 'a option ref 737|}];; 738 739(* Type variable scope *) 740 741let f (x: <m:'a.<p: 'a * 'b> as 'b>) (y : 'b) = ();; 742let f (x: <m:'a. 'a * (<p:int*'b> as 'b)>) (y : 'b) = ();; 743[%%expect {| 744val f : < m : 'a. < p : 'a * 'c > as 'c > -> 'b -> unit = <fun> 745val f : < m : 'a. 'a * (< p : int * 'b > as 'b) > -> 'b -> unit = <fun> 746|}, Principal{| 747val f : < m : 'a. < p : 'a * 'c > as 'c > -> 'b -> unit = <fun> 748val f : 749 < m : 'a. 'a * (< p : int * 'b > as 'b) > -> 750 (< p : int * 'c > as 'c) -> unit = <fun> 751|}];; 752 753(* PR#1374 *) 754 755type 'a t= [`A of 'a];; 756class c = object (self) 757 method m : 'a. ([> 'a t] as 'a) -> unit 758 = fun x -> self#m x 759end;; 760class c = object (self) 761 method m : 'a. ([> 'a t] as 'a) -> unit = function 762 | `A x' -> self#m x' 763 | _ -> failwith "c#m" 764end;; 765class c = object (self) 766 method m : 'a. ([> 'a t] as 'a) -> 'a = fun x -> self#m x 767end;; 768[%%expect {| 769type 'a t = [ `A of 'a ] 770class c : object method m : ([> 'a t ] as 'a) -> unit end 771class c : object method m : ([> 'a t ] as 'a) -> unit end 772class c : object method m : ([> 'a t ] as 'a) -> 'a end 773|}];; 774 775(* use before instancing *) 776class c = object method m : 'a. 'a option -> ([> `A] as 'a) = fun x -> `A end;; 777[%%expect {| 778class c : object method m : ([> `A ] as 'a) option -> 'a end 779|}];; 780 781(* various old bugs *) 782class virtual ['a] visitor = 783object method virtual caseNil : 'a end 784and virtual int_list = 785object method virtual visit : 'a.('a visitor -> 'a) end;; 786[%%expect {| 787Line _, characters 30-51: 788Error: The universal type variable 'a cannot be generalized: 789 it escapes its scope. 790|}];; 791 792type ('a,'b) list_visitor = < caseNil : 'a; caseCons : 'b -> 'b list -> 'a > 793type 'b alist = < visit : 'a. ('a,'b) list_visitor -> 'a > 794[%%expect {| 795type ('a, 'b) list_visitor = < caseCons : 'b -> 'b list -> 'a; caseNil : 'a > 796type 'b alist = < visit : 'a. ('a, 'b) list_visitor -> 'a > 797|}];; 798 799(* PR#1607 *) 800class type ct = object ('s) 801 method fold : ('b -> 's -> 'b) -> 'b -> 'b 802end 803type t = {f : 'a 'b. ('b -> (#ct as 'a) -> 'b) -> 'b};; 804[%%expect {| 805class type ct = object ('a) method fold : ('b -> 'a -> 'b) -> 'b -> 'b end 806type t = { f : 'a 'b. ('b -> (#ct as 'a) -> 'b) -> 'b; } 807|}];; 808 809(* PR#1663 *) 810type t = u and u = t;; 811[%%expect {| 812Line _, characters 0-10: 813Error: The definition of t contains a cycle: 814 u 815|}];; 816 817(* PR#1731 *) 818class ['t] a = object constraint 't = [> `A of 't a] end 819type t = [ `A of t a ];; 820[%%expect {| 821class ['a] a : object constraint 'a = [> `A of 'a a ] end 822type t = [ `A of t a ] 823|}];; 824 825(* Wrong in 3.06 *) 826type ('a,'b) t constraint 'a = 'b and ('a,'b) u = ('a,'b) t;; 827[%%expect {| 828Line _, characters 50-59: 829Error: Constraints are not satisfied in this type. 830 Type ('a, 'b) t should be an instance of ('c, 'c) t 831|}];; 832 833(* Full polymorphism if we do not expand *) 834type 'a t = 'a and u = int t;; 835[%%expect {| 836type 'a t = 'a 837and u = int t 838|}];; 839 840(* Loose polymorphism if we expand *) 841type 'a t constraint 'a = int;; 842type 'a u = 'a and 'a v = 'a u t;; 843type 'a u = 'a and 'a v = 'a u t constraint 'a = int;; 844[%%expect {| 845type 'a t constraint 'a = int 846Line _, characters 26-32: 847Error: Constraints are not satisfied in this type. 848 Type 'a u t should be an instance of int t 849|}];; 850 851(* Behaviour is unstable *) 852type g = int;; 853type 'a t = unit constraint 'a = g;; 854type 'a u = 'a and 'a v = 'a u t;; 855type 'a u = 'a and 'a v = 'a u t constraint 'a = int;; 856[%%expect {| 857type g = int 858type 'a t = unit constraint 'a = g 859Line _, characters 26-32: 860Error: Constraints are not satisfied in this type. 861 Type 'a u t should be an instance of g t 862|}];; 863 864(* Example of wrong expansion *) 865type 'a u = < m : 'a v > and 'a v = 'a list u;; 866[%%expect {| 867Line _, characters 0-24: 868Error: In the definition of v, type 'a list u should be 'a u 869|}];; 870 871(* PR#1744: Ctype.matches *) 872type 'a t = 'a 873type 'a u = A of 'a t;; 874[%%expect {| 875type 'a t = 'a 876type 'a u = A of 'a t 877|}];; 878 879(* Unification of cyclic terms *) 880type 'a t = < a : 'a >;; 881fun (x : 'a t as 'a) -> (x : 'b t);; 882type u = 'a t as 'a;; 883[%%expect {| 884type 'a t = < a : 'a > 885- : ('a t as 'a) -> 'a t = <fun> 886type u = 'a t as 'a 887|}, Principal{| 888type 'a t = < a : 'a > 889- : ('a t as 'a) -> ('b t as 'b) t = <fun> 890type u = 'a t as 'a 891|}];; 892 893 894(* Variant tests *) 895type t = A | B;; 896function `A,_ -> 1 | _,A -> 2 | _,B -> 3;; 897function `A,_ -> 1 | _,(A|B) -> 2;; 898function Some `A, _ -> 1 | Some _, A -> 2 | None, A -> 3 | _, B -> 4;; 899function Some `A, A -> 1 | Some `A, B -> 1 900 | Some _, A -> 2 | None, A -> 3 | _, B -> 4;; 901function A, `A -> 1 | A, `B -> 2 | B, _ -> 3;; 902function `A, A -> 1 | `B, A -> 2 | _, B -> 3;; 903function (`A|`B), _ -> 0 | _,(`A|`B) -> 1;; 904function `B,1 -> 1 | _,1 -> 2;; 905function 1,`B -> 1 | 1,_ -> 2;; 906[%%expect {| 907type t = A | B 908- : [> `A ] * t -> int = <fun> 909- : [> `A ] * t -> int = <fun> 910- : [> `A ] option * t -> int = <fun> 911- : [> `A ] option * t -> int = <fun> 912- : t * [< `A | `B ] -> int = <fun> 913- : [< `A | `B ] * t -> int = <fun> 914Line _, characters 0-41: 915Warning 8: this pattern-matching is not exhaustive. 916Here is an example of a case that is not matched: 917(`AnyExtraTag, `AnyExtraTag) 918- : [> `A | `B ] * [> `A | `B ] -> int = <fun> 919Line _, characters 0-29: 920Warning 8: this pattern-matching is not exhaustive. 921Here is an example of a case that is not matched: 922(_, 0) 923Line _, characters 21-24: 924Warning 11: this match case is unused. 925- : [< `B ] * int -> int = <fun> 926Line _, characters 0-29: 927Warning 8: this pattern-matching is not exhaustive. 928Here is an example of a case that is not matched: 929(0, _) 930Line _, characters 21-24: 931Warning 11: this match case is unused. 932- : int * [< `B ] -> int = <fun> 933|}];; 934 935(* pass typetexp, but fails during Typedecl.check_recursion *) 936type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b] 937and ('a, 'b) b = 'b -> unit constraint 'b = [> `A of ('a, 'b) a as 'a];; 938[%%expect {| 939Line _, characters 0-71: 940Error: The definition of a contains a cycle: 941 [> `B of ('a, 'b) b as 'b ] as 'a 942|}];; 943 944(* PR#1917: expanding may change original in Ctype.unify2 *) 945(* Note: since 3.11, the abbreviations are not used when printing 946 a type where they occur recursively inside. *) 947class type ['a, 'b] a = object 948 method b: ('a, 'b) #b as 'b 949 method as_a: ('a, 'b) a 950end and ['a, 'b] b = object 951 method a: ('a, 'b) #a as 'a 952 method as_b: ('a, 'b) b 953end;; 954[%%expect {| 955class type ['a, 'b] a = 956 object 957 constraint 'a = < as_a : ('a, 'b) a as 'c; b : 'b; .. > 958 constraint 'b = < a : 'a; as_b : ('a, 'b) b; .. > 959 method as_a : 'c 960 method b : 'b 961 end 962and ['a, 'b] b = 963 object 964 constraint 'a = < as_a : ('a, 'b) a; b : 'b; .. > 965 constraint 'b = < a : 'a; as_b : ('a, 'b) b; .. > 966 method a : 'a 967 method as_b : ('a, 'b) b 968 end 969|}];; 970 971class type ['b] ca = object ('s) inherit ['s, 'b] a end;; 972class type ['a] cb = object ('s) inherit ['a, 's] b end;; 973[%%expect {| 974class type ['a] ca = 975 object ('b) 976 constraint 'a = < a : 'b; as_b : ('b, 'a) b; .. > 977 method as_a : ('b, 'a) a 978 method b : 'a 979 end 980class type ['a] cb = 981 object ('b) 982 constraint 'a = < as_a : ('a, 'b) a; b : 'b; .. > 983 method a : 'a 984 method as_b : ('a, 'b) b 985 end 986|}];; 987 988type bt = 'b ca cb as 'b 989;; 990[%%expect {| 991type bt = 'a ca cb as 'a 992|}];; 993 994(* final classes, etc... *) 995class c = object method m = 1 end;; 996let f () = object (self:c) method m = 1 end;; 997let f () = object (self:c) method private n = 1 method m = self#n end;; 998let f () = object method private n = 1 method m = {<>}#n end;; 999let f () = object (self:c) method n = 1 method m = 2 end;; 1000let f () = object (_:'s) constraint 's = < n : int > method m = 1 end;; 1001class c = object (_ : 's) 1002 method x = 1 1003 method private m = 1004 object (self: 's) method x = 3 method private m = self end 1005end;; 1006let o = object (_ : 's) 1007 method x = 1 1008 method private m = 1009 object (self: 's) method x = 3 method private m = self end 1010end;; 1011[%%expect {| 1012class c : object method m : int end 1013val f : unit -> c = <fun> 1014val f : unit -> c = <fun> 1015Line _, characters 11-60: 1016Warning 15: the following private methods were made public implicitly: 1017 n. 1018val f : unit -> < m : int; n : int > = <fun> 1019Line _, characters 11-56: 1020Error: This object is expected to have type c but actually has type 1021 < m : int; n : 'a > 1022 The first object type has no method n 1023|}];; 1024 1025 1026(* Unsound! *) 1027fun (x : <m : 'a. 'a * <m: 'b. 'a * 'foo> > as 'foo) -> 1028 (x : <m : 'a. 'a * (<m:'b. 'a * <m:'c. 'c * 'bar> > as 'bar) >);; 1029type 'a foo = <m: 'b. 'a * 'a foo> 1030type foo' = <m: 'a. 'a * 'a foo> 1031type 'a bar = <m: 'b. 'a * <m: 'c. 'c * 'a bar> > 1032type bar' = <m: 'a. 'a * 'a bar > 1033let f (x : foo') = (x : bar');; 1034[%%expect {| 1035Line _, characters 3-4: 1036Error: This expression has type < m : 'a. 'a * < m : 'a * 'b > > as 'b 1037 but an expression was expected of type 1038 < m : 'a. 'a * (< m : 'a * < m : 'c. 'c * 'd > > as 'd) > 1039 Types for method m are incompatible 1040|}];; 1041 1042fun (x : <m : 'a. 'a * ('a * <m : 'a. 'a * 'foo> as 'foo)>) -> 1043 (x : <m : 'b. 'b * ('b * <m : 'c. 'c * ('c * 'bar)>)> as 'bar);; 1044fun (x : <m : 'a. 'a * ('a * <m : 'a. 'a * 'foo> as 'foo)>) -> 1045 (x : <m : 'b. 'b * ('b * <m : 'c. 'c * ('b * 'bar)>)> as 'bar);; 1046fun (x : <m : 'a. 'a * ('a * 'foo)> as 'foo) -> 1047 (x : <m : 'b. 'b * ('b * <m:'c. 'c * 'bar> as 'bar)>);; 1048let f x = 1049 (x : <m : 'a. 'a -> ('a * <m:'c. 'c -> 'bar> as 'bar)> 1050 :> <m : 'a. 'a -> ('a * 'foo)> as 'foo);; 1051[%%expect {| 1052Line _, characters 3-4: 1053Error: This expression has type 1054 < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > 1055 but an expression was expected of type 1056 < m : 'b. 'b * ('b * < m : 'c. 'c * ('c * 'd) >) > as 'd 1057 Types for method m are incompatible 1058|}];; 1059 1060module M 1061: sig val f : (<m : 'b. 'b * ('b * <m:'c. 'c * 'bar> as 'bar)>) -> unit end 1062= struct let f (x : <m : 'a. 'a * ('a * 'foo)> as 'foo) = () end;; 1063module M 1064: sig type t = <m : 'b. 'b * ('b * <m:'c. 'c * 'bar> as 'bar)> end 1065= struct type t = <m : 'a. 'a * ('a * 'foo)> as 'foo end;; 1066[%%expect {| 1067Line _, characters 2-64: 1068Error: Signature mismatch: 1069 Modules do not match: 1070 sig val f : (< m : 'a. 'a * ('a * 'b) > as 'b) -> unit end 1071 is not included in 1072 sig 1073 val f : < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > -> unit 1074 end 1075 Values do not match: 1076 val f : (< m : 'a. 'a * ('a * 'b) > as 'b) -> unit 1077 is not included in 1078 val f : < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > -> unit 1079|}];; 1080 1081module M : sig type 'a t type u = <m: 'a. 'a t> end 1082= struct type 'a t = int type u = <m: int> end;; 1083module M : sig type 'a t val f : <m: 'a. 'a t> -> int end 1084= struct type 'a t = int let f (x : <m:int>) = x#m end;; 1085(* The following should be accepted too! *) 1086module M : sig type 'a t val f : <m: 'a. 'a t> -> int end 1087= struct type 'a t = int let f x = x#m end;; 1088[%%expect {| 1089module M : sig type 'a t type u = < m : 'a. 'a t > end 1090module M : sig type 'a t val f : < m : 'a. 'a t > -> int end 1091module M : sig type 'a t val f : < m : 'a. 'a t > -> int end 1092|}];; 1093 1094let f x y = 1095 ignore (x :> <m:'a.'a -> 'c * < > > as 'c); 1096 ignore (y :> <m:'b.'b -> 'd * < > > as 'd); 1097 x = y;; 1098[%%expect {| 1099val f : 1100 (< m : 'a. 'a -> (< m : 'a. 'a -> 'c * < > > as 'c) * < .. >; .. > as 'b) -> 1101 'b -> bool = <fun> 1102|}];; 1103 1104 1105(* Subtyping *) 1106 1107type t = [`A|`B];; 1108type v = private [> t];; 1109fun x -> (x : t :> v);; 1110type u = private [< t];; 1111fun x -> (x : u :> v);; 1112fun x -> (x : v :> u);; 1113type v = private [< t];; 1114fun x -> (x : u :> v);; 1115type p = <x:p>;; 1116type q = private <x:p; ..>;; 1117fun x -> (x : q :> p);; 1118fun x -> (x : p :> q);; 1119[%%expect {| 1120type t = [ `A | `B ] 1121type v = private [> t ] 1122- : t -> v = <fun> 1123type u = private [< t ] 1124- : u -> v = <fun> 1125Line _, characters 9-21: 1126Error: Type v = [> `A | `B ] is not a subtype of u = [< `A | `B ] 1127|}];; 1128 1129let f1 x = 1130 (x : <m:'a. (<p:int;..> as 'a) -> int> 1131 :> <m:'b. (<p:int;q:int;..> as 'b) -> int>);; 1132let f2 x = 1133 (x : <m:'a. (<p:<a:int>;..> as 'a) -> int> 1134 :> <m:'b. (<p:<a:int;b:int>;..> as 'b) -> int>);; 1135let f3 x = 1136 (x : <m:'a. (<p:<a:int;b:int>;..> as 'a) -> int> 1137 :> <m:'b. (<p:<a:int>;..> as 'b) -> int>);; 1138let f4 x = (x : <p:<a:int;b:int>;..> :> <p:<a:int>;..>);; 1139let f5 x = 1140 (x : <m:'a. [< `A of <p:int> ] as 'a> :> <m:'a. [< `A of < > ] as 'a>);; 1141let f6 x = 1142 (x : <m:'a. [< `A of < > ] as 'a> :> <m:'a. [< `A of <p:int> ] as 'a>);; 1143[%%expect {| 1144Line _, characters 2-88: 1145Error: Type < m : 'a. (< p : int; .. > as 'a) -> int > is not a subtype of 1146 < m : 'b. (< p : int; q : int; .. > as 'b) -> int > 1147 Type < p : int; q : int; .. > as 'c is not a subtype of 1148 < p : int; .. > as 'd 1149|}];; 1150 1151(* Keep sharing the epsilons *) 1152let f x = if true then (x : < m : 'a. 'a -> 'a >) else x;; 1153fun x -> (f x)#m;; (* Warning 18 *) 1154let f (x, y) = if true then (x : < m : 'a. 'a -> 'a >) else x;; 1155fun x -> (f (x,x))#m;; (* Warning 18 *) 1156let f x = if true then [| (x : < m : 'a. 'a -> 'a >) |] else [|x|];; 1157fun x -> (f x).(0)#m;; (* Warning 18 *) 1158[%%expect {| 1159val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > = <fun> 1160- : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun> 1161val f : < m : 'a. 'a -> 'a > * 'b -> < m : 'a. 'a -> 'a > = <fun> 1162- : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun> 1163val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > array = <fun> 1164- : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun> 1165|}, Principal{| 1166val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > = <fun> 1167Line _, characters 9-16: 1168Warning 18: this use of a polymorphic method is not principal. 1169- : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun> 1170val f : < m : 'a. 'a -> 'a > * 'b -> < m : 'a. 'a -> 'a > = <fun> 1171Line _, characters 9-20: 1172Warning 18: this use of a polymorphic method is not principal. 1173- : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun> 1174val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > array = <fun> 1175Line _, characters 9-20: 1176Warning 18: this use of a polymorphic method is not principal. 1177- : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun> 1178|}];; 1179 1180(* Not really principal? *) 1181class c = object method id : 'a. 'a -> 'a = fun x -> x end;; 1182type u = c option;; 1183let just = function None -> failwith "just" | Some x -> x;; 1184let f x = let l = [Some x; (None : u)] in (just(List.hd l))#id;; 1185let g x = 1186 let none = (fun y -> ignore [y;(None:u)]; y) None in 1187 let x = List.hd [Some x; none] in (just x)#id;; 1188let h x = 1189 let none = let y = None in ignore [y;(None:u)]; y in 1190 let x = List.hd [Some x; none] in (just x)#id;; 1191[%%expect {| 1192class c : object method id : 'a -> 'a end 1193type u = c option 1194val just : 'a option -> 'a = <fun> 1195val f : c -> 'a -> 'a = <fun> 1196val g : c -> 'a -> 'a = <fun> 1197val h : < id : 'a; .. > -> 'a = <fun> 1198|}, Principal{| 1199class c : object method id : 'a -> 'a end 1200type u = c option 1201val just : 'a option -> 'a = <fun> 1202Line _, characters 42-62: 1203Warning 18: this use of a polymorphic method is not principal. 1204val f : c -> 'a -> 'a = <fun> 1205Line _, characters 36-47: 1206Warning 18: this use of a polymorphic method is not principal. 1207val g : c -> 'a -> 'a = <fun> 1208val h : < id : 'a; .. > -> 'a = <fun> 1209|}];; 1210 1211(* Only solved for parameterless abbreviations *) 1212type 'a u = c option;; 1213let just = function None -> failwith "just" | Some x -> x;; 1214let f x = let l = [Some x; (None : _ u)] in (just(List.hd l))#id;; 1215[%%expect {| 1216type 'a u = c option 1217val just : 'a option -> 'a = <fun> 1218val f : c -> 'a -> 'a = <fun> 1219|}];; 1220 1221(* polymorphic recursion *) 1222 1223let rec f : 'a. 'a -> _ = fun x -> 1 and g x = f x;; 1224type 'a t = Leaf of 'a | Node of ('a * 'a) t;; 1225let rec depth : 'a. 'a t -> _ = 1226 function Leaf _ -> 1 | Node x -> 1 + depth x;; 1227let rec depth : 'a. 'a t -> _ = 1228 function Leaf _ -> 1 | Node x -> 1 + d x 1229and d x = depth x;; (* fails *) 1230let rec depth : 'a. 'a t -> _ = 1231 function Leaf x -> x | Node x -> 1 + depth x;; (* fails *) 1232let rec depth : 'a. 'a t -> _ = 1233 function Leaf x -> x | Node x -> depth x;; (* fails *) 1234let rec depth : 'a 'b. 'a t -> 'b = 1235 function Leaf x -> x | Node x -> depth x;; (* fails *) 1236let rec r : 'a. 'a list * 'b list ref = [], ref [] 1237and q () = r;; 1238let f : 'a. _ -> _ = fun x -> x;; 1239let zero : 'a. [> `Int of int | `B of 'a] as 'a = `Int 0;; (* ok *) 1240let zero : 'a. [< `Int of int] as 'a = `Int 0;; (* fails *) 1241[%%expect {| 1242val f : 'a -> int = <fun> 1243val g : 'a -> int = <fun> 1244type 'a t = Leaf of 'a | Node of ('a * 'a) t 1245val depth : 'a t -> int = <fun> 1246Line _, characters 2-42: 1247Error: This definition has type 'a t -> int which is less general than 1248 'a0. 'a0 t -> int 1249|}];; 1250 1251(* compare with records (should be the same) *) 1252type t = {f: 'a. [> `Int of int | `B of 'a] as 'a} 1253let zero = {f = `Int 0} ;; 1254type t = {f: 'a. [< `Int of int] as 'a} 1255let zero = {f = `Int 0} ;; (* fails *) 1256[%%expect {| 1257type t = { f : 'a. [> `B of 'a | `Int of int ] as 'a; } 1258val zero : t = {f = `Int 0} 1259type t = { f : 'a. [< `Int of int ] as 'a; } 1260Line _, characters 16-22: 1261Error: This expression has type [> `Int of int ] 1262 but an expression was expected of type [< `Int of int ] 1263 Types for tag `Int are incompatible 1264|}];; 1265 1266(* Yet another example *) 1267let rec id : 'a. 'a -> 'a = fun x -> x 1268and neg i b = (id (-i), id (not b));; 1269[%%expect {| 1270val id : 'a -> 'a = <fun> 1271val neg : int -> bool -> int * bool = <fun> 1272|}];; 1273 1274(* De Xavier *) 1275 1276type t = A of int | B of (int*t) list | C of (string*t) list 1277[%%expect {| 1278type t = A of int | B of (int * t) list | C of (string * t) list 1279|}];; 1280 1281let rec transf f = function 1282 | A x -> f x 1283 | B l -> B (transf_alist f l) 1284 | C l -> C (transf_alist f l) 1285and transf_alist : 'a. _ -> ('a*t) list -> ('a*t) list = fun f -> function 1286 | [] -> [] 1287 | (k,v)::tl -> (k, transf f v) :: transf_alist f tl 1288;; 1289[%%expect {| 1290val transf : (int -> t) -> t -> t = <fun> 1291val transf_alist : (int -> t) -> ('a * t) list -> ('a * t) list = <fun> 1292|}];; 1293 1294(* PR#4862 *) 1295 1296type t = {f: 'a. ('a list -> int) Lazy.t} 1297let l : t = { f = lazy (raise Not_found)};; 1298[%%expect {| 1299type t = { f : 'a. ('a list -> int) Lazy.t; } 1300val l : t = {f = <lazy>} 1301|}];; 1302 1303(* variant *) 1304type t = {f: 'a. 'a -> unit};; 1305let f ?x y = () in {f};; 1306let f ?x y = y in {f};; (* fail *) 1307[%%expect {| 1308type t = { f : 'a. 'a -> unit; } 1309- : t = {f = <fun>} 1310Line _, characters 19-20: 1311Error: This field value has type unit -> unit which is less general than 1312 'a. 'a -> unit 1313|}];; 1314 1315(* Polux Moon caml-list 2011-07-26 *) 1316module Polux = struct 1317 type 'par t = 'par 1318 let ident v = v 1319 class alias = object method alias : 'a . 'a t -> 'a = ident end 1320 let f (x : <m : 'a. 'a t>) = (x : <m : 'a. 'a>) 1321end;; 1322[%%expect {| 1323module Polux : 1324 sig 1325 type 'par t = 'par 1326 val ident : 'a -> 'a 1327 class alias : object method alias : 'a t -> 'a end 1328 val f : < m : 'a. 'a t > -> < m : 'a. 'a > 1329 end 1330|}];; 1331 1332(* PR#5560 *) 1333 1334let (a, b) = (raise Exit : int * int);; 1335type t = { foo : int } 1336let {foo} = (raise Exit : t);; 1337type s = A of int 1338let (A x) = (raise Exit : s);; 1339[%%expect {| 1340Exception: Pervasives.Exit. 1341|}];; 1342 1343(* PR#5224 *) 1344 1345type 'x t = < f : 'y. 'y t >;; 1346[%%expect {| 1347Line _, characters 0-28: 1348Error: In the definition of t, type 'y t should be 'x t 1349|}];; 1350 1351(* PR#6056, PR#6057 *) 1352let using_match b = 1353 let f = 1354 match b with 1355 | true -> fun x -> x 1356 | false -> fun x -> x 1357 in 1358 f 0,f 1359;; 1360[%%expect {| 1361val using_match : bool -> int * ('a -> 'a) = <fun> 1362|}];; 1363 1364match (fun x -> x), fun x -> x with x, y -> x, y;; 1365match fun x -> x with x -> x, x;; 1366[%%expect {| 1367- : ('a -> 'a) * ('b -> 'b) = (<fun>, <fun>) 1368- : ('a -> 'a) * ('b -> 'b) = (<fun>, <fun>) 1369|}];; 1370 1371(* PR#6747 *) 1372(* ok *) 1373let n = object 1374 method m : 'x 'o. ([< `Foo of 'x] as 'o) -> 'x = fun x -> assert false 1375end;; 1376[%%expect {| 1377val n : < m : 'x 'a. ([< `Foo of 'x ] as 'a) -> 'x > = <obj> 1378|}];; 1379(* ok, but not with -principal *) 1380let n = 1381 object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;; 1382[%%expect {| 1383val n : < m : 'x. [< `Foo of 'x ] -> 'x > = <obj> 1384|}, Principal{| 1385Line _, characters 47-68: 1386Error: This method has type ([< `Foo of 'b ] as 'a) -> 'b 1387 which is less general than 'x. 'a -> 'x 1388|}];; 1389(* fail *) 1390let (n : < m : 'a. [< `Foo of int] -> 'a >) = 1391 object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;; 1392[%%expect {| 1393Line _, characters 2-72: 1394Error: This expression has type < m : 'x. [< `Foo of 'x ] -> 'x > 1395 but an expression was expected of type 1396 < m : 'a. [< `Foo of int ] -> 'a > 1397 The universal variable 'x would escape its scope 1398|}, Principal{| 1399Line _, characters 47-68: 1400Error: This method has type ([< `Foo of 'b ] as 'a) -> 'b 1401 which is less general than 'x. 'a -> 'x 1402|}];; 1403(* fail *) 1404let (n : 'b -> < m : 'a . ([< `Foo of int] as 'b) -> 'a >) = fun x -> 1405 object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;; 1406[%%expect {| 1407Line _, characters 2-72: 1408Error: This expression has type < m : 'x. [< `Foo of 'x ] -> 'x > 1409 but an expression was expected of type 1410 < m : 'a. [< `Foo of int ] -> 'a > 1411 The universal variable 'x would escape its scope 1412|}, Principal{| 1413Line _, characters 47-68: 1414Error: This method has type ([< `Foo of 'b ] as 'a) -> 'b 1415 which is less general than 'x. 'a -> 'x 1416|}];; 1417 1418(* PR#6171 *) 1419let f b (x: 'x) = 1420 let module M = struct type t = A end in 1421 if b then x else M.A;; 1422[%%expect {| 1423Line _, characters 19-22: 1424Error: This expression has type M.t but an expression was expected of type 'x 1425 The type constructor M.t would escape its scope 1426|}];; 1427 1428 1429(* PR#6987 *) 1430type 'a t = V1 of 'a 1431 1432type ('c,'t) pvariant = [ `V of ('c * 't t) ] 1433 1434class ['c] clss = 1435 object 1436 method mthod : 't . 'c -> 't t -> ('c, 't) pvariant = fun c x -> 1437 `V (c, x) 1438 end;; 1439 1440let f2 = fun o c x -> match x with | V1 _ -> x 1441 1442let rec f1 o c x = 1443 match (o :> _ clss)#mthod c x with 1444 | `V c -> f2 o c x;; 1445[%%expect{| 1446type 'a t = V1 of 'a 1447type ('c, 't) pvariant = [ `V of 'c * 't t ] 1448class ['c] clss : object method mthod : 'c -> 't t -> ('c, 't) pvariant end 1449val f2 : 'a -> 'b -> 'c t -> 'c t = <fun> 1450val f1 : 1451 < mthod : 't. 'a -> 't t -> [< ('a, 't) pvariant ]; .. > -> 1452 'a -> 'b t -> 'b t = <fun> 1453|}] 1454 1455(* PR#7285 *) 1456type (+'a,-'b) foo = private int;; 1457let f (x : int) : ('a,'a) foo = Obj.magic x;; 1458let x = f 3;; 1459[%%expect{| 1460type (+'a, -'b) foo = private int 1461val f : int -> ('a, 'a) foo = <fun> 1462val x : ('_a, '_a) foo = 3 1463|}] 1464 1465(* PR#7395 *) 1466type u 1467type 'a t = u;; 1468let c (f : u -> u) = 1469 object 1470 method apply: 'a. 'a t -> 'a t = fun x -> f x 1471 end;; 1472[%%expect{| 1473type u 1474type 'a t = u 1475val c : (u -> u) -> < apply : 'a. 'a t -> 'a t > = <fun> 1476|}] 1477