From 874af34a80ab799d0470810b7ade337b96ce50bc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 21 Jul 2015 01:03:37 -0400 Subject: - Added a way to pass the cursor from un-expanded macro-forms to their expansions in order to aid error-reporting. - Added recursive type definitions through the #rec tag in deftype. --- input/lux.lux | 105 +++++++++++++++++++++++++++++++++++++-------- input/lux/control/lazy.lux | 2 +- src/lux/analyser.clj | 2 +- src/lux/analyser/lux.clj | 12 ++++-- 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)] -- cgit v1.2.3