node lookupword(node f){ node p; f = unpos(f); assertpos(f->tag == unique_string_tag,f); p = f->body.unique_string.symbol_list; return p != NULL ? car(p) : NULL; }
node chktype2(node e,scope v){ node f, ftype; f = chk(e,v); if (f == bad__K) return bad_or_undefined_T; if (equal(f,type__K)) return type__T; ftype = type(f); if (ftype != type__T) { node sym; if (ftype != deferred__T) { errorpos(e,"not valid type"); return NULL; } sym = unpos(f); assert(issym(sym)); if (sym->body.symbol.value == NULL) { node t = newtype(f,NULL,FALSE); t->body.type.flags = deferred_F; assert(issym(sym)); sym->body.symbol.value = t; t->body.type.name = sym; } return sym->body.symbol.value; } return f; /* was totype(f) */ }
node ormembertype(node ortype, node membername) { node m; assert(isortype(ortype)); membername = unpos(membername); m = ortype->body.type.commons; while (m != NULL) { if (equal(CAAR(m),membername)) { node t = typeforward(CADAR(m)); return t; } m = CDR(m); } return 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; }
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; }
int main(int argc, char **argv){ int i; char *p; GC_INIT(); ::cgc1::cgc_root_t hash_bucket_root(hash_buckets); hash_buckets=reinterpret_cast<node*>(::cgc1::cgc_malloc(sizeof(node)*7313)); progname = BaseName(argv[0]); yyinit(); for (p=argv[0]; *p; p++) if (*p=='/') progname = p+1; for (i=1; i<argc; i++) { if (EQUAL == strcmp(argv[i],"--help")) { usage(); exit(0); } if (EQUAL == strcmp(argv[i],"-dep")) { stop_after_dep = TRUE; continue; } if (EQUAL == strcmp(argv[i],"-cxx")) { do_cxx = TRUE; continue; } if (EQUAL == strcmp(argv[i],"-noline")) { noline = TRUE; continue; } if (EQUAL == strcmp(argv[i],"-pthreadlocal")) { pthreadThreadLocal=TRUE; compilerThreadLocal=FALSE; continue; } if (EQUAL == strcmp(argv[i],"-typecodes")) { printtypecodes(); return 0; } if (EQUAL == strcmp(argv[i],"-noarraychks")) { arraychks = FALSE; continue; } if (EQUAL == strcmp(argv[i],"-nocasechks")) { casechks = FALSE; continue; } if (EQUAL == strcmp(argv[i],"-nomacros")) { nomacros = TRUE; continue; } if (EQUAL == strcmp(argv[i],"-O")) { arraychks = FALSE; casechks = FALSE; continue; } if (EQUAL == strcmp(argv[i],"-tabwidth")) { i++; if (i < argc) tabwidth = atoi(argv[i]); continue; } if (EQUAL == strcmp(argv[i],"-yydebug")) { yydebug = 1; continue; } if (EQUAL == strcmp(argv[i],"-debug")) { debug = TRUE; continue; } if (EQUAL == strcmp(argv[i],"-v")) { puts(Version); puts(Copyright); continue; } if ('-' == argv[i][0] && 'I' == argv[i][1]) { if (argv[i][2] == 0) { error("-I option: missing directory"); usage(); exit(1); } char buf[256]; strcpy(buf,sigpath); strcat(buf,":"); strcat(buf,argv[i]+2); sigpath = strperm(buf); continue; } if ('-' == argv[i][0]) { error("unrecognized option %s\n",argv[i]); usage(); exit(1); } if ( EQUAL == strcmp(".d",tail(argv[i])) || EQUAL == strcmp(".dd",tail(argv[i])) ) { node f; do_this_cxx = do_cxx || EQUAL == strcmp(".dd",tail(argv[i])); global_scope = new(struct SCOPE); readsetup(global_scope); targetname = newsuffixbase(argv[i],""); f = readfile(argv[i]); if (debug) { char *n = newsuffixbase(argv[i],".out"); if (NULL == freopen(n,"w", stdout)) { fatal("can't open file %s",n); } put("After parsing:\n"); pp(f); fflush(stdout); } outfilename = newsuffixbase(argv[i], do_this_cxx ? "-tmp.cc" : "-tmp.c"); { char *n = newsuffixbase(argv[i],".dep.tmp"); dependfile = fopen(n,"w"); if (dependfile == NULL) fatal("can't open file %s",n); } f = chkprogram(f); if (debug) { char *n = newsuffixbase(argv[i],".log"); if (NULL == freopen(n,"w", stdout)) { fatal("can't open file %s",n); } pprintl(f); } { node t = global_scope->signature; char *n = newsuffixbase(argv[i],".sig.tmp"); if (NULL == freopen(n,"w", stdout)) { fatal("can't open file %s",n); } printf("-- generated by %s\n\n",progname); while (t != NULL) { dprint(CAR(t)); put(";\n"); t = CDR(t); } } if (stop_after_dep) quit(); checkfordeferredsymbols(); if (debug) { char *n = newsuffixbase(argv[i],".sym"); if (NULL == freopen(n,"w", stdout)) { fatal("can't open file %s",n); } printsymboltable(); printtypelist(); printstringlist(); } if (n_errors > 0) { quit(); } if (TRUE) { char *n = newsuffixbase(argv[i],"-exports.h.tmp"); if (NULL == freopen(n,"w", stdout)) { fatal("can't open file %s",n); } printf("#ifndef %s_included\n",targetname); printf("#define %s_included\n",targetname); declarationsstrings = reverse(declarationsstrings); while (declarationsstrings) { node s = unpos(car(declarationsstrings)); assert(isstrconst(s)); put_unescape(s->body.string_const.characters); put("\n"); declarationsstrings = cdr(declarationsstrings); } put(declarations_header); /* printtypecodes(); */ cprinttypes(); put(declarations_trailer); put("#endif\n"); } if (TRUE) { if (NULL == freopen(outfilename,"w", stdout)) { fatal("can't open file %s",outfilename); } printf("#include \"%s\"\n",newsuffixbase(argv[i],"-exports.h")); put(code_header); headerstrings = reverse(headerstrings); while (headerstrings) { locn(car(headerstrings)); printpos(); node s = unpos(car(headerstrings)); assert(isstrconst(s)); put_unescape(s->body.string_const.characters); put("\n"); locn(NULL); headerstrings = cdr(headerstrings); } cprintsemi(f); } } else { fprintf(stderr,"unknown file type %s\n",argv[i]); usage(); exit(1); } } quit(); return 0; }