aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux181
-rw-r--r--src/lux/analyser/lux.clj48
-rw-r--r--src/lux/analyser/module.clj20
-rw-r--r--src/lux/type.clj8
4 files changed, 167 insertions, 90 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 111aac611..637c4607f 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -22,6 +22,9 @@
(def' Void (#VariantT #Nil))
(export' Void)
+(def' Ident (#TupleT (#Cons [Text (#Cons [Text #Nil])])))
+(export' Ident)
+
## (deftype (List a)
## (| #Nil
## (#Cons (, a (List a)))))
@@ -137,23 +140,20 @@
Syntax
(case' (#AppT [List Syntax])
SyntaxList
- (case' (#TupleT (#Cons [Text (#Cons [Text #Nil])]))
- Ident
- (#AllT [#None "Syntax'" "w"
- (#VariantT (#Cons [["lux;Bool" Bool]
- (#Cons [["lux;Int" Int]
- (#Cons [["lux;Real" Real]
- (#Cons [["lux;Char" Char]
- (#Cons [["lux;Text" Text]
- (#Cons [["lux;Symbol" Ident]
- (#Cons [["lux;Tag" Ident]
- (#Cons [["lux;Form" SyntaxList]
- (#Cons [["lux;Tuple" SyntaxList]
- (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])]
- #Nil])
- ])])])])])])])])])
- )])
- ))))
+ (#AllT [#None "Syntax'" "w"
+ (#VariantT (#Cons [["lux;Bool" Bool]
+ (#Cons [["lux;Int" Int]
+ (#Cons [["lux;Real" Real]
+ (#Cons [["lux;Char" Char]
+ (#Cons [["lux;Text" Text]
+ (#Cons [["lux;Symbol" Ident]
+ (#Cons [["lux;Tag" Ident]
+ (#Cons [["lux;Form" SyntaxList]
+ (#Cons [["lux;Tuple" SyntaxList]
+ (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])]
+ #Nil])
+ ])])])])])])])])])
+ )]))))
(export' Syntax')
## (deftype Syntax
@@ -209,13 +209,15 @@
## (deftype (DefData' m)
## (| #TypeD
## (#ValueD Type)
-## (#MacroD m)))
+## (#MacroD m)
+## (#AliasD Ident)))
(def' DefData'
(#AllT [#None "DefData'" ""
(#VariantT (#Cons [["lux;TypeD" (#TupleT #Nil)]
(#Cons [["lux;ValueD" Type]
(#Cons [["lux;MacroD" (#BoundT "")]
- #Nil])])]))]))
+ (#Cons [["lux;AliasD" Ident]
+ #Nil])])])]))]))
## (deftype #rec CompilerState
## (& #source (Maybe Reader)
@@ -297,10 +299,6 @@
(lambda' _ state
(#Left msg)))))
-(def' Ident
- (#TupleT (#Cons [Text (#Cons [Text #Nil])])))
-(export' Ident)
-
(def' $text
(:' (#LambdaT [Text Syntax])
(lambda' _ text
@@ -835,7 +833,6 @@
(wrap-meta ($form (list ($tag ["lux" "Text"]) (_meta (#Text value)))))
(#Meta [_ (#Tag [module name])])
- (case' name)
(let [module' (case' module
""
subst
@@ -1191,39 +1188,6 @@
(let [[module name] ident]
($ text:++ module ";" name)))
-(defmacro #export (| tokens)
- (do Lux:Monad
- [pairs (map% Lux:Monad
- (:' (-> Syntax ($' Lux Syntax))
- (lambda [token]
- (case' token
- (#Meta [_ (#Tag ident)])
- (;return (:' Syntax (`' [(~ ($text (ident->text ident))) (;,)])))
-
- (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))])
- (;return (:' Syntax (`' [(~ ($text (ident->text ident))) (~ value)])))
-
- _
- (fail "Wrong syntax for |"))))
- tokens)]
- (;return (:' SyntaxList (list (`' (#;VariantT (;list (~@ pairs)))))))))
-
-(defmacro #export (& tokens)
- (if (not (multiple? 2 (length tokens)))
- (fail "& expects an even number of arguments.")
- (do Lux:Monad
- [pairs (map% Lux:Monad
- (:' (-> (, Syntax Syntax) ($' Lux Syntax))
- (lambda [pair]
- (case' pair
- [(#Meta [_ (#Tag ident)]) value]
- (;return (:' Syntax (`' [(~ ($text (ident->text ident))) (~ value)])))
-
- _
- (fail "Wrong syntax for &"))))
- (as-pairs tokens))]
- (;return (:' SyntaxList (list (`' (#;RecordT (;list (~@ pairs))))))))))
-
(def__ (replace-syntax reps syntax)
(-> RepEnv Syntax Syntax)
(case' syntax
@@ -1352,6 +1316,45 @@
_
(#Right [state ident])))
+(defmacro #export (| tokens)
+ (do Lux:Monad
+ [pairs (map% Lux:Monad
+ (:' (-> Syntax ($' Lux Syntax))
+ (lambda [token]
+ (case' token
+ (#Meta [_ (#Tag ident)])
+ (do Lux:Monad
+ [ident (normalize ident)]
+ (;return (:' Syntax (`' [(~ ($text (ident->text ident))) (;,)]))))
+
+ (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))])
+ (do Lux:Monad
+ [ident (normalize ident)]
+ (;return (:' Syntax (`' [(~ ($text (ident->text ident))) (~ value)]))))
+
+ _
+ (fail "Wrong syntax for |"))))
+ tokens)]
+ (;return (:' SyntaxList (list (`' (#;VariantT (;list (~@ pairs)))))))))
+
+(defmacro #export (& tokens)
+ (if (not (multiple? 2 (length tokens)))
+ (fail "& expects an even number of arguments.")
+ (do Lux:Monad
+ [pairs (map% Lux:Monad
+ (:' (-> (, Syntax Syntax) ($' Lux Syntax))
+ (lambda [pair]
+ (case' pair
+ [(#Meta [_ (#Tag ident)]) value]
+ (do Lux:Monad
+ [ident (normalize ident)]
+ (;return (:' Syntax (`' [(~ ($text (ident->text ident))) (~ value)]))))
+
+ _
+ (fail "Wrong syntax for &"))))
+ (as-pairs tokens))]
+ (;return (:' SyntaxList (list (`' (#;RecordT (;list (~@ pairs))))))))))
+
(def__ (->text x)
(-> (^ java.lang.Object) Text)
(jvm-invokevirtual java.lang.Object toString [] x []))
@@ -1674,11 +1677,22 @@
[inc 1]
[dec -1])
-(def #export (int:show int)
+(def (int:show int)
(-> Int Text)
(jvm-invokevirtual java.lang.Object toString []
int []))
+(defmacro #export (` tokens)
+ (do Lux:Monad
+ [module-name get-module-name]
+ (case tokens
+ (\ (list template))
+ (;return (: (List Syntax)
+ (list (untemplate (: Text module-name) template))))
+
+ _
+ (fail "Wrong syntax for `"))))
+
(def #export (gensym prefix state)
(-> Text (Lux Syntax))
(case state
@@ -1842,16 +1856,47 @@
[Real:Show Real (->text x)]
[Char:Show Char ($ text:++ "#\"" (->text x) "\"")])
-(defmacro #export (` tokens)
- (do Lux:Monad
- [module-name get-module-name]
- (case tokens
- (\ (list template))
- (;return (: (List Syntax)
- (list (untemplate (: Text module-name) template))))
-
- _
- (fail "Wrong syntax for `"))))
+(defsig #export (Ord a)
+ (: (-> a a Bool)
+ <)
+ (: (-> a a Bool)
+ <=)
+ (: (-> a a Bool)
+ >)
+ (: (-> a a Bool)
+ >=))
+
+(do-template [<name> <form> <message>]
+ [(defmacro #export (<name> tokens)
+ (case (reverse tokens)
+ (\ (list& last init))
+ (return (: (List Syntax)
+ (list (fold (: (-> Syntax Syntax Syntax)
+ (lambda [post pre] (` <form>)))
+ last
+ init))))
+
+ _
+ (fail <message>)))]
+
+ [and (if (~ pre) true (~ post)) "and requires >=1 elements."]
+ [or (if (~ pre) (~ post) false) "or requires >=1 elements."])
+
+(do-template [<name> <type> <lt> <gt> <eq>]
+ [(defstruct #export <name> (Ord <type>)
+ (def (< x y)
+ (<lt> x y))
+ (def (<= x y)
+ (or (<lt> x y)
+ (<eq> x y)))
+ (def (> x y)
+ (<gt> x y))
+ (def (>= x y)
+ (or (<gt> x y)
+ (<eq> x y))))]
+
+ [Int:Ord Int jvm-llt jvm-lgt jvm-leq]
+ [Real:Ord Real jvm-dlt jvm-dgt jvm-deq])
## (def #export (print x)
## (-> Text (IO (,)))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 47c18aded..b8ffafd59 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -114,6 +114,15 @@
?elems)]
(return (&/|list (&/T (&/V "record" =slots) (&/V "lux;RecordT" exo-type))))))
+(defn find-def+ [?module ?name]
+ (|do [$def (&&module/find-def ?module ?name)]
+ (matchv ::M/objects [$def]
+ [["lux;AliasD" [?r-module ?r-name]]]
+ (find-def+ ?r-module ?r-name)
+
+ [_]
+ (return $def))))
+
(defn analyse-symbol [analyse exo-type ident]
(|do [module-name &/get-module-name]
(fn [state]
@@ -126,10 +135,8 @@
[inner outer] (&/|split-with no-binding? stack)]
(matchv ::M/objects [outer]
[["lux;Nil" _]]
- (&/run-state (|do [$def (&&module/find-def (if (= "" ?module) module-name ?module)
- ?name)
- ;; :let [_ (println "Found def:" (if (= "" ?module) module-name ?module)
- ;; ?name)]
+ (&/run-state (|do [$def (find-def+ (if (= "" ?module) module-name ?module)
+ ?name)
endo-type (matchv ::M/objects [$def]
[["lux;ValueD" ?type]]
(return ?type)
@@ -364,22 +371,25 @@
(|do [;; :let [_ (prn 'analyse-def/_0)]
=value (&/with-scope ?name
(analyse-1+ analyse ?value))
- ;; :let [_ (prn 'analyse-def/_1)]
- =value-type (&&/expr-type =value)
- ;; :let [_ (prn 'analyse-def/_2)]
- ;; _ &type/delete-vars
- :let [_ (prn 'analyse-def/TYPE ?name ;; (&type/show-type =value-type)
- )
- _ (println)
- def-data (cond (&type/type= &type/Type =value-type)
- (&/V "lux;TypeD" nil)
-
- :else
- (&/V "lux;ValueD" =value-type))]
- _ (&&module/define module-name ?name def-data)
- ;; :let [_ (prn 'analyse-def/_3)]
+ ;; :let [_ (prn 'analyse-def/_1 (aget =value 0 0))]
]
- (return (&/|list (&/V "def" (&/T ?name =value def-data))))))))
+ (matchv ::M/objects [=value]
+ [["global" [?r-module ?r-name]]]
+ (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name)]
+ (return (&/|list)))
+
+ [_]
+ (|do [=value-type (&&/expr-type =value)
+ :let [_ (prn 'analyse-def/END ?name)
+ _ (println)
+ def-data (cond (&type/type= &type/Type =value-type)
+ (&/V "lux;TypeD" nil)
+
+ :else
+ (&/V "lux;ValueD" =value-type))]
+ _ (&&module/define module-name ?name def-data)]
+ (return (&/|list (&/V "def" (&/T ?name =value def-data))))))
+ ))))
(defn analyse-declare-macro [analyse ?name]
(|do [module-name &/get-module-name
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index d2e0a745b..6e42a56f7 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -30,6 +30,26 @@
[_]
(fail* "[Analyser Error] Can't create a new global definition outside of a global environment."))))
+(defn def-alias [a-module a-name r-module r-name]
+ (fn [state]
+ (matchv ::M/objects [(&/get$ &/$ENVS state)]
+ [["lux;Cons" [?env ["lux;Nil" _]]]]
+ (return* (->> state
+ (&/update$ &/$MODULES (fn [ms]
+ (&/|update a-module #(&/|put a-name (&/V "lux;AliasD" (&/T r-module r-name)) %)
+ ms)))
+ (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
+ (&/update$ &/$MAPPINGS (fn [mappings]
+ (&/|put (str "" &/+name-separator+ name)
+ (&/T (&/V "global" (&/T r-module r-name)) &type/$Void)
+ mappings))
+ locals))
+ ?env))))
+ nil)
+
+ [_]
+ (fail* "[Analyser Error] Can't alias a global definition outside of a global environment."))))
+
(defn exists? [name]
(fn [state]
;; (prn `exists? name (->> state (&/get$ &/$MODULES) (&/|contains? name)))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index c8ee06059..38f848676 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -77,12 +77,13 @@
(&/V "lux;VariantT" (&/|list (&/T "lux;Meta" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "m")
(&/V "lux;BoundT" "v")))))))))
+(def Ident (&/V "lux;TupleT" (&/|list Text Text)))
+
(def Syntax*
(let [Syntax* (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "w")
(&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Syntax'")
(&/V "lux;BoundT" "w")))))
- Syntax*List (&/V "lux;AppT" (&/T List Syntax*))
- Ident (&/V "lux;TupleT" (&/|list Text Text))]
+ Syntax*List (&/V "lux;AppT" (&/T List Syntax*))]
(fAll "Syntax'" "w"
(&/V "lux;VariantT" (&/|list (&/T "lux;Bool" Bool)
(&/T "lux;Int" Int)
@@ -131,7 +132,8 @@
(fAll "DefData'" ""
(&/V "lux;VariantT" (&/|list (&/T "lux;TypeD" Unit)
(&/T "lux;ValueD" Type)
- (&/T "lux;MacroD" (&/V "lux;BoundT" ""))))))
+ (&/T "lux;MacroD" (&/V "lux;BoundT" ""))
+ (&/T "lux;AliasD" Ident)))))
(def CompilerState
(&/V "lux;AppT" (&/T (fAll "CompilerState" ""
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-10 14:33:12 +0000