append (struct coroutine *k, expr a, expr b, expr c) { begin_decl (); decl_expr (&a); decl_expr (&b); decl_expr (&c); if (alt (k, 1, 0)) /* append ([], L, L) */ { expr l, var_l; decl_loc (l); decl_loc (var_l); l = UNDEF; var_l = mk_var (&l); unify (k, nil, a); unify (k, var_l, b); unify (k, var_l, c); unify (k, a, nil); unify (k, b, var_l); unify (k, c, var_l); } else /* append ([X|A], B, [X|C]) :- append (A, B, C) */ if (alt (k, 1, 0)) { expr X, A, B, C, _X, _A, _B, _C, XA, XC; dle(X) dle(A) dle(B) dle(X) dle(_X) dle(_A) dle(_B) dle(_C) dle(XA) dle(XC) X = UNDEF; A = UNDEF; B = UNDEF; C = UNDEF; _X = mk_var (&X); _A = mk_var (&A); _B = mk_var (&B); _C = mk_var (&C); XA = cons (_X, _A); XC = cons (_X, _C); unify (k, XA, a); unify (k, _B, b); unify (k, XC, c); append (k, _A, _B, _C); unify (k, a, XA); unify (k, b, _B); unify (k, c, XC); } else end (k); free_expr (); }
void free_expr(st_expr_t *expr) { switch(expr->type) { case ste_near_lines: case ste_near: case ste_or: case ste_and: if (expr->subexpr.exprs[0]) free_expr(expr->subexpr.exprs[0]); if (expr->subexpr.exprs[1]) free_expr(expr->subexpr.exprs[1]); break; case ste_not: if (expr->subexpr.expr) free_expr(expr->subexpr.expr); break; case ste_term: /* We always free the matches, if there are any. */ if (expr->subexpr.term && expr->subexpr.term->matches) { st_match_t *mp, *next; for (mp = expr->subexpr.term->matches; mp; mp = next) { next = mp->next; free(mp); } expr->subexpr.term->matches = 0; expr->subexpr.term->curmatch = 0; } /* We never actually free the terms here, because they should * be in an array by now. */ break; case ste_matchset: if (expr->subexpr.set) free(expr->subexpr.set); break; } free(expr); }
ParsingErrors parse(const char input[], var_t *result) { expr_t expr_root; assert(initialized && "Parser must be initialized before use."); last_error = PE_NO_ERROR; last_token.type = BEGIN; last_position = input; get_next(&last_position); expr_root = parse_or_expr(&last_position); last_parsed_char = last_position; if(last_token.type != END) { if(last_parsed_char > input) { last_parsed_char--; } if(last_error == PE_NO_ERROR) { if(last_token.type == DQ && strchr(last_position, '"') == NULL) { /* This is a comment, just ignore it. */ last_position += strlen(last_position); } else if(eval_expr(&expr_root) == 0) { var_free(res_val); res_val = var_clone(expr_root.value); last_error = PE_INVALID_EXPRESSION; } } } if(last_error == PE_NO_ERROR) { if(eval_expr(&expr_root) == 0) { var_free(res_val); res_val = var_clone(expr_root.value); *result = var_clone(expr_root.value); } } if(last_error == PE_INVALID_EXPRESSION) { last_position = skip_whitespace(input); } free_expr(&expr_root); return last_error; }
struct expr * not(struct expr * e, struct context * ctx) { struct expr *a, *re; if (!e || list_len(e) < 2) { free_expr(e); return empty_list(); } a = eval(e->v.list->next->v, ctx); if (is_empty_list(a)) re = atom_t(); else re = empty_list(); full_free_expr(a); free_expr(e); return re; }
static int do_cond(char **s) { expr *condexp = parse_expr_tmplab(s); taddr val; if (!eval_expr(condexp,&val,NULL,0)) { general_error(30); /* expression must be constant */ val = 0; } free_expr(condexp); return val != 0; }
struct expr * atom(struct expr * e, struct context * ctx) { struct expr *a, *re; int n; if (!e || list_len(e) < 2) { free_expr(e); return empty_list(); } a = eval(e->v.list->next->v, ctx); if (a->t == LATOM) re = atom_t(); else if (a->t == LLIST && list_len(a) == 0) re = atom_t(); else re = empty_list(); full_free_expr(a); free_expr(e); return re; }
struct expr * list(struct expr * e, struct context * ctx) { struct expr *pe, *re; const struct list *l; int i; if (!e) return empty_list(); if (list_len(e) < 2) { free_expr(e); return empty_list(); } re = new_expr(LLIST); for (i = 1; (l = get_list_el(e, i)) != NULL; ++i) { pe = eval(l->v, ctx); list_add(re, pe); } free_expr(e); return re; }
void evaluate(expr* expression) { value_object val = eval_aux(expression); if (val.type != VAL_NULL) { printf(" ["); print_type(val.type); printf("]"); printf(" = "); print_value(val); } printf("\n"); free_expr(expression); }
struct expr * defun(struct expr * e, struct context * ctx) { struct expr *pe, *pl; struct list *l; if (!e || list_len(e) < 4) { free_expr(e); return empty_list(); } if (!e->v.list->next || !e->v.list->next->v || e->v.list->next->v->t != LATOM || !e->v.list->next->v->v.atom || !e->v.list->next->v->v.atom->v) { free_expr(e); return empty_list(); } if (!e->v.list->next->next || !is_valid_p_expr(e->v.list->next->next->v)) { free_expr(e); return empty_list(); } if (!e->v.list->next->next->next || !e->v.list->next->next->next->v) { free_expr(e); return empty_list(); } pl = new_expr(LLIST); pl->v.list = new_list(); pl->v.list->v = new_expr(LATOM); pl->v.list->v->v.atom = new_atom("lambda"); pl->v.list->next = new_list(); pl->v.list->next->v = exprs_dup(e->v.list->next->next->v); pl->v.list->next->next = new_list(); pl->v.list->next->next->v = exprs_dup(e->v.list->next->next->next->v); pe = add_to_context(ctx, strdup(e->v.list->next->v->v.atom->v), pl); full_free_expr(pe); free_expr(e); return empty_list(); }
struct expr * label(struct expr * e, struct context * ctx) { struct expr *pe; if (!e || list_len(e) < 3) { dbgprintf("first\n"); free_expr(e); return empty_list(); } if (!e->v.list->v || e->v.list->v->t != LATOM || !e->v.list->v->v.atom || !e->v.list->v->v.atom->v) { dbgprintf("second\n"); free_expr(e); return empty_list(); } if (!is_valid_lambda_expr(e->v.list->next->next->v)) { free_expr(e); return empty_list(); } pe = add_to_context(ctx, strdup(e->v.list->next->v->v.atom->v), exprs_dup(e->v.list->next->next->v)); full_free_expr(pe); free_expr(e); return empty_list(); }
pl_consonne_1 (struct coroutine *k, expr a0) { expr nx[MAX_NEW_CONS]; int pnx, i; struct process_list *alt_process; pnx = 0; begin_decl (); decl_expr (&a0); for (i=0; i<MAX_NEW_CONS; i++) dle (nx[i]); #ifdef TRACE printf ("\nconsonne: a0 = "); print_expr (a0); #endif if (alt (k, 1, 0)) { /* clause */ expr val_X, var_X; alt_process = getpl (k) -> alt; dle(val_X) dle(var_X) val_X=UNDEF; var_X=mk_var(&val_X); #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif unify (k, var_X, a0); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; pl_lettre_1 (k, var_X); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; pl_non_voyelle_1 (k, var_X); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; unify (k, a0, var_X); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif } else end (k); free_expr (); }
inter (expr x, expr y) { expr r, t1; begin_decl (); decl_expr (&x); decl_expr (&y); r = nil; decl_expr (&r); t1 = nil; decl_expr (&t1); if (x > y) return nil; /* r = cons (x, inter (x+1, y)); */ t1 = inter (x+1, y); r = cons (x, t1); t1 = nil; free_expr (); return r; }
struct expr * quote(struct expr * e, struct context * ctx) { struct expr *re; int len; if (e == NULL) return empty_list(); if (e->quoted) { re = exprs_dup(e); re->quoted = 0; } else { if (list_len(e) < 2) re = empty_list(); else re = exprs_dup(e->v.list->next->v); } free_expr(e); return re; }
pl_lettre_1 (struct coroutine *k, expr a0) { expr nx[MAX_NEW_CONS]; int pnx, i; struct process_list *alt_process; pnx = 0; begin_decl (); decl_expr (&a0); for (i=0; i<MAX_NEW_CONS; i++) dle (nx[i]); #ifdef TRACE printf ("\nlettre: a0 = "); print_expr (a0); #endif if (alt (k, 1, 0)) { /* clause */ alt_process = getpl (k) -> alt; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif unify (k, nx[pnx++] = cons (symbol("a"), 0), a0); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; unify (k, a0, nx[pnx++] = cons (symbol("a"), 0)); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif } else if (alt (k, 1, 0)) { /* clause */ alt_process = getpl (k) -> alt; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif unify (k, nx[pnx++] = cons (symbol("b"), 0), a0); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; unify (k, a0, nx[pnx++] = cons (symbol("b"), 0)); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif } else if (alt (k, 1, 0)) { /* clause */ alt_process = getpl (k) -> alt; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif unify (k, nx[pnx++] = cons (symbol("c"), 0), a0); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; unify (k, a0, nx[pnx++] = cons (symbol("c"), 0)); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif } else if (alt (k, 1, 0)) { /* clause */ alt_process = getpl (k) -> alt; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif unify (k, nx[pnx++] = cons (symbol("d"), 0), a0); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; unify (k, a0, nx[pnx++] = cons (symbol("d"), 0)); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif } else if (alt (k, 1, 0)) { /* clause */ alt_process = getpl (k) -> alt; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif unify (k, nx[pnx++] = cons (symbol("e"), 0), a0); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; unify (k, a0, nx[pnx++] = cons (symbol("e"), 0)); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif } else if (alt (k, 1, 0)) { /* clause */ alt_process = getpl (k) -> alt; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif unify (k, nx[pnx++] = cons (symbol("f"), 0), a0); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; unify (k, a0, nx[pnx++] = cons (symbol("f"), 0)); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif } else if (alt (k, 1, 0)) { /* clause */ alt_process = getpl (k) -> alt; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif unify (k, nx[pnx++] = cons (symbol("g"), 0), a0); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; unify (k, a0, nx[pnx++] = cons (symbol("g"), 0)); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif } else if (alt (k, 1, 0)) { /* clause */ alt_process = getpl (k) -> alt; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif unify (k, nx[pnx++] = cons (symbol("h"), 0), a0); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; unify (k, a0, nx[pnx++] = cons (symbol("h"), 0)); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif } else if (alt (k, 1, 0)) { /* clause */ alt_process = getpl (k) -> alt; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif unify (k, nx[pnx++] = cons (symbol("i"), 0), a0); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; unify (k, a0, nx[pnx++] = cons (symbol("i"), 0)); for (i=0; i<pnx; i++) nx[i] = 0; pnx=0; #ifdef TRACE printf ("\n\ta0 = "); print_expr (a0); #endif } else end (k); free_expr (); }
int main (int argc, char **argv) { struct expr *e; int i; mpz_t r; int errcode = 0; char *str; int base = 10; setup_error_handler (); gmp_randinit (rstate, GMP_RAND_ALG_LC, 128); { #if HAVE_GETTIMEOFDAY struct timeval tv; gettimeofday (&tv, NULL); gmp_randseed_ui (rstate, tv.tv_sec + tv.tv_usec); #else time_t t; time (&t); gmp_randseed_ui (rstate, t); #endif } mpz_init (r); while (argc > 1 && argv[1][0] == '-') { char *arg = argv[1]; if (arg[1] >= '0' && arg[1] <= '9') break; if (arg[1] == 't') print_timing = 1; else if (arg[1] == 'b' && arg[2] >= '0' && arg[2] <= '9') { base = atoi (arg + 2); if (base < 2 || base > 62) { fprintf (stderr, "error: invalid output base\n"); exit (-1); } } else if (arg[1] == 'b' && arg[2] == 0) base = 2; else if (arg[1] == 'x' && arg[2] == 0) base = 16; else if (arg[1] == 'X' && arg[2] == 0) base = -16; else if (arg[1] == 'o' && arg[2] == 0) base = 8; else if (arg[1] == 'd' && arg[2] == 0) base = 10; else if (arg[1] == 'v' && arg[2] == 0) { printf ("pexpr linked to gmp %s\n", __gmp_version); } else if (strcmp (arg, "-html") == 0) { flag_html = 1; newline = "<br>"; } else if (strcmp (arg, "-wml") == 0) { flag_wml = 1; newline = "<br/>"; } else if (strcmp (arg, "-split") == 0) { flag_splitup_output = 1; } else if (strcmp (arg, "-noprint") == 0) { flag_print = 0; } else { fprintf (stderr, "error: unknown option `%s'\n", arg); exit (-1); } argv++; argc--; } for (i = 1; i < argc; i++) { int s; int jmpval; /* Set up error handler for parsing expression. */ jmpval = setjmp (errjmpbuf); if (jmpval != 0) { fprintf (stderr, "error: %s%s\n", error, newline); fprintf (stderr, " %s%s\n", argv[i], newline); if (! flag_html) { /* ??? Dunno how to align expression position with arrow in HTML ??? */ fprintf (stderr, " "); for (s = jmpval - (long) argv[i]; --s >= 0; ) putc (' ', stderr); fprintf (stderr, "^\n"); } errcode |= 1; continue; } str = expr (argv[i], &e); if (str[0] != 0) { fprintf (stderr, "error: garbage where end of expression expected%s\n", newline); fprintf (stderr, " %s%s\n", argv[i], newline); if (! flag_html) { /* ??? Dunno how to align expression position with arrow in HTML ??? */ fprintf (stderr, " "); for (s = str - argv[i]; --s; ) putc (' ', stderr); fprintf (stderr, "^\n"); } errcode |= 1; free_expr (e); continue; } /* Set up error handler for evaluating expression. */ if (setjmp (errjmpbuf)) { fprintf (stderr, "error: %s%s\n", error, newline); fprintf (stderr, " %s%s\n", argv[i], newline); if (! flag_html) { /* ??? Dunno how to align expression position with arrow in HTML ??? */ fprintf (stderr, " "); for (s = str - argv[i]; --s >= 0; ) putc (' ', stderr); fprintf (stderr, "^\n"); } errcode |= 2; continue; } if (print_timing) { int t; TIME (t, mpz_eval_expr (r, e)); printf ("computation took %d ms%s\n", t, newline); } else mpz_eval_expr (r, e); if (flag_print) { size_t out_len; char *tmp, *s; out_len = mpz_sizeinbase (r, base >= 0 ? base : -base) + 2; #ifdef LIMIT_RESOURCE_USAGE if (out_len > 100000) { printf ("result is about %ld digits, not printing it%s\n", (long) out_len - 3, newline); exit (-2); } #endif tmp = malloc (out_len); if (print_timing) { int t; printf ("output conversion "); TIME (t, mpz_get_str (tmp, base, r)); printf ("took %d ms%s\n", t, newline); } else mpz_get_str (tmp, base, r); out_len = strlen (tmp); if (flag_splitup_output) { for (s = tmp; out_len > 80; s += 80) { fwrite (s, 1, 80, stdout); printf ("%s\n", newline); out_len -= 80; } fwrite (s, 1, out_len, stdout); } else { fwrite (tmp, 1, out_len, stdout); } free (tmp); printf ("%s\n", newline); } else { printf ("result is approximately %ld digits%s\n", (long) mpz_sizeinbase (r, base >= 0 ? base : -base), newline); } free_expr (e); } exit (errcode); }
main (int argc, char **argv) { struct expr *e; int i; mpz_t r; int errcode = 0; char *str; int base = 10; #if !defined(_WIN32) && !defined(__DJGPP__) setup_error_handler (); #endif mpz_init (r); while (argc > 1 && argv[1][0] == '-') { char *arg = argv[1]; if (arg[1] >= '0' && arg[1] <= '9') break; if (arg[1] == 't') print_timing = 1; else if (arg[1] == 'b' && arg[2] >= '0' && arg[2] <= '9') { base = atoi (arg + 2); if (base < 2 || base > 36) { fprintf (stderr, "error: invalid output base\n"); exit (-1); } } else if (arg[1] == 'b' && arg[2] == 0) base = 2; else if (arg[1] == 'x' && arg[2] == 0) base = 16; else if (arg[1] == 'o' && arg[2] == 0) base = 8; else if (arg[1] == 'd' && arg[2] == 0) base = 10; else if (strcmp (arg, "-html") == 0) { flag_html = 1; newline = "<BR>"; } else if (strcmp (arg, "-split") == 0) { flag_splitup_output = 1; } else if (strcmp (arg, "-noprint") == 0) { flag_print = 0; } else { fprintf (stderr, "error: unknown option `%s'\n", arg); exit (-1); } argv++; argc--; } for (i = 1; i < argc; i++) { int s; int jmpval; /* Set up error handler for parsing expression. */ jmpval = setjmp (errjmpbuf); if (jmpval != 0) { fprintf (stderr, "error: %s%s\n", error, newline); fprintf (stderr, " %s%s\n", argv[i], newline); if (! flag_html) { /* ??? Dunno how to align expression position with arrow in HTML ??? */ fprintf (stderr, " "); for (s = jmpval - (long) argv[i]; --s >= 0; ) putc (' ', stderr); fprintf (stderr, "^\n"); } errcode |= 1; continue; } str = expr (argv[i], &e); if (str[0] != 0) { fprintf (stderr, "error: garbage where end of expression expected%s\n", newline); fprintf (stderr, " %s%s\n", argv[i], newline); if (! flag_html) { /* ??? Dunno how to align expression position with arrow in HTML ??? */ fprintf (stderr, " "); for (s = str - argv[i]; --s; ) putc (' ', stderr); fprintf (stderr, "^\n"); } errcode |= 1; free_expr (e); continue; } /* Set up error handler for evaluating expression. */ if (setjmp (errjmpbuf)) { fprintf (stderr, "error: %s%s\n", error, newline); fprintf (stderr, " %s%s\n", argv[i], newline); if (! flag_html) { /* ??? Dunno how to align expression position with arrow in HTML ??? */ fprintf (stderr, " "); for (s = str - argv[i]; --s >= 0; ) putc (' ', stderr); fprintf (stderr, "^\n"); } errcode |= 2; continue; } { int t0; if (print_timing) t0 = cputime (); mpz_eval_expr (r, e); if (print_timing) printf ("computation took %d ms%s\n", cputime () - t0, newline); } if (flag_print) { size_t out_len; char *tmp, *s; int t0; out_len = mpz_sizeinbase (r, base) + 1; tmp = malloc (out_len); if (print_timing) t0 = cputime (); if (print_timing) /* Print first half of message... */ printf ("output conversion "); mpz_get_str (tmp, -base, r); if (print_timing) /* ...print 2nd half of message unless we caught a time limit and therefore longjmp'ed */ printf ("took %d ms%s\n", cputime () - t0, newline); out_len = strlen (tmp); if (flag_splitup_output) { for (s = tmp; out_len > 60; s += 60) { fwrite (s, 1, 60, stdout); printf ("%s\n", newline); out_len -= 60; } fwrite (s, 1, out_len, stdout); } else { fwrite (tmp, 1, out_len, stdout); } free (tmp); printf ("%s\n", newline); } else { printf ("result is approximately %ld digits%s\n", (long) mpz_sizeinbase (r, 10), newline); } free_expr (e); } exit (errcode); }
append (struct coroutine *k, expr a, expr b, expr c) { #ifndef OLD begin_decl (); decl_expr (&a); decl_expr (&b); decl_expr (&c); #endif #ifdef TRACE printf ("\na = "); print_expr (a); printf ("\nb = "); print_expr (b); printf ("\nc = "); print_expr (c); #endif if (alt (k, 1, 0)) /* append ([], L, L) */ { expr l, var_l; #ifndef OLD decl_loc (l); decl_loc (var_l); #endif l = UNDEF; var_l = mk_var (&l); unify (k, nil, a); unify (k, var_l, b); unify (k, var_l, c); #ifdef TRACE printf ("\nvar_l = "); print_expr (var_l); #endif unify (k, a, nil); unify (k, b, var_l); unify (k, c, var_l); #ifdef TRACE printf ("\na = "); print_expr (a); printf ("\nb = "); print_expr (b); printf ("\nc = "); print_expr (c); #endif /* free (var_l); */ } else /* append ([X|A], B, [X|C]) :- append (A, B, C) */ { expr X, A, B, C, _X, _A, _B, _C, XA, XC; #ifndef OLD dle(X) dle(A) dle(B) dle(X) dle(_X) dle(_A) dle(_B) dle(_C) dle(XA) dle(XC) #endif X = UNDEF; A = UNDEF; B = UNDEF; C = UNDEF; _X = mk_var (&X); _A = mk_var (&A); _B = mk_var (&B); _C = mk_var (&C); XA = cons (_X, _A); XC = cons (_X, _C); #ifdef TRACE printf ("\nXA = "); print_expr (XA); printf ("\n_B = "); print_expr (_B); printf ("\nXC = "); print_expr (XC); printf ("\na = "); print_expr (a); printf ("\nb = "); print_expr (b); printf ("\nc = "); print_expr (c); #endif unify (k, XA, a); unify (k, _B, b); unify (k, XC, c); #ifdef TRACE printf ("\nXA = "); print_expr (XA); printf ("\n_B = "); print_expr (_B); printf ("\nXC = "); print_expr (XC); #endif append (k, _A, _B, _C); #ifdef TRACE printf ("\n_A = "); print_expr (_A); printf ("\n_B = "); print_expr (_B); printf ("\n_C = "); print_expr (_C); printf ("\nXA = "); print_expr (XA); printf ("\n_B = "); print_expr (_B); printf ("\nXC = "); print_expr (XC); #endif unify (k, a, XA); unify (k, b, _B); unify (k, c, XC); #ifdef TRACE printf ("\na = "); print_expr (a); printf ("\nb = "); print_expr (b); printf ("\nc = "); print_expr (c); #endif /* free (_X); free (_A); free (_B); free (_C); free (XA); free (XC); */ } #ifndef OLD free_expr (); #endif }
struct expr * eval(struct expr * e, struct context * ctx) { int i, is_root_level; struct expr *pa, *pb, *pc, *pe, **ev, *re; if (ctx->is_root_level) { is_root_level = 1; ctx->is_root_level = 0; } else { is_root_level = 0; } dbgprintf("\n>>> EVAL <<<\n"); if (dflag) { peval(e, "@ "); pcontext(ctx, "< "); } if (e == NULL) { dbgprintf(">>> NULL\n"); re = empty_list(); if (is_root_level) { free_expr(e); free(e); } return re; } if (e->quoted) { dbgprintf(">>> QUOTE\n"); re = quote(e, ctx); if (is_root_level) { free_expr(e); free(e); } return re; } if (e->t == LATOM) { dbgprintf(">>> RET ATOM\n"); if ((pe = search_context(ctx, e->v.atom->v)) != NULL) { re = exprs_dup(pe); if (is_root_level) { free_expr(e); free(e); } return re; } else { re = exprs_dup(e); if (is_root_level) { free_expr(e); free(e); } return re; } } else if (e->t == LLIST) { if (e->v.list == NULL) return exprs_dup(e); if (!e->v.list->v->v.list) return empty_list(); if (e->v.list->v->t == LATOM) { for (i = 0; ops[i] != NULL; ++i) { if (!strcmp(ops[i], e->v.list->v->v.atom->v)) break; } if (ops[i] == NULL) { if (pe = search_context(ctx, e->v.list->v->v.atom->v)) { free_expr(e->v.list->v); e->v.list->v = exprs_dup(pe); return eval(e, ctx); } else { return empty_list(); } } dbgprintf(">>> %s\n", ops[i]); re = op_funcs[i] (e, ctx); if (is_root_level) { free_expr(e); free(e); } return re; } else if (e->v.list->v->t == LLIST) { /* First check if it's a lambda */ if (is_function_call_expr(e)) { dbgprintf(">>> IS FUNCTION CALL\n"); re = lambda(e, ctx); if (is_root_level) { free_expr(e); free(e); } return re; } else { dbgprintf(">>> IS NOT FUNCTION CALL\n"); pe = eval(e->v.list->v, ctx); free_expr(e->v.list->v); e->v.list->v = (struct expr *) pe; re = eval(e, ctx); if (is_root_level) { free_expr(e); free(e); } return re; } } } return NULL; }
void free_expr(struct expr_node *expr) { if(expr->left) free_expr(expr->left); if(expr->right) free_expr(expr->right); free(expr); }
void init_game() { struct array_mem_small *msmall; struct array_mem_mid *mmid; struct array_mem_norm *mlarge; struct Process *proc; struct instruction_node *in; struct process_thread *pthread; struct process_task *ptask; int next_offs,proc_offs,pos; double xx,lato_x,lato_y; if(arena_mem_type==MEM_TYPE_ONE) { msmall=(struct array_mem_small*)malloc(sizeof(struct array_mem_small)*size_arena); if(msmall==NULL) die("error malloking small array mem"); bzero(msmall,sizeof(struct array_mem_small)*size_arena); arena=msmall; } if(arena_mem_type==MEM_TYPE_TWO) { mmid=(struct array_mem_mid*)malloc(sizeof(struct array_mem_mid)*size_arena); if(mmid==NULL) die("error malloking mid array mem"); bzero(mmid,sizeof(struct array_mem_mid)*size_arena); arena=mmid; } if(arena_mem_type==MEM_TYPE_FOUR) { mlarge=(struct array_mem_norm*)malloc(sizeof(struct array_mem_norm)*size_arena); if(mlarge==NULL) die("error malloking large array mem"); bzero(mlarge,sizeof(struct array_mem_norm)*size_arena); arena=mlarge; } next_offs=0; for(proc=proc_primo;proc;proc=proc->next) { //calc offset in mem proc_offs=(next_offs+(rand()%min_distance))%size_arena; //put in mem pos=proc_offs; for(in=proc->pc->first;in;in=in->next) { putcode(pos++,proc->processID,in->code); } //create pt pthread=(struct process_thread*)malloc(sizeof(struct process_thread)); if(pthread==NULL) die("error alloking new thread"); pthread->IP=proc_offs+(atoi(proc->pc->org)); pthread->communication_in_a=0; pthread->communication_out_a=0; pthread->communication_in_b=0; pthread->communication_out_b=0; pthread->prev=NULL; pthread->next=NULL; pthread->ptask=NULL; ptask=(struct process_task*)malloc(sizeof(struct process_task)); if(ptask==NULL) die("error alloking new task"); ptask->ID=proc->processID; ptask->n_threads=1; ptask->prev=NULL; ptask->next=NULL; ptask->primo_thread=NULL; ptask->ultimo_thread=NULL; ptask->cur_thread=pthread; ptask->communication_in_a=0; ptask->communication_out_a=0; ptask->communication_in_b=0; ptask->communication_out_b=0; get_symbols(&ptask->out_symbol,&ptask->out_color); //add pt add_thread(pthread,ptask); add_task(ptask); //recalc next_offs next_offs+=proc_offs+proc->pc->len; //free proc&pc in=proc->pc->first; do{ if(in->left) free_expr(in->left); if(in->right) free_expr(in->right); if(in->code) free(in->code); if(in->next) {in=in->next;free(in->prev);} else {free(in);in=NULL;} }while(in!=NULL); } xx=sqrt(size_arena); lato_y=rint(xx); lato_x=ceil(xx); max_x=(int)lato_x; max_y=(int)lato_y; if(output_mode>=OUTPUT_DEBUG) { sprintf(out_str,"max_x=%d max_y=%d\n",max_x,max_y); fputs(out_str,fpout); } //init_graph if(vo_mode==VO_FRAMEBUFFER) init_txt(); if(vo_mode==VO_X11) init_x11(); }
struct expr *parse_expr() { int error = 0, current = current_token; token t; token_type type; struct expr *e; e = malloc(sizeof(struct expr)); if (e == NULL) { perror("No memory"); return NULL; } if ((e->data.id = parse_id()) != NULL) { e->type = E_ID; return e; } if ((e->data.number = parse_number()) != NULL) { e->type = E_NUMBER; return e; } t = get_token(); switch (t.type) { case T_SUM: case T_DIFF: case T_PRODUKT: case T_QUOSHUNT: case T_MOD: case T_BIGGR: case T_SMALLR: type = t.type; t = get_token(); if (t.type != T_OF) { error = 1; parse_error("expected `OF`"); } else { e->data.exprs.e1 = parse_expr(); if (e->data.exprs.e1 == NULL) { error = 1; } else { t = get_token(); if (t.type != T_AN) { error = 1; parse_error("exptected `AN`"); } else { e->data.exprs.e2 = parse_expr(); if (e->data.exprs.e2 == NULL) { free_expr(e->data.exprs.e1); error = 1; } } } } switch (type) { case T_SUM: e->type = E_SUM; break; case T_DIFF: e->type = E_DIFF; break; case T_PRODUKT: e->type = E_PROD; break; case T_QUOSHUNT: e->type = E_QUO; break; case T_MOD: e->type = E_MOD; break; case T_BIGGR: e->type = E_MAX; break; case T_SMALLR: e->type = E_MIN; break; default: break; } break; default: unget_token(); parse_error("expected expression"); error = 1; } if (error == 1) { current_token = current; free(e); return NULL; } return e; }