Syntax change: require declaration of function argument names

compiler/desugared/from_surface.ml

@@ -1179,15 +1179,10 @@ let process_topdef
       (Marked.unmark def.S.topdef_name)
       ctxt.Name_resolution.topdefs
   in
-  let ty_pos = Marked.get_mark def.S.topdef_type in
-  let translate_typ t =
-    (* Todo: better helper function from a more appropriate place *)
-    Name_resolution.process_base_typ ctxt
-      (S.Data (Marked.unmark t), Marked.get_mark t)
-  in
-  let body_type = translate_typ def.S.topdef_type in
+  let translate_typ t = Name_resolution.process_type ctxt t in
+  let typ = translate_typ def.S.topdef_type in
   let arg_types =
-    List.map (fun (_, ty) -> translate_typ ty) def.S.topdef_args
+    List.map (fun (_, (ty, m)) -> translate_typ (Base ty, m)) def.S.topdef_args
   in
   let expr =
     let ctxt, rv_args =
@@ -1208,11 +1203,6 @@ let process_topdef
         body arg_types
         (Marked.get_mark def.S.topdef_name)
   in
-  let typ =
-    match arg_types with
-    | [] -> body_type
-    | _ -> TArrow (arg_types, body_type), ty_pos
-  in
   {
     prgm with
     Ast.program_topdefs =

compiler/desugared/name_resolution.ml

@@ -319,10 +319,8 @@ let process_type (ctxt : context) ((naked_typ, typ_pos) : Surface.Ast.typ) : typ
   match naked_typ with
   | Surface.Ast.Base base_typ -> process_base_typ ctxt (base_typ, typ_pos)
   | Surface.Ast.Func { arg_typ; return_typ } ->
-    (* TODO Louis: /!\ There is only one argument in the surface syntax for
-       function now. *)
-    ( TArrow ([process_base_typ ctxt arg_typ], process_base_typ ctxt return_typ),
-      typ_pos )
+    let targs = List.map (fun (_, t) -> process_base_typ ctxt t) arg_typ in
+    TArrow (targs, process_base_typ ctxt return_typ), typ_pos
 
 (** Process data declaration *)
 let process_data_decl

compiler/desugared/name_resolution.mli

@@ -150,7 +150,7 @@ val get_scope : context -> IdentName.t Marked.pos -> ScopeName.t
 (** Find a scope definition from the typedefs, failing if there is none or it
     has a different kind *)
 
-val process_base_typ : context -> Surface.Ast.base_typ Marked.pos -> typ
+val process_type : context -> Surface.Ast.typ -> typ
 (** Convert a surface base type to an AST type *)
 (* Note: should probably be moved to a different module *)
 

compiler/surface/ast.ml

@@ -131,21 +131,21 @@ type base_typ = Condition | Data of base_typ_data
       }]
 
 type func_typ = {
-  arg_typ : base_typ Marked.pos;
+  arg_typ : (lident Marked.pos * base_typ Marked.pos) list;
   return_typ : base_typ Marked.pos;
 }
 [@@deriving
   visitors
     {
       variety = "map";
-      ancestors = ["base_typ_map"];
+      ancestors = ["lident_map"; "base_typ_map"];
       name = "func_typ_map";
       nude = true;
     },
     visitors
       {
         variety = "iter";
-        ancestors = ["base_typ_iter"];
+        ancestors = ["lident_iter"; "base_typ_iter"];
         name = "func_typ_iter";
         nude = true;
       }]
@@ -739,10 +739,9 @@ type scope_decl = {
 
 type top_def = {
   topdef_name : lident Marked.pos;
-  topdef_args : (lident Marked.pos * base_typ_data Marked.pos) list;
+  topdef_args : (lident Marked.pos * base_typ Marked.pos) list;
       (** Empty list if this is not a function *)
-  topdef_type : base_typ_data Marked.pos;
-      (** Output type if this is a function *)
+  topdef_type : typ;
   topdef_expr : expression;
 }
 [@@deriving
@@ -921,3 +920,11 @@ let rule_to_def (rule : rule) : definition =
     definition_expr = consequence_expr, Marked.get_mark rule.rule_consequence;
     definition_state = rule.rule_state;
   }
+
+let type_from_args
+    (args : (lident Marked.pos * base_typ Marked.pos) list)
+    (return_typ : base_typ Marked.pos) : typ =
+  match args with
+  | [] -> Marked.map_under_mark (fun r -> Base r) return_typ
+  | arg_typ ->
+    Marked.mark (Marked.get_mark return_typ) (Func { arg_typ; return_typ })

compiler/surface/parser.mly

@@ -49,8 +49,9 @@ end>
 
 %type<Ast.uident Marked.pos> addpos(UIDENT)
 %type<Pos.t> pos(CONDITION)
-%type<Ast.primitive_typ> typ_base
-%type<Ast.base_typ_data> typ
+%type<Ast.primitive_typ> primitive_typ
+%type<Ast.base_typ_data> typ_data
+%type<Ast.base_typ> typ
 %type<Ast.uident Marked.pos> uident
 %type<Ast.lident Marked.pos> lident
 %type<Ast.scope_var> scope_var
@@ -82,7 +83,6 @@ end>
 %type<Ast.scope_use_item> assertion
 %type<Ast.scope_use_item> scope_item
 %type<Ast.lident Marked.pos * Ast.base_typ Marked.pos> struct_scope_base
-%type<Ast.base_typ_data Marked.pos> struct_scope_func
 %type<Ast.struct_decl_field> struct_scope
 %type<Ast.io_input> scope_decl_item_attribute_input
 %type<bool> scope_decl_item_attribute_output
@@ -107,7 +107,7 @@ let pos(x) ==
 let addpos(x) ==
 | ~=x ; { x, Pos.from_lpos $loc(x) }
 
-let typ_base :=
+let primitive_typ :=
 | INTEGER ; { Integer }
 | BOOLEAN ; { Boolean }
 | MONEY ; { Money }
@@ -117,9 +117,11 @@ let typ_base :=
 | DATE ; { Date }
 | c = quident ; { let path, uid = c in Named (path, uid) }
 
-let typ :=
-| t = typ_base ; <Primitive>
-| COLLECTION ; t = addpos(typ) ; <Collection>
+let typ_data :=
+| t = primitive_typ ; <Primitive>
+| COLLECTION ; t = addpos(typ_data) ; <Collection>
+
+let typ == t = typ_data ; <Data>
 
 let uident ==
 | ~ = addpos(UIDENT) ; <>
@@ -200,7 +202,7 @@ let naked_expression ==
   e2 = expression ; {
   MemCollection (e2, e1)
 } %prec apply
-| SUM ; typ = addpos(typ_base) ;
+| SUM ; typ = addpos(primitive_typ) ;
   OF ; coll = expression ; {
   CollectionOp (AggregateSum { typ = Marked.unmark typ }, coll)
 } %prec apply
@@ -482,31 +484,19 @@ let scope_item :=
 
 let struct_scope_base :=
 | DATA ; i = lident ;
-  CONTENT ; t = addpos(typ) ; {
-  let t, pos = t in
-  (i, (Data t, pos))
-}
+  CONTENT ; t = addpos(typ) ; <>
 | pos = pos(CONDITION) ; i = lident ; {
   (i, (Condition, pos))
 }
 
-let struct_scope_func ==
-| DEPENDS ; t = addpos(typ) ; <>
-
 let struct_scope :=
 | name_and_typ = struct_scope_base ;
-  func_typ = option(struct_scope_func) ; {
+  args = depends_stance; {
   let (name, typ) = name_and_typ in
-  let (typ, typ_pos) = typ in
+  (* let (typ, typ_pos) = typ in *)
   {
     struct_decl_field_name = name;
-    struct_decl_field_typ = match func_typ with
-    | None -> (Base typ, typ_pos)
-    | Some (arg_typ, arg_pos) ->
-      Func {
-        arg_typ = (Data arg_typ, arg_pos);
-        return_typ = (typ, typ_pos);
-      }, Pos.from_lpos $sloc ;
+    struct_decl_field_typ = Ast.type_from_args args typ;
   }
 }
 
@@ -544,20 +534,12 @@ let scope_decl_item :=
 | attr = scope_decl_item_attribute ;
   i = lident ;
   CONTENT ; t = addpos(typ) ;
-  func_typ = option(struct_scope_func) ;
+  args_typ = depends_stance ;
   states = list(state) ; {
   ContextData {
   scope_decl_context_item_name = i;
   scope_decl_context_item_attribute = attr;
-  scope_decl_context_item_typ =
-    (let (typ, typ_pos) = t in
-    match func_typ with
-    | None -> (Base (Data typ), typ_pos)
-    | Some (arg_typ, arg_pos) ->
-      Func {
-        arg_typ = (Data arg_typ, arg_pos);
-        return_typ = (Data typ, typ_pos);
-      }, Pos.from_lpos $sloc);
+  scope_decl_context_item_typ = type_from_args args_typ t;
   scope_decl_context_item_states = states;
   }
 }
@@ -574,19 +556,13 @@ let scope_decl_item :=
 | attr = scope_decl_item_attribute ;
   i = lident ;
   pos_condition = pos(CONDITION) ;
-  func_typ = option(struct_scope_func) ;
+  args = depends_stance ;
   states = list(state) ; {
   ContextData {
     scope_decl_context_item_name = i;
     scope_decl_context_item_attribute = attr;
     scope_decl_context_item_typ =
-      (match func_typ with
-      | None -> (Base (Condition), pos_condition)
-      | Some (arg_typ, arg_pos) ->
-        Func {
-          arg_typ = (Data arg_typ, arg_pos);
-          return_typ = (Condition, pos_condition);
-        }, Pos.from_lpos $sloc);
+      Ast.type_from_args args (Condition, pos_condition);
     scope_decl_context_item_states = states;
   }
 }
@@ -597,7 +573,7 @@ let enum_decl_line :=
   {
     enum_decl_case_name = c;
     enum_decl_case_typ =
-      Option.map (fun (t, t_pos) ->  Base (Data t), t_pos) t;
+      Option.map (fun (t, t_pos) ->  Base t, t_pos) t;
   }
 }
 
@@ -646,7 +622,7 @@ let code_item :=
   Topdef {
     topdef_name = name;
     topdef_args = args;
-    topdef_type = ty;
+    topdef_type = type_from_args args ty;
     topdef_expr = e;
   }
 }

tests/test_func/bad/bad_func.catala_en

@@ -2,7 +2,7 @@
 
 ```catala
 declaration scope S:
-  context f content integer depends on integer
+  context f content integer depends on x content integer
   context b content boolean
   context output out content integer
 

tests/test_func/bad/recursive.catala_en

@@ -2,7 +2,7 @@
 
 ```catala
 declaration scope RecursiveFunc:
-  context f content integer depends on integer
+  context f content integer depends on x content integer
 
 scope RecursiveFunc:
   definition f of x equals f of x + 1

tests/test_func/good/context_func.catala_en

@@ -2,7 +2,7 @@
 
 ```catala
 declaration scope A:
-  context f content integer depends on integer
+  context f content integer depends on x content integer
 
 declaration scope B:
   input b content boolean

tests/test_func/good/func.catala_en

@@ -2,7 +2,7 @@
 
 ```catala
 declaration scope S:
-  context f content integer depends on integer
+  context f content integer depends on x content integer
   context b content boolean
   context output out content integer
 

tests/test_func/good/param_consistency.catala_en

@@ -1,7 +1,7 @@
 ```catala
 declaration scope S:
   input cond content boolean
-  internal f1 content decimal depends on integer
+  internal f1 content decimal depends on x content integer
   output out content decimal
 
 scope S:

tests/test_proof/good/functions.catala_en

@@ -2,7 +2,7 @@
 
 ```catala
 declaration scope A:
-  context x content integer depends on boolean
+  context x content integer depends on y content boolean
   context z content integer
 
 scope A:

tests/test_scope/good/scope_call3.catala_en

@@ -1,6 +1,6 @@
 ```catala
 declaration scope HousingComputation:
-  output f content integer depends on integer
+  output f content integer depends on x content integer
   output result content integer
 
 scope HousingComputation:
@@ -8,8 +8,8 @@ scope HousingComputation:
   definition result equals f of 1
 
 declaration scope RentComputation:
-  internal g content integer depends on integer
-  output f content integer depends on integer
+  internal g content integer depends on x content integer
+  output f content integer depends on x content integer
 
 scope RentComputation:
   definition g of x equals x + 1

tests/test_scope/good/subscope_function_arg_not_defined.catala_en

@@ -2,7 +2,7 @@
 
 ```catala
 declaration scope Callee:
-  context input_v content integer depends on boolean
+  context input_v content integer depends on b content boolean
   context output output_v content integer
 
 declaration scope Caller:

tests/test_scope/good/subscope_function_arg_not_defined2.catala_en

@@ -2,7 +2,7 @@
 
 ```catala
 declaration scope Callee:
-  context function condition depends on integer
+  context function condition depends on x content integer
   context input_v content integer
   context output output_v condition