From db90f5d15ecc59b928b0f86092ba35076075365a Mon Sep 17 00:00:00 2001
From: =?utf8?q?J=C3=A9r=C3=A9mie=20Astor?= <fennecdjay@gmail.com>
Date: Mon, 18 Apr 2022 03:01:34 +0200
Subject: [PATCH] :art: Improve curry

---
 src/lib/curry.c    | 47 ++++++++++++++++++++++++++++------------------
 src/lib/engine.c   |  2 +-
 src/lib/lib_func.c | 37 +++++++++++++++++-------------------
 3 files changed, 47 insertions(+), 39 deletions(-)

diff --git a/src/lib/curry.c b/src/lib/curry.c
index 8815ba23..ab4f6f4e 100644
--- a/src/lib/curry.c
+++ b/src/lib/curry.c
@@ -12,26 +12,29 @@
 #include "traverse.h"
 #include "parse.h"
 
-ANN static Arg_List curry_arg_list(const Env env, const Exp e) {
+ANN static Arg_List curry_arg_list(const Env env, const Arg_List base, const Exp e) {
   Arg_List args = new_mp_vector(env->gwion->mp, sizeof(Arg), 0);
   Exp next = e;
+  uint32_t i = 0;
   while(next) {
     if(is_hole(env, next)) {
       char c[256];
       sprintf(c, "@%u\n", args->len);
-      Arg arg = { .var_decl = { .xid = insert_symbol(c) }};
+      Type_Decl *td = cpy_type_decl(env->gwion->mp, mp_vector_at(base, Arg, i)->td);
+      Arg arg = { .td = td, .var_decl = { .xid = insert_symbol(c) }};
       mp_vector_add(env->gwion->mp, &args, Arg, arg);
     }
+    i++;
     next = next->next;
   }
   return args;
 }
 
-ANN2(1) static Func_Base *curry_base(const Env env, Exp earg, const loc_t loc) {
-  Arg_List args = earg ? curry_arg_list(env, earg) : NULL;
-  Func_Base *base = new_func_base(env->gwion->mp, NULL, lambda_name(env->gwion->st, loc.first), args, ae_flag_none, loc);
-  base->fbflag |= fbflag_lambda;
-  return base;
+ANN2(1) static Func_Base *curry_base(const Env env, const Func_Base *base, Exp earg, const loc_t loc) {
+  Arg_List args = earg ? curry_arg_list(env, base->args, earg) : NULL;
+  Func_Base *fb = new_func_base(env->gwion->mp, cpy_type_decl(env->gwion->mp, base->td), lambda_name(env->gwion->st, loc.first), args, ae_flag_none, loc);
+  fb->fbflag |= fbflag_lambda;
+  return fb;
 }
 
 ANN static Exp curry_call(const Env env, Exp e) {
@@ -56,27 +59,34 @@ ANN static Exp curry_call(const Env env, Exp e) {
 
 ANN static Stmt curry_code(const Env env, const Exp efun, const Exp earg) {
   Stmt_List slist = new_mp_vector(env->gwion->mp, sizeof(struct Stmt_), 1);
-  const Exp _args = curry_call(env, earg);
-  mp_free(env->gwion->mp, Exp, earg);
-  const Exp new = new_exp_call(env->gwion->mp, efun, _args, efun->pos);
+  const Exp arg = curry_call(env, earg);
+  const Exp exp = new_exp_call(env->gwion->mp, efun, arg, efun->pos);
   Stmt stmt = mp_vector_at(slist, struct Stmt_, 0);
   stmt->stmt_type = ae_stmt_exp;
-  stmt->d.stmt_exp.val = new;
+  stmt->d.stmt_exp.val = exp;
   return new_stmt_code(env->gwion->mp, slist, efun->pos);
 }
 
+ANN static Type curry_type(const Env env, const Exp exp, const Exp efun, const Exp earg) {
+  Func_Base *base = curry_base(env, efun->type->info->func->def->base, earg, exp->pos);
+  Stmt code = curry_code(env, efun, earg);
+  exp->d.exp_lambda.def = new_func_def(env->gwion->mp, base, code);
+  exp->exp_type = ae_exp_lambda;
+  return check_exp(env, exp);
+}
+
 static OP_CHECK(opck_curry) {
   Exp_Call *call = (Exp_Call*)data;
-  if(!call->args) exit(2);
+  if(!call->args)
+    ERR_N(exp_self(call)->pos, _("`curry` requires a function as first argument"));
   const Exp efun = call->args;
   const Exp earg = efun->next;
   efun->next = NULL;
-  Func_Base *base = curry_base(env, earg, exp_self(call)->pos);
-  base->fbflag |= fbflag_lambda;
-  Stmt code = curry_code(env, efun, earg);
-  exp_self(call)->d.exp_lambda.def = new_func_def(env->gwion->mp, base, code);
-  exp_self(call)->exp_type = ae_exp_lambda;
-  return check_exp(env, exp_self(call));
+  const Type ret = check_exp(env, efun)
+    ? curry_type(env, exp_self(call), efun, earg)
+    : env->gwion->type[et_error];
+  mp_free(env->gwion->mp, Exp, earg);
+  return ret;
 }
 
 GWION_IMPORT(curry) {
@@ -94,3 +104,4 @@ GWION_IMPORT(curry) {
   CHECK_BB(add_op(gwi->gwion, &opi));
   return GW_OK;
 }
+
diff --git a/src/lib/engine.c b/src/lib/engine.c
index ad6d43a5..892169d0 100644
--- a/src/lib/engine.c
+++ b/src/lib/engine.c
@@ -138,7 +138,7 @@ ANN static m_bool import_core_libs(const Gwi gwi) {
 
   gwidoc(gwi, "the base of lamdbas.");
   const Type t_lambda = gwi_mk_type(gwi, "@lambda", SZ_INT, "@function");
-  set_tflag(t_lambda, tflag_infer);
+  /*set_tflag(t_lambda, tflag_infer);*/
   GWI_BB(gwi_set_global_type(gwi, t_lambda, et_lambda))
 
   gwidoc(gwi, "Mark function as curried.");
diff --git a/src/lib/lib_func.c b/src/lib/lib_func.c
index dd20b8f1..33e91e5e 100644
--- a/src/lib/lib_func.c
+++ b/src/lib/lib_func.c
@@ -329,21 +329,12 @@ ANN static m_bool _check_lambda(const Env env, Exp_Lambda *l,
         arg->var_decl.value = NULL;
       }
     }
-/*
-    Arg_List args = l->def->base->args;
-    while(args) {
-      if(!args->var_decl->value) break;
-      free_value(args->var_decl->value, env->gwion);
-      args->var_decl->value = NULL;
-      args = args->next;
-    }
-*/
   }
   return ret;
 }
 
 ANN m_bool check_lambda(const Env env, const Type t, Exp_Lambda *l) {
-  if (l->def->base->func) return GW_ERROR;
+//  if (!l->def->base->func) return GW_ERROR;
   const Func_Def fdef = t->info->func->def;
   if (!GET_FLAG(t->info->func->value_ref, global))
     l->owner = t->info->value->from->owner_class;
@@ -360,8 +351,18 @@ ANN static m_bool fptr_do(const Env env, struct FptrInfo *info) {
     return GW_OK;
   }
   Exp_Lambda *l = &info->exp->d.exp_lambda;
-  return check_lambda(env, actual_type(env->gwion, info->rhs->value_ref->type),
-                      l);
+  return check_lambda(env, actual_type(env->gwion, info->rhs->value_ref->type), l);
+}
+
+ANN static Type curry2auto(const Env env, const Exp_Binary *bin) {
+  const Func_Def fdef = bin->lhs->d.exp_lambda.def;
+  unset_fbflag(fdef->base, fbflag_lambda);
+  CHECK_BN(traverse_func_def(env, fdef));
+  const Type actual = fdef->base->func->value_ref->type;
+  set_fbflag(fdef->base, fbflag_lambda);
+  Var_Decl vd = mp_vector_at(bin->rhs->d.exp_decl.list, struct Var_Decl_, 0);
+  exp_setvar(bin->rhs, true);
+  return vd->value->type = bin->rhs->type = bin->rhs->d.exp_decl.type = actual;
 }
 
 static OP_CHECK(opck_auto_fptr) {
@@ -372,6 +373,8 @@ static OP_CHECK(opck_auto_fptr) {
     ERR_N(bin->lhs->pos, "invalid {G+}function{0} {+}@=>{0} {+G}function{0} assignment");
   if (bin->lhs->exp_type == ae_exp_td)
     ERR_N(bin->lhs->pos, "can't use {/}type decl expressions{0} in auto function pointer declarations");
+  if(!bin->lhs->type->info->func)
+    return curry2auto(env, bin);
   // create a matching signature
   // TODO: we could check first if there a matching existing one
   Func_Base *const fbase =
@@ -386,7 +389,7 @@ static OP_CHECK(opck_auto_fptr) {
   const Type   t      = fptr_def->type;
   free_fptr_def(env->gwion->mp, fptr_def);
 //  type_remref(t, env->gwion);
-    Var_Decl vd = mp_vector_at(bin->rhs->d.exp_decl.list, struct Var_Decl_, 0);
+  Var_Decl vd = mp_vector_at(bin->rhs->d.exp_decl.list, struct Var_Decl_, 0);
   vd->value->type = bin->rhs->type =
       bin->rhs->d.exp_decl.type                = t;
   exp_setvar(bin->rhs, 1);
@@ -537,12 +540,6 @@ static inline void op_impl_ensure_types(const Env env, const Func func) {
     Arg *arg = mp_vector_at(args, Arg, i);
     if (!arg->type) arg->type = known_type(env, arg->td);
   }
-/*
-  while (arg) {
-    if (!arg->type) arg->type = known_type(env, arg->td);
-    arg = arg->next;
-  }
-*/
   if (!func->def->base->ret_type)
     func->def->base->ret_type = known_type(env, func->def->base->td);
   if (owner_tmpl) nspc_pop_type(env->gwion->mp, env->curr);
@@ -754,7 +751,7 @@ GWION_IMPORT(func) {
   GWI_BB(gwi_oper_end(gwi, "fork", NULL))
   GWI_BB(gwi_oper_ini(gwi, "@function", "@function", NULL))
   GWI_BB(gwi_oper_add(gwi, opck_auto_fptr))
-  GWI_BB(gwi_oper_end(gwi, "@=>", NULL))
+  GWI_BB(gwi_oper_end(gwi, "@=>", int_r_assign))
   gwi_register_freearg(gwi, SporkIni, freearg_xork);
   gwi_register_freearg(gwi, DotTmpl, freearg_dottmpl);
   return GW_OK;
-- 
2.43.0