|
|
|
@ -1,6 +1,6 @@ |
|
|
|
# main.leg -- C parser + interpreter |
|
|
|
# |
|
|
|
# Last edited: 2025-01-26 12:13:05 by piumarta on zora |
|
|
|
# Last edited: 2025-01-26 21:27:29 by piumarta on zora |
|
|
|
|
|
|
|
%{ |
|
|
|
; |
|
|
|
@ -64,7 +64,7 @@ typedef union Object Object, *oop; |
|
|
|
_(Tvoid) _(Tchar) _(Tshort) _(Tint) _(Tlong) _(Tfloat) _(Tdouble) \ |
|
|
|
_(Tpointer) _(Tarray) _(Tstruct) _(Tfunction) _(Tetc) \ |
|
|
|
_(Scope) _(TypeName) _(Variable) _(Constant) _(Function) _(Primitive) \ |
|
|
|
_(VarDecls) |
|
|
|
_(VarDecls) _(TypeDecls) |
|
|
|
|
|
|
|
#define _do_unaries(_) \ |
|
|
|
_(NEG) _(NOT) _(COM) _(PREINC) _(PREDEC) _(POSTINC) _(POSTDEC) |
|
|
|
@ -101,6 +101,8 @@ char *binaryName(int op) { |
|
|
|
|
|
|
|
typedef oop (* prim_t)(int nargs, oop *arguments, oop environment); |
|
|
|
|
|
|
|
typedef oop (*cvt_t)(oop input); |
|
|
|
|
|
|
|
struct Undefined { type_t _type; }; |
|
|
|
struct Input { type_t _type; char *name; FILE *file; oop next; }; |
|
|
|
struct Integer { type_t _type; long value; }; |
|
|
|
@ -118,7 +120,7 @@ struct Dereference { type_t _type; oop rhs; }; |
|
|
|
struct Unary { type_t _type; unary_t operator; oop rhs; }; |
|
|
|
struct Binary { type_t _type; binary_t operator; oop lhs, rhs; }; |
|
|
|
struct Assign { type_t _type; oop lhs, rhs; }; |
|
|
|
struct Cast { type_t _type; oop type, rhs; }; |
|
|
|
struct Cast { type_t _type; oop type, rhs; cvt_t converter; }; |
|
|
|
struct While { type_t _type; oop condition, expression; }; |
|
|
|
struct For { type_t _type; oop initialiser, condition, update, body; }; |
|
|
|
struct If { type_t _type; oop condition, consequent, alternate; }; |
|
|
|
@ -145,7 +147,8 @@ struct Variable { type_t _type; oop name, type, value; }; |
|
|
|
struct Constant { type_t _type; oop name, type, value; }; |
|
|
|
struct Function { type_t _type; oop name, type, parameters, body, *code; int variadic; }; |
|
|
|
struct Primitive { type_t _type; oop name, type, parameters; prim_t function; int variadic; }; |
|
|
|
struct VarDecls { type_t _type; oop type, declarations, variables; }; |
|
|
|
struct VarDecls { type_t _type; oop type, variables; }; |
|
|
|
struct TypeDecls { type_t _type; oop type, typenames; }; |
|
|
|
|
|
|
|
union Object |
|
|
|
{ |
|
|
|
@ -595,7 +598,16 @@ oop newBinary(binary_t operator, oop lhs, oop rhs) |
|
|
|
} |
|
|
|
|
|
|
|
CTOR2(Assign, lhs, rhs); |
|
|
|
CTOR2(Cast, type, rhs); |
|
|
|
|
|
|
|
oop newCast(oop type, oop rhs) |
|
|
|
{ |
|
|
|
oop obj = new(Cast); |
|
|
|
obj->Cast.type = type; |
|
|
|
obj->Cast.rhs = rhs; |
|
|
|
obj->Cast.converter = 0; |
|
|
|
return obj; |
|
|
|
} |
|
|
|
|
|
|
|
CTOR2(While, condition, expression); |
|
|
|
CTOR4(For, initialiser, condition, update, body); |
|
|
|
CTOR3(If, condition, consequent, alternate); |
|
|
|
@ -633,6 +645,7 @@ oop t_void = 0; |
|
|
|
oop t_char = 0; |
|
|
|
oop t_short = 0; |
|
|
|
oop t_int = 0; |
|
|
|
oop t_long = 0; |
|
|
|
oop t_float = 0; |
|
|
|
oop t_double = 0; |
|
|
|
oop t_string = 0; |
|
|
|
@ -790,25 +803,6 @@ oop newPrimitive(oop name, oop type, oop parameters, prim_t function) |
|
|
|
return obj; |
|
|
|
} |
|
|
|
|
|
|
|
oop makeType(oop base, oop decl); |
|
|
|
|
|
|
|
oop makeTypes(oop declarations) |
|
|
|
{ |
|
|
|
int size = get(declarations, Array,size); |
|
|
|
oop *elts = get(declarations, Array,elements); |
|
|
|
oop types = newArray(); |
|
|
|
for (int i = 0; i < size; ++i) { |
|
|
|
oop vdecl = elts[i]; |
|
|
|
oop type = get(vdecl, VarDecls,type); |
|
|
|
oop decls = get(vdecl, VarDecls,declarations); |
|
|
|
int dsize = get(decls, Array,size); |
|
|
|
oop *delts = get(decls, Array,elements); |
|
|
|
for (int j = 0; j < dsize; ++j) |
|
|
|
Array_append(types, makeType(type, delts[j])); |
|
|
|
} |
|
|
|
return types; |
|
|
|
} |
|
|
|
|
|
|
|
oop makeType(oop base, oop type) |
|
|
|
{ |
|
|
|
switch (getType(type)) { |
|
|
|
@ -840,25 +834,45 @@ oop makeName(oop decl) |
|
|
|
return 0; |
|
|
|
} |
|
|
|
|
|
|
|
oop makeBaseType(oop type) |
|
|
|
{ |
|
|
|
if (is(Symbol, type)) { |
|
|
|
oop value = Scope_lookup(type); |
|
|
|
if (!value || !is(TypeName, value)) |
|
|
|
fatal("identifier '%s' does not name a type", type); |
|
|
|
type = get(value, TypeName,type); |
|
|
|
} |
|
|
|
return type; |
|
|
|
} |
|
|
|
|
|
|
|
void VarDecls_append(oop vds, oop decl) |
|
|
|
{ |
|
|
|
oop val = is(Assign, decl) ? get(decl, Assign,rhs) : nil; |
|
|
|
oop type = makeType(get(vds, VarDecls,type), decl); |
|
|
|
oop name = makeName(decl); |
|
|
|
Array_append(get(vds, VarDecls,declarations), decl); |
|
|
|
Array_append(get(vds, VarDecls,variables), newVariable(name, type, val)); |
|
|
|
Array_append(get(vds, VarDecls,variables), decl); |
|
|
|
} |
|
|
|
|
|
|
|
oop newVarDecls(oop type, oop decl) |
|
|
|
{ |
|
|
|
oop obj = new(VarDecls); |
|
|
|
obj->VarDecls.type = type; |
|
|
|
obj->VarDecls.declarations = newArray(); |
|
|
|
obj->VarDecls.variables = newArray(); |
|
|
|
VarDecls_append(obj, decl); |
|
|
|
return obj; |
|
|
|
} |
|
|
|
|
|
|
|
void TypeDecls_append(oop tds, oop decl) |
|
|
|
{ |
|
|
|
Array_append(get(tds, TypeDecls,typenames), decl); |
|
|
|
} |
|
|
|
|
|
|
|
oop newTypeDecls(oop type, oop decl) |
|
|
|
{ |
|
|
|
oop obj = new(TypeDecls); |
|
|
|
obj->TypeDecls.type = type; |
|
|
|
obj->TypeDecls.typenames = newArray(); |
|
|
|
TypeDecls_append(obj, decl); |
|
|
|
return obj; |
|
|
|
} |
|
|
|
|
|
|
|
#undef CTOR4 |
|
|
|
#undef CTOR3 |
|
|
|
#undef CTOR2 |
|
|
|
@ -868,6 +882,12 @@ oop newVarDecls(oop type, oop decl) |
|
|
|
oop baseType(oop type) |
|
|
|
{ |
|
|
|
switch (getType(type)) { |
|
|
|
case Symbol: { |
|
|
|
oop value = Scope_lookup(type); |
|
|
|
if (!value || !is(TypeName, value)) |
|
|
|
fatal("baseType: '%s' does not name a type"); |
|
|
|
return baseType(get(value, TypeName,type)); |
|
|
|
} |
|
|
|
case Tvoid: |
|
|
|
case Tchar: |
|
|
|
case Tshort: |
|
|
|
@ -888,13 +908,22 @@ oop toStringOn(oop obj, oop str); |
|
|
|
void declareStringOn(oop type, oop name, oop str) |
|
|
|
{ |
|
|
|
switch (getType(type)) { |
|
|
|
case Tvoid: String_format(str, "void"); break; |
|
|
|
case Tchar: String_format(str, "char"); break; |
|
|
|
case Tshort: String_format(str, "short"); break; |
|
|
|
case Tint: String_format(str, "int"); break; |
|
|
|
case Tlong: String_format(str, "long"); break; |
|
|
|
case Tfloat: String_format(str, "float"); break; |
|
|
|
case Tdouble: String_format(str, "double"); break; |
|
|
|
case Symbol: { |
|
|
|
oop value = Scope_lookup(type); |
|
|
|
if (!value || !is(TypeName, value)) |
|
|
|
fatal("declareString: '%s' does not name a type"); |
|
|
|
declareStringOn(get(value, TypeName,type), name, str); |
|
|
|
return; |
|
|
|
} |
|
|
|
case Tvoid: |
|
|
|
case Tchar: |
|
|
|
case Tshort: |
|
|
|
case Tint: |
|
|
|
case Tlong: |
|
|
|
case Tfloat: |
|
|
|
case Tdouble: |
|
|
|
toStringOn(name, str); |
|
|
|
break; |
|
|
|
case Tpointer: |
|
|
|
String_append(str, '*'); |
|
|
|
declareStringOn(get(type, Tpointer,target), name, str); |
|
|
|
@ -1113,12 +1142,18 @@ oop toStringOn(oop obj, oop str) |
|
|
|
case VarDecls: { |
|
|
|
oop vars = get(obj, VarDecls,variables); |
|
|
|
oop base = get(obj, VarDecls,type); |
|
|
|
oop decls = get(obj, VarDecls,declarations); |
|
|
|
Array_do(decls, decl) { |
|
|
|
Array_do(vars, var) { |
|
|
|
if (do_index) String_appendAll(str, ", ", 2); |
|
|
|
toStringOn(decl, str); |
|
|
|
String_append(str, ' '); |
|
|
|
toStringOn(base, str); |
|
|
|
toStringOn(var, str); |
|
|
|
} |
|
|
|
break; |
|
|
|
} |
|
|
|
case TypeDecls: { |
|
|
|
oop types = get(obj, TypeDecls,typenames); |
|
|
|
oop base = get(obj, TypeDecls,type); |
|
|
|
Array_do(types, type) { |
|
|
|
if (do_index) String_appendAll(str, ", ", 2); |
|
|
|
toStringOn(type, str); |
|
|
|
} |
|
|
|
break; |
|
|
|
} |
|
|
|
@ -1295,14 +1330,14 @@ void printiln(oop obj, int indent) |
|
|
|
printf("BREAK\n"); |
|
|
|
break; |
|
|
|
} |
|
|
|
case Tvoid: printf("<void:1>"); break; |
|
|
|
case Tchar: printf("<char:1>"); break; |
|
|
|
case Tshort: printf("<short:2>"); break; |
|
|
|
case Tint: printf("<int:4>"); break; |
|
|
|
case Tlong: printf("<long:8>"); break; |
|
|
|
case Tfloat: printf("<float:4>"); break; |
|
|
|
case Tdouble: printf("<double:8>"); break; |
|
|
|
case Tetc: printf("<...>"); break; |
|
|
|
case Tvoid: printf("<void:1>\n"); break; |
|
|
|
case Tchar: printf("<char:1>\n"); break; |
|
|
|
case Tshort: printf("<short:2>\n"); break; |
|
|
|
case Tint: printf("<int:4>\n"); break; |
|
|
|
case Tlong: printf("<long:8>\n"); break; |
|
|
|
case Tfloat: printf("<float:4>\n"); break; |
|
|
|
case Tdouble: printf("<double:8>\n"); break; |
|
|
|
case Tetc: printf("<...>\n"); break; |
|
|
|
case Tpointer: { |
|
|
|
printf("Tpointer\n"); |
|
|
|
printiln(get(obj, Tpointer,target), indent+1); |
|
|
|
@ -1329,10 +1364,15 @@ void printiln(oop obj, int indent) |
|
|
|
case VarDecls: { |
|
|
|
printf("VarDecls\n"); |
|
|
|
printiln(get(obj, VarDecls,type ), indent+1); |
|
|
|
printiln(get(obj, VarDecls,declarations), indent+1); |
|
|
|
printiln(get(obj, VarDecls,variables ), indent+1); |
|
|
|
break; |
|
|
|
} |
|
|
|
case TypeDecls: { |
|
|
|
printf("TypeDecls\n"); |
|
|
|
printiln(get(obj, TypeDecls,type ), indent+1); |
|
|
|
printiln(get(obj, TypeDecls,typenames ), indent+1); |
|
|
|
break; |
|
|
|
} |
|
|
|
case Scope: { |
|
|
|
printf("SCOPE "); |
|
|
|
oop names = get(obj, Scope,names); |
|
|
|
@ -1454,16 +1494,26 @@ include = HASH INCLUDE ( |
|
|
|
| '"' < [a-zA-Z0-9_.]* > '"' @{ pushInput(yytext, usrOpen(yytext)) } |
|
|
|
) |
|
|
|
|
|
|
|
tldecl = fundefn | primdef | vardecl |
|
|
|
tldecl = typedec | fundefn | primdef | vardecl |
|
|
|
|
|
|
|
typedec = TYPEDEF |
|
|
|
t:tname d:decltor { d = newTypeDecls(t, d) } |
|
|
|
( COMMA e:decltor { TypeDecls_append(d, e) } |
|
|
|
)* SEMI { $$ = d } |
|
|
|
|
|
|
|
vardecl = t:tname d:inidecl { d = newVarDecls(t, d) } |
|
|
|
( COMMA e:inidecl { VarDecls_append(d, e) } |
|
|
|
)* SEMI { $$ = d } |
|
|
|
|
|
|
|
tname = INT { $$ = t_int } |
|
|
|
tname = VOID { $$ = t_void } |
|
|
|
| CHAR { $$ = t_char } |
|
|
|
| VOID { $$ = t_void } |
|
|
|
| SHORT { $$ = t_short } |
|
|
|
| INT { $$ = t_int } |
|
|
|
| LONG { $$ = t_long } |
|
|
|
| FLOAT { $$ = t_float } |
|
|
|
| DOUBLE { $$ = t_double } |
|
|
|
| struct |
|
|
|
| id |
|
|
|
|
|
|
|
struct = STRUCT ( i:id m:members { $$ = newTstruct( i, m) } |
|
|
|
| i:id { $$ = newTstruct(nil, m) } |
|
|
|
@ -1498,7 +1548,7 @@ params = LPAREN a:mkArray |
|
|
|
| e:error { expected(e, "parameter declaration") } |
|
|
|
) |
|
|
|
|
|
|
|
pdecl = t:tname d:decltor { $$ = newVariable(makeName(d), makeType(t, d), nil) } |
|
|
|
pdecl = t:tname d:decltor { $$ = newVariable(d, t, nil) } |
|
|
|
|
|
|
|
initor = agrinit | expr |
|
|
|
|
|
|
|
@ -1508,14 +1558,14 @@ agrinit = LBRACE i:mkArray |
|
|
|
)* COMMA? )? RBRACE { $$ = i } |
|
|
|
|
|
|
|
fundefn = t:tname d:funid |
|
|
|
p:params b:block { $$ = newFunction(makeName(d), makeType(t, d), p, b) } |
|
|
|
p:params b:block { $$ = newFunction(d, t, p, b) } |
|
|
|
|
|
|
|
funid = STAR d:funid { $$ = newTpointer(d) } |
|
|
|
| LPAREN d:funid RPAREN { $$ = d } |
|
|
|
| id |
|
|
|
|
|
|
|
primdef = EXTERN t:tname d:funid |
|
|
|
p:params SEMI { $$ = newPrimitive(makeName(d), makeType(t, d), p, 0) } |
|
|
|
p:params SEMI { $$ = newPrimitive(d, t, p, 0) } |
|
|
|
|
|
|
|
block = LBRACE b:mkArray |
|
|
|
( s:stmt { Array_append(b, s) } |
|
|
|
@ -1525,7 +1575,7 @@ block = LBRACE b:mkArray |
|
|
|
|
|
|
|
stmt = WHILE c:cond s:stmt { $$ = newWhile(c, s) } |
|
|
|
| FOR LPAREN |
|
|
|
( i:vardecl | i:expropt SEMI ) |
|
|
|
( i:expropt SEMI | i:vardecl ) |
|
|
|
c:expropt SEMI u:expropt RPAREN |
|
|
|
b:stmt { $$ = newFor(i, c, u, b) } |
|
|
|
| IF c:cond s:stmt |
|
|
|
@ -1659,7 +1709,7 @@ idopt = id | { $$ = nil } |
|
|
|
|
|
|
|
id = !keyword < alpha alnum* > - { $$ = intern(yytext) } |
|
|
|
|
|
|
|
keyword = EXTERN | VOID | CHAR | INT | STRUCT |
|
|
|
keyword = EXTERN | TYPEDEF | VOID | CHAR | SHORT | INT | LONG | FLOAT | DOUBLE | STRUCT |
|
|
|
| IF | ELSE | WHILE | FOR | RETURN | CONTINU | BREAK |
|
|
|
|
|
|
|
alpha = [a-zA-Z_] |
|
|
|
@ -1672,9 +1722,14 @@ comment = "//" < (![\n\r] .)* > |
|
|
|
|
|
|
|
INCLUDE = "include" ![_a-zA-Z0-9] - |
|
|
|
EXTERN = "extern" ![_a-zA-Z0-9] - |
|
|
|
TYPEDEF = "typedef" ![_a-zA-Z0-9] - |
|
|
|
VOID = "void" ![_a-zA-Z0-9] - |
|
|
|
CHAR = "char" ![_a-zA-Z0-9] - |
|
|
|
SHORT = "short" ![_a-zA-Z0-9] - |
|
|
|
INT = "int" ![_a-zA-Z0-9] - |
|
|
|
LONG = "long" ![_a-zA-Z0-9] - |
|
|
|
FLOAT = "float" ![_a-zA-Z0-9] - |
|
|
|
DOUBLE = "double" ![_a-zA-Z0-9] - |
|
|
|
STRUCT = "struct" ![_a-zA-Z0-9] - |
|
|
|
# UNION = "union" ![_a-zA-Z0-9] - |
|
|
|
# ENUM = "enum" ![_a-zA-Z0-9] - |
|
|
|
@ -1759,7 +1814,7 @@ oop nlrPop(void) |
|
|
|
#define isFalse(O) (false == (O)) |
|
|
|
#define isTrue(O) (true == (O)) |
|
|
|
|
|
|
|
void declareVariable(oop name, oop type, oop value); |
|
|
|
oop declareVariable(oop name, oop type, oop value); |
|
|
|
|
|
|
|
oop apply(oop function, oop arguments, oop env) |
|
|
|
{ |
|
|
|
@ -1815,7 +1870,7 @@ oop apply(oop function, oop arguments, oop env) |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
void declare(oop name, oop value) |
|
|
|
oop declare(oop name, oop value) |
|
|
|
{ |
|
|
|
oop scope = Array_last(scopes); |
|
|
|
int index = Scope_find(scope, name); // searches active scope only |
|
|
|
@ -1828,13 +1883,13 @@ void declare(oop name, oop value) |
|
|
|
switch (getType(value)) { |
|
|
|
case Variable: { |
|
|
|
oop valtype = get(value, Variable,type); |
|
|
|
if (oldtype == valtype) return; // function declaration |
|
|
|
if (oldtype == valtype) return value; // function declaration |
|
|
|
printf("FUNCTION FORWARD TYPE MISMATCH 1\n"); |
|
|
|
break; |
|
|
|
} |
|
|
|
case Function: { // replace forard declaration with actual function |
|
|
|
Scope_redeclare(name, value); |
|
|
|
return; |
|
|
|
return value; |
|
|
|
} |
|
|
|
default: |
|
|
|
break; |
|
|
|
@ -1846,7 +1901,7 @@ void declare(oop name, oop value) |
|
|
|
if (is(Variable, value)) { |
|
|
|
oop oldtype = get(old, Function,type); |
|
|
|
oop valtype = get(old, Variable,type); |
|
|
|
if (oldtype == valtype) return; // compatible redeclaration |
|
|
|
if (oldtype == valtype) return value; // compatible redeclaration |
|
|
|
printf("FUNCTION FORWARD TYPE MISMATCH 2\n"); |
|
|
|
} |
|
|
|
break; |
|
|
|
@ -1858,16 +1913,44 @@ void declare(oop name, oop value) |
|
|
|
} |
|
|
|
Array_append(get(scope, Scope,names ), name ); |
|
|
|
Array_append(get(scope, Scope,values), value); |
|
|
|
return value; |
|
|
|
} |
|
|
|
|
|
|
|
oop declareVariable(oop name, oop type, oop value) |
|
|
|
{ |
|
|
|
return declare(name, newVariable(name, type, value)); |
|
|
|
} |
|
|
|
|
|
|
|
void declareVariable(oop name, oop type, oop value) |
|
|
|
oop declareType(oop name, oop type) |
|
|
|
{ |
|
|
|
declare(name, newVariable(name, type, value)); |
|
|
|
return declare(name, newTypeName(name, type)); |
|
|
|
} |
|
|
|
|
|
|
|
void declarePrimitive(oop name, oop type, oop parameters, prim_t function) |
|
|
|
oop declarePrimitive(oop name, oop type, oop parameters, prim_t function) |
|
|
|
{ |
|
|
|
declare(name, newPrimitive(name, type, parameters, function)); |
|
|
|
return declare(name, newPrimitive(name, type, parameters, function)); |
|
|
|
} |
|
|
|
|
|
|
|
oop cvt_(oop obj) { return obj; } |
|
|
|
oop cvtI(oop obj) { return newInteger((int)_integerValue(obj)); } |
|
|
|
|
|
|
|
cvt_t converter(int tfrom, int tto) |
|
|
|
{ |
|
|
|
static cvt_t converters[9][9] = { |
|
|
|
/* void char short int long float double pointer array <- FROM TO -v */ |
|
|
|
{ 0, 0, 0, 0, 0, 0, 0, 0, 0 }, // void |
|
|
|
{ 0, 0, 0, 0, 0, 0, 0, 0, 0 }, // char |
|
|
|
{ 0, 0, 0, 0, 0, 0, 0, 0, 0 }, // short |
|
|
|
{ 0, 0, 0, cvtI, cvtI, 0, 0, 0, 0 }, // int |
|
|
|
{ 0, 0, 0, cvtI, 0, 0, 0, cvt_, 0 }, // long |
|
|
|
{ 0, 0, 0, 0, 0, 0, 0, 0, 0 }, // float |
|
|
|
{ 0, 0, 0, 0, 0, 0, 0, 0, 0 }, // double |
|
|
|
{ 0, 0, 0, 0, cvt_, 0, 0, cvt_, 0 }, // pointer |
|
|
|
{ 0, 0, 0, 0, 0, 0, 0, 0, 0 }, // array |
|
|
|
}; |
|
|
|
if (tfrom < Tvoid || tfrom > Tarray) return 0; |
|
|
|
if (tto < Tvoid || tto > Tarray) return 0; |
|
|
|
return converters[tto - Tvoid][tfrom - Tvoid]; |
|
|
|
} |
|
|
|
|
|
|
|
oop incr(oop val, int amount) |
|
|
|
@ -2108,27 +2191,9 @@ oop eval(oop exp, oop env) |
|
|
|
break; |
|
|
|
} |
|
|
|
case Cast: { |
|
|
|
oop lhs = get(exp, Cast,type); |
|
|
|
oop rhs = eval(get(exp, Cast,rhs), nil); |
|
|
|
switch (getType(rhs)) { |
|
|
|
case Integer: |
|
|
|
case Float: { |
|
|
|
switch (getType(lhs)) { |
|
|
|
case Tchar: return newInteger( (char)integerValue(rhs)); |
|
|
|
case Tshort: return newInteger( (short)integerValue(rhs)); |
|
|
|
case Tint: return newInteger( ( int)integerValue(rhs)); |
|
|
|
case Tlong: return newInteger( (long)integerValue(rhs)); |
|
|
|
case Tfloat: return newInteger( (float)floatValue(rhs)); |
|
|
|
case Tdouble: return newInteger((double)floatValue(rhs)); |
|
|
|
default: break; |
|
|
|
} |
|
|
|
break; |
|
|
|
} |
|
|
|
default: |
|
|
|
break; |
|
|
|
} |
|
|
|
fatal("cannot convert '%s' to '%s'", toString(rhs), toString(lhs)); |
|
|
|
break; |
|
|
|
cvt_t cvt = get(exp, Cast,converter); assert(cvt); |
|
|
|
oop rhs = eval(get(exp, Cast,rhs), nil); |
|
|
|
return cvt(rhs); |
|
|
|
} |
|
|
|
case While: { |
|
|
|
oop cond = get(exp, While,condition); |
|
|
|
@ -2203,6 +2268,15 @@ oop eval(oop exp, oop env) |
|
|
|
} |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case TypeDecls: { |
|
|
|
oop types = get(exp, TypeDecls,typenames); |
|
|
|
Array_do(types, type) { |
|
|
|
oop name = get(type, TypeName,name); |
|
|
|
oop type = get(type, TypeName,type); |
|
|
|
declareType(name, type); |
|
|
|
} |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case Scope: break; |
|
|
|
case TypeName: break; |
|
|
|
case Variable: break; |
|
|
|
@ -2265,6 +2339,13 @@ oop preval(oop exp) |
|
|
|
} |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case TypeDecls: { |
|
|
|
oop types = get(exp, TypeDecls,typenames); |
|
|
|
Array_do(types, type) { |
|
|
|
assert(Scope_lookup(get(type, TypeName,name))); |
|
|
|
} |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case Scope: break; |
|
|
|
case TypeName: break; |
|
|
|
case Variable: break; |
|
|
|
@ -2274,6 +2355,7 @@ oop preval(oop exp) |
|
|
|
return exp; |
|
|
|
} |
|
|
|
} |
|
|
|
println(exp); |
|
|
|
assert(!"this cannot happen"); |
|
|
|
return 0; |
|
|
|
} |
|
|
|
@ -2313,6 +2395,9 @@ oop prim_printf(int argc, oop *argv, oop env) // array |
|
|
|
} |
|
|
|
case 'p': { |
|
|
|
switch (getType(arg)) { |
|
|
|
case Integer: |
|
|
|
n += printf("%p", (void *)(intptr_t)_integerValue(arg)); |
|
|
|
continue; |
|
|
|
case Reference: |
|
|
|
n += printf("%p", get(arg, Reference,target)); |
|
|
|
continue; |
|
|
|
@ -2796,6 +2881,7 @@ void compileOn(oop exp, oop program, oop cs, oop bs) |
|
|
|
case Tfunction: assert(!"unimplemented"); return; |
|
|
|
case Tetc: assert(!"unimplemented"); return; |
|
|
|
case VarDecls: assert(!"unimplemented"); return; |
|
|
|
case TypeDecls: assert(!"unimplemented"); return; |
|
|
|
case Scope: assert(!"this cannot happen"); return; |
|
|
|
case TypeName: assert(!"unimplemented"); return; |
|
|
|
case Variable: assert(!"unimplemented"); return; |
|
|
|
@ -2877,39 +2963,15 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
return get(rhs, Tpointer,target); |
|
|
|
} |
|
|
|
case Cast: { |
|
|
|
oop lhs = get(exp, Cast,type); |
|
|
|
oop lhs = makeBaseType(get(exp, Cast,type)); |
|
|
|
set(exp, Cast,type, lhs); |
|
|
|
oop rhs = typeCheck(get(exp, Cast,rhs), fntype); |
|
|
|
type_t lht = getType(lhs), rht = getType(rhs); |
|
|
|
switch (lht) { |
|
|
|
case Tlong: if (Tpointer == rht) return lhs; |
|
|
|
case Tchar: |
|
|
|
case Tshort: |
|
|
|
case Tint: |
|
|
|
case Tfloat: |
|
|
|
case Tdouble: { |
|
|
|
switch (rht) { |
|
|
|
case Tchar: |
|
|
|
case Tshort: |
|
|
|
case Tint: |
|
|
|
case Tlong: |
|
|
|
case Tfloat: |
|
|
|
case Tdouble: return lhs; |
|
|
|
default: break; |
|
|
|
} |
|
|
|
break; |
|
|
|
} |
|
|
|
case Tpointer: { |
|
|
|
switch (rht) { |
|
|
|
case Tpointer: |
|
|
|
case Tlong: return lhs; |
|
|
|
default: break; |
|
|
|
} |
|
|
|
break; |
|
|
|
} |
|
|
|
default: break; |
|
|
|
} |
|
|
|
fatal("cannot convert '%s' to '%s'", toString(lhs), toString(rhs)); |
|
|
|
return nil; |
|
|
|
cvt_t cvt = converter(rht, lht); |
|
|
|
if (!cvt) |
|
|
|
fatal("cannot convert '%s' to '%s'", toString(rhs), toString(lhs)); |
|
|
|
set(exp, Cast,converter, cvt); |
|
|
|
return lhs; |
|
|
|
} |
|
|
|
case Unary: { |
|
|
|
oop rhs = typeCheck(get(exp, Unary,rhs), fntype); |
|
|
|
@ -2991,21 +3053,28 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case Primitive: { |
|
|
|
oop result = get(exp, Primitive,type ); |
|
|
|
oop type = get(exp, Primitive,type ); |
|
|
|
oop name = get(exp, Primitive,name ); |
|
|
|
oop parameters = get(exp, Primitive,parameters); |
|
|
|
oop ptypes = newArray(); |
|
|
|
if (t_etc == Array_last(parameters)) { |
|
|
|
oop result = makeType(type, name); |
|
|
|
name = makeName(name); |
|
|
|
set(exp, Primitive,name, name); |
|
|
|
set(exp, Primitive,type, result); |
|
|
|
if (Array_size(parameters) && t_etc == Array_last(parameters)) { |
|
|
|
Array_popLast(parameters); |
|
|
|
set(exp, Primitive,variadic, 1); |
|
|
|
} |
|
|
|
Array_do(parameters, var) { |
|
|
|
oop type = get(var, Variable,type); |
|
|
|
if (t_void == type && (do_index || do_size > 1)) |
|
|
|
oop ptype = makeBaseType(get(var, Variable,type)); |
|
|
|
if (t_void == ptype && (do_index || do_size > 1)) |
|
|
|
fatal("illegal void parameter"); |
|
|
|
else { |
|
|
|
Array_append(ptypes, type); |
|
|
|
} |
|
|
|
oop pname = get(var, Variable,name); |
|
|
|
ptype = makeType(ptype, pname); |
|
|
|
pname = makeName(pname); |
|
|
|
set(var, Variable,name, pname); |
|
|
|
set(var, Variable,type, ptype); |
|
|
|
Array_append(ptypes, ptype); |
|
|
|
} |
|
|
|
if (1 == Array_size(ptypes) && Array_last(ptypes) == t_void) { |
|
|
|
Array_popLast(ptypes); |
|
|
|
@ -3022,22 +3091,29 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case Function: { |
|
|
|
oop result = get(exp, Function,type ); |
|
|
|
oop type = makeBaseType(get(exp, Function,type)); |
|
|
|
oop name = get(exp, Function,name ); |
|
|
|
oop parameters = get(exp, Function,parameters); |
|
|
|
oop body = get(exp, Function,body ); |
|
|
|
oop ptypes = newArray(); |
|
|
|
oop result = makeType(type, name); |
|
|
|
name = makeName(name); |
|
|
|
set(exp, Function,name, name); |
|
|
|
set(exp, Function,type, result); |
|
|
|
if (Array_size(parameters) && t_etc == Array_last(parameters)) { |
|
|
|
Array_popLast(parameters); |
|
|
|
set(exp, Function,variadic, 1); |
|
|
|
} |
|
|
|
Array_do(parameters, var) { |
|
|
|
oop type = get(var, Variable,type); |
|
|
|
if (t_void == type && (do_index || do_size > 1)) |
|
|
|
oop ptype = makeBaseType(get(var, Variable,type)); |
|
|
|
if (t_void == ptype && (do_index || do_size > 1)) |
|
|
|
fatal("illegal void parameter"); |
|
|
|
else { |
|
|
|
Array_append(ptypes, type); |
|
|
|
} |
|
|
|
oop pname = get(var, Variable,name); |
|
|
|
ptype = makeType(ptype, pname); |
|
|
|
pname = makeName(pname); |
|
|
|
set(var, Variable,name, pname); |
|
|
|
set(var, Variable,type, ptype); |
|
|
|
Array_append(ptypes, ptype); |
|
|
|
} |
|
|
|
if (1 == Array_size(ptypes) && Array_last(ptypes) == t_void) { |
|
|
|
Array_popLast(ptypes); |
|
|
|
@ -3096,11 +3172,17 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
return result; |
|
|
|
} |
|
|
|
case VarDecls: { |
|
|
|
oop vars = get(exp, VarDecls,variables); |
|
|
|
Array_do(vars, var) { |
|
|
|
oop varname = get(var, Variable,name); |
|
|
|
oop vartype = get(var, Variable,type); |
|
|
|
oop varval = get(var, Variable,value); |
|
|
|
oop base = makeBaseType(get(exp, VarDecls,type)); |
|
|
|
oop decls = get(exp, VarDecls,variables); |
|
|
|
oop vars = newArray(); |
|
|
|
Array_do(decls, decl) { |
|
|
|
oop init = nil; |
|
|
|
if (is(Assign, decl)) { |
|
|
|
init = get(decl, Assign,rhs); |
|
|
|
decl = get(decl, Assign,lhs); |
|
|
|
} |
|
|
|
oop varname = makeName(decl); |
|
|
|
oop vartype = makeType(base, decl); |
|
|
|
if (is(Tfunction, vartype)) { |
|
|
|
oop ptypes = get(vartype, Tfunction,parameters); |
|
|
|
if (1 == Array_size(ptypes) && t_void == Array_last(ptypes)) { |
|
|
|
@ -3118,7 +3200,7 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
if (oldtype == vartype) { // identical declarations |
|
|
|
oop oldval = get(old, Variable,value); |
|
|
|
if (isNil(fntype)) // global declarations |
|
|
|
if (isNil(varval) || isNil(oldval)) // at most one initialiser |
|
|
|
if (isNil(init) || isNil(oldval)) // at most one initialiser |
|
|
|
continue; // redeclaration is permitted |
|
|
|
fatal("multiple definiton of variable '%s'", toString(varname)); |
|
|
|
} |
|
|
|
@ -3135,14 +3217,49 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
declareString(oldtype, varname), |
|
|
|
declareString(vartype, varname)); |
|
|
|
} |
|
|
|
if (!isNil(varval)) { |
|
|
|
oop initype = typeCheck(varval, fntype); |
|
|
|
if (initype != vartype) |
|
|
|
fatal("initialising %s (%s) with incompatible expression (%s)", |
|
|
|
if (!isNil(init)) { |
|
|
|
oop initype = typeCheck(init, fntype); |
|
|
|
cvt_t cvt = converter(getType(initype), getType(vartype)); |
|
|
|
if (!cvt) { |
|
|
|
fatal("initialising '%s': cannot convert '%s' to '%s'", |
|
|
|
toString(varname), toString(vartype), toString(initype)); |
|
|
|
} |
|
|
|
} |
|
|
|
oop var = declareVariable(varname, vartype, init); |
|
|
|
Array_append(vars, var); |
|
|
|
} |
|
|
|
set(exp, VarDecls,variables, vars); |
|
|
|
return nil; |
|
|
|
} |
|
|
|
case TypeDecls: { |
|
|
|
oop base = makeBaseType(get(exp, TypeDecls,type)); |
|
|
|
oop decls = get(exp, TypeDecls,typenames); |
|
|
|
oop typenames = newArray(); |
|
|
|
Array_do(decls, decl) { |
|
|
|
oop name = makeName(decl); |
|
|
|
oop type = makeType(base, decl); |
|
|
|
if (is(Tfunction, type)) { |
|
|
|
oop ptypes = get(type, Tfunction,parameters); |
|
|
|
if (1 == Array_size(ptypes) && t_void == Array_last(ptypes)) { |
|
|
|
Array_popLast(ptypes); |
|
|
|
type = newTfunction(get(type, Tfunction,result), ptypes); |
|
|
|
} |
|
|
|
} |
|
|
|
oop old = Scope_local(name); |
|
|
|
if (old) { // declared |
|
|
|
if (getType(old) != TypeName) |
|
|
|
fatal("'%s' redeclared as different kind of symbol", toString(name)); |
|
|
|
oop oldtype = get(old, TypeName,type); |
|
|
|
if (oldtype != type) |
|
|
|
fatal("incompatible declarations of type '%s': %s -> %s", |
|
|
|
toString(name), toString(oldtype), toString(type)); |
|
|
|
} |
|
|
|
else { |
|
|
|
oop typename = declareType(name, type); |
|
|
|
Array_append(typenames, typename); |
|
|
|
} |
|
|
|
declare(varname, var); |
|
|
|
} |
|
|
|
set(exp, TypeDecls,typenames, typenames); |
|
|
|
return nil; |
|
|
|
} |
|
|
|
default: |
|
|
|
@ -3210,6 +3327,7 @@ int main(int argc, char **argv) |
|
|
|
t_char = newTchar(); |
|
|
|
t_short = newTshort(); |
|
|
|
t_int = newTint(); |
|
|
|
t_long = newTlong(); |
|
|
|
t_float = newTfloat(); |
|
|
|
t_double = newTdouble(); |
|
|
|
t_string = newTpointer(t_char); |
|
|
|
|
