|
|
@ -1,6 +1,6 @@ |
|
|
|
# main.leg -- C parser + interpreter |
|
|
|
# |
|
|
|
# Last edited: 2025-01-22 11:44:37 by piumarta on zora |
|
|
|
# Last edited: 2025-01-22 15:05:59 by piumarta on zora |
|
|
|
|
|
|
|
%{ |
|
|
|
; |
|
|
@ -64,21 +64,38 @@ typedef union Object Object, *oop; |
|
|
|
_(Scope) _(TypeName) _(Variable) _(Constant) _(Function) _(Primitive) \ |
|
|
|
_(VarDecls) |
|
|
|
|
|
|
|
#define _do_unaries(_) \ |
|
|
|
_(NEG) _(NOT) _(COM) _(DEREF) _(REF) _(PREINC) _(PREDEC) _(POSTINC) _(POSTDEC) |
|
|
|
|
|
|
|
typedef enum { |
|
|
|
# define _(X) X, |
|
|
|
_do_types(_) |
|
|
|
# undef _ |
|
|
|
} type_t; |
|
|
|
#define _do_binaries(_) \ |
|
|
|
_(INDEX) \ |
|
|
|
_(MUL) _(DIV) _(MOD) _(ADD) _(SUB) _(SHL) _(SHR) \ |
|
|
|
_(LT) _(LE) _(GE) _(GT) _(EQ) _(NE) \ |
|
|
|
_(BAND) _(BXOR) _(BOR) _(LAND) _(LOR) |
|
|
|
|
|
|
|
typedef enum { NEG, NOT, COM, DEREF, REF, PREINC, PREDEC, POSTINC, POSTDEC } unary_t; |
|
|
|
#define _(X) X, |
|
|
|
|
|
|
|
typedef enum { |
|
|
|
INDEX, |
|
|
|
MUL, DIV, MOD, ADD, SUB, SHL, SHR, |
|
|
|
LT, LE, GE, GT, EQ, NE, |
|
|
|
BAND, BXOR, BOR, LAND, LOR, |
|
|
|
} binary_t; |
|
|
|
typedef enum { _do_types(_) } type_t; |
|
|
|
typedef enum { _do_unaries(_) } unary_t; |
|
|
|
typedef enum { _do_binaries(_) } binary_t; |
|
|
|
|
|
|
|
#undef _ |
|
|
|
|
|
|
|
#define _(X) #X, |
|
|
|
|
|
|
|
char *unaryName(int op) { |
|
|
|
static char *names[] = { _do_unaries(_) }; |
|
|
|
assert(0 <= op && op < indexableSize(names)); |
|
|
|
return names[op]; |
|
|
|
} |
|
|
|
|
|
|
|
char *binaryName(int op) { |
|
|
|
static char *names[] = { _do_binaries(_) }; |
|
|
|
assert(0 <= op && op < indexableSize(names)); |
|
|
|
return names[op]; |
|
|
|
} |
|
|
|
|
|
|
|
#undef _ |
|
|
|
|
|
|
|
typedef oop (* prim_t)(int nargs, oop *arguments, oop environment); |
|
|
|
|
|
|
@ -414,6 +431,24 @@ char *String_appendAll(oop string, char *chars, int len) |
|
|
|
return chars; |
|
|
|
} |
|
|
|
|
|
|
|
char *String_format(oop string, char *format, ...) |
|
|
|
{ |
|
|
|
static char *buf = 0; |
|
|
|
static int buflen = 0; |
|
|
|
int n = 0; |
|
|
|
for (;;) { |
|
|
|
va_list ap; |
|
|
|
va_start(ap, format); |
|
|
|
n = vsnprintf(buf, buflen, format, ap); |
|
|
|
va_end(ap); |
|
|
|
if (n < buflen) break; |
|
|
|
buflen = n + 1; |
|
|
|
buf = realloc(buf, sizeof(*buf) * buflen); |
|
|
|
} |
|
|
|
String_appendAll(string, buf, n); |
|
|
|
return buf; |
|
|
|
} |
|
|
|
|
|
|
|
#define Array_do(ARR, VAR) \ |
|
|
|
for (oop do_array = (ARR), VAR = nil; do_array; do_array = 0) \ |
|
|
|
for (int do_size = get(do_array, Array,size), do_index = 0; \ |
|
|
@ -701,7 +736,7 @@ oop Scope_lookup(oop name) |
|
|
|
return 0; // NOTE: 0 means undefined (rather than nil, which means uninitialised) |
|
|
|
} |
|
|
|
|
|
|
|
oop Scope_redefine(oop name, oop value) |
|
|
|
oop Scope_redeclare(oop name, oop value) |
|
|
|
{ |
|
|
|
int n = get(scopes, Array,size); |
|
|
|
oop *elts = get(scopes, Array,elements); |
|
|
@ -877,13 +912,29 @@ oop toStringOn(oop obj, oop str) |
|
|
|
String_appendAll(str, "<NIL>", 5); |
|
|
|
break; |
|
|
|
case Symbol: |
|
|
|
String_appendAll(str, get(obj, Symbol,name), strlen(get(obj, Symbol,name))); |
|
|
|
String_format(str, "%s", get(obj, Symbol,name)); |
|
|
|
break; |
|
|
|
case String: { |
|
|
|
String_append(str, '"'); |
|
|
|
char *chars = get(obj, String,elements); |
|
|
|
for (int i = 0, n = get(obj, String,size); i < n; ++i) { |
|
|
|
int c = chars[i]; |
|
|
|
if (' ' <= c || c <= 126) String_append(str, c); |
|
|
|
else String_format(str, "\\x%02x", c); |
|
|
|
} |
|
|
|
String_append(str, '"'); |
|
|
|
break; |
|
|
|
case String: |
|
|
|
String_appendAll(str, get(obj, String,elements), get(obj, String,size)); |
|
|
|
} |
|
|
|
case Unary: { |
|
|
|
String_format(str, "%s", unaryName(get(obj, Unary,operator))); |
|
|
|
break; |
|
|
|
} |
|
|
|
case Binary: { |
|
|
|
String_format(str, "%s", binaryName(get(obj, Binary,operator))); |
|
|
|
break; |
|
|
|
} |
|
|
|
case Tbase: |
|
|
|
String_appendAll(str, get(obj, Tbase,name), strlen(get(obj, Tbase,name))); |
|
|
|
String_format(str, "%s", get(obj, Tbase,name)); |
|
|
|
break; |
|
|
|
case Tpointer: { |
|
|
|
oop target = get(obj, Tpointer,target); |
|
|
@ -925,6 +976,10 @@ oop toStringOn(oop obj, oop str) |
|
|
|
String_append(str, ')'); |
|
|
|
break; |
|
|
|
} |
|
|
|
case Primitive: { |
|
|
|
String_format(str, "%s", symbolName(get(obj, Primitive,name))); |
|
|
|
break; |
|
|
|
} |
|
|
|
case VarDecls: { |
|
|
|
oop vars = get(obj, VarDecls,variables); |
|
|
|
oop base = get(obj, VarDecls,type); |
|
|
@ -1550,7 +1605,7 @@ oop nlrPop(void) |
|
|
|
#define isFalse(O) ((O) == nil) |
|
|
|
#define isTrue(O) ((O) != nil) |
|
|
|
|
|
|
|
void defineVariable(oop name, oop type, oop value); |
|
|
|
void declareVariable(oop name, oop type, oop value); |
|
|
|
|
|
|
|
oop apply(oop function, oop arguments, oop env) |
|
|
|
{ |
|
|
@ -1582,13 +1637,13 @@ oop apply(oop function, oop arguments, oop env) |
|
|
|
while (argn < parc) { |
|
|
|
oop var = parv[argn]; |
|
|
|
oop arg = argv[argn]; |
|
|
|
defineVariable(get(var, Variable,name), get(var, Variable,type), eval(arg, nil)); |
|
|
|
declareVariable(get(var, Variable,name), get(var, Variable,type), eval(arg, nil)); |
|
|
|
++argn; |
|
|
|
} |
|
|
|
if (argn < argc) { // put varargs array in local variable called "..." |
|
|
|
oop etc = newArray(); |
|
|
|
while (argn < argc) Array_append(etc, eval(argv[argn++], nil)); |
|
|
|
defineVariable(s_etc, t_etc, etc); |
|
|
|
declareVariable(s_etc, t_etc, etc); |
|
|
|
} |
|
|
|
switch (nlrPush()) { // longjmp occurred |
|
|
|
case NLR_INIT: break; |
|
|
@ -1604,7 +1659,7 @@ oop apply(oop function, oop arguments, oop env) |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
void define(oop name, oop value) |
|
|
|
void declare(oop name, oop value) |
|
|
|
{ |
|
|
|
oop scope = Array_last(scopes); |
|
|
|
int index = Scope_find(scope, name); // searches active scope only |
|
|
@ -1622,7 +1677,7 @@ void define(oop name, oop value) |
|
|
|
break; |
|
|
|
} |
|
|
|
case Function: { // replace forard declaration with actual function |
|
|
|
Scope_redefine(name, value); |
|
|
|
Scope_redeclare(name, value); |
|
|
|
return; |
|
|
|
} |
|
|
|
default: |
|
|
@ -1649,47 +1704,14 @@ void define(oop name, oop value) |
|
|
|
Array_append(get(scope, Scope,values), value); |
|
|
|
} |
|
|
|
|
|
|
|
void defineTypeName(oop name, oop type) |
|
|
|
void declareVariable(oop name, oop type, oop value) |
|
|
|
{ |
|
|
|
define(name, newTypeName(name, type)); |
|
|
|
declare(name, newVariable(name, type, value)); |
|
|
|
} |
|
|
|
|
|
|
|
void defineVariable(oop name, oop type, oop value) |
|
|
|
void declarePrimitive(oop name, oop type, prim_t function) |
|
|
|
{ |
|
|
|
define(name, newVariable(name, type, value)); |
|
|
|
} |
|
|
|
|
|
|
|
void defineConstant(oop name, oop type, oop value) |
|
|
|
{ |
|
|
|
define(name, newConstant(name, type, value)); |
|
|
|
} |
|
|
|
|
|
|
|
void defineFunction(oop name, oop type, oop parameters, oop body) |
|
|
|
{ |
|
|
|
define(name, newFunction(name, type, parameters, body)); |
|
|
|
} |
|
|
|
|
|
|
|
void definePrimitive(oop name, oop type, prim_t function) |
|
|
|
{ |
|
|
|
define(name, newPrimitive(name, type, function)); |
|
|
|
} |
|
|
|
|
|
|
|
int VarDecls_finalise(oop vds) |
|
|
|
{ |
|
|
|
oop vars = get(vds, VarDecls,variables); |
|
|
|
if (nil == vars) { |
|
|
|
assert(nil == vars); |
|
|
|
oop base = get(vds, VarDecls,type ); |
|
|
|
oop decls = get(vds, VarDecls,declarations); |
|
|
|
vars = newArray(); |
|
|
|
Array_do(decls, decl) { |
|
|
|
oop name = makeName(decl); |
|
|
|
oop type = makeType(base, decl); |
|
|
|
Array_append(vars, newVariable(name, type, nil)); |
|
|
|
} |
|
|
|
set(vds, VarDecls,variables, vars); |
|
|
|
} |
|
|
|
return get(vars, Array,size); |
|
|
|
declare(name, newPrimitive(name, type, function)); |
|
|
|
} |
|
|
|
|
|
|
|
oop eval(oop exp, oop env) |
|
|
@ -1704,7 +1726,13 @@ oop eval(oop exp, oop env) |
|
|
|
oop value = Scope_lookup(exp); |
|
|
|
if (!value) fatal("'%s' is undefined\n", get(exp, Symbol,name)); |
|
|
|
if (isNil(value)) fatal("'%s' is uninitialised\n", get(exp, Symbol,name)); |
|
|
|
return value; |
|
|
|
switch (getType(value)) { |
|
|
|
case Variable: return get(value, Variable,value); |
|
|
|
case Function: return value; |
|
|
|
case Primitive: return value; |
|
|
|
default: fatal("cannot convert to value: %s", toString(value)); |
|
|
|
} |
|
|
|
break; |
|
|
|
} |
|
|
|
case Pair: assert(!"this cannot happen"); |
|
|
|
case String: return exp; |
|
|
@ -1867,16 +1895,65 @@ oop eval(oop exp, oop env) |
|
|
|
oop valu = nil; |
|
|
|
if (is(Tfunction, type)) continue; // function declaration |
|
|
|
if (!isNil(init)) valu = eval(init, nil); |
|
|
|
defineVariable(name, type, valu); |
|
|
|
declareVariable(name, type, valu); |
|
|
|
} |
|
|
|
return nil; |
|
|
|
break; |
|
|
|
} |
|
|
|
case Scope: break; |
|
|
|
case TypeName: break; |
|
|
|
case Variable: break; |
|
|
|
case Constant: break; |
|
|
|
case Function: return exp; |
|
|
|
case Function: break; |
|
|
|
} |
|
|
|
assert(!"this cannot happen"); |
|
|
|
return 0; |
|
|
|
} |
|
|
|
|
|
|
|
// pre-evaluate a top-level declaration, definition, or constant expression |
|
|
|
|
|
|
|
oop preval(oop exp) |
|
|
|
{ |
|
|
|
if (opt_v > 2) { printf("PREVAL "); println(exp); } |
|
|
|
switch (getType(exp)) { |
|
|
|
case Undefined: assert(!"this cannot happen"); |
|
|
|
case Input: assert(!"this cannot happen"); |
|
|
|
case Integer: assert(!"this cannot happen"); |
|
|
|
case Float: assert(!"this cannot happen"); |
|
|
|
case Symbol: assert(!"this cannot happen"); |
|
|
|
case Pair: assert(!"this cannot happen"); |
|
|
|
case String: assert(!"this cannot happen"); |
|
|
|
case Array: assert(!"this cannot happen"); |
|
|
|
case Primitive: assert(!"this cannot happen"); |
|
|
|
case Closure: assert(!"this cannot happen"); |
|
|
|
case Call: assert(!"this cannot happen"); |
|
|
|
case Block: assert(!"this cannot happen"); |
|
|
|
case Unary: assert(!"this cannot happen"); |
|
|
|
case Binary: assert(!"this cannot happen"); |
|
|
|
case Assign: assert(!"this cannot happen"); |
|
|
|
case Cast: assert(!"this cannot happen"); |
|
|
|
case While: assert(!"this cannot happen"); |
|
|
|
case For: assert(!"this cannot happen"); |
|
|
|
case If: assert(!"this cannot happen"); |
|
|
|
case Return: assert(!"this cannot happen"); |
|
|
|
case Continue: assert(!"this cannot happen"); |
|
|
|
case Break: assert(!"this cannot happen"); |
|
|
|
case Tbase: assert(!"this cannot happen"); |
|
|
|
case Tpointer: assert(!"this cannot happen"); |
|
|
|
case Tarray: assert(!"this cannot happen"); |
|
|
|
case Tstruct: assert(!"this cannot happen"); |
|
|
|
case Tfunction: assert(!"this cannot happen"); |
|
|
|
case VarDecls: { |
|
|
|
oop vars = get(exp, VarDecls,variables); |
|
|
|
Array_do(vars, var) assert(Scope_lookup(get(var, Variable,name))); |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case Scope: assert(!"this cannot happen"); |
|
|
|
case TypeName: assert(!"this cannot happen"); |
|
|
|
case Variable: assert(!"this cannot happen"); |
|
|
|
case Constant: assert(!"this cannot happen"); |
|
|
|
case Function: { |
|
|
|
assert(Scope_lookup(get(exp, Function,name))); |
|
|
|
return exp; |
|
|
|
} |
|
|
|
} |
|
|
|
assert(!"this cannot happen"); |
|
|
|
return 0; |
|
|
@ -2400,6 +2477,53 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
} |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case Unary: { |
|
|
|
oop rhs = typeCheck(get(exp, Unary,rhs), fntype); |
|
|
|
switch (get(exp, Unary,operator)) { |
|
|
|
case NEG: assert(!"unimplemented"); |
|
|
|
case NOT: assert(!"unimplemented"); |
|
|
|
case COM: assert(!"unimplemented"); |
|
|
|
case DEREF: assert(!"unimplemented"); |
|
|
|
case REF: return newTpointer(rhs); |
|
|
|
case PREINC: assert(!"unimplemented"); |
|
|
|
case PREDEC: assert(!"unimplemented"); |
|
|
|
case POSTINC: assert(!"unimplemented"); |
|
|
|
case POSTDEC: assert(!"unimplemented"); |
|
|
|
} |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case Binary: { |
|
|
|
oop lhs = typeCheck(get(exp, Binary,lhs), fntype); |
|
|
|
oop rhs = typeCheck(get(exp, Binary,rhs), fntype); |
|
|
|
switch (get(exp, Binary,operator)) { |
|
|
|
case INDEX: assert(!"unimplemented"); break; |
|
|
|
case MUL: assert(!"unimplemented"); break; |
|
|
|
case DIV: assert(!"unimplemented"); break; |
|
|
|
case MOD: assert(!"unimplemented"); break; |
|
|
|
case ADD: { |
|
|
|
if (lhs == rhs) { |
|
|
|
if (t_int == lhs) return lhs; |
|
|
|
} |
|
|
|
fatal("cannot add '%s' and '%s'", toString(lhs), toString(rhs)); |
|
|
|
break; |
|
|
|
} |
|
|
|
case SUB: assert(!"unimplemented"); break; |
|
|
|
case SHL: assert(!"unimplemented"); break; |
|
|
|
case SHR: assert(!"unimplemented"); break; |
|
|
|
case LT: assert(!"unimplemented"); break; |
|
|
|
case LE: assert(!"unimplemented"); break; |
|
|
|
case GE: assert(!"unimplemented"); break; |
|
|
|
case GT: assert(!"unimplemented"); break; |
|
|
|
case EQ: assert(!"unimplemented"); break; |
|
|
|
case NE: assert(!"unimplemented"); break; |
|
|
|
case BAND: assert(!"unimplemented"); break; |
|
|
|
case BXOR: assert(!"unimplemented"); break; |
|
|
|
case BOR: assert(!"unimplemented"); break; |
|
|
|
case LAND: assert(!"unimplemented"); break; |
|
|
|
case LOR: assert(!"unimplemented"); break; |
|
|
|
} |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case Primitive: { |
|
|
|
return get(exp, Primitive,type); |
|
|
|
} |
|
|
@ -2427,9 +2551,9 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
assert(isNil(fntype)); |
|
|
|
fntype = newTfunction(result, ptypes); |
|
|
|
set(exp, Function,type, fntype); |
|
|
|
define(name, exp); // add function to global scope so recursive calls will work |
|
|
|
declare(name, exp); // add function to global scope so recursive calls will work |
|
|
|
Scope_begin(); // parameters |
|
|
|
Array_do(parameters, param) define(get(param, Variable,name), param); |
|
|
|
Array_do(parameters, param) declare(get(param, Variable,name), param); |
|
|
|
typeCheck(body, fntype); // block |
|
|
|
Scope_end(); |
|
|
|
return nil; |
|
|
@ -2521,7 +2645,7 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
fatal("initialising %s (%s) with incompatible expression (%s)", |
|
|
|
toString(varname), toString(vartype), toString(initype)); |
|
|
|
} |
|
|
|
define(varname, var); |
|
|
|
declare(varname, var); |
|
|
|
} |
|
|
|
return nil; |
|
|
|
} |
|
|
@ -2554,8 +2678,8 @@ void replFile(char *name, FILE *file) |
|
|
|
} |
|
|
|
if (opt_v > 1) printf("---------------- typecheck\n"); |
|
|
|
typeCheck(yysval, nil); |
|
|
|
if (opt_v > 1) printf("---------------- eval\n"); |
|
|
|
result = eval(yysval, nil); |
|
|
|
if (opt_v > 1) printf("---------------- declare\n"); |
|
|
|
result = preval(yysval); |
|
|
|
nlrPop(); |
|
|
|
} |
|
|
|
if (opt_v > 0) { |
|
|
@ -2589,9 +2713,9 @@ int main(int argc, char **argv) |
|
|
|
|
|
|
|
Scope_begin(); // the global scope |
|
|
|
|
|
|
|
definePrimitive(intern("printf"), |
|
|
|
newTfunction(t_int, newArray2(t_string, t_etc)), |
|
|
|
prim_printf); |
|
|
|
declarePrimitive(intern("printf"), |
|
|
|
newTfunction(t_int, newArray2(t_string, t_etc)), |
|
|
|
prim_printf); |
|
|
|
|
|
|
|
int repls = 0; |
|
|
|
|
|
|
|