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

add generics.lisp, better names for types

Browse Source
This commit is contained in:
Erik Svedäng 2016-02-23 21:30:47 +01:00
parent 0191ac0659
commit 59c7fd015c
3 changed files with 56 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
lisp/compiler.carp
View File

@ -19,6 +19,7 @@
(load-lisp (str carp-dir "lisp/calculate_lifetimes.carp"))
(load-lisp (str carp-dir "lisp/builder.carp"))
(load-lisp (str carp-dir "lisp/func_deps.carp"))
(load-lisp (str carp-dir "lisp/generics.carp"))
(defn annotate-ast (ast)
(annotate-ast-internal ast false nil))
@ -39,46 +40,6 @@
(defn ann (lambda) (annotate-ast (lambda-to-ast (code lambda))))
(defn sig (lambda) (:type (ann lambda)))
(defn generic-suffix (signature)
(join "-" (map name (nth signature 1))))
(defn visit-generic-funcs [ast]
(let [deps (copy (:func-deps ast))
visit-generic-funcs-internal (fn [ast]
(match (:node ast)
:function (update-in ast '(:body) (fn (a) (visit-generic-funcs-internal a)))
:app (let [t (:type ast)
head (:head ast)
tail (:tail ast)
ast0 (update-in ast '(:head) (fn (a) (visit-generic-funcs-internal head)))
ast1 (update-in ast0 '(:tail) (fn (a) (map visit-generic-funcs-internal tail)))]
ast1)
:lookup (let [t (:type ast)]
(do
;;(println (str (:value ast) " : " t))
(if (:global-lookup ast) ;; TODO: shouldn't have to be a global lookup..?
(let [lookup-sym (:value ast)
;;_ (println (str "Will eval " ast))
global-lookup (eval lookup-sym)
lookup-t (type global-lookup)
;;_ (println (str "lookup-t: " lookup-t))
]
(if (and (lambda? global-lookup) (meta-get lookup-t :generic))
(let [generic-name (str lookup-sym "--" (generic-suffix t))]
(do
;;(println (str "generic lookup of '" lookup-sym "', t: " t ", lookup-t: " lookup-t ", n: " generic-name))
(bake-generic-func-internal (new-builder) generic-name (code global-lookup) '() false t)
(reset! deps (cons (symbol generic-name) deps))
(let [ast0 (assoc-in ast '(:value) (symbol generic-name)) ;; make it call another function...
]
ast0)))
ast))
ast)))
_ ast))]
(assoc (visit-generic-funcs-internal ast) :func-deps deps)))
(defn check-for-ref-return (ast)
(let [t (:type ast)]
(when (ref? (nth t 2)) (error (str "Return type of function '" (:name ast) "' is a reference: " (pretty-signature t))))))

47
lisp/generics.carp Normal file
View File

@ -0,0 +1,47 @@
(defn generic-safe-name (t)
(match t
(:fn args ret) (str "FUNC" (join "" (map pretty-signature args)) "->" (pretty-signature ret))
(:ref r) (str "REF" (pretty-signature r) "")
x (if (keyword? t) (name t)
(error (str "Invalid type signature: " t)))))
(defn generic-suffix (signature)
(join "-" (map generic-safe-name (nth signature 1))))
(defn visit-generic-funcs [ast]
(let [deps (copy (:func-deps ast))
visit-generic-funcs-internal (fn [ast]
(match (:node ast)
:function (update-in ast '(:body) (fn (a) (visit-generic-funcs-internal a)))
:app (let [t (:type ast)
head (:head ast)
tail (:tail ast)
ast0 (update-in ast '(:head) (fn (a) (visit-generic-funcs-internal head)))
ast1 (update-in ast0 '(:tail) (fn (a) (map visit-generic-funcs-internal tail)))]
ast1)
:lookup (let [t (:type ast)]
(do
;;(println (str (:value ast) " : " t))
(if (:global-lookup ast) ;; TODO: shouldn't have to be a global lookup..?
(let [lookup-sym (:value ast)
;;_ (println (str "Will eval " ast))
global-lookup (eval lookup-sym)
lookup-t (type global-lookup)
;;_ (println (str "lookup-t: " lookup-t))
]
(if (and (lambda? global-lookup) (meta-get lookup-t :generic))
(let [generic-name (str lookup-sym "--" (generic-suffix t))]
(do
;;(println (str "generic lookup of '" lookup-sym "', t: " t ", lookup-t: " lookup-t ", n: " generic-name))
(bake-generic-func-internal (new-builder) generic-name (code global-lookup) '() false t)
(reset! deps (cons (symbol generic-name) deps))
(let [ast0 (assoc-in ast '(:value) (symbol generic-name)) ;; make it call another function...
]
ast0)))
ast))
ast)))
_ ast))]
(assoc (visit-generic-funcs-internal ast) :func-deps deps)))

8
out/project.carp
View File

@ -25,3 +25,11 @@
(defn whatever [a b]
100)
(defn test-whatever-1 []
(whatever 1 2))
(defn test-whatever-2 []
(whatever "hej" "svejs"))
;; (bake test-whatever-1)