NODE *list_to_array(NODE *list) { NODE *np = list, *result; FIXNUM len = 0, i; for (; np; np = cdr(np)) len++; result = make_array(len); setarrorg(result,1); for (i = 0, np = list; np; np = cdr(np)) (getarrptr(result))[i++] = car(np); return(result); }
NODE *make_array(int len) { NODE *node; NODE **data; node = newnode(ARRAY); setarrorg(node, 1); setarrdim(node, len); data = (NODE * *) malloc((size_t) len * sizeof(NODE *)); if (data == NULL) { err_logo(OUT_OF_MEM, NIL); return UNBOUND; } setarrptr(node, data); while (--len >= 0) *data++ = NIL; return (node); }
NODE *parser_iterate(char **inln, char *inlimit, struct string_block *inhead, BOOLEAN semi, int endchar) { char ch, *wptr = NULL; static char terminate = '\0'; /* KLUDGE */ NODE *outline = NIL, *lastnode = NIL, *tnode = NIL; int windex = 0, vbar = 0; NODETYPES this_type = STRING; BOOLEAN broken = FALSE; do { /* get the current character and increase pointer */ ch = **inln; if (!vbar && windex == 0) wptr = *inln; if (++(*inln) >= inlimit) *inln = &terminate; /* skip through comments and line continuations */ while (!vbar && ((semi && ch == ';') || #ifdef WIN32 (ch == '~' && (**inln == 012 || **inln == 015)))) { while (ch == '~' && (**inln == 012 || **inln == 015)) { #else (ch == '~' && **inln == '\n'))) { while (ch == '~' && **inln == '\n') { #endif if (++(*inln) >= inlimit) *inln = &terminate; ch = **inln; if (windex == 0) wptr = *inln; else { if (**inln == ']' || **inln == '[' || **inln == '{' || **inln == '}') { ch = ' '; break; } else { broken = TRUE; } } if (++(*inln) >= inlimit) *inln = &terminate; } if (semi && ch == ';') { #ifdef WIN32 if (**inln != 012 && **inln != 015) #else if (**inln != '\n') #endif do { ch = **inln; if (windex == 0) wptr = *inln; else broken = TRUE; if (++(*inln) >= inlimit) *inln = &terminate; } #ifdef WIN32 while (ch != '\0' && ch != '~' && **inln != 012 && **inln != 015); #else /* !Win32 */ while (ch != '\0' && ch != '~' && **inln != '\n'); #endif if (ch != '\0' && ch != '~') ch = '\n'; } } /* flag that this word will be of BACKSLASH_STRING type */ if (getparity(ch)) this_type = BACKSLASH_STRING; if (ch == '|') { vbar = !vbar; this_type = VBAR_STRING; broken = TRUE; /* so we'll copy the chars */ } else if (vbar || (!white_space(ch) && ch != ']' && ch != '{' && ch != '}' && ch != '[')) windex++; if (vbar) continue; else if (ch == endchar) break; else if (ch == ']') err_logo(UNEXPECTED_BRACKET, NIL); else if (ch == '}') err_logo(UNEXPECTED_BRACE, NIL); /* if this is a '[', parse a new list */ else if (ch == '[') { tnode = cons(parser_iterate(inln,inlimit,inhead,semi,']'), NIL); if (**inln == '\0') ch = '\0'; } else if (ch == '{') { tnode = cons(list_to_array (parser_iterate(inln,inlimit,inhead,semi,'}')), NIL); if (**inln == '@') { int i = 0, sign = 1; (*inln)++; if (**inln == '-') { sign = -1; (*inln)++; } while ((ch = **inln) >= '0' && ch <= '9') { i = (i*10) + ch - '0'; (*inln)++; } setarrorg(car(tnode),sign*i); } if (**inln == '\0') ch = '\0'; } /* if this character or the next one will terminate string, make the word */ else if (white_space(ch) || **inln == ']' || **inln == '[' || **inln == '{' || **inln == '}') { if (windex > 0 || this_type == VBAR_STRING) { if (broken == FALSE) tnode = cons(make_strnode(wptr, inhead, windex, this_type, strnzcpy), NIL); else { tnode = cons(make_strnode(wptr, (struct string_block *)NULL, windex, this_type, (semi ? mend_strnzcpy : mend_nosemi)), NIL); broken = FALSE; } this_type = STRING; windex = 0; } } /* put the word onto the end of the return list */ if (tnode != NIL) { if (outline == NIL) outline = tnode; else setcdr(lastnode, tnode); lastnode = tnode; tnode = NIL; } } while (ch); return(outline); } NODE *parser(NODE *nd, BOOLEAN semi) { NODE *rtn; int slen; char *lnsav; rtn = cnv_node_to_strnode(nd); slen = getstrlen(rtn); lnsav = getstrptr(rtn); rtn = parser_iterate(&lnsav,lnsav + slen,getstrhead(rtn),semi,-1); return(rtn); } NODE *lparse(NODE *args) { NODE *arg, *val = UNBOUND; arg = string_arg(args); if (NOT_THROWING) { val = parser(arg, FALSE); } return(val); }