solved severe bug in constraint solver, fixed the game

examples/game3.carp

@@ -19,7 +19,7 @@
 (defn t []
   (dtof (glfwGetTime)))
 
-^ann '(:fn ((:ref (:Array :Ship))) :void)
+;;^ann '(:fn ((:ref (:Array :Ship))) :void)
 (defn draw [state]
   (do
     (draw-line 300f 200f (+ 300f (* 100.0f (sinf (t)))) (+ 200f (* 100.0f (cosf (t)))))

examples/project.carp

@@ -10,21 +10,44 @@
 ;; (println (str (B true)))
 
 
+(defn f [s]
+  (println s))
 
+;;^ann '(:fn ((:ref (:Array :string))) :void)
+(defn draws [state]
+  (domap f state))
 
-^ann '(:fn ((:ref (:Array :string))) :void)
+(defn run-app [draw-fn]
-(defn draw [state]
+  (let [state [(copy "hej") (copy "på") (copy "dig!")]]
-  (domap println state))
+    (draw-fn &state)))
-
-(defn run-app [init-state draw-fn]
-  (draw-fn init-state))
 
 (defn app []
-  (let [state ["hej" "på" "dig!"]]
+  (run-app draws))
-    (run-app state draw)))
 
 
+(def CONSTRS (list
               
+              {:a "x", 
+               :b '(:BLURG :FLORP)}
+              
+              {:a '("y" "c"), 
+               :b '(("a" "b") "a")}
+              
+              ))
+
+;; (println (str "1:\n" (solve-constraints (cons-last CONSTRS {:a "x" :b "y"}))))
+;; (println (str "\n2:\n" (solve-constraints (cons {:a "x" :b "y"} CONSTRS))))
+
+;; (def answer
+;;   (replace-subst-from-right 
+;;    {"c" "a", 
+;;     "x" '(:BLURG :FLORP), 
+;;     "y" '("a" "b"), 
+;;     "a" "a", 
+;;     "b" "b"}
+;;    "a"
+;;    :BLURG
+;;    ))
 
 
 ;; (defn h [a b]

lisp/compiler_helpers.carp

@@ -1,10 +1,11 @@
 (defn pretty-signature (t)
-  (match t
+  (str t))
-         (:fn args ret) (str "(" (join ", " (map pretty-signature args)) ") -> " (pretty-signature ret))
+  ;; (match t
-         (:ref r) (str "&" (pretty-signature r) "")
+  ;;        (:fn args ret) (str "(" (join ", " (map pretty-signature args)) ") -> " (pretty-signature ret))
-         (:Array a) (str "Array " (pretty-signature a))
+  ;;        (:ref r) (str "&" (pretty-signature r) "")
-         x (if (keyword? t)
+  ;;        (:Array a) (str "Array " (pretty-signature a))
-             (name t)
+  ;;        x (if (keyword? t)
-             (if (string? t)
+  ;;            (name t)
-               t
+  ;;            (if (string? t)
-               (error (str "Can't prettify type signature: " t))))))
+  ;;              t
+  ;;              (error (str "Can't prettify type signature: " t))))))

lisp/gl.carp

@@ -103,7 +103,7 @@
                 (glClearColor 0.1f 0.1f 0.1f 1.0f)
                 (glClear carp-gl-color-buffer-bit)
                 (glColor3f 1.0f 1.0f 1.0f)
-                (render-callback state)
+                (render-callback &state)
                 (reset! state (tick state))
                 (glfwSwapBuffers window)
                 (glfwPollEvents)))

lisp/infer_types.carp

@@ -289,7 +289,7 @@
                   (if (list? existing)
                     (if (list? value-lookup)
                       (let [_ (when log-substs (println "The existing binding is a list"))
-                            new-substs (reduce (fn (s m2) (extend-substitutions substs (:e m2) (:l m2)))
+                            new-substs (reduce (fn (s m2) (extend-substitutions s (:e m2) (:l m2)))
                                                substs
                                                (map2 (fn (e l) {:e e :l l}) existing value-lookup))
                             _ (when log-substs (println (str "\nBack from list, new substs: " new-substs)))]
@@ -297,8 +297,10 @@
                       (do
                         substs))
                     (if (typevar? existing)
-                      (do (when log-substs (println "The existing binding is a typevar, will replace from right"))
+                      (do (when log-substs (println (str "The existing binding is a typevar, will replace " existing " with " value-lookup " from right")))
-                          (replace-subst-from-right substs existing value-lookup))
+                          (let [result (replace-subst-from-right substs existing value-lookup)]
+                            (do ;;(println (str "result: " result))
+                                result)))
                       (do (when log-substs (println "The existing binding is not a typevar"))
                           (if (types-exactly-eq? existing value-lookup)
                             (do (when log-substs (println "Current binding matches new value"))