From 81e1a4f10ad7aa7cfd76f9877e5e7deacb2d441e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 9 Jun 2015 22:37:56 -0400 Subject: - Put definition metadata into the generated .class files. --- source/lux.lux | 29 ++------- src/lux/compiler/lux.clj | 152 +++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 152 insertions(+), 29 deletions(-) diff --git a/source/lux.lux b/source/lux.lux index 2e5752592..2a4cc8660 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -1341,33 +1341,16 @@ (-> ($' List ($' List a)) ($' List a))) (foldL list:++ #Nil xs)) -## (def'' #export (normalize ident) -## (-> Ident ($' Lux Ident)) -## (_lux_case ident -## ["" name] -## (do Lux:Monad -## [module-name get-module-name] -## (;return (: Ident [module-name name]))) - -## _ -## (return ident))) -(def'' #export (normalize ident state) +(def'' #export (normalize ident) (-> Ident ($' Lux Ident)) (_lux_case ident ["" name] - (_lux_case state - {#source source #modules modules #module-aliases module-aliases - #envs envs #types types #host host - #seed seed} - (_lux_case (reverse envs) - #Nil - (#Left "Can't normalize Ident without a global environment.") - - (#Cons [{#name prefix #inner-closures _ #locals _ #closure _} _]) - (#Right [state [prefix name]]))) - + (do Lux:Monad + [module-name get-module-name] + (;return (_lux_: Ident [module-name name]))) + _ - (#Right [state ident]))) + (return ident))) (defmacro #export (| tokens) (do Lux:Monad diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index d0caff173..b47267d25 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -124,6 +124,147 @@ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] (return nil))) +(defn ^:private type->analysis [type] + (matchv ::M/objects [type] + [["lux;DataT" ?class]] + (&/T (&/V "variant" (&/T "lux;DataT" + (&/T (&/V "text" ?class) &type/$Void))) + &type/$Void) + + [["lux;TupleT" ?members]] + (&/T (&/V "variant" (&/T "lux;TupleT" + (&/fold (fn [tail head] + (&/V "variant" (&/T "lux;Cons" + (&/T (&/V "tuple" (&/|list (type->analysis head) + tail)) + &type/$Void)))) + (&/V "variant" (&/T "lux;Nil" + (&/T (&/V "tuple" (&/|list)) + &type/$Void))) + (&/|reverse ?members)))) + &type/$Void) + + [["lux;VariantT" ?cases]] + (&/T (&/V "variant" (&/T "lux;VariantT" + (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (&/V "variant" (&/T "lux;Cons" + (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) + (type->analysis htype))) + &type/$Void) + tail)) + &type/$Void))))) + (&/V "variant" (&/T "lux;Nil" + (&/T (&/V "tuple" (&/|list)) + &type/$Void))) + (&/|reverse ?cases)))) + &type/$Void) + + [["lux;RecordT" ?slots]] + (&/T (&/V "variant" (&/T "lux;RecordT" + (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (&/V "variant" (&/T "lux;Cons" + (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) + (type->analysis htype))) + &type/$Void) + tail)) + &type/$Void))))) + (&/V "variant" (&/T "lux;Nil" + (&/T (&/V "tuple" (&/|list)) + &type/$Void))) + (&/|reverse ?slots)))) + &type/$Void) + + [["lux;LambdaT" [?input ?output]]] + (&/T (&/V "variant" (&/T "lux;LambdaT" + (&/T (&/V "tuple" (&/|map type->analysis (&/|list ?input ?output))) + &type/$Void))) + &type/$Void) + + [["lux;AllT" [?env ?name ?arg ?body]]] + (&/T (&/V "variant" (&/T "lux;AllT" + (&/T (&/V "tuple" (&/|list (matchv ::M/objects [?env] + [["lux;None" _]] + (&/V "variant" (&/T "lux;Some" + (&/T (&/V "tuple" (&/|list)) + &type/$Void))) + + [["lux;Some" ??env]] + (&/V "variant" (&/T "lux;Some" + (&/T (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (&/V "variant" (&/T "lux;Cons" + (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) + (type->analysis htype))) + &type/$Void) + tail)) + &type/$Void))))) + (&/V "variant" (&/T "lux;Nil" + (&/T (&/V "tuple" (&/|list)) + &type/$Void))) + (&/|reverse ??env)) + &type/$Void)))) + (&/T (&/V "text" ?name) &type/$Void) + (&/T (&/V "text" ?arg) &type/$Void) + (type->analysis ?body))) + &type/$Void))) + &type/$Void) + + [["lux;BoundT" ?name]] + (&/T (&/V "variant" (&/T "lux;BoundT" + (&/T (&/V "text" ?name) &type/$Void))) + &type/$Void) + + [["lux;AppT" [?fun ?arg]]] + (&/T (&/V "variant" (&/T "lux;AppT" + (&/T (&/V "tuple" (&/|map type->analysis (&/|list ?fun ?arg))) + &type/$Void))) + &type/$Void) + )) + +(defn ^:private compile-def-type [compile ?body ?def-data] + (|do [^MethodVisitor **writer** &/get-writer] + (matchv ::M/objects [?def-data] + [["lux;TypeD" _]] + (let [_ (doto **writer** + ;; Tail: Begin + (.visitLdcInsn (int 2)) ;; S + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V + (.visitInsn Opcodes/DUP) ;; VV + (.visitLdcInsn (int 0)) ;; VVI + (.visitLdcInsn "lux;TypeD") ;; VVIT + (.visitInsn Opcodes/AASTORE) ;; V + (.visitInsn Opcodes/DUP) ;; VV + (.visitLdcInsn (int 1)) ;; VVI + (.visitInsn Opcodes/ACONST_NULL) ;; VVIN + (.visitInsn Opcodes/AASTORE) ;; V + )] + (return nil)) + + [["lux;ValueD" _]] + (|let [;; _ (prn '?body (aget ?body 0) (aget ?body 1 0)) + [?def-value ?def-type] (matchv ::M/objects [?body] + [[["ann" [?def-value ?type-expr]] ?def-type]] + (&/T ?def-value ?type-expr) + + [[?def-value ?def-type]] + (&/T ?body (type->analysis ?def-type)))] + (|do [:let [_ (doto **writer** + (.visitLdcInsn (int 2)) ;; S + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V + (.visitInsn Opcodes/DUP) ;; VV + (.visitLdcInsn (int 0)) ;; VVI + (.visitLdcInsn "lux;ValueD") ;; VVIT + (.visitInsn Opcodes/AASTORE) ;; V + (.visitInsn Opcodes/DUP) ;; VV + (.visitLdcInsn (int 1)) ;; VVI + )] + _ (compile ?def-type) + :let [_ (.visitInsn **writer** Opcodes/AASTORE)]] + (return nil))) + ))) + (defn compile-def [compile ?name ?body ?def-data] (|do [^ClassWriter *writer* &/get-writer module-name &/get-module-name @@ -136,17 +277,16 @@ current-class nil "java/lang/Object" (into-array ["lux/Function"])) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) (doto (.visitEnd))) - ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_mode" datum-sig nil ...) - ;; (doto (.visitEnd))) - ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_type" datum-sig nil nil) - ;; (doto (.visitEnd))) - )] + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_meta" datum-sig nil nil) + (doto (.visitEnd))))] _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) (|do [^MethodVisitor **writer** &/get-writer :let [_ (.visitCode **writer**)] _ (compile ?body) + :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class "_datum" datum-sig)] + _ (compile-def-type compile ?body ?def-data) + :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class "_meta" datum-sig)] :let [_ (doto **writer** - (.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig) (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) (.visitEnd))]] -- cgit v1.2.3