oceani: introduce 'test' and 'choose' operators

If a type supports testing (only Boolean currently),
   ? expr
converts to Boolean, and
   expra ?? exprb

will return expra if it tests as true, and exprb otherwise.
exprb isn't computed if not needed.

Signed-off-by: NeilBrown <neil@brown.name>

diff --git a/csrc/oceani-tests.mdc b/csrc/oceani-tests.mdc
index d1557010e9c03d1cd27b895ace23989ef6227ff0..f9dce403d3e83f9920736e06853676778bfd7198 100644 (file)
--- a/csrc/oceani-tests.mdc
+++ b/csrc/oceani-tests.mdc
@@ -134,6 +134,15 @@ calculations on them.
                  + b1
                  + b
 
+               z:Boolean= True
+               w:Boolean = False
+               if ?z:
+                       print "w??z", w??z
+                       print "z??w", z??w
+                       print "z??False", z??False, "w??False", w??False
+               if ?w:
+                       print "Weird?"
+
 ###### output: valvar
 
        23 12 35 11 276 1.916666667 11
@@ -142,6 +151,9 @@ calculations on them.
        False True True False False False
        This is a string  field theory This is a string field theory
        81
+       w??z True
+       z??w True
+       z??False True w??False False
 
 Next we change the value of variables
 
@@ -794,7 +806,7 @@ These programs were generated by looking for the
 various places that `type_err()` are called.
 
 ###### test list
-       oceani_failing_tests += type_err1 type_err2 type_err3 type_err4 type_err5
+       oceani_failing_tests += type_err1 type_err2 type_err3 type_err4 type_err5 type_err6
 
 ###### test: type_err1
 
@@ -939,6 +951,20 @@ various places that `type_err()` are called.
        .tmp.code:2:7: error: type has recursive definition: foo
        .tmp.code:5:7: error: type has recursive definition: baz
 
+###### test: type_err6
+
+       func main()
+               a:= "hello"
+               if ?a:
+                       print "no"
+               print a ?? "there"
+
+###### output: type_err6
+       .tmp.code:4:12: error: '?' requires a testable value, not string
+       .tmp.code:6:14: error: "??" requires a testable value, not string
+       oceani: type error in program - not running.
+
+
 ###### test list
        oceani_failing_tests += type_err_const type_err_const1 type_err_const2 missing_program bad_main
 

diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc
index e7976cf086ef03b338527549a4d3d069af7afd45..f2cc254612da9316433537ee9e4dba91f128deb4 100644 (file)
--- a/csrc/oceani.mdc
+++ b/csrc/oceani.mdc
@@ -804,6 +804,7 @@ which might be reported in error messages.
                int (*cmp_eq)(struct type *t1, struct type *t2,
                              struct value *v1, struct value *v2);
                void (*dup)(struct type *type, struct value *vold, struct value *vnew);
+               int (*test)(struct type *type, struct value *val);
                void (*free)(struct type *type, struct value *val);
                void (*free_type)(struct type *t);
                long long (*to_int)(struct value *v);
@@ -1168,6 +1169,11 @@ A separate function encoding these cases will simplify some code later.
 
        static void _free_value(struct type *type, struct value *v);
 
+       static int bool_test(struct type *type, struct value *v)
+       {
+               return v->bool;
+       }
+
        static struct type base_prototype = {
                .init = _val_init,
                .print = _print_value,
@@ -1198,6 +1204,7 @@ A separate function encoding these cases will simplify some code later.
 ###### context initialization
 
        Tbool  = add_base_type(&context, "Boolean", Vbool, sizeof(char));
+       Tbool->test = bool_test;
        Tstr   = add_base_type(&context, "string", Vstr, sizeof(struct text));
        Tnum   = add_base_type(&context, "number", Vnum, sizeof(mpq_t));
        Tnone  = add_base_type(&context, "none", Vnone, 0);
@@ -2305,7 +2312,7 @@ with a const size by whether they are prepared at parse time or not.
                if (!parse_time)
                        return 1;
                if (type->array.member->size <= 0)
-                       return 0;
+                       return 0;       // UNTESTED
 
                type->array.static_size = 1;
                type->size = type->array.size * type->array.member->size;
@@ -3650,10 +3657,17 @@ expression operator, and the `CMPop` non-terminal will match one of them.
 ### Expressions: Arithmetic etc.
 
 The remaining expressions with the highest precedence are arithmetic,
-string concatenation, and string conversion.  String concatenation
+string concatenation, string conversion, and testing.  String concatenation
 (`++`) has the same precedence as multiplication and division, but lower
 than the uniary.
 
+Testing comes in two forms.  A single question mark (`?`) is a uniary
+operator which converts come types into Boolean.  The general meaning is
+"is this a value value" and there will be more uses as the language
+develops.  A double questionmark (`??`) is a binary operator (Choose),
+with same precedence as multiplication, which returns the LHS if it
+tests successfully, else returns the RHS.
+
 String conversion is a temporary feature until I get a better type
 system.  `$` is a prefix operator which expects a string and returns
 a number.
@@ -3669,15 +3683,15 @@ parentheses around an expression converts it into a Term,
 ###### Binode types
        Plus, Minus,
        Times, Divide, Rem,
-       Concat,
-       Absolute, Negate,
+       Concat, Choose,
+       Absolute, Negate, Test,
        StringConv,
        Bracket,
 
 ###### declare terminals
        $LEFT + - Eop
-       $LEFT * / % ++ Top
-       $LEFT Uop $
+       $LEFT * / % ++ ?? Top
+       $LEFT Uop $ ?
        $TERM ( )
 
 ###### expression grammar
@@ -3722,11 +3736,13 @@ parentheses around an expression converts it into a Term,
        Uop ->   + ${ $0.op = Absolute; }$
        |        - ${ $0.op = Negate; }$
        |        $ ${ $0.op = StringConv; }$
+       |        ? ${ $0.op = Test; }$
 
        Top ->   * ${ $0.op = Times; }$
        |        / ${ $0.op = Divide; }$
        |        % ${ $0.op = Rem; }$
        |        ++ ${ $0.op = Concat; }$
+       |        ?? ${ $0.op = Choose; }$
 
 ###### print binode cases
        case Plus:
@@ -3735,6 +3751,7 @@ parentheses around an expression converts it into a Term,
        case Divide:
        case Concat:
        case Rem:
+       case Choose:
                if (bracket) printf("(");
                print_exec(b->left, indent, bracket);
                switch(b->op) {
@@ -3744,6 +3761,7 @@ parentheses around an expression converts it into a Term,
                case Divide: fputs(" / ", stdout); break;
                case Rem:    fputs(" % ", stdout); break;
                case Concat: fputs(" ++ ", stdout); break;
+               case Choose: fputs(" ?? ", stdout); break;
                default: abort();       // NOTEST
                }                       // NOTEST
                print_exec(b->right, indent, bracket);
@@ -3752,11 +3770,13 @@ parentheses around an expression converts it into a Term,
        case Absolute:
        case Negate:
        case StringConv:
+       case Test:
                if (bracket) printf("(");
                switch (b->op) {
                case Absolute:   fputs("+", stdout); break;
                case Negate:     fputs("-", stdout); break;
                case StringConv: fputs("$", stdout); break;
+               case Test:       fputs("?", stdout); break;
                default: abort();       // NOTEST
                }                       // NOTEST
                print_exec(b->right, indent, bracket);
@@ -3804,6 +3824,25 @@ parentheses around an expression converts it into a Term,
                                prog, type, 0, NULL);
                return Tnum;
 
+       case Test:
+               /* LHS must support ->test, result is Tbool */
+               t = propagate_types(b->right, c, perr, NULL, 0);
+               if (!t || !t->test)
+                       type_err(c, "error: '?' requires a testable value, not %1",
+                                prog, t, 0, NULL);
+               return Tbool;
+
+       case Choose:
+               /* LHS and RHS must match and are returned. Must support
+                * ->test
+                */
+               t = propagate_types(b->left, c, perr, type, rules);
+               t = propagate_types(b->right, c, perr, t, rules);
+               if (t && t->test == NULL)
+                       type_err(c, "error: \"??\" requires a testable value, not %1",
+                                prog, t, 0, NULL);
+               return t;
+
        case Bracket:
                return propagate_types(b->right, c, perr, type, 0);
 
@@ -3882,6 +3921,20 @@ parentheses around an expression converts it into a Term,
                        printf("Unsupported suffix: %.*s\n", tx.len, tx.txt);   // UNTESTED
 
                break;
+       case Test:
+               right = interp_exec(c, b->right, &rtype);
+               rvtype = Tbool;
+               rv.bool = !!rtype->test(rtype, &right);
+               break;
+       case Choose:
+               left = interp_exec(c, b->left, &ltype);
+               if (ltype->test(ltype, &left)) {
+                       rv = left;
+                       rvtype = ltype;
+                       ltype = NULL;
+               } else
+                       rv = interp_exec(c, b->right, &rvtype);
+               break;
 
 ###### value functions