mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-17 16:38:14 +03:00
while loop must pop values (from bytecode)
This commit is contained in:
Erik
parent
330ae9f87d
commit
aa72248a0f
1
.gitignore
vendored
1
.gitignore
vendored
@ -31,3 +31,4 @@ sourcetree.license
|
||||
temp/
|
||||
|
||||
/TAGS
|
||||
/bin/project.carp
|
||||
|
||||
@ -5,208 +5,33 @@
|
||||
;;(reset! log-deps-when-baking-ast true)
|
||||
;;(reset! log-redefining-struct true)
|
||||
|
||||
;;(def carp-core-macros (open "../lisp/core_macros.carp"))
|
||||
;;(def carp-core (read (open "../lisp/core.carp")))
|
||||
|
||||
;; (eb '(do (def MAP (fn [f xs]
|
||||
;; (let [i 0
|
||||
;; result (copy xs)]
|
||||
;; (do
|
||||
;; (while (< i (count xs))
|
||||
;; (do (array-set! result i (f (nth xs i)))
|
||||
;; (reset! i (inc i))))
|
||||
;; result))))
|
||||
;; (MAP inc (array 1 2 3))))
|
||||
|
||||
;; (def fi (macro [a b c] (list 'if a c b)))
|
||||
;; (fi true 10 20)
|
||||
|
||||
;; (def inc (fn [x] (+ x 1)))
|
||||
|
||||
(def fib (fn [x]
|
||||
(if (< x 2)
|
||||
1
|
||||
(+ (fib (- x 2))
|
||||
(fib (- x 1))))))
|
||||
|
||||
;; (letrec-internal '(a 10 b 20) '(* a b) '() '())
|
||||
(def d1 {:a {}
|
||||
:b {:a 1
|
||||
:b 2
|
||||
:c 3}
|
||||
:c {:a {:x 100}
|
||||
:b {:x 200}
|
||||
:c {:x 300}}})
|
||||
|
||||
;; (let [f nil]
|
||||
;; (do
|
||||
;; (reset! f (fn [x]
|
||||
;; (if (= 1 x)
|
||||
;; 1
|
||||
;; (* x (f (dec x))))))
|
||||
;; (println (str (f 5)))))
|
||||
(def d2 {:a {}
|
||||
:b {:a 1
|
||||
:b 2
|
||||
:c 3}
|
||||
:c {:a {:x 100}
|
||||
:b {:x 66666}
|
||||
:c {:x 300}}})
|
||||
|
||||
;; (letrec [f (fn [x] (if (= 1 x)
|
||||
;; 1
|
||||
;; (* x (f (dec x)))))]
|
||||
;; (println (str (f 5))))
|
||||
(defn compare []
|
||||
(assert (not (= d1 d2))))
|
||||
|
||||
;; (def g (fn [x] (* x x)))
|
||||
;; (def h (fn [x] (+ (g x) (g x))))
|
||||
;;(time (for (i 0 9999) (compare)))
|
||||
|
||||
(println "bleh...")
|
||||
|
||||
|
||||
|
||||
|
||||
;; (load-lisp "../lisp/core_macros.carp")
|
||||
|
||||
;; (def inc (fn [x] (+ x 1)))
|
||||
|
||||
;; (def make-counter (fn [start]
|
||||
;; (let [value start]
|
||||
;; (fn []
|
||||
;; (do (reset! value (inc value))
|
||||
;; value)))))
|
||||
|
||||
;; (def c1 (make-counter 10))
|
||||
;; (def c2 (make-counter 10))
|
||||
|
||||
;; (println (str "c1: " (c1)))
|
||||
;; (println (str "c1: " (c1)))
|
||||
;; (println (str "c1: " (c1)))
|
||||
;; (println (str "c2: " (c2)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; (match 2 1 "a" 2 "b" 3 "c")
|
||||
|
||||
;; (if true 10 20) (if false 10 20) (do (def t 0) (while (< t 10) (do (println (str t)) (reset! t (inc t)))))
|
||||
|
||||
;; (def defmacro (macro (name args body)
|
||||
;; (list 'do
|
||||
;; (list 'def name (list 'macro args body))
|
||||
;; (list 'meta-set! name :name (str name)))))
|
||||
|
||||
;; (defmacro defn (name args body)
|
||||
;; (list 'do
|
||||
;; (list 'def name (list 'fn args body))
|
||||
;; (list 'meta-set! name :line (meta-get name :line))
|
||||
;; (list 'meta-set! name :name (str name))
|
||||
;; (list 'meta-set! name :user-defined true)))
|
||||
|
||||
;; (defn foo []
|
||||
;; (let [x 5
|
||||
;; y (* x 10)]
|
||||
;; (println (str y))))
|
||||
|
||||
;; (foo)
|
||||
|
||||
;; (load-lisp "../lisp/core.carp")
|
||||
;; (load-lisp "../lisp/infer_types.carp")
|
||||
;; (load-lisp "../lisp/compiler_helpers.carp")
|
||||
;; (load-lisp "../lisp/sicp_solver.carp")
|
||||
|
||||
;; (let [d1 {:x 10 :y 20}
|
||||
;; d2 {:x 10}
|
||||
;; d3 {:y 20 :x 10}]
|
||||
;; (do
|
||||
;; (assert-eq false (= d1 d2))))
|
||||
|
||||
;; (let [d1 (dictionary :x 10 :y 20)
|
||||
;; d2 (dictionary :x 10)
|
||||
;; d3 (dictionary :y 20 :x 10)]
|
||||
;; (do
|
||||
;; (assert-eq d1 d3)
|
||||
;; (assert-eq false (= d1 d2))
|
||||
;; (assert-eq false (= d1 (dictionary)))
|
||||
;; (assert-eq d3 (assoc d2 :y 20))
|
||||
;; (assert-eq true (= d1 (assoc d2 :y 20)))
|
||||
;; ))
|
||||
|
||||
|
||||
|
||||
;; (do (meta-set! find-func-deps :line 7) (meta-set! find-func-deps :name "find-func-deps") (meta-set! find-func-deps :user-defined true))
|
||||
|
||||
|
||||
;; (def find-func-deps
|
||||
;; (fn [ast bake-deps]
|
||||
;; (letrec [deps (copy (quote ()))
|
||||
|
||||
;; _ (when (not (dict? ast)) (error (str "ast is not a dict: " ast)))
|
||||
|
||||
;; _ (when (not (= :function (get-maybe ast :node))) (error (str "ast is not a function ast node: " ast)))
|
||||
|
||||
;; func-name (let [n (get-maybe ast :name)] (if (nil? n) "" n))
|
||||
|
||||
;; find-deps-in-list (fn [asts vars-in-scope] (reduce (fn [result a] (cons-last result (find-func-deps-internal a vars-in-scope))) (quote ()) asts))
|
||||
|
||||
;; find-deps-in-bindings (fn [bindings vars-in-scope] (reduce (fn [result binding] (cons-last result (update-in binding (quote (:value)) (fn [bv] (find-func-deps-internal bv vars-in-scope))))) (quote ()) bindings))
|
||||
|
||||
;; find-func-deps-internal (fn [ast vars-in-scope] (do (match (:node ast) :lookup (let [symbol (:value ast) symbol-name (str symbol) is-global-lookup (global? vars-in-scope symbol) self-recursive (= func-name symbol-name) is-constructor (= true (get-maybe ast :constructor))] (if self-recursive (assoc ast :self-recursive true) (do (when is-global-lookup (let [evaled (eval symbol) is-primop (primop? evaled) is-lambda (lambda? evaled) is-function (function? evaled) is-generic-lens-stub (key-is-true? (meta evaled) :generic-lens-stub)] (do (when (and (not is-function) (not is-constructor)) (do (bake-global (name symbol) deps) (reset! deps (cons symbol-name deps)))) (when is-constructor (do (reset! deps (cons symbol-name deps)))) (when (and* is-lambda bake-deps (not is-generic-lens-stub)) (do (compiler/bake-code symbol-name (code evaled) (meta-get evaled :ann)) (reset! deps (cons symbol-name deps)))) (when (foreign? evaled) (reset! deps (cons symbol-name deps)))))) (assoc ast :global-lookup is-global-lookup)))) :reset (let [ast0 (update-in ast (quote (:expr)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast1 (update-in ast0 (quote (:symbol)) (fn [a] (find-func-deps-internal a vars-in-scope)))] ast1) :app (let [ast0 (update-in ast (quote (:head)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast1 (update-in ast0 (quote (:tail)) (fn [a] (find-deps-in-list a vars-in-scope)))] ast1) :function (let [args (:args ast) new-vars (union (map :name args) vars-in-scope)] (update-in ast (quote (:body)) (fn [a] (find-func-deps-internal a new-vars)))) :if (let [ast0 (update-in ast (quote (:expr)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast1 (update-in ast0 (quote (:if-true)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast2 (update-in ast1 (quote (:if-false)) (fn [a] (find-func-deps-internal a vars-in-scope)))] ast2) :while (let [ast0 (update-in ast (quote (:expr)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast1 (update-in ast0 (quote (:body)) (fn [a] (find-func-deps-internal a vars-in-scope)))] ast1) :binop (let [ast0 (update-in ast (quote (:left)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast1 (update-in ast0 (quote (:right)) (fn [a] (find-func-deps-internal a vars-in-scope)))] ast1) :literal ast :do (let [new-ast (update-in ast (quote (:forms)) (fn [a] (find-deps-in-list a vars-in-scope)))] new-ast) :let (let [bindings (:bindings ast) new-vars (union (map :name bindings) vars-in-scope) ast0 (assoc ast :bindings (find-deps-in-bindings bindings new-vars))] (update-in ast0 (quote (:body)) (fn [a] (find-func-deps-internal a new-vars)))) :ref (let [ast0 (update-in ast (quote (:expr)) (fn [a] (find-func-deps-internal a vars-in-scope)))] ast0) :null ast :array (let [ast0 (update-in ast (quote (:values)) (fn [a] (find-deps-in-list a vars-in-scope)))] ast0) x (error (str "find-func-deps can't handle node: " x)))))
|
||||
|
||||
;; new-ast (find-func-deps-internal ast (quote ()))]
|
||||
|
||||
;; (assoc new-ast :func-deps deps)))
|
||||
;; )
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; (lets deps :undefined
|
||||
;; (lets _ :undefined
|
||||
;; (lets _ :undefined
|
||||
;; (lets func-name :undefined
|
||||
;; (lets find-deps-in-list :undefined
|
||||
;; (lets find-deps-in-bindings :undefined
|
||||
;; (lets find-func-deps-internal :undefined
|
||||
;; (lets new-ast :undefined
|
||||
;; (do
|
||||
;; (reset! new-ast (find-func-deps-internal ast (quote ())))
|
||||
|
||||
;; (reset! find-func-deps-internal (fn [ast vars-in-scope] (do (match (:node ast) :lookup (let [symbol (:value ast) symbol-name (str symbol) is-global-lookup (global? vars-in-scope symbol) self-recursive (= func-name symbol-name) is-constructor (= true (get-maybe ast :constructor))] (if self-recursive (assoc ast :self-recursive true) (do (when is-global-lookup (let [evaled (eval symbol) is-primop (primop? evaled) is-lambda (lambda? evaled) is-function (function? evaled) is-generic-lens-stub (key-is-true? (meta evaled) :generic-lens-stub)] (do (when (and (not is-function) (not is-constructor)) (do (bake-global (name symbol) deps) (reset! deps (cons symbol-name deps)))) (when is-constructor (do (reset! deps (cons symbol-name deps)))) (when (and* is-lambda bake-deps (not is-generic-lens-stub)) (do (compiler/bake-code symbol-name (code evaled) (meta-get evaled :ann)) (reset! deps (cons symbol-name deps)))) (when (foreign? evaled) (reset! deps (cons symbol-name deps)))))) (assoc ast :global-lookup is-global-lookup)))) :reset (let [ast0 (update-in ast (quote (:expr)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast1 (update-in ast0 (quote (:symbol)) (fn [a] (find-func-deps-internal a vars-in-scope)))] ast1) :app (let [ast0 (update-in ast (quote (:head)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast1 (update-in ast0 (quote (:tail)) (fn [a] (find-deps-in-list a vars-in-scope)))] ast1) :function (let [args (:args ast) new-vars (union (map :name args) vars-in-scope)] (update-in ast (quote (:body)) (fn [a] (find-func-deps-internal a new-vars)))) :if (let [ast0 (update-in ast (quote (:expr)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast1 (update-in ast0 (quote (:if-true)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast2 (update-in ast1 (quote (:if-false)) (fn [a] (find-func-deps-internal a vars-in-scope)))] ast2) :while (let [ast0 (update-in ast (quote (:expr)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast1 (update-in ast0 (quote (:body)) (fn [a] (find-func-deps-internal a vars-in-scope)))] ast1) :binop (let [ast0 (update-in ast (quote (:left)) (fn [a] (find-func-deps-internal a vars-in-scope))) ast1 (update-in ast0 (quote (:right)) (fn [a] (find-func-deps-internal a vars-in-scope)))] ast1) :literal ast :do (let [new-ast (update-in ast (quote (:forms)) (fn [a] (find-deps-in-list a vars-in-scope)))] new-ast) :let (let [bindings (:bindings ast) new-vars (union (map :name bindings) vars-in-scope) ast0 (assoc ast :bindings (find-deps-in-bindings bindings new-vars))] (update-in ast0 (quote (:body)) (fn [a] (find-func-deps-internal a new-vars)))) :ref (let [ast0 (update-in ast (quote (:expr)) (fn [a] (find-func-deps-internal a vars-in-scope)))] ast0) :null ast :array (let [ast0 (update-in ast (quote (:values)) (fn [a] (find-deps-in-list a vars-in-scope)))] ast0) x (error (str "find-func-deps can't handle node: " x))))))
|
||||
;; (reset! find-deps-in-bindings (fn [bindings vars-in-scope] (reduce (fn [result binding] (cons-last result (update-in binding (quote (:value)) (fn [bv] (find-func-deps-internal bv vars-in-scope))))) (quote ()) bindings)))
|
||||
;; (reset! find-deps-in-list (fn [asts vars-in-scope] (reduce (fn [result a] (cons-last result (find-func-deps-internal a vars-in-scope))) (quote ()) asts)))
|
||||
;; (reset! func-name (let [n (get-maybe ast :name)] (if (nil? n) "" n)))
|
||||
;; (reset! _ (when (not (= :function (get-maybe ast :node))) (error (str "ast is not a function ast node: " ast))))
|
||||
;; (reset! _ (when (not (dict? ast)) (error (str "ast is not a dict: " ast))))
|
||||
;; (reset! deps (copy (quote ())))
|
||||
|
||||
;; (assoc new-ast :func-deps deps))))))))))
|
||||
|
||||
|
||||
;; (defn f []
|
||||
;; (letrec [x 123
|
||||
;; y {:a x :b (inc x)}]
|
||||
;; y))
|
||||
|
||||
;; (deftest test-own-4
|
||||
;; (do
|
||||
;; (defn own-4 ()
|
||||
;; (let [s (string-copy "CARP1")]
|
||||
;; (string-copy "CARP2")))
|
||||
;; (assert-eq '(:fn () :string)
|
||||
;; (sign own-4))
|
||||
;; (assert-eq {:node :function,
|
||||
;; :free (),
|
||||
;; :body {:node :let,
|
||||
;; :free (list {:name "s",
|
||||
;; :type :string}),
|
||||
;; :body ()}}
|
||||
;; (ownership-analyze own-4))))
|
||||
|
||||
;;(test-own-4)
|
||||
|
||||
;; (println (str (let [a 10] (mapcat (fn [x] (list :x (* x a))) (list 1 2 3 4 5)))))
|
||||
|
||||
;; (def f (let [x 100] (fn [] x)))
|
||||
;; (apply f '())
|
||||
|
||||
;; (defn global-int []
|
||||
;; (do
|
||||
;; (def x 10)
|
||||
;; (gc)
|
||||
;; x
|
||||
;; ))
|
||||
|
||||
;; (global-int)
|
||||
(while true (println "."))
|
||||
|
||||
@ -133,6 +133,9 @@ void add_while(Process *process, Obj *env, Obj *bytecodeObj, int *position, Obj
|
||||
|
||||
visit_form(process, env, bytecodeObj, position, form->cdr->cdr->car);
|
||||
|
||||
bytecodeObj->bytecode[*position] = 'e'; // discard return value
|
||||
*position += 1;
|
||||
|
||||
bytecodeObj->bytecode[*position] = 'j'; // go back to start
|
||||
*position += 1;
|
||||
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
|
||||
#include "obj.h"
|
||||
|
||||
#define BYTECODE_EVAL 0
|
||||
#define BYTECODE_EVAL 1
|
||||
|
||||
Obj *form_to_bytecode(Process *process, Obj *env, Obj *form, bool insert_return_instruction);
|
||||
//Obj *bytecode_eval_bytecode(Process *process, Obj *bytecodeObj);
|
||||
|
||||
@ -65,7 +65,11 @@ int main(int argc, char **argv) {
|
||||
eval_text(process, process->global_env, "(def BYTECODE_EVAL false)", false, obj_new_string("main.c"));
|
||||
}
|
||||
|
||||
eval_text(process, process->global_env, "(load-lisp (str (getenv \"CARP_DIR\") \"lisp/boot.carp\"))", false, obj_new_string("main.c"));
|
||||
eval_text(process,
|
||||
process->global_env,
|
||||
"(load-lisp (str (getenv \"CARP_DIR\") \"lisp/boot.carp\"))",
|
||||
false,
|
||||
obj_new_string("main.c"));
|
||||
|
||||
if(argc == 2) {
|
||||
char load_file[512];
|
||||
|
||||
Loading…
Reference in New Issue
Block a user