More work on frontend.

examples/sysir/frontend.janet

@@ -51,16 +51,18 @@
     (array/push into ~(type-prim ,name ,native-name))
     (make-type name))
   (add-prim-type 'float 'f32)
-  (add-prim-type 'double 'f64))
+  (add-prim-type 'double 'f64)
+  (add-prim-type 'boolean 'boolean))
 
 (defn type-extract
   "Given a symbol:type combination, extract the proper name and the type separately"
   [combined-name &opt default-type]
-  (def parts (string/split ":" combined-name 0 1))
+  (def parts (string/split ":" combined-name 0 2))
   (def [name tp] parts)
   [(symbol name) (symbol (or tp default-type))])
 
 (var do-binop nil)
+(var do-comp nil)
 
 (defn visit1
   "Take in a form and compile code and put it into `into`. Return result slot."
@@ -92,6 +94,14 @@
         '* (do-binop 'multiply args into)
         '/ (do-binop 'divide args into)
 
+        # Comparison
+        '= (do-comp 'eq args into)
+        'not= (do-comp 'neq args into)
+        '< (do-comp 'lt args into)
+        '<= (do-comp 'lte args into)
+        '> (do-comp 'gt args into)
+        '>= (do-comp 'gte args into)
+
         # Type hinting
         'the
         (do
@@ -111,7 +121,8 @@
           (def [name tp] (type-extract full-name 'double))
           (def result (visit1 value into))
           (def slot (get-slot name))
-          (array/push into ~(bind ,slot ,tp))
+          (when tp
+            (array/push into ~(bind ,slot ,tp)))
           (array/push into ~(move ,slot ,result))
           slot)
 
@@ -146,6 +157,8 @@
     (errorf "cannot compile %V" code)))
 
 (varfn do-binop
+  "Emit a 'binary' op succh as (+ x y). 
+  Extended to support any number of arguments such as (+ x y z ...)"
   [opcode args into]
   (var final nil)
   (each arg args
@@ -161,14 +174,38 @@
            right)))
   (assert final))
 
+(varfn do-comp
+  "Emit a comparison form such as (= x y z ...)"
+  [opcode args into]
+  (def result (get-slot))
+  (def needs-temp (> 2 (length args)))
+  (def temp-result (if needs-temp (get-slot) nil))
+  (array/push into ~(bind ,result boolean))
+  (when needs-temp
+    (array/push into ~(bind ,temp-result boolean)))
+  (var left nil)
+  (var first-compare true)
+  (each arg args
+    (def right (visit1 arg into))
+    (when left
+      (if first-compare
+        (array/push into ~(,opcode ,result ,left ,right))
+        (do
+          (array/push into ~(,opcode ,temp-result ,left ,right))
+          (array/push into ~(and ,result ,temp-result ,result))))
+      (set first-compare false))
+    (set left right))
+  result)
+
 ###
 ###
 ###
 
 (def myprog
   '(do
-     (def xyz (+ 1 2 3))
+     (def xyz:double (+ 1 2 3))
-     (def abc (* 4 5 6))
+     (def abc:double (* 4 5 6))
+     (def x:boolean (= 5 7))
      (return (/ abc xyz))))
 
 (defn dotest

src/core/gc.c

@@ -132,7 +132,7 @@ static void janet_mark_many(const Janet *values, int32_t n) {
     }
 }
 
-/* Mark a bunch of key values items in memory */
+/* Mark only the keys from a sequence of key-value pairs */
 static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
     const JanetKV *end = kvs + n;
     while (kvs < end) {
@@ -141,7 +141,7 @@ static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
     }
 }
 
-/* Mark a bunch of key values items in memory */
+/* Mark only the values from a sequence of key-value pairs */
 static void janet_mark_values(const JanetKV *kvs, int32_t n) {
     const JanetKV *end = kvs + n;
     while (kvs < end) {
@@ -150,7 +150,7 @@ static void janet_mark_values(const JanetKV *kvs, int32_t n) {
     }
 }
 
-/* Mark a bunch of key values items in memory */
+/* Mark key-value pairs */
 static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
     const JanetKV *end = kvs + n;
     while (kvs < end) {

src/core/net.c

@@ -120,6 +120,18 @@ static void janet_net_socknoblock(JSock s) {
 #endif
 }
 
+static void janet_net_nodelay(JanetStream *stream) {
+    int flag = 1;
+    setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
+    stream->flags |= JANET_STREAM_BUFFERED;
+}
+
+static void janet_net_delay(JanetStream *stream) {
+    int flag = 0;
+    setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
+    stream->flags &= ~JANET_STREAM_BUFFERED;
+}
+
 /* State machine for async connect */
 
 void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
@@ -953,6 +965,7 @@ struct sockopt_type {
 /* List of supported socket options; The type JANET_POINTER is used
  * for options that require special handling depending on the type. */
 static const struct sockopt_type sockopt_type_list[] = {
+    { "tcp-nodelay",  IPPROTO_TCP, TCP_NODELAY, JANET_BOOLEAN },
     { "so-broadcast", SOL_SOCKET, SO_BROADCAST, JANET_BOOLEAN },
     { "so-reuseaddr", SOL_SOCKET, SO_REUSEADDR, JANET_BOOLEAN },
     { "so-keepalive", SOL_SOCKET, SO_KEEPALIVE, JANET_BOOLEAN },
@@ -974,6 +987,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
               "- :so-broadcast boolean\n"
               "- :so-reuseaddr boolean\n"
               "- :so-keepalive boolean\n"
+              "- :tcp-nodelay boolean\n"
               "- :ip-multicast-ttl number\n"
               "- :ip-add-membership string\n"
               "- :ip-drop-membership string\n"

src/core/sysir.c

@@ -31,7 +31,6 @@
  * [x] named registers and types
  * [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top)
  * [ ] switch internal use of uint32_t everywhere to type struct wrappers for safety
- * [ ] support for switch-case
  * [ ] x86/x64 machine code target
  * [ ] LLVM target
  * [ ] target specific extensions - custom instructions and custom primitives
@@ -1075,9 +1074,112 @@ static JanetString rname(JanetSysIR *sysir, uint32_t regid) {
     return name;
 }
 
+static int reg_is_unknown_type(JanetSysIR *sysir, uint32_t reg) {
+    JanetSysIRLinkage *linkage = sysir->linkage;
+    uint32_t t = sysir->types[reg];
+    return (linkage->type_defs[t].prim == JANET_PRIM_UNKNOWN);
+}
+
 static void janet_sysir_type_check(JanetSysIR *sysir) {
 
-    /* TODO: Simple forward type inference */
+    /* Simple forward type inference */
+    for (uint32_t i = 0; i < sysir->instruction_count; i++) {
+        JanetSysInstruction instruction = sysir->instructions[i];
+        switch (instruction.opcode) {
+            default:
+                break;
+            case JANET_SYSOP_MOVE:
+                if (reg_is_unknown_type(sysir, instruction.two.dest)) {
+                    sysir->types[instruction.two.dest] = sysir->types[instruction.two.src];
+                }
+                if (reg_is_unknown_type(sysir, instruction.two.src)) {
+                    sysir->types[instruction.two.src] = sysir->types[instruction.two.dest];
+                }
+                break;
+            case JANET_SYSOP_CAST:
+                tcheck_cast(sysir, instruction.two.dest, instruction.two.src);
+                break;
+            case JANET_SYSOP_POINTER_ADD:
+            case JANET_SYSOP_POINTER_SUBTRACT:
+                tcheck_pointer_math(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.rhs);
+                break;
+            case JANET_SYSOP_ADD:
+            case JANET_SYSOP_SUBTRACT:
+            case JANET_SYSOP_MULTIPLY:
+            case JANET_SYSOP_DIVIDE:
+                tcheck_number(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.dest]));
+                tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs);
+                tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
+                break;
+            case JANET_SYSOP_BAND:
+            case JANET_SYSOP_BOR:
+            case JANET_SYSOP_BXOR:
+                tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.dest]));
+                tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs);
+                tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
+                break;
+            case JANET_SYSOP_BNOT:
+                tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.two.src]));
+                tcheck_equal(sysir, instruction.two.dest, instruction.two.src);
+                break;
+            case JANET_SYSOP_SHL:
+            case JANET_SYSOP_SHR:
+                tcheck_integer(sysir, tcheck_array_element(sysir, sysir->types[instruction.three.lhs]));
+                tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs);
+                tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
+                break;
+            case JANET_SYSOP_LOAD:
+                tcheck_pointer_equals(sysir, instruction.two.src, instruction.two.dest);
+                break;
+            case JANET_SYSOP_STORE:
+                tcheck_pointer_equals(sysir, instruction.two.dest, instruction.two.src);
+                break;
+            case JANET_SYSOP_GT:
+            case JANET_SYSOP_LT:
+            case JANET_SYSOP_EQ:
+            case JANET_SYSOP_NEQ:
+            case JANET_SYSOP_GTE:
+            case JANET_SYSOP_LTE:
+                /* TODO - allow arrays */
+                tcheck_number_or_pointer(sysir, sysir->types[instruction.three.lhs]);
+                tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs);
+                //tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
+                tcheck_boolean(sysir, sysir->types[instruction.three.dest]);
+                break;
+            case JANET_SYSOP_ADDRESS:
+                tcheck_pointer(sysir, sysir->types[instruction.two.dest]);
+                break;
+            case JANET_SYSOP_BRANCH:
+                tcheck_boolean(sysir, sysir->types[instruction.branch.cond]);
+                if (instruction.branch.to >= sysir->instruction_count) {
+                    janet_panicf("label outside of range [0, %u), got %u", sysir->instruction_count, instruction.branch.to);
+                }
+                break;
+            case JANET_SYSOP_CONSTANT:
+                tcheck_constant(sysir, instruction.constant.dest, sysir->constants[instruction.constant.constant]);
+                break;
+            case JANET_SYSOP_CALL:
+                tcheck_pointer(sysir, sysir->types[instruction.call.callee]);
+                break;
+            case JANET_SYSOP_ARRAY_GETP:
+                tcheck_array_getp(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.lhs);
+                break;
+            case JANET_SYSOP_ARRAY_PGETP:
+                tcheck_array_pgetp(sysir, instruction.three.dest, instruction.three.lhs, instruction.three.lhs);
+                break;
+            case JANET_SYSOP_FIELD_GETP:
+                tcheck_fgetp(sysir, instruction.field.r, instruction.field.st, instruction.field.field);
+                break;
+            case JANET_SYSOP_CALLK:
+                /* TODO - check function return type */
+                break;
+        }
+        /* Write back possibly modified instruction */
+        sysir->instructions[i] = instruction;
+    }
+}
+
+
 
     /* Assert no unknown types */
     JanetSysIRLinkage *linkage = sysir->linkage;
@@ -1173,7 +1275,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) {
                 /* TODO - allow arrays */
                 tcheck_number_or_pointer(sysir, sysir->types[instruction.three.lhs]);
                 tcheck_equal(sysir, instruction.three.lhs, instruction.three.rhs);
-                tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
+                //tcheck_equal(sysir, instruction.three.dest, instruction.three.lhs);
                 tcheck_boolean(sysir, sysir->types[instruction.three.dest]);
                 break;
             case JANET_SYSOP_ADDRESS:

src/include/janet.h

@@ -584,6 +584,7 @@ typedef void *JanetAbstract;
 #define JANET_STREAM_WRITABLE 0x400
 #define JANET_STREAM_ACCEPTABLE 0x800
 #define JANET_STREAM_UDPSERVER 0x1000
+#define JANET_STREAM_BUFFERED 0x2000
 #define JANET_STREAM_TOCLOSE 0x10000
 
 typedef enum {