667: eqorin: 668: | EQUAL typeexpr { `Eq (typecode_of_expr $2) } 669: | IN typeexpr { `In (typecode_of_expr $2) } 670: | { `None } 671: 672: tvar: 673: | NAME eqorin { snd $1 , `TYP_type, $2} 674: | NAME COLON typeexpr eqorin { snd $1 , typecode_of_expr $3, $4 } 675: 676: tvar_comma_list: 677: | tvar COMMA tvar_comma_list { $1 :: $3 } 678: | tvar { [$1] } 679: | { [] } 680: qualified_name_comma_list: 681: | qualified_name COMMA qualified_name_comma_list { $1 :: $3 } 682: | qualified_name { [$1] } 683: | { [] } 684: 685: opt_type_constraint: 686: | WITH qualified_name_comma_list WHERE expr 687: { { 688: raw_type_constraint=typecode_of_expr $4; 689: raw_typeclass_reqs=map qualified_name_of_expr $2 690: } } 691: | WHERE expr WITH qualified_name_comma_list 692: { { 693: raw_type_constraint=typecode_of_expr $2; 694: raw_typeclass_reqs=map qualified_name_of_expr $4 695: } } 696: 697: | WITH qualified_name_comma_list 698: { { 699: raw_type_constraint=`TYP_tuple []; 700: raw_typeclass_reqs=map qualified_name_of_expr $2 701: } } 702: 703: | WHERE expr 704: { { 705: raw_type_constraint=typecode_of_expr $2; 706: raw_typeclass_reqs=[] 707: } } 708: 709: | { { 710: raw_type_constraint=`TYP_tuple []; 711: raw_typeclass_reqs=[] 712: } } 713: 714: tvarlist: 715: | LSQB tvar_comma_list opt_type_constraint RSQB 716: { 717: let sr = slift $1 in 718: let vs,cs = fold_left 719: (fun (vs,ct) (v,t,c) -> 720: let ct = match c with 721: | `None -> ct 722: | `Eq et -> `TYP_type_match (`AST_name (sr,v,[]),[et,`TYP_tuple []]) :: ct 723: | `In elt -> `TYP_isin (`AST_name (sr,v,[]),elt) :: ct 724: in 725: (v,t)::vs, ct 726: ) 727: ([], []) 728: $2 729: in 730: let {raw_typeclass_reqs=rtr; raw_type_constraint=rtc} = $3 in 731: let ct = 732: { 733: raw_typeclass_reqs=rtr; 734: raw_type_constraint=`TYP_intersect (rtc::cs) 735: } 736: in 737: rev vs, ct 738: } 739: | { dfltvs } 740: 741: type_qual: 742: | INCOMPLETE { [$1,`Incomplete] } 743: | POD { [$1, `Pod] } /* POD types don't require destructors */ 744: | GC_POINTER { [$1, `GC_pointer] } 745: | GC_TYPE expr 746: { 747: let t = $2 in 748: let t = typecode_of_expr t in 749: [$1, `Raw_needs_shape t ] 750: } 751: 752: type_quals: 753: | type_qual type_quals { $1 @ $2 } 754: | { [] } 755: 756: abstract_type: 757: | type_quals CTYPES basic_name_comma_list requires_clause SEMI 758: { 759: let sr = rstoken $2 $5 in 760: let qs = List.map snd $1 in 761: `AST_ctypes (sr,$3,qs,$4) 762: } 763: 764: | type_quals TYPE declname EQUAL code_spec requires_clause SEMI 765: { 766: let name,vs = hd $3 in 767: let qs = List.map snd $1 in 768: let sr = rstoken $2 $7 in 769: let stmt = `AST_abs_decl (sr, name, vs, qs, $5, $6) in 770: fold_left (fun stmt (name,vs) -> `AST_namespace (sr,name,vs,[stmt])) stmt (tl $3) 771: } 772: 773: | type_quals TYPE declname EQUAL NEW typeexpr SEMI 774: { 775: let name,vs = hd $3 in 776: let sr = rstoken $2 $7 in 777: let t = typecode_of_expr $6 in 778: let stmt = `AST_newtype (sr, name, vs, t) in 779: fold_left (fun stmt (name,vs) -> `AST_namespace (sr,name,vs,[stmt])) stmt (tl $3) 780: } 781: 782: | CALLBACK PROCEDURE NAME COLON expr requires_clause SEMI 783: { 784: let sr = rstoken $1 $7 in 785: let name = snd $3 in 786: let t = typecode_of_expr $5 in 787: let rqs = $6 in 788: let args = 789: match t with 790: | `TYP_tuple lst -> lst 791: | x -> [x] 792: in 793: `AST_callback_decl (sr,name,args,`AST_void sr,rqs) 794: } 795: 796: | CALLBACK FUNCTION NAME COLON expr requires_clause SEMI 797: { 798: let sr = rstoken $1 $7 in 799: let name = snd $3 in 800: let t = typecode_of_expr $5 in 801: let rqs = $6 in 802: match t with 803: | `TYP_function (arg, ret) -> 804: let args = 805: match arg with 806: | `TYP_tuple lst -> lst 807: | x -> [x] 808: in 809: `AST_callback_decl (sr,name,args,ret,rqs) 810: | _ -> 811: failwith 812: ( 813: "Function '"^name^"' requires function type, got " ^ 814: string_of_typecode t ^ " in " ^ 815: short_string_of_src sr 816: ) 817: } 818: 819: