Work on some local type inference.

Right to left type inference in expressions for binary operators.

examples/sysir/frontend.janet

@@ -12,13 +12,14 @@
 # * tail call returns
 # * function definitions
 # * arrays (declaration, loads, stores)
-# * ...
-# insight - using : inside symbols for types can be used to allow manipulating symbols with macros
+
+(defdyn *ret-type* "Current function return type")
 
 (def slot-to-name @[])
 (def name-to-slot @{})
 (def type-to-name @[])
 (def name-to-type @{})
+(def slot-types @{})
 
 (defn get-slot
   [&opt new-name]
@@ -44,6 +45,24 @@
   (assert t)
   t)
 
+(defn binding-type
+  [name]
+  (def slot (assert (get name-to-slot name)))
+  (assert (get slot-types slot)))
+
+(defn slot-type
+  [slot]
+  (assert (get slot-types slot)))
+
+(defn assign-type
+  [name typ]
+  (def slot (get name-to-slot name))
+  (put slot-types slot typ))
+
+(defn assign-slot-type
+  [slot typ]
+  (put slot-types slot typ))
+
 (defn setup-default-types
   [ctx]
   (def into @[])
@@ -76,21 +95,20 @@
 ### Inside functions
 ###
 
-(defdyn *ret-type* "Return type hint if inside function body")
-
 (defn visit1
   "Take in a form and compile code and put it into `into`. Return result slot."
   [code into &opt no-return type-hint]
+  (def subresult
       (cond
 
       # Compile a constant
       (string? code) ~(pointer ,code)
       (boolean? code) ~(boolean ,code)
-    (number? code) ~(,(or type-hint 'long) ,code) # TODO - should default to double
+      (number? code) ~(,(or type-hint 'double) ,code) # TODO - should default to double
 
       # Needed?
-    (= :core/u64 (type code)) ~(,(or type-hint 'ulong) ,code)
-    (= :core/s64 (type code)) ~(,(or type-hint 'long) ,code)
+      (= :core/u64 (type code)) ~(ulong ,code)
+      (= :core/s64 (type code)) ~(long ,code)
 
       # Binding
       (symbol? code)
@@ -142,8 +160,8 @@
             (def [name tp] (type-extract full-name 'int))
             (def result (visit1 value into false tp))
             (def slot (get-slot name))
-          (when tp
-            (array/push into ~(bind ,slot ,tp)))
+            (assign-type name tp)
+            (array/push into ~(bind ,slot ,tp))
             (array/push into ~(move ,slot ,result))
             slot)
 
@@ -156,8 +174,8 @@
             (def [name tp] (type-extract full-name 'int))
             (def result (visit1 value into false tp))
             (def slot (get-slot name))
-          (when tp
-            (array/push into ~(bind ,slot ,tp)))
+            (assign-type name tp)
+            (array/push into ~(bind ,slot ,tp))
             (array/push into ~(move ,slot ,result))
             slot)
 
@@ -166,7 +184,8 @@
           (do
             (assert (= 2 (length args)))
             (def [to x] args)
-          (def result (visit1 x into false))
+            (def type-hint (binding-type to))
+            (def result (visit1 x into false type-hint))
             (def toslot (named-slot to))
             (array/push into ~(move ,toslot ,result))
             toslot)
@@ -226,7 +245,10 @@
 
           # Insert IR
           'ir
-        (do (array/push into ;args) nil)
+          (do
+            (assert no-return)
+            (array/push into ;args)
+            nil)
 
           # Syscall
           'syscall
@@ -249,22 +271,39 @@
 
       (errorf "cannot compile %q" code)))
 
+  # Check type-hint matches return type
+  (if type-hint
+    (when-let [t (first subresult)] # TODO - Disallow empty types
+      (assert (= type-hint t) (string/format "%j, expected type %v, got %v" code type-hint t))))
+
+  subresult)
+
 (varfn do-binop
   "Emit an operation such as (+ x y).
   Extended to support any number of arguments such as (+ x y z ...)"
   [opcode args into type-hint]
+  (var typ type-hint)
   (var final nil)
+  (def slots @[])
   (each arg args
-    (def right (visit1 arg into false type-hint))
+    (def right (visit1 arg into false typ))
+    (when (number? right) (array/push slots right))
+
+    # If we don't have a type hint, infer types from bottom up
+    (when (nil? typ)
+      (when-let [new-typ (get slot-types right)]
+        (set typ new-typ)))
+
     (set final
          (if final
            (let [result (get-slot)]
-             # TODO - finish type inference - we should be able to omit the bind
-             # call and sysir should be able to infer the type
-             (array/push into ~(bind ,result int)) # Why int?
+             (array/push slots result)
              (array/push into ~(,opcode ,result ,final ,right))
              result)
            right)))
+  (assert typ (string "unable to infer type for %j" [opcode ;args]))
+  (each slot (distinct slots)
+    (array/push into ~(bind ,slot ,typ)))
   (assert final))
 
 (varfn do-comp
@@ -278,8 +317,13 @@
     (array/push into ~(bind ,temp-result boolean)))
   (var left nil)
   (var first-compare true)
+  (var typ nil)
   (each arg args
-    (def right (visit1 arg into))
+    (def right (visit1 arg into false typ))
+    # If we don't have a type hint, infer types from bottom up
+    (when (nil? typ)
+      (when-let [new-typ (get slot-types right)]
+        (set typ new-typ)))
     (when left
       (if first-compare
         (array/push into ~(,opcode ,result ,left ,right))
@@ -306,6 +350,7 @@
     (do
       # TODO doc strings
       (table/clear name-to-slot)
+      (table/clear slot-types)
       (array/clear slot-to-name)
       (def [name args & body] rest)
       (assert (tuple? args))
@@ -317,11 +362,12 @@
       (each arg args
         (def [name tp] (type-extract arg 'int))
         (def slot (get-slot name))
+        (assign-type name tp)
         (array/push ir-asm ~(bind ,slot ,tp)))
       (with-dyns [*ret-type* fn-tp]
         (each part body
           (visit1 part ir-asm true)))
-      # (eprintf "%.99M" ir-asm)
+      (eprintf "%.99M" ir-asm)
       (sysir/asm ctx ir-asm))
 
     (errorf "unknown form %v" form)))

examples/sysir/samples.janet

@@ -2,7 +2,7 @@
 
 (def square
   '(defn square:int [num:int]
-     (return (* num num))))
+     (return (* 1 num num))))
 
 (def simple
   '(defn simple:int [x:int]
@@ -13,10 +13,10 @@
   '(defn myprog:int []
      (def xyz:int (+ 1 2 3))
      (def abc:int (* 4 5 6))
-     (def x:boolean (= (the int 5) xyz))
+     (def x:boolean (= xyz 5))
      (var i:int 0)
-     (while (< i (the int 10))
-       (set i (the int (+ 1 i)))
+     (while (< i 10)
+       (set i (+ 1 i))
        (printf "i = %d\n" i))
      (printf "hello, world!\n%d\n" (the int (if x abc xyz)))
      #(return (* abc xyz))))
@@ -46,5 +46,5 @@
 (compile1 doloop)
 (compile1 main-fn)
 #(dump)
-#(dumpc)
-(dumpx64)
+(dumpc)
+#(dumpx64)