diff --git a/Makefile b/Makefile index 5efffcc..4a742b7 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ LEG = leg CC = cc CFLAGS = -I/usr/local/include -I/opt/local/include -Wall -Wno-unused-label -g -LDLIBS = -L/usr/local/lib -L/opt/local/lib -lgc +LDLIBS = -L/usr/local/lib -L/opt/local/lib -lgc -lm all : parse diff --git a/object.c b/object.c index ffc9b1b..55c9be9 100644 --- a/object.c +++ b/object.c @@ -11,9 +11,11 @@ # include #endif -typedef long long int_t; +typedef long long int_t; +typedef long double flt_t; #define FMT_I "%lli" +#define FMT_F "%Lg" void *memcheck(void *ptr) { @@ -71,6 +73,7 @@ char *xstrdup(char *s) typedef enum { Undefined, Integer, + Float, String, Symbol, Function, @@ -91,6 +94,11 @@ struct Integer { int_t _value; }; +struct Float { + type_t type; + flt_t _value; +}; + struct String { type_t type; char *value; @@ -142,6 +150,7 @@ union object { type_t type; struct Undefined Undefined; struct Integer Integer; + struct Float Float; struct String String; struct Symbol Symbol; struct Function Function; @@ -170,7 +179,7 @@ int isInteger(oop obj) } #if (USE_TAG) -# define getType(PTR) (((intptr_t)(PTR) & 1) ? Integer : (PTR)->type) +# define getType(PTR) (type_t)(((intptr_t)(PTR) & 1) ? Integer : (PTR)->type) #else type_t getType(oop ptr) { @@ -211,7 +220,7 @@ int_t getInteger(oop obj) if (isTag(obj)) return (intptr_t)obj >> 1; #endif if (!isInteger(obj)) { - fprintf(stderr, "\nNon-integer in arithmetic expression\n"); + fprintf(stderr, "\ngetInteger call on non-integer\n"); exit(1); } return get(obj, Integer, _value); @@ -236,7 +245,14 @@ oop makeInteger(int_t value) return newInt; } -// value will be copied +oop makeFloat(flt_t value) +{ + oop newFloat= malloc(sizeof(struct Float)); + newFloat->type= Float; + newFloat->Float._value= value; + return newFloat; +} + oop makeString(char *value) { oop newString = malloc(sizeof(struct String)); @@ -392,20 +408,26 @@ int oopcmp(oop a, oop b) type_t ta = getType(a), tb = getType(b); if (ta == tb) { switch (getType(a)) { - case Integer: { - int l= getInteger(a), r= getInteger(b); - if (l < r) return -1; - if (l > r) return 1; - return 0; - } - case String: - return strcmp(get(a, String, value), get(b, String, value)); - default: { - intptr_t l= (intptr_t)a, r= (intptr_t)b; - if (l < r) return -1; - if (l > r) return 1; - return 0; - } + case Integer: { + int_t l= getInteger(a), r= getInteger(b); + if (l < r) return -1; + if (l > r) return 1; + return 0; + } + case Float: { + flt_t l= get(a, Float, _value), r= get(b, Float, _value); + if (l < r) return -1; + if (l > r) return 1; + return 0; + } + case String: + return strcmp(get(a, String, value), get(b, String, value)); + default: { + intptr_t l= (intptr_t)a, r= (intptr_t)b; + if (l < r) return -1; + if (l > r) return 1; + return 0; + } } } return ta - tb; @@ -686,11 +708,17 @@ void printOn(StringBuffer *buf, oop obj, int indent) return; } case Integer: { - char tmp[40]; + char tmp[44]; int length = snprintf(tmp, sizeof(tmp), FMT_I, getInteger(obj)); StringBuffer_appendAll(buf, tmp, length); return; } + case Float: { + char tmp[44]; + int length = snprintf(tmp, sizeof(tmp), FMT_F, get(obj, Float, _value)); + StringBuffer_appendAll(buf, tmp, length); + return; + } case String: { StringBuffer_appendAll(buf, get(obj, String, value), string_size(obj)); return; diff --git a/parse.leg b/parse.leg index 1ca26b0..da83787 100644 --- a/parse.leg +++ b/parse.leg @@ -7,11 +7,12 @@ */ #include +#include #define DO_PROTOS() \ _DO(If) _DO(While) _DO(Do) _DO(For) _DO(ForIn) _DO(Switch) _DO(Call) \ _DO(Invoke) _DO(Func) _DO(Block) _DO(Declaration) _DO(Assign) \ - _DO(Map) _DO(Symbol) _DO(Integer) _DO(String) \ + _DO(Map) _DO(Symbol) _DO(Integer) _DO(Float) _DO(String) \ _DO(Logor) _DO(Logand) _DO(Bitor) _DO(Bitxor) _DO(Bitand) \ _DO(Equal) _DO(Noteq) _DO(Less) _DO(Lesseq) _DO(Greater) _DO(Greatereq) _DO(Shleft) _DO(Shright) \ _DO(Add) _DO(Sub) _DO(Mul) _DO(Div) _DO(Mod) _DO(Not) _DO(Neg) _DO(Com) \ @@ -297,6 +298,13 @@ oop newInteger(oop value) return integer; } +oop newFloat(oop value) +{ + oop obj = newObject(Float_proto); + map_set(obj, value_symbol, value); + return obj; +} + int digitValue(int c) { if (c < '0') return -1; @@ -735,7 +743,7 @@ prod = l:prefix )* { $$ = l } prefix = PLUS n:prefix { $$= n } - | MINUS n:prefix { $$= newUnary(Neg_proto, n) } + | NEGATE n:prefix { $$= newUnary(Neg_proto, n) } | TILDE n:prefix { $$= newUnary(Com_proto, n) } | PLING n:prefix { $$= newUnary(Not_proto, n) } | PLUSPLUS n:prefix { $$= newPreIncrement(n) } @@ -777,7 +785,8 @@ argument = ATAT e:value { $$ = newUnary(Unsplice_proto, e) } value = BACKTICK n:value { $$ = newUnary(Quasiquote_proto, n) } | AT n:value { $$ = newUnary(Unquote_proto, n) } - | n:NUMBER { $$ = newInteger(n) } + | n:FLOAT { $$ = newFloat(n) } + | n:integer { $$ = newInteger(n) } | s:string { $$ = newString(s) } | s:symbol { $$ = s } | m:map { $$ = newMap(m) } @@ -810,7 +819,7 @@ map = LCB m:makeMap makeMap = { $$ = makeMap() } -key = ident | NUMBER +key = IDENT | integer - = (blank | comment)* @@ -828,11 +837,18 @@ keyword = FUN | SYNTAX | VAR | SWITCH | CASE | DEFAULT | DO | FOR | IN | WHILE | IDENT = !keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) } -NUMBER = '0b' < [01]+ > - { $$ = makeInteger(strtol(yytext, 0, 2)) } - | '0x' < [0-9a-fA-F]+ > - { $$ = makeInteger(strtol(yytext, 0, 16)) } - | '0' < [0-7]+ > - { $$ = makeInteger(strtol(yytext, 0, 8)) } - | < [0-9]+ > - { $$ = makeInteger(strtol(yytext, 0, 10)) } - | SQUOTE < (!SQUOTE char) > SQUOTE - { $$ = makeInteger(unescape(yytext)[0]) } +integer = i:INTEGER { $$ = i } + | '-' i:integer { $$ = makeInteger(-getInteger(i)) } + +INTEGER = '0b' < [01]+ > - { $$ = makeInteger(strtol(yytext, 0, 2)) } + | '0x' < [0-9a-fA-F]+ > - { $$ = makeInteger(strtol(yytext, 0, 16)) } + | '0' < [0-7]+ > - { $$ = makeInteger(strtol(yytext, 0, 8)) } + | < [0-9]+ > - { $$ = makeInteger(strtol(yytext, 0, 10)) } + | SQUOTE < (!SQUOTE char) > SQUOTE - { $$ = makeInteger(unescape(yytext)[0]) } + +FLOAT = < [-+]* [0-9]+ '.' [0-9]* ('e'[-+]*[0-9]+)? > - { $$ = makeFloat(strtold(yytext, 0)) } + | < [-+]* [0-9]* '.' [0-9]+ ('e'[-+]*[0-9]+)? > - { $$ = makeFloat(strtold(yytext, 0)) } + | < [-+]* [0-9]+ ('e'[-+]*[0-9]+) > - { $$ = makeFloat(strtold(yytext, 0)) } FUN = 'fun' ![a-zA-Z0-9_] - SYNTAX = 'syntax' ![a-zA-Z0-9_] - @@ -871,6 +887,7 @@ SHLEFT = '<<' ![=] - SHRIGHT = '>>' ![=] - PLUS = '+' ![+=] - MINUS = '-' ![-=] - +NEGATE = '-' ![-=0-9.] - PLUSPLUS = '++' - MINUSMINUS = '--' - TILDE = '~' - @@ -930,6 +947,7 @@ oop clone(oop obj) switch(getType(obj)) { case Undefined: case Integer: + case Float: case Symbol: return obj; case String: @@ -1031,37 +1049,67 @@ void runtimeError(char *fmt, ...) #define TYPESIG(L, R) L*NTYPES+R #define CASE(L, R) case TYPESIG(L, R) -oop addOperation(oop ast, oop lhs, oop rhs) +oop addOperation(oop lhs, oop rhs) { switch (TYPESIG(getType(lhs), getType(rhs))) { - CASE(Integer, Integer): { - return makeInteger(getInteger(lhs) + getInteger(rhs)); - } - CASE(String, String): { - return string_concat(lhs, rhs); - } + CASE(Integer, Integer): return makeInteger(getInteger(lhs) + getInteger(rhs)); + CASE(Integer, Float ): return makeFloat(getInteger(lhs) + get(rhs, Float, _value)); + CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) + getInteger(rhs)); + CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) + get(rhs, Float, _value)); + CASE(String , String ): return string_concat(lhs, rhs); } runtimeError("addition between two incompatible types"); return NULL; // to prevent: control may reach end of non-void function } -oop mulOperation(oop ast, oop lhs, oop rhs) +oop subOperation(oop lhs, oop rhs) { switch (TYPESIG(getType(lhs), getType(rhs))) { - CASE(Integer, Integer): { - return makeInteger(getInteger(lhs) * getInteger(rhs)); - } - CASE(String, Integer): { - return string_mul(lhs, rhs); - } - CASE(Integer, String): { - return string_mul(rhs, lhs); - } + CASE(Integer, Integer): return makeInteger(getInteger(lhs) - getInteger(rhs)); + CASE(Integer, Float ): return makeFloat(getInteger(lhs) - get(rhs, Float, _value)); + CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) - getInteger(rhs)); + CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) - get(rhs, Float, _value)); + } + runtimeError("substraction between two incompatible types"); + return NULL; // to prevent: control may reach end of non-void function +} + +oop mulOperation(oop lhs, oop rhs) +{ + switch (TYPESIG(getType(lhs), getType(rhs))) { + CASE(Integer, Integer): return makeInteger(getInteger(lhs) * getInteger(rhs)); + CASE(Integer, Float ): return makeFloat(getInteger(lhs) * get(rhs, Float, _value)); + CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) * getInteger(rhs)); + CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) * get(rhs, Float, _value)); + CASE(String , Integer): return string_mul(lhs, rhs); + CASE(Integer, String ): return string_mul(rhs, lhs); } runtimeError("multiplication between two incompatible types"); return NULL; // to prevent: control may reach end of non-void function } +oop divOperation(oop lhs, oop rhs) +{ + switch (TYPESIG(getType(lhs), getType(rhs))) { + CASE(Integer, Integer): return makeInteger(getInteger(lhs) / getInteger(rhs)); + CASE(Integer, Float ): return makeFloat(getInteger(lhs) / get(rhs, Float, _value)); + CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) / getInteger(rhs)); + CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) / get(rhs, Float, _value)); + } + runtimeError("division between two incompatible types"); + return NULL; // to prevent: control may reach end of non-void function +} + +oop modOperation(oop lhs, oop rhs) +{ + switch (TYPESIG(getType(lhs), getType(rhs))) { + CASE(Integer, Integer): return makeInteger(getInteger(lhs) % getInteger(rhs)); + CASE(Float , Float ): return makeFloat(fmodl(get(lhs, Float, _value), get(rhs, Float, _value))); + } + runtimeError("modulo between two incompatible types"); + return NULL; // to prevent: control may reach end of non-void function +} + #undef TYPESIG #undef CASE @@ -1113,15 +1161,15 @@ oop expandUnquotes(oop scope, oop ast) return map; } -oop applyOperator(oop ast, oop op, oop lhs, oop rhs) +oop applyOperator(oop op, oop lhs, oop rhs) { if (null != op) { assert(is(Symbol, op)); switch (get(op, Symbol, prototype)) { - case t_Add: return addOperation(ast, lhs, rhs); - case t_Sub: return makeInteger(getInteger(lhs) - getInteger(rhs)); - case t_Mul: return mulOperation(ast, lhs, rhs); - case t_Div: return makeInteger(getInteger(lhs) / getInteger(rhs)); - case t_Mod: return makeInteger(getInteger(lhs) % getInteger(rhs)); + case t_Add: return addOperation(lhs, rhs); + case t_Sub: return subOperation(lhs, rhs); + case t_Mul: return mulOperation(lhs, rhs); + case t_Div: return divOperation(lhs, rhs); + case t_Mod: return modOperation(lhs, rhs); case t_Bitor: return makeInteger(getInteger(lhs) | getInteger(rhs)); case t_Bitxor: return makeInteger(getInteger(lhs) ^ getInteger(rhs)); case t_Bitand: return makeInteger(getInteger(lhs) & getInteger(rhs)); @@ -1226,15 +1274,16 @@ oop eval(oop scope, oop ast) } switch(getType(ast)) { - case Undefined: - case Integer: - case String: - case Function: - return ast; - case Symbol: - return getVariable(scope, ast); - case Map: - break; + case Undefined: + case Integer: + case Float: + case String: + case Function: + return ast; + case Symbol: + return getVariable(scope, ast); + case Map: + break; } assert(is(Map, ast)); @@ -1466,7 +1515,7 @@ oop eval(oop scope, oop ast) oop lhs = map_get(ast, lhs_symbol); oop op = map_get(ast, operator_symbol); oop rhs = eval(scope, map_get(ast, rhs_symbol)); - if (null != op) rhs= applyOperator(ast, op, getVariable(scope, lhs), rhs); + if (null != op) rhs= applyOperator(op, getVariable(scope, lhs), rhs); setVariable(scope, lhs, rhs); if (is(Function, rhs) && null == get(rhs, Function, name)) { set(rhs, Function, name, lhs); @@ -1610,7 +1659,7 @@ oop eval(oop scope, oop ast) oop key = map_get(ast, key_symbol); oop op = map_get(ast, operator_symbol); oop value = eval(scope, map_get(ast, value_symbol)); - if (null != op) value= applyOperator(ast, op, getProperty(map, key), value); + if (null != op) value= applyOperator(op, getProperty(map, key), value); if (is(Function, value) && null == get(value, Function, name)) { set(value, Function, name, key); } @@ -1656,7 +1705,7 @@ oop eval(oop scope, oop ast) get(map, String, value)[getInteger(key)] = getInteger(value); return value; case Map: - if (null != op) value= applyOperator(ast, op, map_get(map, key), value); + if (null != op) value= applyOperator(op, map_get(map, key), value); return map_set(map, key, value); default: runtimeError("SetIndex on non Map or String"); @@ -1694,6 +1743,7 @@ oop eval(oop scope, oop ast) } case t_Symbol: case t_Integer: + case t_Float: case t_String: { return map_get(ast, value_symbol); } @@ -1723,6 +1773,12 @@ oop eval(oop scope, oop ast) oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ return makeInteger(getInteger(lhs) OPERATOR getInteger(rhs)); \ } +# define BINARYOP(NAME, FUNCPREFIX) \ + case t_##NAME: { \ + oop lhs = eval(scope, map_get(ast, lhs_symbol)); \ + oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ + return FUNCPREFIX##Operation(lhs, rhs); \ + } BINARY(Bitor, | ); BINARY(Bitxor, ^ ); BINARY(Bitand, & ); @@ -1734,21 +1790,12 @@ oop eval(oop scope, oop ast) RELATION(Greater, > ); BINARY(Shleft, <<); BINARY(Shright, >>); -// BINARY(Add, + ); - case t_Add: { - oop lhs = eval(scope, map_get(ast, lhs_symbol)); - oop rhs = eval(scope, map_get(ast, rhs_symbol)); - return addOperation(ast, lhs, rhs); - } - BINARY(Sub, - ); -// BINARY(Mul, * ); - case t_Mul: { - oop lhs = eval(scope, map_get(ast, lhs_symbol)); - oop rhs = eval(scope, map_get(ast, rhs_symbol)); - return mulOperation(ast, lhs, rhs); - } - BINARY(Div, / ); - BINARY(Mod, % ); + BINARYOP(Add, add); + BINARYOP(Mul, mul); + BINARYOP(Sub, sub); + BINARYOP(Div, div); + BINARYOP(Mod, mod); +# undef BINARYOP # undef BINARY # undef RELATION case t_Not: { diff --git a/test-float.txt b/test-float.txt new file mode 100644 index 0000000..11ecff2 --- /dev/null +++ b/test-float.txt @@ -0,0 +1,24 @@ +println(3.14) +println(3.) +println(.14) +println(3.14e3) +println(3.14e-3) +println(-42e100) +println("ADD") +println(3.14+3.14) +println(3.14+3) +println(3+3.14) +println("MUL"); +println(3.14*3.14) +println(3.14*3) +println(3*3.14) +println("SUB") +println(3.14-3.14) +println(3.14-3) +println(3-3.14) +println("DIV") +println(3.14/3.14) +println(3.14/3) +println(3/3.14) +println("MOD") +println(3.15%3.14) \ No newline at end of file