From: Eric S. Raymond <esr@thyrsus.com>
Date: Mon, 7 Nov 1994 09:21:55 +0000 (+0000)
Subject: Relations with roundoff are implemented, but not tested.
X-Git-Tag: 1-2~61
X-Git-Url: http://thyrsus.com/gitweb/?a=commitdiff_plain;h=240242c9a94d68d4f726b8b5fa89625313097cc2;p=cupl.git

Relations with roundoff are implemented, but not tested.
---

diff --git a/cupl.doc b/cupl.doc
index 739df4c..b2700aa 100644
--- a/cupl.doc
+++ b/cupl.doc
@@ -524,5 +524,5 @@ b. If either x or y is not zero:
 
    (ii)  x * 10**n and y * 10**n are truncated to 14 decimal places
 
-   (iii) The specified condition is interpreted or the resulting numbers.
+   (iii) The specified condition is interpreted on the resulting numbers.
 
diff --git a/cupl.h b/cupl.h
index 7fc4081..98d570f 100644
--- a/cupl.h
+++ b/cupl.h
@@ -138,6 +138,12 @@ extern value cupl_rand(value);
 
 extern value cupl_sgm(value right);
 
+extern bool cupl_eq(value, value);
+extern bool cupl_lt(value, value);
+extern bool cupl_gt(value, value);
+extern bool cupl_le(value, value);
+extern bool cupl_ge(value, value);
+
 #define DEBUG_PARSEDUMP	1
 #define DEBUG_CHECKDUMP	2
 #define DEBUG_ALLOCATE	3
diff --git a/execute.c b/execute.c
index 0886a5f..f0a846c 100644
--- a/execute.c
+++ b/execute.c
@@ -7,8 +7,8 @@ SYNOPSIS
    void execute(node *tree)	-- execute a parse tree
 
 DESCRIPTION 
-   This code does execution of a CUPL parse tree.  Actual execution is
-handed off to execute().
+   This code does execution of a CUPL parse tree.  It uses the runtime
+support in monitor.c.
 
 *****************************************************************************/
 /*LINTLIBRARY*/
@@ -19,9 +19,8 @@ handed off to execute().
 #include "tokens.h"
 #include "nodetype.h"
 
-#define car	u.n.left
-#define cdr	u.n.right
-#define EVAL_WRAP
+/* debugging macros */
+#define EVAL_WRAP	/* empty */
 #define RETURN_WRAP(t, l, r, v)	display_return(t, l, r, v);
 
 static node *pc;	/* the statement node to evaluate next */
@@ -100,7 +99,7 @@ static void display_return(node *tree, node *left, node *right, value v)
 static value cupl_eval(node *tree)
 /* recursively evaluate a CUPL parse tree */
 {
-    value	leftside, rightside, result;
+    value	leftside, rightside, result, cond;
     node	*np;
 
     switch(tree->type)
@@ -138,6 +137,10 @@ static value cupl_eval(node *tree)
 	RETURN_WRAP(tree, tree->car, tree->cdr, result)
 	return(result);
 
+	/*
+	 * Arithmetic
+	 */
+
     case PLUS:
 	leftside = EVAL_WRAP(cupl_eval(tree->car));
 	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
@@ -192,6 +195,10 @@ static value cupl_eval(node *tree)
 	RETURN_WRAP(tree, tree->car, tree->cdr, result)
 	return(result);
 
+	/*
+	 * Special functions
+	 */
+
     case ATAN:
 	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
 	result = cupl_atan(rightside);
@@ -257,6 +264,10 @@ static value cupl_eval(node *tree)
 	RETURN_WRAP(tree, tree->car, tree->cdr, result)
 	return(result);
 
+	/*
+	 * Matrix functions
+	 */
+
     case SGM:
 	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
 	result = cupl_sgm(rightside);
@@ -264,6 +275,90 @@ static value cupl_eval(node *tree)
 	RETURN_WRAP(tree, tree->car, tree->cdr, result)
 	return(result);
 
+	/*
+	 * Relations.
+	 *
+	 * These compute their value into the result node's rank field.
+	 */
+
+    case '=':
+	leftside = EVAL_WRAP(cupl_eval(tree->car));
+	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+	result.rank = cupl_eq(leftside, rightside);
+	RETURN_WRAP(tree, tree->car, tree->cdr, result)
+	return(result);
+
+    case NE:
+	leftside = EVAL_WRAP(cupl_eval(tree->car));
+	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+	result.rank = !cupl_eq(leftside, rightside);
+	RETURN_WRAP(tree, tree->car, tree->cdr, result)
+	return(result);
+
+    case LE:
+	leftside = EVAL_WRAP(cupl_eval(tree->car));
+	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+	result.rank = !cupl_gt(leftside, rightside);
+	RETURN_WRAP(tree, tree->car, tree->cdr, result)
+	return(result);
+
+    case GE:
+	leftside = EVAL_WRAP(cupl_eval(tree->car));
+	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+	result.rank = !cupl_lt(leftside, rightside);
+	RETURN_WRAP(tree, tree->car, tree->cdr, result)
+	return(result);
+
+    case LT:
+	leftside = EVAL_WRAP(cupl_eval(tree->car));
+	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+	result.rank = cupl_lt(leftside, rightside);
+	RETURN_WRAP(tree, tree->car, tree->cdr, result)
+	return(result);
+
+    case GT:
+	leftside = EVAL_WRAP(cupl_eval(tree->car));
+	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+	result.rank = cupl_gt(leftside, rightside);
+	RETURN_WRAP(tree, tree->car, tree->cdr, result)
+	return(result);
+
+	/*
+	 * Conjunctions.
+	 *
+	 * These assume that their left- and right-side nodes
+	 * are relations, so that the relation status is in the
+	 * rank field.
+	 */
+
+    case AND:
+	leftside = EVAL_WRAP(cupl_eval(tree->car));
+	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+	result.rank = leftside.rank && rightside.rank;
+	RETURN_WRAP(tree, tree->car, tree->cdr, result)
+	return(result);
+
+    case OR:
+	leftside = EVAL_WRAP(cupl_eval(tree->car));
+	rightside = EVAL_WRAP(cupl_eval(tree->cdr));
+	result.rank = leftside.rank || rightside.rank;
+	RETURN_WRAP(tree, tree->car, tree->cdr, result)
+	return(result);
+
+	/*
+	 * Control structures.
+	 */
+
+    case WHILE:
+	do {
+	    (void) cupl_eval(tree->car);
+
+	    cond = cupl_eval(tree->cdr);
+	} while
+	    (cond.rank);	/* conditional values use an odd convention */
+	result.rank = FAIL;
+	break;
+
     case STOP:
 	longjmp(jmpbuf, 1);
 	/* no fall through */
diff --git a/interpret.c b/interpret.c
index 6a998f4..cf37fe9 100644
--- a/interpret.c
+++ b/interpret.c
@@ -322,8 +322,6 @@ static void rewrite(node *tree)
 	    if (!found)
 		die("no END matching %s BLOCK\n", sp->car->u.string);
 	}
-
-	/* rewrite code coes here */
     }
 
     /* now, hack label references to eliminate name references */