From a6e052d98c1cd4495b97733a30db0e889e8eca5e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Erik=20Sved=C3=A4ng?= <erik.svedang@gmail.com>
Date: Thu, 17 Mar 2016 23:37:50 +0100
Subject: [PATCH] solved severe bug in constraint solver, fixed the game

---
 examples/game3.carp        |  2 +-
 examples/project.carp      | 39 ++++++++++++++++++++++++++++++--------
 lisp/compiler_helpers.carp | 19 ++++++++++---------
 lisp/gl.carp               |  2 +-
 lisp/infer_types.carp      |  8 +++++---
 5 files changed, 48 insertions(+), 22 deletions(-)

diff --git a/examples/game3.carp b/examples/game3.carp
index ebeb2c69..18d52e83 100644
--- a/examples/game3.carp
+++ b/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)))))
diff --git a/examples/project.carp b/examples/project.carp
index d9fbea71..4a15e8ea 100644
--- a/examples/project.carp
+++ b/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 draw [state]
-  (domap println state))
-
-(defn run-app [init-state draw-fn]
-  (draw-fn init-state))
+(defn run-app [draw-fn]
+  (let [state [(copy "hej") (copy "på") (copy "dig!")]]
+    (draw-fn &state)))
 
 (defn app []
-  (let [state ["hej" "på" "dig!"]]
-    (run-app state draw)))
+  (run-app draws))
 
 
+(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]
diff --git a/lisp/compiler_helpers.carp b/lisp/compiler_helpers.carp
index fe796f9f..d33c8774 100644
--- a/lisp/compiler_helpers.carp
+++ b/lisp/compiler_helpers.carp
@@ -1,10 +1,11 @@
 (defn pretty-signature (t)
-  (match t
-         (:fn args ret) (str "(" (join ", " (map pretty-signature args)) ") -> " (pretty-signature ret))
-         (:ref r) (str "&" (pretty-signature r) "")
-         (:Array a) (str "Array " (pretty-signature a))
-         x (if (keyword? t)
-             (name t)
-             (if (string? t)
-               t
-               (error (str "Can't prettify type signature: " t))))))
+  (str t))
+  ;; (match t
+  ;;        (:fn args ret) (str "(" (join ", " (map pretty-signature args)) ") -> " (pretty-signature ret))
+  ;;        (:ref r) (str "&" (pretty-signature r) "")
+  ;;        (:Array a) (str "Array " (pretty-signature a))
+  ;;        x (if (keyword? t)
+  ;;            (name t)
+  ;;            (if (string? t)
+  ;;              t
+  ;;              (error (str "Can't prettify type signature: " t))))))
diff --git a/lisp/gl.carp b/lisp/gl.carp
index a0863deb..7ed97e67 100644
--- a/lisp/gl.carp
+++ b/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)))
diff --git a/lisp/infer_types.carp b/lisp/infer_types.carp
index 136b850d..ff7ba9a6 100644
--- a/lisp/infer_types.carp
+++ b/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"))
-                          (replace-subst-from-right substs existing value-lookup))
+                      (do (when log-substs (println (str "The existing binding is a typevar, will replace " existing " with " value-lookup " from right")))
+                          (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"))