5.16.5.11. Function and Procedure Definition

Start data section to src/flx_parse.mly[16 /33 ] Next Prev First Last
  1214: fun_arg:
  1215:   | LPAR parameter_comma_list WHEN expr RPAR { rstoken $1 $3,($2,Some $4) }
  1216:   | LPAR parameter_comma_list RPAR { rstoken $1 $3,($2,None) }
  1217:   | NAME { slift (fst $1),([snd $1,`TYP_none],None) }
  1218: 
  1219: fun_args:
  1220:   | fun_arg fun_args      { $1 :: $2 }
  1221:   | fun_arg               { [$1] }
  1222: opt_fun_args:
  1223:   | fun_args { $1 }
  1224:   | { [] }
  1225: 
  1226: opt_type_expr:
  1227:   | COLON expr EXPECT expr { typecode_of_expr $2, Some $4 }
  1228:   | COLON expr { typecode_of_expr $2, None }
  1229:   | EXPECT expr { `TYP_none, Some $2 }
  1230:   | { `TYP_none, None }
  1231: 
  1232: opt_cstring:
  1233:   | EQUAL code_spec { Some $2 }
  1234:   | { None }
  1235: 
  1236: adjective:
  1237:   | INLINE { $1,`InlineFunction }
  1238:   | NOINLINE { $1,`NoInlineFunction }
  1239: 
  1240: adjectives:
  1241:   | adjective adjectives { $1 :: $2 }
  1242:   | { [] }
  1243: 
  1244: opt_prec:
  1245:   | IS NAME { snd $2 }
  1246:   | { "" }
  1247: 
  1248: opt_traint_eq:
  1249:   | EXPECT expr EQUAL { Some $2 }
  1250:   | { None }
  1251: 
  1252: reduce_args:
  1253:   | LPAR parameter_comma_list RPAR { $2 }
  1254: 
  1255: function_definition:
  1256:   | REDUCE NAME tvarlist reduce_args COLON expr EQRIGHTARROW expr SEMI
  1257:     {
  1258:       let sr = rstoken $1 $9
  1259:       and name = snd $2
  1260:       and vs = $3
  1261:       and args = $4
  1262:       and rsrc = $6
  1263:       and rdst = $8
  1264:       in
  1265:       `AST_reduce (sr,name,vs,args,rsrc,rdst)
  1266:     }
  1267: 
  1268:   | AXIOM NAME tvarlist reduce_args COLON expr SEMI
  1269:     {
  1270:       let sr = rstoken $1 $7
  1271:       and name = snd $2
  1272:       and vs = $3
  1273:       and args = $4
  1274:       and rsrc = $6
  1275:       in
  1276:       `AST_axiom (sr,name,vs,args,rsrc)
  1277:     }
  1278: 
  1279:   | adjectives FUNCTION NAME tvarlist fun_args opt_type_expr EQRIGHTARROW expr SEMI
  1280:     {
  1281:       let kind = match $1 with
  1282:         | [] -> `Function
  1283:         | h :: t -> snd h
  1284:       in
  1285:       let sr = rstoken $2 $9 in
  1286:       let name = snd $3
  1287:       and return_type = $6
  1288:       and body = [`AST_fun_return (sr,$8)]
  1289:       and args = List.map snd $5 (* elide srcref *)
  1290:       and vs = $4
  1291:       in
  1292:       mkcurry sr name vs args return_type kind body
  1293:     }
  1294: 
  1295:   | adjectives FUNCTION NAME tvarlist fun_args opt_type_expr EQUAL compound
  1296:     {
  1297:       let kind = match $1 with
  1298:         | [] -> `Function
  1299:         | h :: t -> snd h
  1300:       in
  1301:       let sr = rsrange (slift $2) (fst $8)
  1302:       and name = snd $3
  1303:       and return_type = $6
  1304:       and body = snd $8
  1305:       and args = List.map snd $5 (* elide srcref *)
  1306:       and vs = $4
  1307:       in mkcurry sr name vs args return_type kind body
  1308:     }
  1309: 
  1310:   | adjectives FUNCTION NAME tvarlist opt_type_expr opt_cstring opt_prec requires_clause SEMI
  1311:     {
  1312:       let name = snd $3
  1313:       and vs = $4
  1314:       and t,traint = $5
  1315:       and sr = rstoken $2 $9
  1316:       and prec = $7
  1317:       and reqs = $8
  1318:       in
  1319:       let ct =
  1320:         match $6 with
  1321:         | Some x -> x
  1322:         | None -> `StrTemplate (name ^ "($a)")
  1323:       in
  1324:       match t with
  1325:       | `TYP_cfunction (arg, ret)
  1326:       | `TYP_function (arg, ret) ->
  1327:         let args =
  1328:           match arg with
  1329:           | `TYP_tuple lst -> lst
  1330:           | x -> [x]
  1331:         in
  1332:         if List.length args > 0 && list_last args = `TYP_ellipsis
  1333:         then
  1334:           let vs = vs @ ["_varargs",`TPAT_any] in
  1335:           let args = List.rev (`AST_name (sr,"_varargs",[]) :: List.tl (List.rev args)) in
  1336:           `AST_fun_decl (sr, name, vs, args,  ret,  ct, reqs,prec)
  1337:         else
  1338:           `AST_fun_decl (sr, name, vs, args,  ret,  ct, reqs,prec)
  1339:       | _ ->
  1340:         failwith
  1341:         (
  1342:           "Function '"^name^"' requires function type, got " ^
  1343:           string_of_typecode t ^ " in " ^
  1344:           short_string_of_src sr
  1345:         )
  1346:     }
  1347: 
  1348:   | adjectives FUNCTION NAME tvarlist opt_type_expr EQRIGHTARROW expr SEMI
  1349:     {
  1350:       let kind = match $1 with
  1351:         | [] -> `Function
  1352:         | h :: t -> snd h
  1353:       in
  1354:       let sr = rstoken $2 $8 in
  1355:       let name = snd $3
  1356:       and return_type = $5
  1357:       and body = [`AST_fun_return (sr,$7)]
  1358:       and args = []
  1359:       and vs = $4
  1360:       in
  1361:       mkcurry sr name vs args return_type kind body
  1362:     }
  1363: 
  1364:   | adjectives FUNCTION NAME tvarlist opt_type_expr EQUAL matchings SEMI
  1365:     {
  1366:       let kind = match $1 with
  1367:         | [] -> `Function
  1368:         | h :: t -> snd h
  1369:       in
  1370:       let sr = rstoken $2 $8 in
  1371:       let name = snd $3 in
  1372:       let vs = $4 in
  1373:       let t,traint = $5 in
  1374:       let body = $7 in
  1375:       match t with
  1376:       | `TYP_function (argt, return_type) ->
  1377:         let args = [["_a",argt],None] in
  1378:         let match_expr = `AST_match (sr,(`AST_name (sr,"_a",[]),body)) in
  1379:         let body = [`AST_fun_return (sr,match_expr)] in
  1380:         mkcurry sr name vs args (return_type,traint) kind body
  1381:       | _ ->
  1382:         failwith
  1383:         (
  1384:           "Function '"^name^"' requires function type, got " ^
  1385:           string_of_typecode t ^ " in " ^
  1386:           short_string_of_src sr
  1387:         )
  1388:     }
  1389: 
  1390: ctor_init:
  1391:   | NAME LPAR expr RPAR { $1,$3 }
  1392: 
  1393: ctor_init_list:
  1394:   | ctor_init COMMA ctor_init_list { $1 :: $3 }
  1395:   | ctor_init { [$1] }
  1396: 
  1397: ctor_inits:
  1398:   | COLON ctor_init_list { $2 }
  1399:   | {[]}
  1400: 
  1401: procedure_definition:
  1402:   | CTOR tvarlist opt_fun_args opt_traint_eq ctor_inits compound
  1403:     {
  1404:       let sr = rsrange (slift $1) (fst $6) in
  1405:       let name = "__constructor__"
  1406:       and vs = $2
  1407:       and return_type = `AST_void sr
  1408:       and traint = $4
  1409:       and body = snd $6
  1410:       and inits = $5
  1411:       and args = List.map snd $3 (* elide srcref *)
  1412:       in
  1413:       let body = map (fun (n,e) -> `AST_init (slift (fst n), snd n, e)) inits @ body in
  1414:       mkcurry sr name vs args (return_type,traint) `Ctor body
  1415:     }
  1416: 
  1417:   | PROCEDURE NAME tvarlist opt_fun_args opt_traint_eq compound
  1418:     {
  1419:       let sr = rsrange (slift $1) (fst $6) in
  1420:       let name = snd $2
  1421:       and vs = $3
  1422:       and return_type = `AST_void sr
  1423:       and traint = $5
  1424:       and body = snd $6
  1425:       and args = List.map snd $4 (* elide srcref *)
  1426:       in mkcurry sr name vs args (return_type,traint) `Function body
  1427:     }
  1428: 
  1429:   | adjective PROCEDURE NAME tvarlist fun_args opt_traint_eq compound
  1430:     {
  1431:       let sr = rsrange (slift (fst $1)) (fst $7) in
  1432:       let name = snd $3
  1433:       and vs = $4
  1434:       and return_type = `AST_void sr
  1435:       and traint = $6
  1436:       and body = snd $7
  1437:       and args = List.map snd $5 (* elide srcref *)
  1438:       and adjective = snd $1
  1439:       in mkcurry sr name vs args (return_type,traint) adjective body
  1440:     }
  1441: 
  1442:   | PROCEDURE NAME tvarlist COLON expr opt_cstring requires_clause SEMI
  1443:     {
  1444:       let sr = rstoken $1 $8
  1445:       and vs = $3
  1446:       and name = snd $2
  1447:       and t = typecode_of_expr $5
  1448:       in
  1449:       let ct =
  1450:         match $6 with
  1451:         | Some x -> x
  1452:         | None -> `StrTemplate (name ^ "($a);")
  1453:       in
  1454:       let args =
  1455:         match t with
  1456:         | `TYP_tuple lst -> lst
  1457:         | x -> [x]
  1458:       in
  1459:         if List.length args > 0 && list_last args = `TYP_ellipsis
  1460:         then
  1461:           let vs = vs @ ["_varargs",`TPAT_any] in
  1462:           let args = List.rev (`AST_name (sr,"_varargs",[]) :: List.tl (List.rev args)) in
  1463:           `AST_fun_decl (sr, name, vs, args,  `AST_void sr,  ct,$7,"")
  1464:         else
  1465:           `AST_fun_decl (sr,name,vs, args,`AST_void sr, ct, $7,"")
  1466:     }
  1467: 
End data section to src/flx_parse.mly[16]