Change :a and :b in binop and if to :left and :right

This commit is contained in:
Erik Svedäng 2016-02-12 22:25:55 +01:00
parent 7fc447fd00
commit 1da8567f56
7 changed files with 46 additions and 46 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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