#include #include #include #include #include #include "com_let.h" #include "com_display.h" #include "completion.h" void com_let(wordlist *wl) { char *p, *q, *s; int indices[MAXDIMS]; int numdims; wordlist fake_wl; int need_open; int offset, length; struct pnode *nn; struct dvec *n, *t; int i, cube; int depth; int newvec; char *rhs; fake_wl.wl_next = NULL; if (!wl) { com_display((wordlist *) NULL); return; } p = wl_flatten(wl); /* extract indices */ numdims = 0; if ((rhs =strchr(p, '='))) { *rhs++ = 0; } else { fprintf(cp_err, "Error: bad let syntax\n"); tfree(p); return; } if ((s =strchr(p, '['))) { need_open = 0; *s++ = 0; while (!need_open || *s == '[') { depth = 0; if (need_open) s++; for (q = s; *q && (*q != ']' && (*q != ',' || depth > 0)); q++) { switch (*q) { case '[': depth += 1; break; case ']': depth -= 1; break; } } if (depth != 0 || !*q) { printf("syntax error specifyingstrchr\n"); tfree(p); return; } if (*q == ']') need_open = 1; else need_open = 0; if (*q) *q++ = 0; for (s = q; *s && isspace(*s); s++) ; } } /* vector name at p */ for (q = p + strlen(p) - 1; *q <= ' ' && p <= q; q--) ; *++q = 0; /* sanity check */ if (eq(p, "all") ||strchr(p, '@')) { fprintf(cp_err, "Error: bad variable name %s\n", p); tfree(p); return; } /* evaluate rhs */ fake_wl.wl_word = rhs; nn = ft_getpnames(&fake_wl, TRUE); if (nn == NULL) { /* XXX error message */ tfree(p); return; } t = ft_evaluate(nn); if (!t) { fprintf(cp_err, "Error: Can't evaluate %s\n", rhs); free_pnode(nn); tfree(p); return; } if (t->v_link2) fprintf(cp_err, "Warning: extra wildcard values ignored\n"); n = vec_get(p); if (n) { /* re-allocate? */ /* vec_free(n); */ newvec = 0; } else { if (numdims) { fprintf(cp_err, "Can't assign into a subindex of a new vector\n"); goto quit; } /* create and assign a new vector */ n = alloc(struct dvec); ZERO(n, struct dvec); n->v_name = copy(p); n->v_type = t->v_type; n->v_flags = (t->v_flags | VF_PERMANENT); n->v_length = t->v_length; if (!t->v_numdims) { n->v_numdims = 1; n->v_dims[0] = n->v_length; } else { n->v_numdims = t->v_numdims; for (i = 0; i < t->v_numdims; i++) n->v_dims[i] = t->v_dims[i]; } if (isreal(t)) n->v_realdata = (double *) tmalloc(n->v_length * sizeof(double)); else n->v_compdata = (complex *) tmalloc(n->v_length * sizeof(complex)); newvec = 1; vec_new(n); } /* fix-up dimensions */ if (n->v_numdims < 1) { n->v_numdims = 1; n->v_dims[0] = n->v_length; } /* Compare dimensions */ offset = 0; length = n->v_length; cube = 1; for (i = n->v_numdims - 1; i >= numdims; i--) cube *= n->v_dims[i]; for (i = numdims - 1; i >= 0; i--) { offset += cube * indices[i]; if (i < n->v_numdims) { cube *= n->v_dims[i]; length /= n->v_dims[i]; } } /* length is the size of the unit refered to */ /* cube ends up being the length */ if (length > t->v_length) { fprintf(cp_err, "left-hand expression is too small (need %d)\n", length * cube); if (newvec) n->v_flags &= ~VF_PERMANENT; goto quit; } if (isreal(t) != isreal(n)) { fprintf(cp_err, "Types of vectors are not the same (real vs. complex)\n"); if (newvec) n->v_flags &= ~VF_PERMANENT; goto quit; } else if (isreal(t)) { bcopy((char *) t->v_realdata, (char *) (n->v_realdata + offset), length * sizeof (double)); } else { bcopy((char *) t->v_compdata, (char *) (n->v_compdata + offset), length * sizeof (complex)); } n->v_minsignal = 0.0; /* How do these get reset ??? */ n->v_maxsignal = 0.0; n->v_scale = t->v_scale; if (newvec) cp_addkword(CT_VECTOR, n->v_name); quit: /* va: garbage collection for t, if pnode nn is no simple value */ if (nn->pn_value==NULL && t!=NULL) vec_free(t); free_pnode(nn); /* frees also t, if pnode nn is simple value */ tfree(p); return; }