bool subtype(node s, node t){ if (ispos(s)) s = s->body.position.contents; if (ispos(t)) t = t->body.position.contents; assert(istype(s) && istype(t)); s = typeforward(s); t = typeforward(t); if (s == t) return TRUE; if (s == bad_or_undefined_T || t == bad_or_undefined_T) return TRUE; if (isortype(s) && isortype(t)) { int i, j, slen, tlen; s = typedeftail(s); slen = length(s); t = typedeftail(t); tlen = length(t); for (i=1; i<=slen; i++) { for (j=1; j<=tlen; j++) { if (subtype(nth(s,i),nth(t,j))) goto okay; } return FALSE; okay:; } return TRUE; } if (isortype(s)) return FALSE; if (isortype(t)) { int j, tlen; t = typedeftail(t); tlen = length(t); for (j=1; j<=tlen; j++) { if (subtype(s,nth(t,j))) return TRUE; } return FALSE; } return FALSE; /* for other types, we assume that totypesRec has worked and made equivalent types identical */ }
double sqrt (double x) { double f, y; int exp, i, odd; /* Check for special values. */ switch (numtest (x)) { case NAN: errno = EDOM; return (x); case INF: if (ispos (x)) { errno = EDOM; return (z_notanum.d); } else { errno = ERANGE; return (z_infinity.d); } } /* Initial checks are performed here. */ if (x == 0.0) return (0.0); if (x < 0) { errno = EDOM; return (z_notanum.d); } /* Find the exponent and mantissa for the form x = f * 2^exp. */ f = frexp (x, &exp); odd = exp & 1; /* Get the initial approximation. */ y = 0.41731 + 0.59016 * f; f /= 2.0; /* Calculate the remaining iterations. */ for (i = 0; i < 3; ++i) y = y / 2.0 + f / y; /* Calculate the final value. */ if (odd) { y *= __SQRT_HALF; exp++; } exp >>= 1; y = ldexp (y, exp); return (y); }
bool israwtypeexpr(node e) { while (ispos(e)) e = e->body.position.contents; while (issym(e)) { if (e->body.symbol.type != type__T) return FALSE; e = e->body.symbol.value; } if (!istype(e)) return FALSE; return israwtype(e); }
bool istaggedarraytypeexpr(node e){ while (ispos(e)) e = e->body.position.contents; while (issym(e)) { if (e->body.symbol.type != type__T) return FALSE; e = e->body.symbol.value; } if (istype(e)) return istaggedarraytype(e); if (!iscons(e)) return FALSE; return equal(car(e),tarray_K); }
node chktypelist(node e,scope v) { node l = NULL, m; if (ispos(e)) e = e->body.position.contents; while (e != NULL) { push(l,chktype(CAR(e),v)); e = CDR(e); } m = reverse(l); return m; }
double exp (double x) { int N; double g, z, R, P, Q; switch (numtest (x)) { case NAN: errno = EDOM; return (x); case INF: errno = ERANGE; if (ispos (x)) return (z_infinity.d); else return (0.0); case 0: return (1.0); } /* Check for out of bounds. */ if (x > BIGX || x < SMALLX) { errno = ERANGE; return (x); } /* Check for a value too small to calculate. */ if (-z_rooteps < x && x < z_rooteps) { return (1.0); } /* Calculate the exponent. */ if (x < 0.0) N = (int) (x * INV_LN2 - 0.5); else N = (int) (x * INV_LN2 + 0.5); /* Construct the mantissa. */ g = x - N * LN2; z = g * g; P = g * ((p[2] * z + p[1]) * z + p[0]); Q = ((q[3] * z + q[2]) * z + q[1]) * z + q[0]; R = 0.5 + P / (Q - P); /* Return the floating point value. */ N++; return (ldexp (R, N)); }
struct POS *pos(node n) { struct POS *p; while (iscons(n)) { if (n->body.cons.pos.filename != NULL) return &n->body.cons.pos; p = pos(CAR(n)); if (p != NULL) return p; n = CDR(n); } return ( ispos(n) ? &n->body.position.pos : issym(n) && n->body.symbol.pos.filename != NULL ? &n->body.symbol.pos : istype(n) && n->body.type.name != NULL ? pos(n->body.type.name) : NULL ); }
node membertype(node structtype, node membername) { node m; membername = unpos(membername); if (membername == len_S) return int_T; if (membername == type__S) return int_T; if (istype(structtype)) m = typedeftail(structtype); else m = CDR(structtype); if (ispos(membername)) membername = membername->body.position.contents; while (m != NULL) { if (equal(CAAR(m),membername)) { node t = typeforward(CADAR(m)); return t; } m = CDR(m); } return NULL; }
char *ft_itoa(int n) { char *nb; int i; char *rnb; i = 0; nb = (char *)malloc(sizeof(char) * 12); rnb = (char *)malloc(sizeof(char) * 12); if (n == -2147483648) return (ft_strdup("-2147483648")); if (n >= 0 && n < 10) { nb[0] = n + 48; nb[1] = '\0'; free(rnb); return (nb); } if (n > 9) return (ispos(n, nb, rnb)); if (n < 0) return (isneg(n, nb, rnb)); return (NULL); }
node unpos(node e){ while (ispos(e)) e = e->body.position.contents; return e; }
node ExpandType(node t, node *f) { /* t should be a type expression that might need expanding. Its expanded form gets returned, and also put on the top of the list f unless it's already a type or basic type */ switch(t->tag) { case position_tag: return ExpandType(t->body.position.contents,f); case type_tag: return t; case symbol_tag: { if (t->body.symbol.type == type__T) { assert(istype(t->body.symbol.value)); return t->body.symbol.value; } if (t == bad__K) return bad_or_undefined_T; assert(FALSE); return NULL; } case cons_tag: { node fun = CAR(t); if (ispos(fun)) fun = fun->body.position.contents; t = CDR(t); if (fun == or_K) { /* here we should sort! */ /* we should also merge sub-or's in, and eliminate duplicates */ /* we really only handle (or null (object)) now! */ node newN = NULL; node mems = NULL; while (t != NULL) { node u = ExpandType(CAR(t),f); push(mems,u); t = CDR(t); } apply(reverse,mems); newN = newtype(cons(fun,mems),NULL,FALSE); push(*f,newN); return newN; } else if (fun == object__K || fun == tagged_object_K /* ? */ ) { node newN = NULL; while (t != NULL) { node name = CAAR(t); node u = CADAR(t); push(newN, list(2, unpos(name), ExpandType(u,f))); t = CDR(t); } apply(reverse,newN); newN = newtype(cons(fun,newN),NULL,FALSE); push(*f,newN); return newN; } else if (fun == array_K || fun == tarray_K) { node newN; newN = cons(fun,cons(ExpandType(car(t),f),cdr(t))); newN = newtype(newN,NULL,FALSE); *f = cons(newN,*f); return newN; } else if (fun == function_S) { node argtypes = car(t); node rettype = cadr(t); node newargtypes = NULL; node newN; while (argtypes != NULL) { newargtypes = cons( ExpandType(car(argtypes),f), newargtypes); argtypes = cdr(argtypes); } newargtypes = reverse(newargtypes); rettype = ExpandType(rettype,f); newN = list(3,fun,newargtypes,rettype); newN = newtype(newN,NULL,FALSE); *f = cons(newN,*f); return newN; } else assert(FALSE); return NULL; } default: assert(FALSE); return NULL; } }
node type(node e){ /* assume e is checked previously */ /* this returns a unique TYPE */ if (e == NULL) return void_T; again: switch(e->tag) { case position_tag: e = e->body.position.contents; goto again; case symbol_tag: return e->body.symbol.type; case string_const_tag: /* not implemented yet */ return bad_or_undefined_T; case char_const_tag: return char_T; case int_const_tag: return int_T; case double_const_tag: return double_T; case string_tag: assert(FALSE); case unique_string_tag: assert(FALSE); /* was return bad_or_undefined_T; */ case cons_tag: { node h, ht; h = unpos(CAR(e)); if (h->tag == unique_string_tag) { if (h == equalequal__S || h == unequal_S) return bool_T; if (h == cast__S) { assert(istype(CADR(e))); return cadr(e); } if (h == function_S) return type__T; if (h == funcall__S || h == prefix__S || h == infix__S) { return functionrettype(type(CADR(e))); } if (h == take__S) { return membertype(type(CADR(e)),CADDR(e)); } if (h == array_take_S) { return arrayElementType(type(CADR(e))); } if (h == return_S) return returns_T; if (h == exits_S) return exits_T; if (h == Ccode_S) return cadr(e); assert(FALSE); } ht = type(h); if (ht == type__T) return totype(h); if (ht == keyword_T) { node w = ispos(h) ? h->body.position.contents : h; if (w == block__K) return void_T; if (w == blockn__K) { if (length(e) < 2) return void_T; return type(last(e)); } if ( w == object__K || w == tagged_object_K || w == array_K || w == tarray_K || w == or_K) { return type__T; } if (w == label__S) return void_T; if (w == goto__S) return void_T; assert(FALSE); /* there must be some other keywords! */ } ht = ht->body.type.definition; if (iscons(ht)) { if (equal(CAR(ht),function_S)) { assert(FALSE); return caddr(ht); } else assert(FALSE); return NULL; } assert(FALSE); return NULL; } case type_tag: return type__T; } assert(FALSE); return NULL; }