Implement PExpConstruct/TExpConstruct

Signed-off-by: Itay Dafna <i.b.dafna@gmail.com>

compiler/src/formatting/debug.re

@@ -81,6 +81,7 @@ let debug_expression = (expr: Parsetree.expression) => {
  | PExpLambda(patterns, expression) =>
  print_loc("PExpLambda", expr.pexp_loc)
  | PExpApp(func, expressions) => print_loc("PExpApp", expr.pexp_loc)
+ | PExpConstruct(func, expression) => print_loc("PExpConstruct", expr.pexp_loc)
  | PExpBlock(expressions) => print_loc("PExpBlock", expr.pexp_loc)
  | PExpBoxAssign(expression, expression1) =>
  print_loc("PExpBoxAssign", expr.pexp_loc)

compiler/src/parsing/parser.mly

@@ -384,6 +384,10 @@ paren_expr:
 app_expr:
  | left_accessor_expr lparen lseparated_list(comma, expr) comma? rparen { Exp.apply ~loc:(to_loc $loc) $1 $3 }
 
+construct_expr:
+ | type_id lparen lseparated_list(comma, expr) comma? rparen { Exp.construct ~loc:(to_loc $loc) $1 $3 }
+ | type_id { Exp.construct ~loc:(to_loc $loc) $1 [] }
+
 // These are all inlined to carry over their precedence.
 %inline plus_op:
  | PLUS { "+" }
@@ -596,6 +600,7 @@ assign_expr:
 
 non_assign_expr:
  | app_expr { $1 }
+ | construct_expr { $1 }
  | prim1_expr { $1 }
  | simple_expr { $1 }
  | record_get { $1 }
@@ -611,6 +616,7 @@ non_assign_expr:
 
 %inline left_accessor_expr:
  | app_expr { $1 }
+ | construct_expr { $1 }
  | simple_expr { $1 }
  | array_get { $1 }
  | record_get { $1 }

compiler/src/parsing/parsetree.re

@@ -456,6 +456,7 @@ and expression_desc =
  | PExpConstraint(expression, parsed_type)
  | PExpLambda(list(pattern), expression)
  | PExpApp(expression, list(expression))
+ | PExpConstruct(loc(Identifier.t), list(expression))
  | PExpBlock(list(expression))
  | PExpBoxAssign(expression, expression)
  | PExpAssign(expression, expression)

compiler/src/typed/typecore.re

@@ -935,6 +935,30 @@ and type_expect_ =
  exp_type: ty_res,
  exp_env: env,
  });
+ | PExpConstruct(func, args) =>
+ begin_def();
+ if (Grain_utils.Config.principal^) {
+ begin_def();
+ };
+ let funct = type_exp(env, func);
+ if (Grain_utils.Config.principal^) {
+ end_def();
+ generalize_structure(funct.exp_type);
+ };
+ end_def();
+ /*lower_args [] ty;*/
+ begin_def();
+ let (args, ty_res) = type_construct(env, funct, args);
+ end_def();
+ unify_var(env, newvar(), funct.exp_type);
+ rue({
+ exp_desc: TExpConstruct(funct, args),
+ exp_loc: loc,
+ exp_extra: [],
+ exp_attributes: attributes,
+ exp_type: ty_res,
+ exp_env: env,
+ });
  | PExpMatch(arg, branches) =>
  begin_def();
  let arg = type_exp(env, arg);
@@ -1386,7 +1410,7 @@ and type_application = (env, funct, args) => {
  (typed_args, instance(env, ty_ret));
 }
 
-and type_construct = (env, loc, lid, sarg, ty_expected_explained, attrs) => {
+and type_construct = (env, loc, lid, sargs, ty_expected_explained, attrs) => {
  let {ty: ty_expected, explanation} = ty_expected_explained;
  let opath =
  try({
@@ -1409,14 +1433,14 @@ and type_construct = (env, loc, lid, sarg, ty_expected_explained, attrs) => {
  constrs,
  );
  /*Env.mark_constructor Env.Positive env (Identifier.last lid.txt) constr;*/
- let sargs =
+ /* let sargs =
  switch (sarg) {
  | None => []
  | Some({pexp_desc: PExpTuple(sel)}) when constr.cstr_arity > 1 =>
  /*|| Builtin_attributes.explicit_arity attrs*/
  sel
  | Some(se) => [se]
- };
+ }; */
  if (List.length(sargs) != constr.cstr_arity) {
  raise(
  Error(