1092: type_alias: 1093: | TYPEDEF declname EQUAL expr SEMI 1094: { 1095: let name,vs = hd $2 in 1096: let sr = rstoken $1 $5 in 1097: let return_type = `TYP_type in 1098: let body = typecode_of_expr $4 in 1099: let stmt = `AST_type_alias (sr,name,vs,body) in 1100: fold_left (fun stmt (name,vs) -> `AST_namespace (sr,name,vs,[stmt])) stmt (tl $2) 1101: } 1102: 1103: | TYPEDEF FUNCTION declname typefun_args COLON expr EQRIGHTARROW expr SEMI 1104: { 1105: let name,vs = hd $3 in 1106: let sr = rstoken $1 $9 in 1107: let return_type = typecode_of_expr $6 in 1108: let body = typecode_of_expr $8 in 1109: let args = List.map snd $4 (* elide srcref *) in 1110: let stmt = mktypefun sr name vs args return_type body in 1111: fold_left (fun stmt (name,vs) -> `AST_namespace (sr,name,vs,[stmt])) stmt (tl $3) 1112: } 1113: 1114: | TYPEDEF FUNCTION declname COLON expr EQUAL type_matchings SEMI 1115: { 1116: let name,vs = hd $3 in 1117: let sr = rstoken $1 $8 in 1118: let t = typecode_of_expr $5 in 1119: match t with 1120: | `TYP_function (argt, return_type) -> 1121: let args = [["_a",argt]] in 1122: let match_expr = `AST_type_match (sr,(`AST_name (sr,"_a",[]),$7)) in 1123: let body = typecode_of_expr match_expr in 1124: let stmt = mktypefun sr name vs args return_type body in 1125: fold_left (fun stmt (name,vs) -> `AST_namespace (sr,name,vs,[stmt])) stmt (tl $3) 1126: 1127: | _ -> 1128: failwith 1129: ( 1130: "Function '"^name^"' requires function type, got " ^ 1131: string_of_typecode t ^ " in " ^ 1132: short_string_of_src sr 1133: ) 1134: } 1135: 1136: 1137: | RENAME declname EQUAL qualified_name SEMI 1138: { 1139: let name,vs = hd $2 in 1140: let sr = rstoken $1 $5 in 1141: let qn = qualified_name_of_expr $4 in 1142: let stmt = `AST_inherit (sr,name,vs,qn) in 1143: fold_left (fun stmt (name,vs) -> `AST_namespace (sr,name,vs,[stmt])) stmt (tl $2) 1144: } 1145: 1146: | RENAME FUNCTION declname EQUAL qualified_name SEMI 1147: { 1148: let name,vs = hd $3 in 1149: let sr = rstoken $1 $6 in 1150: let qn = qualified_name_of_expr $5 in 1151: let stmt = `AST_inherit_fun (sr,name,vs,qn) in 1152: fold_left (fun stmt (name,vs) -> `AST_namespace (sr,name,vs,[stmt])) stmt (tl $3) 1153: } 1154: 1155: | INHERIT qualified_name SEMI 1156: { 1157: let sr = rstoken $1 $3 1158: and qn = qualified_name_of_expr $2 1159: in 1160: `AST_inject_module (sr,qn) 1161: } 1162: