From a2faef20e0646a74dca82a0508a9892a8acc32f0 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 14 Dec 2014 16:27:49 -0400 Subject: Added Java class imports. --- src/lang.clj | 53 +++++++++++++++++++++++++++++++++++++++++++++++---- src/lang/analyser.clj | 24 ++++++++++++++++++++--- src/lang/compiler.clj | 28 ++++++++++++++++----------- src/lang/parser.clj | 8 ++++---- 4 files changed, 91 insertions(+), 22 deletions(-) (limited to 'src') diff --git a/src/lang.clj b/src/lang.clj index d8b65afe6..5d5dd0c66 100644 --- a/src/lang.clj +++ b/src/lang.clj @@ -46,16 +46,61 @@ syntax (&parser/parse tokens) ;; _ (prn 'syntax syntax) ann-syntax (&analyser/analyse "test2" syntax) - _ (prn 'ann-syntax ann-syntax) + ;; _ (prn 'ann-syntax ann-syntax) class-data (&compiler/compile "test2" ann-syntax)] (write-file "test2.class" class-data)) - ;; TODO: Define functions as classes inheriting Function. - ;; TODO: Allow importing Java classes. + (let y ... + (lambda x (* x y))) + + (let y ... + (proxy Function1 + (apply1 [_ x] (* x y)))) + + (def (foo w x y z) + ($ * w x y z)) + => + (let f1 (proxy Function1 [w x y] + (apply1 [_ z] + (STATIC-METHOD w x y z))) + (let f2 (proxy Function2 [w x] + (apply1 [_ y] + f1) + (apply2 [_ y z] + (STATIC-METHOD w x y z))) + (proxy Function4 + (apply1 [_ w x] + (proxy Function3 [w] + (apply1 [_ x] + f2) + (apply2 [_ x y] + f1) + (apply3 [_ x y z] + (STATIC-METHOD w x y z)))) + (apply2 [_ w x] + f2) + (apply3 [_ w x y] + f1) + (apply4 [_ w x y z] + (STATIC-METHOD w x y z))))) + + + (proxy Function [] + (apply [_ w] + (proxy Function [w] + (apply [_ x] + (proxy Function [w x] + (apply [_ y] + (proxy Function [w x y] + (apply [_ z] + (STATIC-METHOD w x y z))))))))) + + ;; TODO: Allow using other modules. + ;; TODO: Define functions as classes inheriting Function. ;; TODO: Add tuples. - ;; TODO: Add thunks. ;; TODO: Add pattern-matching. + ;; TODO: Add thunks. ;; TODO: Add Java-interop. ;; TODO: Do tail-call optimization. ;; TODO: Add macros. diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj index c40fccffb..abf8fa638 100644 --- a/src/lang/analyser.clj +++ b/src/lang/analyser.clj @@ -1,6 +1,7 @@ (ns lang.analyser (:refer-clojure :exclude [resolve]) (:require [clojure.core.match :refer [match]] + [clojure.string :as string] (lang [util :as &util :refer [exec return* return fail fail* repeat-m try-m try-all-m map-m apply-m within]] @@ -40,6 +41,13 @@ _ =return)))) +(defn ^:private import-class [long-name short-name] + (fn [state] + (let [=class (annotated [::class long-name] ::&type/nothing)] + [::&util/ok [(update-in state [:env :mappings] merge {long-name =class, + short-name =class}) + nil]]))) + (defn ^:private resolve [ident] (fn [state] (if-let [resolved (get-in state [:env :mappings ident])] @@ -88,8 +96,12 @@ (return (annotated [::ann-class ?class ?members] ::&type/nothing))) (defanalyser analyse-static-access - [::&parser/static-access ?class ?member] - (return (annotated [::static-access ?class ?member] ::&type/nothing))) + [::&parser/static-access ?target ?member] + (exec [=target (resolve ?target) + :let [_ (prn '=target ?target (:form =target))]] + (match (:form =target) + [::class ?class] + (return (annotated [::static-access ?class ?member] ::&type/nothing))))) (defanalyser analyse-dynamic-access [::&parser/dynamic-access ?object ?member] @@ -173,6 +185,11 @@ (return (annotated [::def [?name args] =value] ::&type/nothing)))) )) +(defanalyser analyse-import + [::&parser/import ?class] + (exec [_ (import-class ?class (last (string/split ?class #"\.")))] + (return (annotated [::import ?class] ::&type/nothing)))) + (def ^:private analyse-form (try-all-m [analyse-boolean analyse-string @@ -186,7 +203,8 @@ analyse-let analyse-defclass analyse-definterface - analyse-def])) + analyse-def + analyse-import])) ;; [Interface] (defn analyse [module-name tokens] diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj index a8d38842a..d6a6f5125 100644 --- a/src/lang/compiler.clj +++ b/src/lang/compiler.clj @@ -74,19 +74,19 @@ (defcompiler ^:private compile-local [::&analyser/local ?idx] - (do (prn 'LOCAL ?idx) + (do ;; (prn 'LOCAL ?idx) (doto *writer* (.visitVarInsn Opcodes/ALOAD (int ?idx))))) (defcompiler ^:private compile-global [::&analyser/global ?owner-class ?name] - (do (prn 'GLOBAL ?owner-class ?name *type*) + (do ;; (prn 'GLOBAL ?owner-class ?name *type*) (doto *writer* (.visitFieldInsn Opcodes/GETSTATIC (->class ?owner-class) ?name (->java-sig *type*))))) (defcompiler ^:private compile-call [::&analyser/call ?fn ?args] - (do (prn 'compile-call ?fn) + (do ;; (prn 'compile-call ?fn) (doseq [arg ?args] (compile-form (assoc *state* :form arg))) (match (:form ?fn) @@ -115,7 +115,7 @@ [::&analyser/if ?test ?then ?else] (let [else-label (new Label) end-label (new Label)] - (println "PRE") + ;; (println "PRE") (assert (compile-form (assoc *state* :form ?test)) "CAN't COMPILE TEST") (doto *writer* (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z") @@ -145,7 +145,8 @@ (match ?form (?name :guard string?) (let [=type (:type ?body) - _ (prn '?body ?body)] + ;; _ (prn '?body ?body) + ] (doto (.visitField *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name (->java-sig =type) nil nil) (.visitEnd))) @@ -153,7 +154,7 @@ (if (= "main" ?name) (let [=method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name "([Ljava/lang/String;)V" nil nil) (.visitCode))] - (prn 'FN/?body ?body) + ;; (prn 'FN/?body ?body) (assert (compile-form (assoc *state* :writer =method :form ?body)) (str "Body couldn't compile: " (pr-str ?body))) (doto =method (.visitInsn Opcodes/RETURN) @@ -207,7 +208,7 @@ (defcompiler ^:private compile-variant [::&analyser/variant ?tag ?value] (let [variant-class* (->class +variant-class+)] - (prn 'compile-variant ?tag ?value) + ;; (prn 'compile-variant ?tag ?value) (doto *writer* (.visitTypeInsn Opcodes/NEW variant-class*) (.visitInsn Opcodes/DUP) @@ -221,7 +222,12 @@ (.visitFieldInsn Opcodes/PUTFIELD variant-class* "value" "Ljava/lang/Object;")) )) +(defcompiler compile-import + [::&analyser/import ?class] + nil) + (let [+compilers+ [compile-literal + compile-variant compile-local compile-global compile-call @@ -233,15 +239,15 @@ compile-def compile-defclass compile-definterface - compile-variant]] + compile-import]] (defn ^:private compile-form [state] - (prn 'compile-form/state state) + ;; (prn 'compile-form/state state) (or (some #(% state) +compilers+) (assert false (str "Can't compile: " (pr-str (:form state))))))) ;; [Interface] (defn compile [class-name inputs] - (prn 'inputs inputs) + ;; (prn 'inputs inputs) (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) (->class class-name) nil "java/lang/Object" nil)) @@ -261,7 +267,7 @@ (when (not (compile-form (assoc state :form input))) (assert false input))) ;; (doall (map #(compile-form (assoc state :form %)) inputs)) - (prn 'inputs inputs) + ;; (prn 'inputs inputs) (when-let [constants (seq (for [input inputs :let [payload (match (:form input) [::&analyser/def (?name :guard string?) ?body] diff --git a/src/lang/parser.clj b/src/lang/parser.clj index fd50a04fb..f756a8b14 100644 --- a/src/lang/parser.clj +++ b/src/lang/parser.clj @@ -98,9 +98,9 @@ =body (apply-m parse-form (list ?body))] (return [::let ?label =value =body]))) -(defparser ^:private parse-module - [::&lexer/list ([[::&lexer/ident "module"]] :seq)] - (return [::module])) +(defparser ^:private parse-import + [::&lexer/list ([[::&lexer/ident "import"] [::&lexer/ident ?class]] :seq)] + (return [::import ?class])) (defparser ^:private parse-defclass [::&lexer/list ([[::&lexer/ident "defclass"] [::&lexer/ident ?name] [::&lexer/tuple ?fields]] :seq)] @@ -200,7 +200,7 @@ parse-static-access parse-dynamic-access parse-ann-class - parse-module + parse-import parse-defclass parse-definterface parse-fn-call])) -- cgit v1.2.3