aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--input/lux.lux105
-rw-r--r--input/lux/control/lazy.lux2
-rw-r--r--src/lux/analyser.clj2
-rw-r--r--src/lux/analyser/lux.clj12
4 files changed, 98 insertions, 23 deletions
diff --git a/input/lux.lux b/input/lux.lux
index 0c8b73c34..7ba6cef76 100644
--- a/input/lux.lux
+++ b/input/lux.lux
@@ -295,6 +295,12 @@
(_lux_export Macro)
## Base functions & macros
+## (def _cursor
+## Cursor
+## ["" -1 -1])
+(_lux_def _cursor
+ (_lux_: Cursor ["" -1 -1]))
+
## (def (_meta data)
## (-> (Syntax' (Meta Cursor)) Syntax)
## (#Meta [["" -1 -1] data]))
@@ -303,7 +309,7 @@
(#AppT [Meta Cursor])])
Syntax])
(_lux_lambda _ data
- (#Meta [["" -1 -1] data]))))
+ (#Meta [_cursor data]))))
## (def (return x)
## (All [a]
@@ -1488,21 +1494,34 @@
_
(fail "Wrong syntax for :!")))
+(def'' (empty? xs)
+ (All [a] (-> ($' List a) Bool))
+ (_lux_case xs
+ #Nil true
+ _ false))
+
(defmacro #export (deftype tokens)
(let [[export? tokens'] (: (, Bool (List Syntax))
- (_lux_case (:! (List Syntax) tokens)
+ (_lux_case tokens
(#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
- [true (:! (List Syntax) tokens')]
+ [true tokens']
_
- [false (:! (List Syntax) tokens)]))
- parts (: (Maybe (, Syntax (List Syntax) Syntax))
+ [false tokens]))
+ [rec? tokens'] (: (, Bool (List Syntax))
+ (_lux_case tokens'
+ (#Cons [(#Meta [_ (#TagS ["" "rec"])]) tokens'])
+ [true tokens']
+
+ _
+ [false tokens']))
+ parts (: (Maybe (, Text (List Syntax) Syntax))
(_lux_case tokens'
- (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])])
- (#Some [(symbol$ name) #Nil type])
+ (#Cons [(#Meta [_ (#SymbolS ["" name])]) (#Cons [type #Nil])])
+ (#Some [name #Nil type])
- (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS name)]) args]))]) (#Cons [type #Nil])])
- (#Some [(symbol$ name) args type])
+ (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" name])]) args]))]) (#Cons [type #Nil])])
+ (#Some [name args type])
_
#None))]
@@ -1510,21 +1529,71 @@
(#Some [name args type])
(let [with-export (: (List Syntax)
(if export?
- (list (`' (_lux_export (~ name))))
+ (list (`' (_lux_export (~ (symbol$ ["" name])))))
#Nil))
- type' (: Syntax
- (_lux_case args
- #Nil
- type
+ type' (: (Maybe Syntax)
+ (if rec?
+ (if (empty? args)
+ (let [g!param (symbol$ ["" ""])
+ prime-name (symbol$ ["" (text:++ name "'")])
+ type+ (replace-syntax (list [name (`' ((~ prime-name) (~ g!param)))]) type)]
+ (#Some (`' ((;All (~ prime-name) [(~ g!param)] (~ type+))
+ ;Void))))
+ #None)
+ (_lux_case args
+ #Nil
+ (#Some type)
- _
- (`' (;All (~ name) [(~@ args)] (~ type)))))]
- (return (list& (`' (_lux_def (~ name) (;type (~ type'))))
- with-export)))
+ _
+ (#Some (`' (;All (~ (symbol$ ["" name])) [(~@ args)] (~ type)))))))]
+ (_lux_case type'
+ (#Some type'')
+ (return (list& (`' (_lux_def (~ (symbol$ ["" name])) (;type (~ type''))))
+ with-export))
+
+ #None
+ (fail "Wrong syntax for deftype")))
#None
(fail "Wrong syntax for deftype"))
))
+## (defmacro #export (deftype tokens)
+## (let [[export? tokens'] (: (, Bool (List Syntax))
+## (_lux_case (:! (List Syntax) tokens)
+## (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
+## [true (:! (List Syntax) tokens')]
+
+## _
+## [false (:! (List Syntax) tokens)]))
+## parts (: (Maybe (, Syntax (List Syntax) Syntax))
+## (_lux_case tokens'
+## (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])])
+## (#Some [(symbol$ name) #Nil type])
+
+## (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS name)]) args]))]) (#Cons [type #Nil])])
+## (#Some [(symbol$ name) args type])
+
+## _
+## #None))]
+## (_lux_case parts
+## (#Some [name args type])
+## (let [with-export (: (List Syntax)
+## (if export?
+## (list (`' (_lux_export (~ name))))
+## #Nil))
+## type' (: Syntax
+## (_lux_case args
+## #Nil
+## type
+
+## _
+## (`' (;All (~ name) [(~@ args)] (~ type)))))]
+## (return (list& (`' (_lux_def (~ name) (;type (~ type'))))
+## with-export)))
+
+## #None
+## (fail "Wrong syntax for deftype"))
+## ))
(defmacro #export (exec tokens)
(_lux_case (reverse tokens)
diff --git a/input/lux/control/lazy.lux b/input/lux/control/lazy.lux
index fca63179e..22dac74fe 100644
--- a/input/lux/control/lazy.lux
+++ b/input/lux/control/lazy.lux
@@ -36,7 +36,7 @@
## Structs
(defstruct #export Lazy/Functor (Functor Lazy)
(def (F;map f ma)
- (... (f (! ma)))))
+ (lambda [k] (ma (. k f)))))
(defstruct #export Lazy/Monad (Monad Lazy)
(def M;_functor Lazy/Functor)
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 995e77fe6..f85b3d619 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -535,7 +535,7 @@
]
[["lux;Right" [state* =fn]]]
(do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0))
- ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*))
+ ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type meta =fn ?args) state*))
[_]
((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state)))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index fc96fecff..8be2a8924 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -30,6 +30,11 @@
(return (&/T ?item =type)))
)))))
+(defn ^:private with-cursor [cursor form]
+ (matchv ::M/objects [form]
+ [["lux;Meta" [_ syntax]]]
+ (&/V "lux;Meta" (&/T cursor syntax))))
+
;; [Exports]
(defn analyse-tuple [analyse exo-type ?elems]
(|do [exo-type* (&type/actual-type exo-type)]
@@ -245,7 +250,7 @@
(fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*)))))
))
-(defn analyse-apply [analyse exo-type =fn ?args]
+(defn analyse-apply [analyse exo-type form-cursor =fn ?args]
(|do [loader &/loader]
(matchv ::M/objects [=fn]
[[=fn-form =fn-type]]
@@ -255,14 +260,15 @@
(matchv ::M/objects [$def]
[["lux;MacroD" macro]]
(|do [macro-expansion #(-> macro (.apply ?args) (.apply %))
+ :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)]
:let [_ (when (and ;; (= "lux/control/monad" ?module)
(= "case" ?name))
- (->> (&/|map &/show-ast macro-expansion)
+ (->> (&/|map &/show-ast macro-expansion*)
(&/|interpose "\n")
(&/fold str "")
(prn ?module "case")))]
]
- (&/flat-map% (partial analyse exo-type) macro-expansion))
+ (&/flat-map% (partial analyse exo-type) macro-expansion*))
[_]
(|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-16 13:22:10 +0000