mirror of
https://github.com/carp-lang/Carp.git
synced 2024-10-12 04:58:18 +03:00
Change :a and :b in binop and if to :left and :right
This commit is contained in:
parent
7fc447fd00
commit
1da8567f56
4
TODO.md
4
TODO.md
@ -7,8 +7,7 @@
|
||||
- Compiling arrays
|
||||
- Handle global variables referenced inside functions, in regards to the lifetime checker
|
||||
- Avoid problems with name shadowing when freeing a local variable (is this possible? disallow shadowing instead?)
|
||||
- Track dependencies between functions to enable automatic recompilation when a function changes
|
||||
- Change :a and :b in binop and if to :left and :right
|
||||
- Track dependencies between functions to enable automatic recompilation when a function changes
|
||||
- lambdas / lambda lifting
|
||||
- defstruct
|
||||
- deftype
|
||||
@ -17,6 +16,7 @@
|
||||
- Compiler doesn't catch when a let-binding refers to a variable that's defined later (in the same let binding)
|
||||
- add proper no-op :node for ()
|
||||
- self recuring function doens't check argument count/types in the actual call to itself
|
||||
- rewrite a bunch of functions in the compiler passes using pipe operator and update-in
|
||||
|
||||
# Lisp Core Libs
|
||||
- assert-eq shows wrong result when the assertion fails? (in ffi situations...)
|
||||
|
@ -34,17 +34,17 @@
|
||||
(defn list-to-ast (l)
|
||||
(if (binop? l)
|
||||
(match l
|
||||
(op a b) {:node :binop
|
||||
(op left right) {:node :binop
|
||||
:type (gen-typevar)
|
||||
:op op
|
||||
:a (form-to-ast a)
|
||||
:b (form-to-ast b)})
|
||||
:left (form-to-ast left)
|
||||
:right (form-to-ast right)})
|
||||
(match l
|
||||
('= left right) {:node :binop
|
||||
:type :bool
|
||||
:op '==
|
||||
:a (form-to-ast left)
|
||||
:b (form-to-ast right)}
|
||||
:left (form-to-ast left)
|
||||
:right (form-to-ast right)}
|
||||
(x & xs) (if (and (symbol? x) (def? x) (macro? (eval x)))
|
||||
(expand-macro l)
|
||||
{:node :app
|
||||
@ -68,12 +68,12 @@
|
||||
;;(println (str "called-macro:\n" called-macro ", type: " (type called-macro)))
|
||||
expanded-ast)))
|
||||
|
||||
(defn if-to-ast (expr a b)
|
||||
(defn if-to-ast (expr if-true if-false)
|
||||
{:node :if
|
||||
:type (gen-typevar)
|
||||
:expr (form-to-ast expr)
|
||||
:a (form-to-ast a)
|
||||
:b (form-to-ast b)})
|
||||
:if-true (form-to-ast if-true)
|
||||
:if-false (form-to-ast if-false)})
|
||||
|
||||
(defn do-to-ast (forms)
|
||||
{:node :do
|
||||
|
@ -118,8 +118,8 @@
|
||||
;;(println (str "\nvisit-form:\n" form))
|
||||
(match (get form :node)
|
||||
|
||||
:binop (let [result-a (visit-form c (get form :a) false)
|
||||
result-b (visit-form c (get form :b) false)]
|
||||
:binop (let [result-a (visit-form c (get form :left) false)
|
||||
result-b (visit-form c (get form :right) false)]
|
||||
{:c (str (if toplevel "" "(") (:c result-a) " " (:op form) " " (:c result-b) (if toplevel "" ")"))})
|
||||
|
||||
:literal (let [val (:value form)
|
||||
@ -159,7 +159,7 @@
|
||||
;; true-block begins
|
||||
(str-append! c " {\n")
|
||||
(indent-in!)
|
||||
(let [result-a (visit-form c (get form :a) true)]
|
||||
(let [result-a (visit-form c (:if-true form) true)]
|
||||
(do
|
||||
(str-append! c (free-variables (get-maybe form :free-left)))
|
||||
(if (= :void (:type form))
|
||||
@ -169,7 +169,7 @@
|
||||
(str-append! c (str (indent) "} else {\n"))))
|
||||
|
||||
(indent-in!) ;; false-block-begins
|
||||
(let [result-b (visit-form c (get form :b) true)]
|
||||
(let [result-b (visit-form c (:if-false form) true)]
|
||||
(do
|
||||
(str-append! c (free-variables (get-maybe form :free-right)))
|
||||
(if (= :void (:type form))
|
||||
|
@ -9,8 +9,8 @@
|
||||
:if {:node :if
|
||||
:free-left (clean-free-list (:free-left ast))
|
||||
:free-right (clean-free-list (:free-right ast))
|
||||
:body-left (ownership-analyze-internal (:a ast))
|
||||
:body-right (ownership-analyze-internal (:b ast))}
|
||||
:body-left (ownership-analyze-internal (:if-true ast))
|
||||
:body-right (ownership-analyze-internal (:if-false ast))}
|
||||
;;:app {:node :app :head (ownership-analyze-internal (:head ast)) :tail (map ownership-analyze-internal (:tail ast))}
|
||||
x nil ;;{:node x}
|
||||
))
|
||||
@ -258,12 +258,12 @@
|
||||
]
|
||||
final-data)))
|
||||
|
||||
:binop (let [left (calculate-lifetimes-internal {:ast (:a ast) :env env :vars vars} in-ref)
|
||||
:binop (let [left (calculate-lifetimes-internal {:ast (:left ast) :env env :vars vars} in-ref)
|
||||
vars-after-left (:vars left)
|
||||
right (calculate-lifetimes-internal {:ast (:b ast) :env env :vars vars-after-left} in-ref)
|
||||
right (calculate-lifetimes-internal {:ast (:right ast) :env env :vars vars-after-left} in-ref)
|
||||
vars-after-right (:vars right)
|
||||
ast0 (assoc ast :a (:ast left))
|
||||
ast1 (assoc ast0 :b (:ast right))]
|
||||
ast0 (assoc ast :left (:ast left))
|
||||
ast1 (assoc ast0 :right (:ast right))]
|
||||
{:ast ast1
|
||||
:env env
|
||||
:vars vars-after-right})
|
||||
@ -293,17 +293,17 @@
|
||||
vars-after-expr (:vars data-after-expr)
|
||||
;;_ (println (str "\nvars-after-expr:\n" vars-after-expr))
|
||||
|
||||
data-after-left (calculate-lifetimes-internal {:ast (:a ast) :env env :vars vars-after-expr} in-ref)
|
||||
data-after-right (calculate-lifetimes-internal {:ast (:b ast) :env env :vars vars-after-expr} in-ref)
|
||||
data-after-left (calculate-lifetimes-internal {:ast (:if-true ast) :env env :vars vars-after-expr} in-ref)
|
||||
data-after-right (calculate-lifetimes-internal {:ast (:if-false ast) :env env :vars vars-after-expr} in-ref)
|
||||
;;_ (println (str "data-after-left:\n" data-after-left "\ndata-after-right:\n" data-after-right))
|
||||
|
||||
vars-after-left (let [result-name (get-maybe (:a ast) :result-name)
|
||||
vars-after-left (let [result-name (get-maybe (:if-true ast) :result-name)
|
||||
vs (:vars data-after-left)]
|
||||
(if (nil? result-name)
|
||||
vs
|
||||
(remove-var-with-name vs result-name)))
|
||||
|
||||
vars-after-right (let [result-name (get-maybe (:b ast) :result-name)
|
||||
vars-after-right (let [result-name (get-maybe (:if-false ast) :result-name)
|
||||
vs (:vars data-after-right)]
|
||||
(if (nil? result-name)
|
||||
vs
|
||||
@ -346,8 +346,8 @@
|
||||
;;_ (println (str "\neaten:\n" eaten))
|
||||
|
||||
ast-after-expr (assoc ast :expr (:ast data-after-expr))
|
||||
ast0 (assoc ast-after-expr :a (:ast data-after-left))
|
||||
ast1 (assoc ast0 :b (:ast data-after-right))
|
||||
ast0 (assoc ast-after-expr :if-true (:ast data-after-left))
|
||||
ast1 (assoc ast0 :if-false (:ast data-after-right))
|
||||
ast2 (assoc ast1 :free-left free-left)
|
||||
ast3 (assoc ast2 :free-right free-right)
|
||||
|
||||
|
@ -55,16 +55,16 @@
|
||||
(update-in ast '(:body) (fn (a) (find-func-deps-internal a new-vars))))
|
||||
|
||||
:if (let [ast0 (update-in ast '(:expr) (fn (a) (find-func-deps-internal a vars-in-scope)))
|
||||
ast1 (update-in ast0 '(:a) (fn (a) (find-func-deps-internal a vars-in-scope)))
|
||||
ast2 (update-in ast1 '(:b) (fn (a) (find-func-deps-internal a vars-in-scope)))]
|
||||
ast1 (update-in ast0 '(:if-true) (fn (a) (find-func-deps-internal a vars-in-scope)))
|
||||
ast2 (update-in ast1 '(:if-false) (fn (a) (find-func-deps-internal a vars-in-scope)))]
|
||||
ast2)
|
||||
|
||||
:while (let [ast0 (update-in ast '(:expr) (fn (a) (find-func-deps-internal a vars-in-scope)))
|
||||
ast1 (update-in ast0 '(:body) (fn (a) (find-func-deps-internal a vars-in-scope)))]
|
||||
ast1)
|
||||
|
||||
:binop (let [ast0 (update-in ast '(:a) (fn (a) (find-func-deps-internal a vars-in-scope)))
|
||||
ast1 (update-in ast0 '(:b) (fn (a) (find-func-deps-internal a vars-in-scope)))]
|
||||
:binop (let [ast0 (update-in ast '(:left) (fn (a) (find-func-deps-internal a vars-in-scope)))
|
||||
ast1 (update-in ast0 '(:right) (fn (a) (find-func-deps-internal a vars-in-scope)))]
|
||||
ast1)
|
||||
|
||||
:literal ast
|
||||
|
@ -20,8 +20,8 @@
|
||||
:if (let [if-result-name (gen-var-name var-name-counters "if_result")
|
||||
ast1 (assoc ast :result-name if-result-name)
|
||||
ast2 (assoc ast1 :expr (generate-names var-name-counters (:expr ast)))
|
||||
ast3 (assoc ast2 :a (generate-names var-name-counters (:a ast)))
|
||||
ast4 (assoc ast3 :b (generate-names var-name-counters (:b ast)))]
|
||||
ast3 (assoc ast2 :if-true (generate-names var-name-counters (:if-true ast)))
|
||||
ast4 (assoc ast3 :if-false (generate-names var-name-counters (:if-false ast)))]
|
||||
ast4)
|
||||
|
||||
:while (let [while-expr-name (gen-var-name var-name-counters "expr")
|
||||
@ -55,8 +55,8 @@
|
||||
]
|
||||
ast4)
|
||||
|
||||
:binop (let [ast1 (assoc ast :a (generate-names var-name-counters (:a ast)))
|
||||
ast2 (assoc ast1 :b (generate-names var-name-counters (:b ast)))]
|
||||
:binop (let [ast1 (assoc ast :left (generate-names var-name-counters (:left ast)))
|
||||
ast2 (assoc ast1 :right (generate-names var-name-counters (:right ast)))]
|
||||
ast2)
|
||||
|
||||
:do (let [named-forms (map (fn (x) (generate-names var-name-counters x)) (:forms ast))
|
||||
|
@ -91,25 +91,25 @@
|
||||
:b t
|
||||
:doc (str "lookup " val)} constraints)))
|
||||
|
||||
:binop (let [x0 (generate-constraints-internal constraints (get ast :a) type-env)
|
||||
x1 (generate-constraints-internal x0 (get ast :b) type-env)
|
||||
:binop (let [x0 (generate-constraints-internal constraints (get ast :left) type-env)
|
||||
x1 (generate-constraints-internal x0 (get ast :right) type-env)
|
||||
;;tvar (gen-typevar)
|
||||
;;left-arg-constr {:a tvar :b (get-in ast '(:a :type)) :doc "left-arg-constr"}
|
||||
;;right-arg-constr {:a tvar :b (get-in ast '(:b :type)) :doc "right-arg-constr"}
|
||||
;;ret-constr {:a tvar :b (:type ast)}
|
||||
same-arg-type-constr {:a (get-in ast '(:a :type)) :b (get-in ast '(:b :type)) :doc "same-arg-type-constr"}
|
||||
same-arg-type-constr {:a (get-in ast '(:left :type)) :b (get-in ast '(:right :type)) :doc "same-arg-type-constr"}
|
||||
maybe-constr (if (math-op? (:op ast))
|
||||
(list {:a (get-in ast '(:a :type)) :b (:type ast)})
|
||||
(list {:a (get-in ast '(:left :type)) :b (:type ast)})
|
||||
())
|
||||
]
|
||||
;;(concat x1 (list left-arg-constr right-arg-constr ret-constr)))
|
||||
(concat maybe-constr (cons same-arg-type-constr x1)))
|
||||
|
||||
:if (let [x0 (generate-constraints-internal constraints (get ast :a) type-env)
|
||||
x1 (generate-constraints-internal x0 (get ast :b) type-env)
|
||||
:if (let [x0 (generate-constraints-internal constraints (get ast :if-true) type-env)
|
||||
x1 (generate-constraints-internal x0 (get ast :if-false) type-env)
|
||||
x2 (generate-constraints-internal x1 (get ast :expr) type-env)
|
||||
left-result-constr {:a (get-in ast '(:a :type)) :b (:type ast)}
|
||||
right-result-constr {:a (get-in ast '(:b :type)) :b (:type ast)}
|
||||
left-result-constr {:a (get-in ast '(:if-true :type)) :b (:type ast)}
|
||||
right-result-constr {:a (get-in ast '(:if-false :type)) :b (:type ast)}
|
||||
expr-must-be-bool {:a :bool :b (get-in ast '(:expr :type))}]
|
||||
(concat x2 (list
|
||||
expr-must-be-bool
|
||||
@ -348,13 +348,13 @@
|
||||
x0)
|
||||
|
||||
:binop (let [x0 (assoc ast :type (get-type substs (:type ast)))
|
||||
x1 (assoc x0 :a (assign-types (:a ast) substs))
|
||||
x2 (assoc x1 :b (assign-types (:b ast) substs))]
|
||||
x1 (assoc x0 :left (assign-types (:left ast) substs))
|
||||
x2 (assoc x1 :right (assign-types (:right ast) substs))]
|
||||
x2)
|
||||
|
||||
:if (let [x0 (assoc ast :type (get-type substs (:type ast)))
|
||||
x1 (assoc x0 :a (assign-types (:a ast) substs))
|
||||
x2 (assoc x1 :b (assign-types (:b ast) substs))
|
||||
x1 (assoc x0 :if-true (assign-types (:if-true ast) substs))
|
||||
x2 (assoc x1 :if-false (assign-types (:if-false ast) substs))
|
||||
x3 (assoc x2 :expr (assign-types (:expr ast) substs))]
|
||||
x3)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user