diff options
author | Eduardo Julian | 2015-07-21 01:03:37 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-07-21 01:03:37 -0400 |
commit | 874af34a80ab799d0470810b7ade337b96ce50bc (patch) | |
tree | e34e3768410b01e3fb8530d1b142e3cd8bcec8e3 /input | |
parent | 3a760fa6c0f47f7621970b9747779f3edcc96286 (diff) |
- 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.
Diffstat (limited to 'input')
-rw-r--r-- | input/lux.lux | 105 | ||||
-rw-r--r-- | input/lux/control/lazy.lux | 2 |
2 files changed, 88 insertions, 19 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) |