From fed0f8b6b42f11740d673131edecdff1764053a9 Mon Sep 17 00:00:00 2001
From: Dale Weiler <killfieldengine@gmail.com>
Date: Tue, 5 Feb 2013 16:34:03 +0000
Subject: [PATCH] Work in progress <=> operator.

---
 lexer.c             | 14 +++++++++---
 lexer.h             |  1 +
 parser.c            | 52 +++++++++++++++++++++++++++++++++++++++++++--
 tests/perl-ops.qc   | 19 +++++++++++++++++
 tests/perl-ops.tmpl |  7 ++++++
 5 files changed, 88 insertions(+), 5 deletions(-)
 create mode 100644 tests/perl-ops.qc
 create mode 100644 tests/perl-ops.tmpl

diff --git a/lexer.c b/lexer.c
index 42b21a1..0dc17ad 100644
--- a/lexer.c
+++ b/lexer.c
@@ -1289,15 +1289,22 @@ int lex_do(lex_file *lex)
 
     if (ch == '+' || ch == '-' || /* ++, --, +=, -=  and -> as well! */
         ch == '>' || ch == '<' || /* <<, >>, <=, >=                  */
-        ch == '=' || ch == '!' || /* ==, !=                          */
+        ch == '=' || ch == '!' || /* <=>, ==, !=                     */
         ch == '&' || ch == '|' || /* &&, ||, &=, |=                  */
         ch == '~'                 /* ~=, ~                           */
     )  {
         lex_tokench(lex, ch);
 
         nextch = lex_getch(lex);
-        if (nextch == '=' || (nextch == ch && ch != '!')) {
+        if ((nextch == '=' && ch != '<') || (nextch == ch && ch != '!')) {
             lex_tokench(lex, nextch);
+        } else if (ch == '<' && nextch == '=') {
+            lex_tokench(lex, nextch);
+            if ((thirdch = lex_getch(lex)) == '>')
+                lex_tokench(lex, thirdch);
+            else
+                lex_ungetch(lex, thirdch);
+
         } else if (ch == '-' && nextch == '>') {
             lex_tokench(lex, nextch);
         } else if (ch == '&' && nextch == '~') {
@@ -1321,8 +1328,9 @@ int lex_do(lex_file *lex)
                 lex->tok.constval.f = -lex->tok.constval.f;
             lex_endtoken(lex);
             return lex->tok.ttype;
-        } else
+        } else {
             lex_ungetch(lex, nextch);
+        }
 
         lex_endtoken(lex);
         return (lex->tok.ttype = TOKEN_OPERATOR);
diff --git a/lexer.h b/lexer.h
index 75fb83e..15730ee 100644
--- a/lexer.h
+++ b/lexer.h
@@ -191,6 +191,7 @@ static const oper_info c_operators[] = {
 
     { "<",   2, opid1('<'),         ASSOC_LEFT,  10, 0 },
     { ">",   2, opid1('>'),         ASSOC_LEFT,  10, 0 },
+    { "<=>", 2, opid3('<','=','>'), ASSOC_LEFT,  10, 0 },
     { "<=",  2, opid2('<','='),     ASSOC_LEFT,  10, 0 },
     { ">=",  2, opid2('>','='),     ASSOC_LEFT,  10, 0 },
 
diff --git a/parser.c b/parser.c
index 3375acc..e2bb6ee 100644
--- a/parser.c
+++ b/parser.c
@@ -1068,6 +1068,51 @@ static bool parser_sy_apply_operator(parser_t *parser, shunt *sy)
                 out = (ast_expression*)ast_ternary_new(ctx, exprs[0], exprs[1], exprs[2]);
             break;
 
+        case opid3('<', '=', '>'): /* -1, 0, or 1 */
+            if (NotSameType(TYPE_FLOAT)) {
+                ast_type_to_string(exprs[0], ty1, sizeof(ty1));
+                ast_type_to_string(exprs[1], ty2, sizeof(ty2));
+                compile_error(ctx, "invalid types used in comparision: %s and %s",
+                    ty1, ty2);
+
+                return false;
+            }
+
+            if (CanConstFold(exprs[0], exprs[1])) {
+                if (ConstF(0) < ConstF(1))
+                    out = (ast_expression*)parser_const_float_neg1(parser);
+                else if (ConstF(0) == ConstF(1))
+                    out = (ast_expression*)parser_const_float_0(parser);
+                else if (ConstF(0) > ConstF(1))
+                    out = (ast_expression*)parser_const_float_1(parser);
+            } else {
+                    /* if (lt) { */
+                out = (ast_expression*)ast_ternary_new(ctx,
+                        (ast_expression*)ast_binary_new(ctx, INSTR_LT, exprs[0], exprs[1]),
+
+                        /* out = -1 */
+                        (ast_expression*)parser_const_float_neg1(parser),
+
+                    /* } else { */
+                        /* if (eq) { */
+                        (ast_expression*)ast_ternary_new(ctx,
+                            (ast_expression*)ast_binary_new(ctx, INSTR_EQ_F, exprs[0], exprs[1]),
+
+                            /* out = 0 */
+                            (ast_expression*)parser_const_float_0(parser),
+
+                        /* } else { */
+
+                            /* out = 1 */
+                            (ast_expression*)parser_const_float_1(parser)
+                        /* } */
+                        )
+                    /* } */
+                    );
+
+            }
+            break;
+
         case opid1('>'):
             generated_op += 1; /* INSTR_GT */
         case opid1('<'):
@@ -1372,7 +1417,6 @@ static bool parser_sy_apply_operator(parser_t *parser, shunt *sy)
             else
                 out = (ast_expression*)ast_binary_new(ctx, INSTR_SUB_F, (ast_expression*)parser_const_float_neg1(parser), exprs[0]);
             break;
-            
     }
 #undef NotSameType
 
@@ -1899,7 +1943,11 @@ static ast_expression* parse_expression_leave(parser_t *parser, bool stopatcomma
             }
             if (o == operator_count) {
                 /* no operator found... must be the end of the statement */
-                break;
+                compile_error(parser_ctx(parser), "unknown operator: %s", parser_tokval(parser));
+                goto onerr;
+
+                /*Are there any expressions which actually end with an operator?*/
+                /*break;*/
             }
             /* found an operator */
             op = &operators[o];
diff --git a/tests/perl-ops.qc b/tests/perl-ops.qc
new file mode 100644
index 0000000..ee6631b
--- /dev/null
+++ b/tests/perl-ops.qc
@@ -0,0 +1,19 @@
+void main() {
+    /* so far only one perl operator is implemented */
+    float x = 100;
+    float y = 200;
+    float z = 300;
+
+    /* to ensure runtime */
+    x += 1;
+    y += 1;
+    z += 1;
+
+    float test_x = (x <=> x + 1); // -1 less than
+    float test_y = (x <=> x);     //  0 equal
+    float test_z = (x <=> x - 1); //  1 greater than
+
+    print(ftos(test_x), "\n");
+    print(ftos(test_y), "\n");
+    print(ftos(test_z), "\n");
+}
diff --git a/tests/perl-ops.tmpl b/tests/perl-ops.tmpl
new file mode 100644
index 0000000..f3f1eb5
--- /dev/null
+++ b/tests/perl-ops.tmpl
@@ -0,0 +1,7 @@
+I: perl-opts.qc
+D: test perl operators
+T: -execute
+C: -std=gmqcc
+M: -1
+M: 0
+M: 1
-- 
2.39.2