From: Jérémie Astor <fennecdjay@gmail.com>
Date: Tue, 15 Jun 2021 23:10:29 +0000 (+0200)
Subject: :art: Sort form of *not* currying
X-Git-Tag: nightly~586
X-Git-Url: http://10.10.0.4:5575/?a=commitdiff_plain;h=a42ca9df380d26e5e2666049aa7fd59015d90981;p=gwion.git

:art: Sort form of *not* currying
---

diff --git a/include/env/type.h b/include/env/type.h
index c77f7ea9..df5ff724 100644
--- a/include/env/type.h
+++ b/include/env/type.h
@@ -127,6 +127,7 @@ typedef enum {
   et_union,
   et_auto,
   et_none,
+  et_curry,
   MAX_TYPE
 } type_enum;
 #endif
diff --git a/include/parse.h b/include/parse.h
index bde830d2..4de09fd6 100644
--- a/include/parse.h
+++ b/include/parse.h
@@ -98,4 +98,15 @@ ANN static inline void env_weight(const Env env, const uint16_t weight) {
 ANN static inline void env_inline_mult(const Env env, const float mult) {
   if (env->func) env->func->inline_mult += mult;
 }
+
+ANN static inline bool is_hole(const Env env, const Exp exp) {
+  const Symbol hole = insert_symbol("_");
+  if(exp->exp_type == ae_exp_primary) {
+    if(exp->d.prim.prim_type == ae_prim_id) {
+      if(exp->d.prim.d.var == hole)
+        return true;
+    }
+  }
+  return false;
+}
 #endif
diff --git a/src/lib/engine.c b/src/lib/engine.c
index b61a9ad3..3d88d507 100644
--- a/src/lib/engine.c
+++ b/src/lib/engine.c
@@ -147,10 +147,17 @@ ANN static m_bool import_core_libs(const Gwi gwi) {
   gwidoc(gwi, "the base of decayed operators.");
   const Type t_op = gwi_mk_type(gwi, "@op", SZ_INT, "@function");
   GWI_BB(gwi_set_global_type(gwi, t_op, et_op))
+
+  gwidoc(gwi, "the base of lamdbas.");
   const Type t_lambda = gwi_mk_type(gwi, "@lambda", SZ_INT, "@function");
   set_tflag(t_lambda, tflag_infer);
   GWI_BB(gwi_set_global_type(gwi, t_lambda, et_lambda))
 
+  gwidoc(gwi, "Mark function as curried.");
+  const Type t_curry = gwi_mk_type(gwi, "@Curry", 0, NULL);
+  GWI_BB(gwi_set_global_type(gwi, t_curry, et_curry))
+
+
   gwidoc(gwi, "type for internal pointer data.");
   GWI_BB(gwi_typedef_ini(gwi, "int", "@internal"))
   GWI_BB(gwi_typedef_end(gwi, ae_flag_none))
diff --git a/src/lib/lib_func.c b/src/lib/lib_func.c
index c7019f56..3eabfa43 100644
--- a/src/lib/lib_func.c
+++ b/src/lib/lib_func.c
@@ -22,6 +22,65 @@ static OP_CHECK(opck_func_call) {
   return check_exp_call1(env, &e->d.exp_call) ?: env->gwion->type[et_error];
 }
 
+ANN static inline Exp cpy_nonext(const Env env, const Exp e) {
+  const MemPool mp = env->gwion->mp;
+  const Exp next = e->next;
+  e->next = NULL;
+  const Exp ret = cpy_exp(mp, e);
+  e->next = next;
+  if(!check_exp(env, ret)) {
+    free_exp(mp, ret);
+    return NULL;
+  }
+  return ret;
+}
+
+ANN static Exp order_curry(const Env env, Exp fn, Exp arg) {
+  const MemPool mp = env->gwion->mp;
+  Exp base   = NULL;
+  Exp next   = NULL;
+  do {
+    const bool hole = is_hole(env, fn);
+    const Exp curr = !hole ? fn : arg;
+    if(hole) {
+      if(!arg) {
+        if(base)
+          free_exp(mp, base);
+        ERR_O(fn->pos, "no enough arguments for holes");
+      }
+      arg = arg->next;
+    }
+    if(!base)
+      base = next = cpy_nonext(env, curr);
+    else {
+      next->next = cpy_nonext(env, curr);
+      next = next->next;
+    }
+  } while ((fn = fn->next));
+  assert(base);
+  if(arg) {
+    free_exp(mp, base);
+    ERR_O(arg->pos, "too many arguments for holes");
+  }
+  return base;
+}
+
+static OP_CHECK(opck_curry) {
+  Exp_Binary *bin  = (Exp_Binary *)data;
+  Exp         lhs  = bin->lhs;
+  Exp_Call    base = bin->rhs->d.exp_call;
+  DECL_OO(const Exp,   args, = order_curry(env, base.args, lhs));
+  Exp_Call    call = {.func = base.func, .args = args};
+  Exp         e    = exp_self(bin);
+  e->exp_type      = ae_exp_call;
+  e->type          = NULL;
+  memcpy(&e->d.exp_call, &call, sizeof(Exp_Call));
+  const MemPool mp = env->gwion->mp;
+  free_exp(mp, base.args);
+  free_exp(mp, lhs);
+  return check_exp_call1(env, &e->d.exp_call) ?: env->gwion->type[et_error];
+}
+
 static inline void fptr_instr(const Emitter emit, const Func f,
                               const m_uint i) {
   const Instr set = emit_add_instr(emit, RegSetImm);
@@ -589,6 +648,9 @@ GWION_IMPORT(func) {
   GWI_BB(gwi_oper_ini(gwi, (m_str)OP_ANY_TYPE, "@function", NULL))
   GWI_BB(gwi_oper_add(gwi, opck_func_call))
   GWI_BB(gwi_oper_end(gwi, "=>", NULL))
+  GWI_BB(gwi_oper_ini(gwi, (m_str)OP_ANY_TYPE, "@Curry", NULL))
+  GWI_BB(gwi_oper_add(gwi, opck_curry))
+  GWI_BB(gwi_oper_end(gwi, "=>", NULL))
   GWI_BB(gwi_oper_ini(gwi, NULL, "@func_ptr", "bool"))
   GWI_BB(gwi_oper_end(gwi, "!", IntNot))
   GWI_BB(gwi_oper_ini(gwi, "@function", "@func_ptr", NULL))
diff --git a/src/parse/check.c b/src/parse/check.c
index b451914f..39aa16a5 100644
--- a/src/parse/check.c
+++ b/src/parse/check.c
@@ -887,7 +887,18 @@ ANN static m_bool predefined_call(const Env env, const Type t,
   return GW_ERROR;
 }
 
+ANN2(1) static inline bool curried(const Env env, Exp exp) {
+  while(exp) {
+    if (is_hole(env, exp))
+      return true;
+    exp = exp->next;
+  }
+  return false;
+}
+
 ANN static Type check_exp_call(const Env env, Exp_Call *exp) {
+  if(curried(env, exp->args))
+    return env->gwion->type[et_curry];
   if (exp->tmpl) {
     DECL_BO(const m_bool, ret, = func_check(env, exp));
     if (!ret) return exp_self(exp)->type;