pike.git/ src/ pike_types.cmod

2020-08-17

2020-08-17 14:08:46 by Henrik Grubbström (Grubba) <grubba@grubba.org>

• 5fc96459523283feb0c9063bf3f38cada74d765b (189 lines) (+189/-0) ^{[ Show | Annotate ]}
  Branch: master

Compiler [Typechecker]: Added PIKE_T_TRANSITIVE.

This is a helper type to construct the type for transitive left-
recursive functions (like eg many operator efuns).

268:    * OBJECT implements/is object id(int)    * OPERATOR type Depends on bit #15. Added in 8.1    * FIND_LFUN object type lfun (int) Added in 8.1 +  * TRANSITIVE fun_type fun_type Added in 8.1    *    * Note that the cdr of a FUNCTION is a valid FUNCTION for the rest of    * the arguments.
275:    * Note also that functions that don't take any arguments, or just    * a many argument just have a MANY node, and no FUNCTION node.    * +  * TRANSITIVE has a car with the current state, and a cdr with the +  * function type to apply. +  *    */   static struct block_allocator type_allocator = BA_INIT(sizeof(struct pike_type), 128);   
343:    case PIKE_T_RING:    case T_ARRAY:    case T_STRING: +  case PIKE_T_TRANSITIVE:    /* Free car & cdr */    free_type(car);    t = (struct pike_type *) cdr;
526:    case PIKE_T_RING:    case T_ARRAY:    case T_STRING: +  case PIKE_T_TRANSITIVE:    /* Free car & cdr */    free_type((struct pike_type *)debug_malloc_pass(car));    free_type((struct pike_type *)debug_malloc_pass(cdr));
639:    case PIKE_T_RING:    case T_ARRAY:    case T_STRING: +  case PIKE_T_TRANSITIVE:    debug_malloc_pass(car);    debug_malloc_pass(cdr);    break;
1045:    case PIKE_T_RING:    case T_ARRAY:    case T_STRING: +  case PIKE_T_TRANSITIVE:    /* Make a new type of the top two types. */    --Pike_compiler->type_stackp;    *Pike_compiler->type_stackp = mk_type(type,
1147:    case T_OR:    case T_AND:    case PIKE_T_RING: +  case PIKE_T_TRANSITIVE:    /* Both car & cdr. */    push_finished_type(top->cdr);    push_finished_type(top->car);
1222:    case PIKE_T_ARRAY:    case PIKE_T_STRING:    case PIKE_T_OPERATOR | 0x8000: +  case PIKE_T_TRANSITIVE:    {    /* Binary type-node. -- swap the types. */    struct pike_type *tmp = Pike_compiler->type_stackp[0];
1392:    push_finished_type_with_markers(type->car, markers, marker_set);    push_type_operator(type->type, type->cdr);    goto done; +  } else if (type->type == PIKE_T_TRANSITIVE) { +  push_finished_type(type->cdr); +  push_finished_type_with_markers(type->car, markers, marker_set); +  push_type(PIKE_T_TRANSITIVE); +  goto done;    }    /* FIXME: T_SCOPE */   
2168:    }    break;    +  case PIKE_T_TRANSITIVE: +  fprintf(stderr, "transitive"); +  break; +     default: fprintf(stderr, "%d",EXTRACT_UCHAR(a+e)); break;    }    }
2467:    }    break;    +  case PIKE_T_TRANSITIVE: +  fprintf(stderr, "transitive("); +  simple_describe_type(s->car); +  fprintf(stderr, ", "); +  simple_describe_type(s->cdr); +  fprintf(stderr, ")"); +  break; +     default:    fprintf(stderr, "Unknown type node: %d, %p:%p",    s->type, s->car, s->cdr);
2784:    t->car, lfun_strings[CDR_TO_INT(t)]);    break;    +  case PIKE_T_TRANSITIVE: +  string_builder_sprintf(s, "transitive(%T, %T)", t->car, t->cdr); +  break; +     default:    {    if ((t->type & 0xff) == PIKE_T_OPERATOR) {
2891:    t = t->cdr;    continue;    case PIKE_T_OPERATOR: +  case PIKE_T_TRANSITIVE:    t = t->car;    continue;    }
3869:    free_type(t);    return ret;    } +  +  case PIKE_T_TRANSITIVE: +  { +  /* FIXME */ +  return a;    } -  +  }       switch(b->type & 0xff)    {
3974:    free_type(t);    return ret;    } +  +  case PIKE_T_TRANSITIVE: +  { +  /* FIXME */ +  return a;    } -  +  }       /* 'mixed' matches anything */   
4505:    free_type(t);    return ret;    } +  +  case PIKE_T_TRANSITIVE: +  { +  /* FIXME */ +  return 1;    } -  +  }      #ifdef TYPE_GROUPING    if (a->type != T_OR) {
4731:    free_type(t);    return ret;    } +  +  case PIKE_T_TRANSITIVE: +  { +  /* FIXME */ +  return 1;    } -  +  }       if ((array_cnt < 0) && (b->type == T_ARRAY)) {    while (b->type == T_ARRAY) {
5232:   #endif /* 0 */    switch(a->type & 0xff)    { +  case PIKE_T_TRANSITIVE: +  a = a->car; +  if (a->type != T_FUNCTION) { +  if (a->type == T_MANY) { +  a = a->cdr; +  push_finished_type_with_markers(a, a_markers, 0); +  return 1; +  } +  return low_get_return_type(a, mixed_type_string); +  } +  /* FALLTHRU */    case T_FUNCTION:    a = a->cdr;    while(a->type == T_FUNCTION) {
6007:    return num;    }    +  case PIKE_T_TRANSITIVE: +  num = low_count_arguments(q->car); +  if (num == MAX_INT32) return num; +  if (num < 0) return num; +  return ~num; +     case T_FUNCTION:    while(q->type == T_FUNCTION)    {
6154:    free_type(tmp);    return tmp2;    +  case PIKE_T_TRANSITIVE: +  if (arg_no < 0) { +  fun = fun->cdr; +  goto loop; +  } +  +  tmp = fun->car; +  add_ref(tmp); +  +  do { +  tmp2 = new_get_return_type(tmp, 0); +  if (tmp2) { +  /* Apply fun->cdr with tmp2. */ +  struct pike_type *tmp3 = +  low_new_check_call(fun->cdr, tmp2, 0, NULL); +  free_type(tmp2); +  if (!tmp3) { +  tmp3 = get_argument_type(tmp, arg_no); +  free_type(tmp); +  return tmp3; +  } +  tmp2 = or_pike_types(tmp, tmp3, 1); +  free_type(tmp); +  free_type(tmp3); +  tmp = tmp2; +  tmp2 = NULL; +  } +  +  if (!arg_no) break; +  +  tmp2 = low_new_check_call(tmp, mixed_type_string, 0, NULL); +  free_type(tmp); +  if (!tmp2) { +  add_ref(void_type_string); +  return void_type_string; +  } +  tmp = tmp2; +  tmp2 = NULL; +  arg_no--; +  } while(1); +  +  tmp2 = get_argument_type(tmp, 0); +  free_type(tmp); +  return tmp2; +     case T_FUNCTION:    if (arg_no > 0) {    arg_no--;
7276:    free_type(tmp);    break;    +  case PIKE_T_TRANSITIVE: +  tmp = new_get_return_type(fun_type->car, 0); +  if (tmp) { +  tmp2 = low_new_check_call(fun_type->cdr, tmp, 0, NULL); +  free_type(tmp); +  if (tmp2) { +  tmp = or_pike_types(fun_type->car, tmp2, 1); +  free_type(tmp2); +  } else { +  tmp = fun_type->car; +  add_ref(tmp); +  } +  } else { +  tmp = fun_type->car; +  add_ref(tmp); +  } +  tmp2 = lower_new_check_call(tmp, arg_type, flags, sval CHECK_CALL_ARGS); +  free_type(tmp); +  if (tmp2) { +  type_stack_mark(); +  push_finished_type(fun_type->cdr); +  push_finished_type(tmp2); +  push_type(PIKE_T_TRANSITIVE); +  free_type(tmp2); +  tmp2 = pop_unfinished_type(); +  } +  return tmp2; +     case PIKE_T_FUNCTION:    case T_MANY:    /* Special case to detect workarounds for the old
7762:    free_type(tmp);    break;    +  case PIKE_T_TRANSITIVE: +  /* NB: Not 100% correct, but good enough for most purposes. */ +  fun_type = fun_type->car; +  goto loop; +     default:    /* Not a callable. */    break;
7951:    free_type(tmp);    break;    +  case PIKE_T_TRANSITIVE: +  tmp = new_get_return_type(fun_type->car, 0); +  +  if (!tmp) { +  fun_type = fun_type->car; +  goto loop; +  } +  +  tmp2 = low_new_check_call(fun_type->cdr, tmp, 0, NULL); +  free_type(tmp); +  tmp = NULL; +  +  if (!tmp2) { +  fun_type = fun_type->car; +  goto loop; +  } +  +  tmp = or_pike_types(fun_type->car, tmp2, 1); +  free_type(tmp2); +  res = get_first_arg_type(tmp, flags); +  free_type(tmp); +  return res; +     case T_OR:    if (!(res = get_first_arg_type(fun_type->car, flags))) {    fun_type = fun_type->cdr;
8455:    free_type(tmp);    return ret;    } +  +  case PIKE_T_TRANSITIVE: +  yytype_report(REPORT_WARNING, NULL, 0, NULL, +  NULL, 0, a, +  0, "Zapping the return value for a transitive " +  "function is not supported."); +  break;    }   /* This error is bogus /Hubbe    Pike_fatal("zzap_function_return() called with unexpected value: %d\n",
8951:    case T_TUPLE:    case T_MAPPING:    case PIKE_T_RING: +  case PIKE_T_TRANSITIVE:    /* Order dependant */    low_make_pike_type(type_string+1, cont);    low_make_pike_type(*cont, cont);
9228:    case T_FUNCTION:    case T_MANY:    case PIKE_T_OPERATOR: +  case PIKE_T_TRANSITIVE:    return 0;       case PIKE_T_NAME:
9301:    case T_TUPLE:    case T_OR:    case T_AND: +  case PIKE_T_TRANSITIVE:    buffer_add_char(buf, t->type);    low_type_to_string(buf, t->car);    t = t->cdr;
9640:    case T_OR:    case T_AND:    case PIKE_T_RING: +  case PIKE_T_TRANSITIVE:    res = find_type(t->car, cb);    if (res) return res;    /* FALLTHRU */
9720:    case PIKE_T_RING:    case T_ARRAY:    case T_STRING: +  case PIKE_T_TRANSITIVE:    if (t->car) {    visit_type_ref (t->car, REF_TYPE_INTERNAL, extra);    }
9802:    case T_AND:    case PIKE_T_ARRAY:    case PIKE_T_STRING: +  case PIKE_T_TRANSITIVE:    if (t->cdr) gc_mark_type_as_referenced(t->cdr);    /* FALLTHROUGH */    case PIKE_T_MULTISET:
9897:    case PIKE_T_RING:    case T_ARRAY:    case T_STRING: +  case PIKE_T_TRANSITIVE:    if (t->car) {    debug_gc_check (t->car, " as car in a type");    }