diff --git a/fn/here.fn b/fn/here.fn index d626b62..68a5833 100644 --- a/fn/here.fn +++ b/fn/here.fn @@ -1,6 +1,8 @@ -here - fn (ret) { - if (ret(1)) { +let + fn funky(k) { k(1) } +in + 4 + here fn (k) { + if (funky(k)) { 2 } else { 3 diff --git a/fn/pow.fn b/fn/pow.fn new file mode 100644 index 0000000..24254bc --- /dev/null +++ b/fn/pow.fn @@ -0,0 +1,4 @@ +let + x = 5 ** 3; +in + x diff --git a/src/anf.c b/src/anf.c index 3c175fe..3b5cdfb 100644 --- a/src/anf.c +++ b/src/anf.c @@ -977,6 +977,8 @@ static AexpPrimOp mapPrimOp(LamPrimOp op) { return AEXP_PRIM_MUL; case LAMPRIMOP_TYPE_LAM_PRIM_DIV: return AEXP_PRIM_DIV; + case LAMPRIMOP_TYPE_LAM_PRIM_POW: + return AEXP_PRIM_POW; case LAMPRIMOP_TYPE_LAM_PRIM_EQ: return AEXP_PRIM_EQ; case LAMPRIMOP_TYPE_LAM_PRIM_NE: diff --git a/src/bytecode.c b/src/bytecode.c index 8a99cbf..f75a9c1 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -192,6 +192,9 @@ void writeAexpPrimApp(AexpPrimApp *x, ByteCodeArray *b) { case AEXP_PRIM_DIV: prim = BYTECODE_PRIM_DIV; break; + case AEXP_PRIM_POW: + prim = BYTECODE_PRIM_POW; + break; case AEXP_PRIM_MOD: prim = BYTECODE_PRIM_MOD; break; diff --git a/src/bytecode.h b/src/bytecode.h index cb7865e..14af875 100644 --- a/src/bytecode.h +++ b/src/bytecode.h @@ -32,6 +32,7 @@ typedef enum ByteCodes { BYTECODE_PRIM_SUB, BYTECODE_PRIM_MUL, BYTECODE_PRIM_DIV, + BYTECODE_PRIM_POW, BYTECODE_PRIM_MOD, BYTECODE_PRIM_EQ, BYTECODE_PRIM_NE, diff --git a/src/common.h b/src/common.h index bfc8bb6..addb9ae 100644 --- a/src/common.h +++ b/src/common.h @@ -26,8 +26,10 @@ // #define DEBUG_RUN_TESTS 1 // #define TEST_STACK // #define DEBUG_STACK -// #define DEBUG_STEP +#define DEBUG_STEP +// if DEBUG_STEP is defined, this sleeps for 1 second between each machine step // #define DEBUG_SLOW_STEP +// define this to cause a GC at every possible step (catched memory leaks early) #define DEBUG_STRESS_GC // #define DEBUG_LOG_GC // #define DEBUG_GC @@ -40,13 +42,15 @@ // #define DEBUG_TIN_SUBSTITUTION // #define DEBUG_TIN_INSTANTIATION // #define DEBUG_TIN_UNIFICATION +// define this to make fatal errors dump core (if ulimit allows) #define DEBUG_DUMP_CORE // #define DEBUG_ALGORITHM_W // #define DEBUG_LAMBDA_CONVERT // #define DEBUG_LEAK // #define DEBUG_ANF // #define DEBUG_ALLOC -// #define SAFETY_CHECKS +// define this to turn on additional safety checks for things that shouldn't but just possibly might happen +#define SAFETY_CHECKS void cant_happen(const char *message, ...); void can_happen(const char *message, ...); diff --git a/src/debug.c b/src/debug.c index f979299..2080a53 100644 --- a/src/debug.c +++ b/src/debug.c @@ -773,6 +773,11 @@ void dumpByteCode(ByteCodeArray *b) { i++; } break; + case BYTECODE_PRIM_POW: { + fprintf(stderr, "%04x ### POW\n", i); + i++; + } + break; case BYTECODE_PRIM_MOD: { fprintf(stderr, "%04x ### MOD\n", i); i++; diff --git a/src/exp.h b/src/exp.h index 9c466b5..f04b5bd 100644 --- a/src/exp.h +++ b/src/exp.h @@ -67,6 +67,7 @@ typedef enum { AEXP_PRIM_SUB, AEXP_PRIM_MUL, AEXP_PRIM_DIV, + AEXP_PRIM_POW, AEXP_PRIM_EQ, AEXP_PRIM_NE, AEXP_PRIM_GT, diff --git a/src/lexer.l b/src/lexer.l index 5fef05f..bf5d9db 100644 --- a/src/lexer.l +++ b/src/lexer.l @@ -57,6 +57,7 @@ ID [a-zA-Z_][a-zA-Z_0-9]* "<" { return LT; } ">=" { return GE; } "<=" { return LE; } +"**" { return POW; } "@" { return CONS; } "@@" { return APPEND; } diff --git a/src/parser.y b/src/parser.y index 847196a..7662f30 100644 --- a/src/parser.y +++ b/src/parser.y @@ -179,7 +179,7 @@ static AstUnpack *newStringUnpack(char *str) { %left CAR CDR %left '+' '-' %left '*' '/' '%' -%right '^' +%right POW %nonassoc NEG %nonassoc HERE %left '(' @@ -410,7 +410,7 @@ binop : expression THEN expression { $$ = binOpToFunCall(thenSymbol(), $1, | expression '*' expression { $$ = binOpToFunCall(mulSymbol(), $1, $3); } | expression '/' expression { $$ = binOpToFunCall(divSymbol(), $1, $3); } | expression '%' expression { $$ = binOpToFunCall(modSymbol(), $1, $3); } - | expression '^' expression { $$ = binOpToFunCall(powSymbol(), $1, $3); } + | expression POW expression { $$ = binOpToFunCall(powSymbol(), $1, $3); } | expression '.' expression { $$ = binOpToFunCall(dotSymbol(), $1, $3); } ; diff --git a/src/step.c b/src/step.c index 16dcddf..e90510c 100644 --- a/src/step.c +++ b/src/step.c @@ -141,6 +141,16 @@ static Value divide(Value a, Value b) { return intValue(result); } +// dumb temporary power fn +static Value tmpPow(Value a, Value b) { + int result = 1; + int mul = a.val.z; + for (int i = b.val.z; i > 0; i--) { + result *= mul; + } + return intValue(result); +} + static Value modulo(Value a, Value b) { AexpInteger result = a.val.z % b.val.z; return intValue(result); @@ -509,6 +519,17 @@ static void step() { state.C++; } break; + case BYTECODE_PRIM_POW: { // pop two values, perform the binop and push the result +#ifdef DEBUG_STEP + printCEKF(&state); + printf("%4d) %04x ### POW\n", ++count, state.C); +#endif + Value b = pop(); + Value a = pop(); + push(tmpPow(a, b)); + state.C++; + } + break; case BYTECODE_PRIM_MOD: { // pop two values, perform the binop and push the result #ifdef DEBUG_STEP printCEKF(&state);