Merge pull request #30 from billhails/pow

added exponentiation `**` operator
billhails · Dec 7, 2023 · bc9739c · bc9739c
2 parents a3cb790 + f61722f
commit bc9739c
Show file tree

Hide file tree

Showing 11 changed files with 51 additions and 7 deletions.
diff --git 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
@@ -0,0 +1,4 @@
+let
+    x = 5 ** 3;
+in
+    x
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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);