carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-09-17 16:38:14 +03:00
Code Issues Projects Releases Wiki Activity

finally solved problems with nested let statements

Browse Source
This commit is contained in:
Erik Svedäng 2016-01-20 14:56:31 +01:00
parent 6bb5758170
commit ccece31e98
5 changed files with 58 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -6,3 +6,4 @@
/out/*.h
/src/*.o
/out/exe
a.out

39
lisp/calculate_lifetimes.carp
View File

@ -82,6 +82,7 @@
(let [ast (:ast data)
vars (:vars data)
pos (:pos data)
extended-vars (let [t (:type binding-ast)]
(do
;;(println (str "is " (:name binding-ast) " : " t " a managed type? " (managed-type? t)))
@ -89,7 +90,7 @@
(cons {:name (str (:name binding-ast)) :type t :doc "let binding"} vars)
vars)))
;;_ (println (str "extended-vars: " extended-vars))
;;_ (println (str "\nextended-vars: " extended-vars))
new-data (calculate-lifetimes-internal {:ast (:value binding-ast) :vars extended-vars} false)
new-binding-ast (assoc binding-ast :value (:ast new-data))
@ -174,7 +175,12 @@
vars-after (if in-ref ;;(ref? (:type ast))
vars
(remove-var-with-name vars (str (:value ast))))
;;_ (when (not (= vars vars-after)) (println (str "Lookup ate '" (:value ast) "'."))); Vars before:\n" vars "\nVars after:\n" (:value ast) ": " vars-after)))
;; _ (when (not (= vars vars-after))
;; (do (println (str "\nLookup ate '" (:value ast) "':\n" ast))
;; ;;(println (str "Vars before:\n" vars "\nVars after:\n" (:value ast) ": " vars-after))
;; ))
final-ast {:ast ast
:vars vars-after}
@ -256,7 +262,7 @@
{:ast ast-after-all
:vars vars-after-all})
:let (let [;;_ (println (str "vars before body:\n" vars))
:let (let [;;_ (println (str "\nLET vars in body " (get-maybe ast :result-name) ":\n" vars))
init-data (assoc data :pos 0)
data-after-bindings (reduce calc-lifetime-for-let-binding init-data (:bindings ast))
@ -265,23 +271,41 @@
vars-after-bindings (:vars data-after-bindings)
ast-after-bindings (:ast data-after-bindings)
;;_ (println (str "\nlet vars-after-bindings:\n" vars-after-bindings))
;; _ (println (str "ast:\n" ast))
not-eaten-by-bindings (filter (fn (v) (contains? vars-after-bindings v)) vars)
eaten-by-bindings (remove (fn (v) (contains? not-eaten-by-bindings v)) vars)
;;_ (println (str "\nLET eaten by bindings in " (get-maybe ast :result-name) ":\n" eaten-by-bindings))
;;_ (println (str "\nlet vars-after-bindings (before body):\n" vars-after-bindings))
;; _ (println (str "ast-after-bindings:\n" ast-after-bindings))
;;_ (println (str "\nLET will visit body of " (get-maybe ast :result-name) ", Current vars:\n" vars-after-bindings))
data-after-body (calculate-lifetimes-internal {:ast (:body ast-after-bindings)
:vars vars-after-bindings}
in-ref)
vars-after-body (:vars data-after-body)
;;_ (println (str "\nLET back from visiting body of " (get-maybe ast :result-name) ", Current vars:\n" vars-after-body))
ast-after-body (assoc ast-after-bindings :body (:ast data-after-body))
;;_ (println (str "\nlet vars-after-body:\n" vars-after-body))
;; _ (println (str "ast-after-bindings:\n" ast-after-bindings))
;; _ (println (str "ast-after-body:\n" ast-after-body))
;;_ (println (str "\ndata-after-body:\n" data-after-body))
vars-after-body-minus-eaten (let [eaten (get-maybe data-after-body :eaten)]
(if (nil? eaten)
vars-after-body
(do
;;(println (str "Will eat:\n" eaten))
(remove (fn (v) (contains? eaten v)) vars-after-body))
))
;;_ (println (str "\nLET minus eaten " (get-maybe ast :result-name) ", Current vars:\n" vars-after-body-minus-eaten))
;; only remove the variables that were not already there before entering let form:
vars-after-body-and-return-1 (remove (fn (v) (contains? vars v)) vars-after-body)
vars-after-body-and-return-1 (remove (fn (v) (contains? vars v)) vars-after-body-minus-eaten)
;;_ (println (str "\nlet vars-after-body-and-return-1:\n" vars-after-body-and-return-1))
vars-after-body-and-return-2 (let [result-name (get-maybe (:body ast-after-body) :result-name)]
@ -297,7 +321,8 @@
vars))
]
{:ast final-ast
:vars final-vars})
:vars final-vars
:eaten eaten-by-bindings})
:while (let [data-after-expr (calculate-lifetimes-internal {:ast (:expr ast) :vars vars} in-ref)
;;_ (println (str "data-after-expr:\n" data-after-expr))

8
lisp/glfw_test.carp
View File

@ -45,10 +45,10 @@
(defn gl-demo ()
(if (glfwInit)
(let [window (glfwCreateWindow 640 480 (ref "Yeah!") NULL NULL)]
(let [window (glfwCreateWindow 640 480 "Yeah!" NULL NULL)]
(if (null? window)
(panic (ref "No window."))
(do (println (ref "Window OK."))
(panic "No window.")
(do (println "Window OK.")
(glfwMakeContextCurrent window)
(while (not (glfwWindowShouldClose window))
(do
@ -59,7 +59,7 @@
(glfwSwapBuffers window)
(glfwPollEvents)))
(glfwTerminate))))
(panic (ref "Failed to initialize glfw."))))
(panic "Failed to initialize glfw.")))
;;(bake draw-rect)

29
lisp/string_array.carp
View File

@ -1,8 +1,8 @@
(register-builtin "string_array_new" '(:int) ':string-array)
(register-builtin "string_array_count" '(:string-array) :int)
(register-builtin "string_array_count" '((:ref :string-array)) :int)
(register-builtin "string_array_get" '((:ref :string-array) :int) '(:ref :string))
(register-builtin "string_array_set" '(:string-array :int :string) ':string-array)
(register-builtin "string_array_set" '(:string-array :int (:ref :string)) ':string-array)
(def s (string-array-new 3))
(def s1 (string-array-set s 0 "yeah"))
@ -20,13 +20,24 @@
(println "]"))))
(defn sf1 ()
(let [a (string-array-new 2)
;;a0 (string-array-set a 0 "Hello, ")
;;a1 (string-array-set a0 1 "world!")
]
(str-append (string-array-get (ref a) 0) (string-array-get (ref a) 1))))
(let [a0 (string-array-new 2)]
(let [a1 (string-array-set a0 0 "Hello, ")]
(str-append (string-array-get (ref a1) 0) "YEAH"))))
(defn sf2 ()
(let [a0 (string-array-new 2)]
(let [a1 (string-array-set a0 0 "Hello, ")]
(let [a2 (string-array-set a1 1 "world!")]
(str-append (string-array-get (ref a2) 0) (string-array-get (ref a2) 1))))))
(defn test-string-array-1 ()
(bake sf1))
;(test-string-array-1)
(do
(bake sf1)
(assert-eq "Hello, YEAH" (sf1))))
(test-string-array-1)
(defn test-string-array-2 ()
(do
(bake sf2)
(assert-eq "Hello, world!" (sf2))))
(test-string-array-2)

2
shared/shared.h
View File

@ -97,7 +97,7 @@ string string_array_get(string_array array, int pos) {
}
string_array string_array_set(string_array array, int pos, string new_value) {
array[pos] = new_value;
array[pos] = strdup(new_value);
return array;
}