Fold constants during parsing if FOLDCONST=1.

minproto.leg

@@ -1,6 +1,6 @@
 # minproto.leg -- minimal prototype langauge for semantic experiments
 #
-# last edited: 2024-05-29 09:06:22 by piumarta on m1mbp
+# last edited: 2024-05-29 10:02:58 by piumarta on zora
 
 %{
 ;
@@ -38,6 +38,10 @@
 # define EXCEPTIONS 1
 #endif
 
+#ifndef FOLDCONST       // fold constant expressions during parsing
+# define FOLDCONST 1
+#endif
+
 #include <math.h>
 #include <stdint.h>
 #include <stdio.h>
@@ -312,6 +316,8 @@ oop newFloat(double value)
 # endif
 }
 
+#define isFloat(obj)  is(Float, obj)
+
 double _floatValue(oop obj)
 {
 # if TAGS
@@ -348,6 +354,8 @@ oop newString(char *value)
     return newStringLen(value, strlen(value));
 }
 
+#define isString(obj)   is(String, obj)
+
 int digitValue(int digit, int base)
 {
     if      ('a' <= digit && digit <= 'z') digit -= 'a' - 10;
@@ -2210,17 +2218,7 @@ binop_t binops[] = {
 
 #endif // BINOPT
 
-oop newBinop(enum binop operation, oop lhs, oop rhs)
-{
-    oop o = new(pBinop);
-    Object_put(o, sym_operation, newInteger(operation));
-# if BINOPT
-    Object_put(o, prop_function, mkptr(binops[operation]));
-# endif
-    Object_push(o, lhs);
-    Object_push(o, rhs);
-    return o;
-}
+#define newBoolean(TF)  ((TF) ? sym_t : nil)
 
 #define binop(NAME, OP)                                                         \
     oop NAME(oop lhs, oop rhs)                                                  \
@@ -2234,8 +2232,6 @@ binop(binBitAnd, &);
 
 #undef binop
 
-#define newBoolean(TF)  ((TF) ? sym_t : nil)
-
 #define binop(NAME, OP)                                 \
     oop NAME(oop lhs, oop rhs)                          \
     {                                                   \
@@ -2436,6 +2432,56 @@ oop binMod(oop l, oop r)
     return 0;
 }
 
+int isNumber(oop obj)   { return isInteger(obj) || isFloat(obj); }
+int isAtom(oop obj)     { return nil == obj || isNumber(obj) || isString(obj) || is(Symbol, obj); }
+
+oop newBinop(enum binop operation, oop lhs, oop rhs)
+{
+# if FOLDCONST
+    if (isAtom(lhs) && isAtom(rhs)) {
+        switch (operation) {
+            case opLogOr:       return newBoolean((lhs != nil) || (rhs != nil));
+            case opLogAnd:      return newBoolean((lhs != nil) && (rhs != nil));
+            case opEq:          return binEq   (lhs, rhs);
+            case opNotEq:       return binNotEq(lhs, rhs);
+            default:            break;
+        }
+    }
+    if (isInteger(lhs) && isInteger(rhs)) {
+        switch (operation) {
+            case opBitOr:       return binBitOr (lhs, rhs);
+            case opBitXor:      return binBitXor(lhs, rhs);
+            case opBitAnd:      return binBitAnd(lhs, rhs);
+            case opShl:         return binShl   (lhs, rhs);
+            case opShr:         return binShr   (lhs, rhs);
+            default:            break;
+        }
+    }
+    if (isNumber(lhs) && isNumber(rhs)) {
+        switch (operation) {
+            case opLess:        return binLess  (lhs, rhs);
+            case opLessEq:      return binLessEq(lhs, rhs);
+            case opGrtr:        return binGrtr  (lhs, rhs);
+            case opGrtrEq:      return binGrtrEq(lhs, rhs);
+            case opAdd:         return binAdd   (lhs, rhs);
+            case opSub:         return binSub   (lhs, rhs);
+            case opMul:         return binMul   (lhs, rhs);
+            case opDiv:         return binDiv   (lhs, rhs);
+            case opMod:         return binMod   (lhs, rhs);
+            default:            break;
+        }
+    }
+# endif
+    oop o = new(pBinop);
+    Object_put(o, sym_operation, newInteger(operation));
+# if BINOPT
+    Object_put(o, prop_function, mkptr(binops[operation]));
+# endif
+    Object_push(o, lhs);
+    Object_push(o, rhs);
+    return o;
+}
+
 oop Binop_eval(oop exp, oop env)
 {                                                       assert(_get(exp, Object,isize) == 2);
     oop op   = Object_get(exp, sym_operation);
@@ -2587,14 +2633,6 @@ char *unyopNames[] = {
 
 #undef nameUnyop
 
-oop newUnyop(int operation, oop value)
-{
-    oop o = new(pUnyop);
-    Object_put(o, sym_operation, newInteger(operation));
-    Object_push(o, value);
-    return o;
-}
-
 oop quasiclone(oop exp, oop env)
 {
     if (is(Object, exp)) {
@@ -2645,6 +2683,19 @@ oop com(oop n)
     return 0;
 }
 
+oop newUnyop(int operation, oop value)
+{
+# if FOLDCONST
+    if (operation == opNot && isAtom   (value)) return newBoolean(nil == value);
+    if (operation == opNeg && isNumber (value)) return neg(value);
+    if (operation == opCom && isInteger(value)) return com(value);
+# endif
+    oop o = new(pUnyop);
+    Object_put(o, sym_operation, newInteger(operation));
+    Object_push(o, value);
+    return o;
+}
+
 oop Unyop_eval(oop exp, oop env)
 {                                                       assert(_get(exp, Object,isize) == 1);
     oop op    = Object_get(exp, sym_operation);
@@ -2675,6 +2726,9 @@ void Unyop_codeOn(oop exp, oop str, oop env)
 
 oop newIf(oop condition, oop consequent, oop alternate)
 {
+# if FOLDCONST
+    if (isAtom(condition)) return nil == condition ? alternate : consequent;
+# endif
     oop o = new(pIf);
     Object_put(o, sym_condition,  condition );
     Object_put(o, sym_consequent, consequent);