aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux29
-rw-r--r--src/lux/compiler/lux.clj152
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 "<clinit>" "()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))]]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 15:41:03 +0000