carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-10-11 20:49:05 +03:00
Code Issues Projects Releases Wiki Activity

solved severe bug in constraint solver, fixed the game

Browse Source
This commit is contained in:
Erik Svedäng 2016-03-17 23:37:50 +01:00
parent f75a7ddb61
commit a6e052d98c
5 changed files with 48 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
examples/game3.carp
View File

@ -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)))))

39
examples/project.carp
View File

@ -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]

19
lisp/compiler_helpers.carp
View File

@ -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))))))

2
lisp/gl.carp
View File

@ -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)))

8
lisp/infer_types.carp
View File

@ -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"))