Add some more opcodes for comparison with numeric types.

doc/bytecode.md

@@ -172,17 +172,24 @@ failure to return or error.
 | `bxor`      | `(bxor dest lhs rhs)`       | $dest = $lhs ^ $rhs               |
 | `call`      | `(call dest callee)`        | $dest = call($callee)             |
 | `clo`       | `(clo dest index)`          | $dest = closure(defs[$index])     |
-| `cmp`       | `(cmp dest lhs rhs)`        | $dest = dst_compare($lhs, $rhs)   |
+| `cmp`       | `(cmp dest lhs rhs)`        | $dest = dst\_compare($lhs, $rhs)  |
 | `debug`     | `(debug)`                   | Suspend current fiber             |
 | `div`       | `(div dest lhs rhs)`        | $dest = $lhs / $rhs               |
 | `divi`      | `(divi dest lhs rhs)`       | $dest = $lhs /i $rhs              |
 | `divim`     | `(divim dest lhs im)`       | $dest = $lhs /i im                |
 | `divr`      | `(divr dest lhs rhs)`       | $dest = $lhs /r $rhs              |
 | `eq`        | `(eq dest lhs rhs)`         | $dest = $lhs == $rhs              |
+| `eqi`       | `(eqi dest lhs rhs)`        | $dest = $lhs ==i $rhs             |
+| `eqim`      | `(eqim dest lhs im)`        | $dest = $lhs ==i im               |
+| `eqr`       | `(eqr dest lhs rhs)`        | $dest = $lhs ==r $rhs             |
 | `err`       | `(err message)`             | Throw error $message.             |
 | `get`       | `(get dest ds key)`         | $dest = $ds[$key]                 |
 | `geti`      | `(geti dest ds index)`      | $dest = $ds[index]                |
 | `gt`        | `(gt dest lhs rhs)`         | $dest = $lhs > $rhs               |
+| `gti`       | `(gti dest lhs rhs)`        | $dest = $lhs \>i $rhs             |
+| `gtim`      | `(gtim dest lhs im)`        | $dest = $lhs \>i im               |
+| `gtr`       | `(gtr dest lhs rhs)`        | $dest = $lhs \>r $rhs             |
+| `gter`      | `(gter dest lhs rhs)`       | $dest = $lhs >=r $rhs             |
 | `jmp`       | `(jmp label)`               | pc = label, pc += offset          |
 | `jmpif`     | `(jmpif cond label)`        | if $cond pc = label else pc++     |
 | `jmpno`     | `(jmpno cond label)`        | if $cond pc++ else pc = label     |
@@ -194,6 +201,10 @@ failure to return or error.
 | `ldt`       | `(ldt dest)`                | $dest = true                      |
 | `ldu`       | `(ldu dest env index)`      | $dest = envs[env][index]          |
 | `lt`        | `(lt dest lhs rhs)`         | $dest = $lhs < $rhs               |
+| `lti`       | `(lti dest lhs rhs)`        | $dest = $lhs \<i $rhs             |
+| `ltim`      | `(ltim dest lhs im)`        | $dest = $lhs \<i im               |
+| `ltr`       | `(ltr dest lhs rhs)`        | $dest = $lhs \<r $rhs             |
+| `lter`      | `(lter dest lhs rhs)`       | $dest = $lhs <=r $rhs             |
 | `movf`      | `(movf src dest)`           | $dest = $src                      |
 | `movn`      | `(movn dest src)`           | $dest = $src                      |
 | `mul`       | `(mul dest lhs rhs)`        | $dest = $lhs * $rhs               |

src/assembler/asm.c

@@ -93,10 +93,17 @@ static const DstInstructionDef dst_ops[] = {
     {"divim", DOP_DIVIDE_IMMEDIATE},
     {"divr", DOP_DIVIDE_REAL},
     {"eq", DOP_EQUALS},
+    {"eqi", DOP_EQUALS_INTEGER},
+    {"eqim", DOP_EQUALS_IMMEDIATE},
+    {"eqr", DOP_EQUALS_REAL},
     {"err", DOP_ERROR},
     {"get", DOP_GET},
     {"geti", DOP_GET_INDEX},
     {"gt", DOP_GREATER_THAN},
+    {"gti", DOP_GREATER_THAN_INTEGER},
+    {"gtim", DOP_GREATER_THAN_IMMEDIATE},
+    {"gtr", DOP_GREATER_THAN_REAL},
+    {"gter", DOP_GREATER_THAN_EQUAL_REAL},
     {"jmp", DOP_JUMP},
     {"jmpif", DOP_JUMP_IF},
     {"jmpno", DOP_JUMP_IF_NOT},
@@ -108,6 +115,10 @@ static const DstInstructionDef dst_ops[] = {
     {"ldt", DOP_LOAD_TRUE},
     {"ldu", DOP_LOAD_UPVALUE},
     {"lt", DOP_LESS_THAN},
+    {"lti", DOP_LESS_THAN_INTEGER},
+    {"ltim", DOP_LESS_THAN_IMMEDIATE},
+    {"ltr", DOP_LESS_THAN_REAL},
+    {"lter", DOP_LESS_THAN_EQUAL_REAL},
     {"movf", DOP_MOVE_FAR},
     {"movn", DOP_MOVE_NEAR},
     {"mul", DOP_MULTIPLY},

src/compiler/boot.dst

@@ -41,6 +41,20 @@
  (apply1 tuple (array-concat
   @['defmacro name :private] more)))
 
+(defmacro defdo
+ "Define a value inside of a do form."
+ [name & more]
+ (apply1 tuple (array-concat
+  @['def name]
+  (apply1 tuple (array-concat @['do] more)))))
+
+(defmacro defdo-
+ "Define a private value inside of a do form."
+ [name & more]
+ (apply1 tuple (array-concat
+  @['def name :private]
+  (apply1 tuple (array-concat @['do] more)))))
+
 (defmacro defn-
  "Define a private function that will not be exported."
  [name & more]

src/core/bytecode.c

@@ -62,8 +62,19 @@ enum DstInstructionType dst_instructions[DOP_INSTRUCTION_COUNT] = {
     DIT_SL, /* DOP_JUMP_IF, */
     DIT_SL, /* DOP_JUMP_IF_NOT, */
     DIT_SSS, /* DOP_GREATER_THAN, */
+    DIT_SSS, /* DOP_GREATER_THAN_INTEGER, */
+    DIT_SSI, /* DOP_GREATER_THAN_IMMEDIATE, */
+    DIT_SSS, /* DOP_GREATER_THAN_REAL, */
+    DIT_SSS, /* DOP_GREATER_THAN_EQUAL_REAL, */
     DIT_SSS, /* DOP_LESS_THAN, */
+    DIT_SSS, /* DOP_LESS_THAN_INTEGER, */
+    DIT_SSI, /* DOP_LESS_THAN_IMMEDIATE, */
+    DIT_SSS, /* DOP_LESS_THAN_REAL, */
+    DIT_SSS, /* DOP_LESS_THAN_EQUAL_REAL, */
     DIT_SSS, /* DOP_EQUALS, */
+    DIT_SSS, /* DOP_EQUALS_INTEGER, */
+    DIT_SSI, /* DOP_EQUALS_IMMEDIATE, */
+    DIT_SSS, /* DOP_EQUALS_REAL, */
     DIT_SSS, /* DOP_COMPARE, */
     DIT_S, /* DOP_LOAD_NIL, */
     DIT_S, /* DOP_LOAD_TRUE, */

src/core/vm.c

@@ -108,8 +108,19 @@ static void *op_lookup[255] = {
     &&label_DOP_JUMP_IF,
     &&label_DOP_JUMP_IF_NOT,
     &&label_DOP_GREATER_THAN,
+    &&label_DOP_GREATER_THAN_INTEGER,
+    &&label_DOP_GREATER_THAN_IMMEDIATE,
+    &&label_DOP_GREATER_THAN_REAL,
+    &&label_DOP_GREATER_THAN_EQUAL_REAL,
     &&label_DOP_LESS_THAN,
+    &&label_DOP_LESS_THAN_INTEGER,
+    &&label_DOP_LESS_THAN_IMMEDIATE,
+    &&label_DOP_LESS_THAN_REAL,
+    &&label_DOP_LESS_THAN_EQUAL_REAL,
     &&label_DOP_EQUALS,
+    &&label_DOP_EQUALS_INTEGER,
+    &&label_DOP_EQUALS_IMMEDIATE,
+    &&label_DOP_EQUALS_REAL,
     &&label_DOP_COMPARE,
     &&label_DOP_LOAD_NIL,
     &&label_DOP_LOAD_TRUE,
@@ -389,6 +400,39 @@ static void *op_lookup[255] = {
     pc++;
     vm_next();
 
+    /* Candidate */
+    VM_OP(DOP_LESS_THAN_INTEGER)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) <
+            dst_unwrap_integer(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_LESS_THAN_IMMEDIATE)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) < ((*(int32_t *)pc) >> 24)
+    );
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_LESS_THAN_REAL)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_real(stack[oparg(2, 0xFF)]) <
+            dst_unwrap_real(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_LESS_THAN_EQUAL_REAL)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_real(stack[oparg(2, 0xFF)]) <=
+            dst_unwrap_real(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
+
     VM_OP(DOP_GREATER_THAN)
     stack[oparg(1, 0xFF)] = dst_wrap_boolean(dst_compare(
             stack[oparg(2, 0xFF)],
@@ -397,6 +441,38 @@ static void *op_lookup[255] = {
     pc++;
     vm_next();
 
+    /* Candidate */
+    VM_OP(DOP_GREATER_THAN_INTEGER)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) >
+            dst_unwrap_integer(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_GREATER_THAN_IMMEDIATE)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) > ((*(int32_t *)pc) >> 24)
+    );
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_GREATER_THAN_REAL)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_real(stack[oparg(2, 0xFF)]) >
+            dst_unwrap_real(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_GREATER_THAN_EQUAL_REAL)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_real(stack[oparg(2, 0xFF)]) >=
+            dst_unwrap_real(stack[oparg(3, 0xFF)]));
+    pc++;
+    vm_next();
+
     VM_OP(DOP_EQUALS)
     stack[oparg(1, 0xFF)] = dst_wrap_boolean(dst_equals(
             stack[oparg(2, 0xFF)],
@@ -405,6 +481,32 @@ static void *op_lookup[255] = {
     pc++;
     vm_next();
 
+    /* Candidate */
+    VM_OP(DOP_EQUALS_INTEGER)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) ==
+            dst_unwrap_integer(stack[oparg(3, 0xFF)])
+        );
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_EQUALS_REAL)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_real(stack[oparg(2, 0xFF)]) ==
+            dst_unwrap_real(stack[oparg(3, 0xFF)])
+        );
+    pc++;
+    vm_next();
+
+    /* Candidate */
+    VM_OP(DOP_EQUALS_IMMEDIATE)
+    stack[oparg(1, 0xFF)] = dst_wrap_boolean(
+            dst_unwrap_integer(stack[oparg(2, 0xFF)]) == ((*(int32_t *)pc) >> 24)
+    );
+    pc++;
+    vm_next();
+
     VM_OP(DOP_COMPARE)
     stack[oparg(1, 0xFF)] = dst_wrap_integer(dst_compare(
         stack[oparg(2, 0xFF)],

src/include/dst/dstopcodes.h

@@ -94,8 +94,19 @@ enum DstOpCode {
     DOP_JUMP_IF,
     DOP_JUMP_IF_NOT,
     DOP_GREATER_THAN,
+    DOP_GREATER_THAN_INTEGER,
+    DOP_GREATER_THAN_IMMEDIATE,
+    DOP_GREATER_THAN_REAL,
+    DOP_GREATER_THAN_EQUAL_REAL,
     DOP_LESS_THAN,
+    DOP_LESS_THAN_INTEGER,
+    DOP_LESS_THAN_IMMEDIATE,
+    DOP_LESS_THAN_REAL,
+    DOP_LESS_THAN_EQUAL_REAL,
     DOP_EQUALS,
+    DOP_EQUALS_INTEGER,
+    DOP_EQUALS_IMMEDIATE,
+    DOP_EQUALS_REAL,
     DOP_COMPARE,
     DOP_LOAD_NIL,
     DOP_LOAD_TRUE,

src/mainclient/init.dst

@@ -1,55 +1,51 @@
 (do
 
-(var *should-repl* :private false)
+  (var *should-repl* :private false)
-(var *no-file* :private true)
+  (var *no-file* :private true)
-(var *raw-stdin* :private false)
+  (var *raw-stdin* :private false)
 
-# Flag handlers
+  # Flag handlers
-(def handlers :private {
+  (def handlers :private {
-  "h" (fn [] 
+                          "h" (fn [] 
-        (print "usage: " (get args 0) " [options] scripts...")
+                                  (print "usage: " (get args 0) " [options] scripts...")
-        (print "Options are:")
+                                  (print "Options are:")
-        (print "  -h Show this help")
+                                  (print "  -h Show this help")
-        (print "  -v Print the version string")
+                                  (print "  -v Print the version string")
-        (print "  -s Use raw stdin instead of getline like functionality")
+                                  (print "  -s Use raw stdin instead of getline like functionality")
-        (print "  -e Execute a string of dst")
+                                  (print "  -e Execute a string of dst")
-        (print "  -r Enter the repl after running all scripts")
+                                  (print "  -r Enter the repl after running all scripts")
-        (os-exit 0)
+                                  (os-exit 0)
-        1)
+                                  1)
-  "v" (fn [] (print VERSION) (os-exit 0) 1)
+                          "v" (fn [] (print VERSION) (os-exit 0) 1)
-  "s" (fn [] (:= *raw-stdin* true) (:= *should-repl* true) 1)
+                          "s" (fn [] (:= *raw-stdin* true) (:= *should-repl* true) 1)
-  "r" (fn [] (:= *should-repl* true) 1)
+                          "r" (fn [] (:= *should-repl* true) 1)
-  "e" (fn [i] 
+                          "e" (fn [i] 
-       (:= *no-file* false)
+                                  (:= *no-file* false)
-       (eval (get args (+ i 1)))
+                                  (eval (get args (+ i 1)))
-       2)
+                                  2)
-})
+                          })
 
-(defn- dohandler [n i]
+  (defn- dohandler [n i]
- (def h (get handlers n))
+    (def h (get handlers n))
- (if h (h i) (print "unknown flag -" n)))
+    (if h (h i) (print "unknown flag -" n)))
 
-# Process arguments
+  # Process arguments
-(var i 1)
+  (var i 1)
-(def lenargs (length args))
+  (def lenargs (length args))
-(while (< i lenargs)
+  (while (< i lenargs)
- (def arg (get args i))
+         (def arg (get args i))
- (if (= "-" (string-slice arg 0 1))
+         (if (= "-" (string-slice arg 0 1))
-  (+= i (dohandler (string-slice arg 1 2) i))
+           (+= i (dohandler (string-slice arg 1 2) i))
-  (do
+           (do
-   (:= *no-file* false)
+             (:= *no-file* false)
-   (import arg)
+             (import arg)
-   (++ i))))
+             (++ i))))
 
-(defn xgetline [buf p]
+  (when (or *should-repl* *no-file*) 
-  (def prompt (string (parser-state p) "> "))
+    (if *raw-stdin*
-  (getline prompt buf))
+      (repl nil identity)
-
+      (do
-(when (or *should-repl* *no-file*) 
+        (print (string "Dst " VERSION "  Copyright (C) 2017-2018 Calvin Rose"))
-  (if *raw-stdin*
+        (repl (fn [buf p]
-    (repl nil identity)
+                  (def prompt (string (parser-state p) "> "))
-    (do
+                  (getline prompt buf)))))))
-      (print (string "Dst " VERSION "  Copyright (C) 2017-2018 Calvin Rose"))
-      (repl xgetline))))
-
-)