:art: Uncurry

diff --git a/include/gack.h b/include/gack.h
index d926119bbae4501cd5924f2298819a9a9de815b9..3515a42faf561ada462fa520420490d282d47001 100644 (file)
--- a/include/gack.h
+++ b/include/gack.h
@@ -10,4 +10,5 @@ ANN void gack(const VM_Shred, const m_uint);
   }
 
 ANN2(2) int gw_asprintf(MemPool mp, char **str, const char *fmt, ...);
+ANN m_bool mk_gack(MemPool p, const Type type, const f_gack d);
 #endif

diff --git a/src/import/import_special.c b/src/import/import_special.c
index bcef3eb15b401c842cd6417ed21998e9623ee89e..971a29eec7c91965472ab2e56a822b26871eed4e 100644 (file)
--- a/src/import/import_special.c
+++ b/src/import/import_special.c
@@ -44,7 +44,7 @@ ANN void gwi_set_loc(const Gwi gwi, const m_str file, const uint line) {
   gwi->gwion->env->name                    = file;
 }
 
-ANN static m_bool mk_gack(MemPool p, const Type type, const f_gack d) {
+ANN m_bool mk_gack(MemPool p, const Type type, const f_gack d) {
   const VM_Code code = new_vmcode(p, NULL, NULL, "@gack", SZ_INT, true, false);
   code->native_func  = (m_uint)d;
   type->info->gack   = code;

diff --git a/src/lib/lib_func.c b/src/lib/lib_func.c
index 344ffbd87b08560c7972b3e6f03a3d8841e6586a..c6992f6dca6d19870ffadc08909984f30f97da77 100644 (file)
--- a/src/lib/lib_func.c
+++ b/src/lib/lib_func.c
@@ -14,15 +14,60 @@
 #include "parse.h"
 #include "partial.h"
 
-static OP_CHECK(opck_func_call) {
-  Exp_Binary *bin  = (Exp_Binary *)data;
-  Exp_Call    call = {.func = bin->rhs, .args = bin->lhs};
-  Exp         e    = exp_self(bin);
+ANN static Exp uncurry(const Env env, const Exp_Binary *bin) {
+  const Stmt stmt = mp_vector_at(bin->rhs->type->info->func->def->d.code->d.stmt_code.stmt_list, struct Stmt_, 0);
+  const Exp ecall = stmt->d.stmt_exp.val;
+  const Exp_Call *call = &ecall->d.exp_call;
+  Exp args = call->args;
+  Exp lhs = bin->lhs;
+  Exp base = NULL, tmp = NULL;
+  while(args) {
+    if(args->exp_type != ae_exp_primary || args->d.prim.prim_type != ae_prim_id || *s_name(args->d.prim.d.var) != '@') {
+      // we should check better => use longer name
+      const Exp next = args->next;
+      args->next = NULL;
+      if(tmp) tmp = (tmp->next = cpy_exp(env->gwion->mp, args));
+      else base = (tmp = cpy_exp(env->gwion->mp, args));
+        args->next = next;
+      } else {
+      if(!lhs) {
+        free_exp(env->gwion->mp, base);
+        return NULL;
+      }
+      const Exp next = lhs->next;
+      lhs->next = NULL;
+      if(tmp) tmp = (tmp->next = cpy_exp(env->gwion->mp, lhs));
+      else base = (tmp = cpy_exp(env->gwion->mp, lhs));
+      lhs = lhs->next = next;
+    }
+    args = args->next;
+  }
+  if(traverse_exp(env, base) > 0) {
+    free_exp(env->gwion->mp, bin->lhs);
+    return base;
+  }
+  free_exp(env->gwion->mp, base);
+  return NULL;
+}
+
+ANN static Type mk_call(const Env env, const Exp e, const Exp func, const Exp args) {
+  Exp_Call    call = {.func = func, .args = args };
   e->exp_type      = ae_exp_call;
   memcpy(&e->d.exp_call, &call, sizeof(Exp_Call));
   return check_exp_call1(env, &e->d.exp_call) ?: env->gwion->type[et_error];
 }
 
+static OP_CHECK(opck_func_call) {
+  Exp_Binary *bin  = (Exp_Binary *)data;
+  if(!strncmp(bin->rhs->type->name, "partial:", 8)) {
+    const Stmt stmt = mp_vector_at(bin->rhs->type->info->func->def->d.code->d.stmt_code.stmt_list, struct Stmt_, 0);
+    const Exp_Call *call = &stmt->d.stmt_exp.val->d.exp_call;
+    const Exp args = uncurry(env, bin);
+    if(args) return mk_call(env, exp_self(bin), call->func, args);
+  }
+  return mk_call(env, exp_self(bin), bin->rhs, bin->lhs);
+}
+
 ANN static inline Exp cpy_nonext(const Env env, const Exp e) {
   const MemPool mp   = env->gwion->mp;
   const Exp     next = e->next;
@@ -688,7 +733,7 @@ static OP_CHECK(opck_spork) {
     struct Value_ value = { .type = env->gwion->type[et_lambda]};
     if(env->class_def)
       set_vflag(&value, vflag_member);
-    struct Func_Base_ fbase = { .xid=insert_symbol("in spork"), .values = &upvalues};
+    struct Func_Base_ fbase = { .xid=insert_symbol("in spork"), .values = &upvalues, .pos = exp_self(unary)->pos};
     set_fbflag(&fbase, fbflag_lambda);
     struct Func_Def_ fdef = { .base = &fbase};
     struct Func_ func = { .name = "in spork", .def = &fdef, .value_ref = &value};

diff --git a/src/parse/check.c b/src/parse/check.c
index 788f39a7ab53742bfb85ac6340b734893808d480..978ba4c6add605735870718e3a1f7ef1be700431 100644 (file)
--- a/src/parse/check.c
+++ b/src/parse/check.c
@@ -418,7 +418,6 @@ ANN static Type check_prim_hack(const Env env, const Exp *data) {
   CHECK_OO(check_prim_interp(env, data));
   env_weight(env, 1);
   return env->gwion->type[et_gack];
-//  return (*data)->type;
 }
 
 ANN static Type check_prim_locale(const Env env, const Symbol *data NUSED) {
@@ -1246,7 +1245,8 @@ ANN static Type check_each_val(const Env env, const Exp exp) {
   struct Op_Import opi = {
     .lhs  = exp->type,
     .op   = insert_symbol("@each_val"),
-    .data = (m_uint)exp
+    .data = (m_uint)exp,
+    .pos = exp->pos
   };
   return op_check(env, &opi);
 }

diff --git a/src/parse/partial.c b/src/parse/partial.c
index 94b5dac4692b5eab4f9d64fea0f832e44d3dca98..9979a787ab13f0b1fc40e49bc7093c052c84eae6 100644 (file)
--- a/src/parse/partial.c
+++ b/src/parse/partial.c
@@ -45,21 +45,26 @@ ANN2(1, 2) static inline Func_Base *partial_base(const Env env, const Func_Base
   return fb;
 }
 
-ANN static Exp partial_call(const Env env, Exp e) {
+ANN static Exp partial_exp(const Env env, Exp e, const uint i) {
+  if(is_hole(env, e) || is_typed_hole(env, e)) {
+    char c[256];
+    sprintf(c, "@%u", i);
+    return new_prim_id(env->gwion->mp, insert_symbol(c), e->pos);
+  }
+  const Exp next = e->next;
+  e->next = NULL;
+  const Exp exp = cpy_exp(env->gwion->mp, e);
+  e->next = next;
+  return exp;
+}
+
+ANN2(1) static Exp partial_call(const Env env, Exp e) {
   Exp base = NULL, arg;
   uint32_t i = 0;
   while(e) {
-    if(is_hole(env, e) || is_typed_hole(env, e)) {
-      char c[256];
-      sprintf(c, "@%u", i++);
-      const Exp next = new_prim_id(env->gwion->mp, insert_symbol(c), e->pos);
-      if(base) arg = arg->next = next;
-      else arg = base = next;
-    } else {
-      const Exp next = cpy_exp(env->gwion->mp, e);
-      if(base) arg = arg->next = next;
-      else arg = base = next;
-    }
+    const Exp exp = partial_exp(env, e, i++);
+    if(base) arg = arg->next = exp;
+    else arg = base = exp;
     e = e->next;
   }
   return base;
@@ -95,13 +100,11 @@ ANN Func find_match(const Env env, Func func, const Exp exp, const bool implicit
 }
 
 ANN Func find_match_actual(const Env env, const Func up, const Exp args) {
-  Func func;
-  if ((func = find_match(env, up, args, false, true)) ||
-      (func = find_match(env, up, args, true, true)) ||
-      (func = find_match(env, up, args, false, true)) ||
-      (func = find_match(env, up, args, true, false)))
-    return func;
-  return NULL;
+  return find_match(env, up, args, false, true)  ?:
+         find_match(env, up, args, true,  true)  ?:
+         find_match(env, up, args, false, true)  ?:
+         find_match(env, up, args, true,  false) ?:
+         NULL;
 }
 
 ANN static Func partial_match(const Env env, const Func up, const Exp args, const loc_t loc);

diff --git a/tests/enum/scoped.gw b/tests/enum/scoped.gw
index 27174e3f904dccce59d740212a9fa42e917865fe..93863f9a2abc16978f3e2f8e8e9d140b328314ea 100644 (file)
--- a/tests/enum/scoped.gw
+++ b/tests/enum/scoped.gw
@@ -1,4 +1,4 @@
-#! [contains] 1
+#! [contains] one
 enum MyEnum {
   zero, one
 }