From 59c7fd015c3800a88572b9c0be62dbb01c200bbd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Erik=20Sved=C3=A4ng?= Date: Tue, 23 Feb 2016 21:30:47 +0100 Subject: [PATCH] add generics.lisp, better names for types --- lisp/compiler.carp | 41 +--------------------------------------- lisp/generics.carp | 47 ++++++++++++++++++++++++++++++++++++++++++++++ out/project.carp | 8 ++++++++ 3 files changed, 56 insertions(+), 40 deletions(-) create mode 100644 lisp/generics.carp diff --git a/lisp/compiler.carp b/lisp/compiler.carp index 171d5120..367bf364 100644 --- a/lisp/compiler.carp +++ b/lisp/compiler.carp @@ -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)))))) diff --git a/lisp/generics.carp b/lisp/generics.carp new file mode 100644 index 00000000..dd00a547 --- /dev/null +++ b/lisp/generics.carp @@ -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))) diff --git a/out/project.carp b/out/project.carp index eef8522a..1eb96343 100644 --- a/out/project.carp +++ b/out/project.carp @@ -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) +