diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/concurrency/actor.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/lux/control/effect.lux | 26 | ||||
| -rw-r--r-- | stdlib/source/lux/control/exception.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/data/coll/ordered.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/lux/host.jvm.lux | 70 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/poly.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax.lux | 15 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax/common.lux | 131 | ||||
| -rw-r--r-- | stdlib/source/lux/math.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/test.lux | 4 | ||||
| -rw-r--r-- | stdlib/test/test/lux/macro/syntax.lux | 6 |
11 files changed, 155 insertions, 134 deletions
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index de1c9d745..e9a6b5d37 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -149,11 +149,11 @@ (def: method^ (Syntax Method) (s;form (do s;Monad<Syntax> - [_ (s;this! (' method:)) + [_ (s;this (' method:)) vars (s;default (list) (s;tuple (s;some s;local-symbol))) [name args] (s;form ($_ s;seq s;local-symbol - (s;many common;typed-arg) + (s;many common;typed-input) )) return s;any body s;any] @@ -166,13 +166,13 @@ (def: stop^ (Syntax Code) (s;form (do s;Monad<Syntax> - [_ (s;this! (' stop:))] + [_ (s;this (' stop:))] s;any))) (def: actor-decl^ (Syntax [(List Text) Text (List [Text Code])]) (s;seq (s;default (list) (s;tuple (s;some s;local-symbol))) - (s;either (s;form (s;seq s;local-symbol (s;many common;typed-arg))) + (s;either (s;form (s;seq s;local-symbol (s;many common;typed-input))) (s;seq s;local-symbol (:: s;Monad<Syntax> wrap (list)))))) (def: (actor-def-decl [_vars _name _args] return-type) @@ -190,7 +190,7 @@ (list decl type))) -(syntax: #export (actor: [_ex-lev common;export-level] +(syntax: #export (actor: [_ex-lev common;export] [(^@ decl [_vars _name _args]) actor-decl^] state-type [methods (s;many method^)] @@ -264,16 +264,16 @@ type (` (-> (~@ (List/map product;right args)) (~ g!actor-name) (P;Promise (~ return))))] - (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (code;symbol ["" name])) (~@ arg-names) (~ g!self)) + (` (def: (~@ (common;gen-export _ex-lev)) ((~ (code;symbol ["" name])) (~@ arg-names) (~ g!self)) (~ type) (let [(~ g!output) (P;promise (~ return))] (exec (send ((~ (code;tag ["" name])) [[(~@ arg-names)] (~ g!output)]) (~ g!self)) (~ g!output)))))))) methods)] - (wrap (list& (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!state-name) (~ state-type))) - (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!protocol-name) (~@ protocol))) - (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!actor-name) (Actor (~ g!state-name) (~ g!protocol-name)))) - (` (def: (~@ (common;gen-export-level _ex-lev)) (~@ (actor-def-decl decl (` (Behavior (~ g!state-name) (~ g!protocol-name))))) + (wrap (list& (` (type: (~@ (common;gen-export _ex-lev)) (~ g!state-name) (~ state-type))) + (` (type: (~@ (common;gen-export _ex-lev)) (~ g!protocol-name) (~@ protocol))) + (` (type: (~@ (common;gen-export _ex-lev)) (~ g!actor-name) (Actor (~ g!state-name) (~ g!protocol-name)))) + (` (def: (~@ (common;gen-export _ex-lev)) (~@ (actor-def-decl decl (` (Behavior (~ g!state-name) (~ g!protocol-name))))) (~ g!behavior))) g!methods)) ))) diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux index b684d1874..81f976e98 100644 --- a/stdlib/source/lux/control/effect.lux +++ b/stdlib/source/lux/control/effect.lux @@ -92,7 +92,7 @@ (:: s;Monad<Syntax> wrap (list)) s;any)))) -(syntax: #export (effect: [exp-lvl common;export-level] +(syntax: #export (effect: [exp-lvl common;export] [name s;local-symbol] [ops (s;many op^)]) {#;doc (doc "Define effects by specifying which operations and constants a handler must provide." @@ -111,12 +111,12 @@ (` ((~ g!tag) (~ g!inputs) (~ g!output))))) ops) type-name (code;symbol ["" name]) - type-def (` (type: (~@ (common;gen-export-level exp-lvl)) + type-def (` (type: (~@ (common;gen-export exp-lvl)) ((~ type-name) (~ g!output)) (~@ op-types))) op-tags (List/map (|>. (get@ #name) [""] code;tag (list) code;tuple) ops) - functor-def (` (struct: (~@ (common;gen-export-level exp-lvl)) (~' _) (F;Functor (~ type-name)) + functor-def (` (struct: (~@ (common;gen-export exp-lvl)) (~' _) (F;Functor (~ type-name)) (def: ((~' map) (~' f) (~' fa)) (case (~' fa) (^template [(~' <tag>)] @@ -135,7 +135,7 @@ (format "_") [""] code;symbol)))))] - (` (def: (~@ (common;gen-export-level exp-lvl)) ((~ g!name) (~@ g!params)) + (` (def: (~@ (common;gen-export exp-lvl)) ((~ g!name) (~@ g!params)) (-> (~@ (get@ #inputs op)) ((~ type-name) (~ (get@ #output op)))) ((~ g!tag) [(~@ g!params)] ;id))))) @@ -152,15 +152,15 @@ (def: translation^ (Syntax Translation) (s;form (do s;Monad<Syntax> - [_ (s;this! (' =>))] + [_ (s;this (' =>))] (s;seq s;symbol (s;tuple (s;seq s;any s;any)))))) -(syntax: #export (handler: [exp-lvl common;export-level] +(syntax: #export (handler: [exp-lvl common;export] [name s;local-symbol] [[effect target-type target-monad] translation^] - [defs (s;many (common;def *compiler*))]) + [defs (s;many (common;definition *compiler*))]) {#;doc (doc "Define effect handlers by implementing the operations and values of an effect." (handler: _ (=> EffA [IO Monad<IO>]) @@ -179,15 +179,15 @@ g!wrap (macro;gensym "wrap") #let [g!cases (|> defs (List/map (function [def] - (let [g!tag (code;tag [e-module (get@ #common;def-name def)]) + (let [g!tag (code;tag [e-module (get@ #common;definition-name def)]) g!args (List/map (|>. [""] code;symbol) - (get@ #common;def-args def)) - eff-calc (case (get@ #common;def-type def) + (get@ #common;definition-args def)) + eff-calc (case (get@ #common;definition-type def) #;None - (get@ #common;def-value def) + (get@ #common;definition-value def) (#;Some type) - (` (: (~ type) (~ (get@ #common;def-value def))))) + (` (: (~ type) (~ (get@ #common;definition-value def))))) invocation (case g!args #;Nil eff-calc @@ -201,7 +201,7 @@ ((~ g!wrap) ((~ g!cont) (~ g!value))))) )))) List/join)]] - (wrap (list (` (struct: (~@ (common;gen-export-level exp-lvl)) (~ (code;symbol ["" name])) + (wrap (list (` (struct: (~@ (common;gen-export exp-lvl)) (~ (code;symbol ["" name])) (;;Handler (~ (code;symbol effect)) (~ target-type)) (def: (~' monad) (~ target-monad)) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 222d2e094..6bccbeec8 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -55,13 +55,13 @@ (All [a] (-> Exception Text (Result a))) (#R;Error (exception message))) -(syntax: #export (exception: [_ex-lev common;export-level] [name s;local-symbol]) +(syntax: #export (exception: [_ex-lev common;export] [name s;local-symbol]) {#;doc (doc "Define a new exception type." "It moslty just serves as a way to tag error messages for later catching." (exception: #export Some-Exception))} (do @ [current-module macro;current-module-name #let [g!message (code;symbol ["" "message"])]] - (wrap (list (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (code;symbol ["" name])) (~ g!message)) + (wrap (list (` (def: (~@ (common;gen-export _ex-lev)) ((~ (code;symbol ["" name])) (~ g!message)) Exception ($_ _Text/append_ "[" (~ (code;text current-module)) ";" (~ (code;text name)) "]\t" (~ g!message)))))))) diff --git a/stdlib/source/lux/data/coll/ordered.lux b/stdlib/source/lux/data/coll/ordered.lux index 4735f38ae..5a9794f85 100644 --- a/stdlib/source/lux/data/coll/ordered.lux +++ b/stdlib/source/lux/data/coll/ordered.lux @@ -100,9 +100,6 @@ [redden #Black #Red (error! error-message)] ) -(syntax: (as-is ast) - (wrap (list ast))) - (def: (balance-left-add parent self) (All [a] (-> (Node a) (Node a) (Node a))) (with-expansions diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index b4dde1157..10acfa13d 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -533,14 +533,14 @@ (-> Text Text (Syntax Code)) (do s;Monad<Syntax> [#let [dotted-name (format "." field-name)] - _ (s;this! (code;symbol ["" dotted-name]))] + _ (s;this (code;symbol ["" dotted-name]))] (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" class-name ":" field-name)))] []))))) (def: (make-get-var-parser class-name field-name) (-> Text Text (Syntax Code)) (do s;Monad<Syntax> [#let [dotted-name (format "." field-name)] - _ (s;this! (code;symbol ["" dotted-name]))] + _ (s;this (code;symbol ["" dotted-name]))] (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "getfield" ":" class-name ":" field-name)))] [_jvm_this]))))) (def: (make-put-var-parser class-name field-name) @@ -548,7 +548,7 @@ (do s;Monad<Syntax> [#let [dotted-name (format "." field-name)] [_ _ value] (: (Syntax [Unit Unit Code]) - (s;form ($_ s;seq (s;this! (' :=)) (s;this! (code;symbol ["" dotted-name])) s;any)))] + (s;form ($_ s;seq (s;this (' :=)) (s;this (code;symbol ["" dotted-name])) s;any)))] (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "putfield" ":" class-name ":" field-name)))] [_jvm_this (~ value)]))))) (def: (pre-walk-replace f input) @@ -593,7 +593,7 @@ (-> (List TypeParam) Text (List ArgDecl) (Syntax Code)) (do s;Monad<Syntax> [[_ args] (: (Syntax [Unit (List Code)]) - (s;form ($_ s;seq (s;this! (' .new!)) (s;tuple (s;exactly (list;size arg-decls) s;any))))) + (s;form ($_ s;seq (s;this (' .new!)) (s;tuple (s;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]] (wrap (` (;_lux_proc ["jvm" (~ (code;text (format "new" ":" class-name ":" (text;join-with "," arg-decls'))))] [(~@ args)]))))) @@ -603,7 +603,7 @@ (do s;Monad<Syntax> [#let [dotted-name (format "." method-name "!")] [_ args] (: (Syntax [Unit (List Code)]) - (s;form ($_ s;seq (s;this! (code;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any))))) + (s;form ($_ s;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]] (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] [(~@ args)]))))) @@ -614,7 +614,7 @@ (do s;Monad<Syntax> [#let [dotted-name (format "." method-name "!")] [_ args] (: (Syntax [Unit (List Code)]) - (s;form ($_ s;seq (s;this! (code;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any))))) + (s;form ($_ s;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (s;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]] (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format <jvm-op> ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] [(~' _jvm_this) (~@ args)])))))] @@ -652,32 +652,32 @@ (Syntax PrivacyModifier) (let [(^open) s;Monad<Syntax>] ($_ s;alt - (s;this! (' #public)) - (s;this! (' #private)) - (s;this! (' #protected)) + (s;this (' #public)) + (s;this (' #private)) + (s;this (' #protected)) (wrap [])))) (def: inheritance-modifier^ (Syntax InheritanceModifier) (let [(^open) s;Monad<Syntax>] ($_ s;alt - (s;this! (' #final)) - (s;this! (' #abstract)) + (s;this (' #final)) + (s;this (' #abstract)) (wrap [])))) (def: bound-kind^ (Syntax BoundKind) - (s;alt (s;this! (' <)) - (s;this! (' >)))) + (s;alt (s;this (' <)) + (s;this (' >)))) (def: (generic-type^ imports type-vars) (-> ClassImports (List TypeParam) (Syntax GenericType)) ($_ s;either (do s;Monad<Syntax> - [_ (s;this! (' ?))] + [_ (s;this (' ?))] (wrap (#GenericWildcard #;None))) (s;tuple (do s;Monad<Syntax> - [_ (s;this! (' ?)) + [_ (s;this (' ?)) bound-kind bound-kind^ bound (generic-type^ imports type-vars)] (wrap (#GenericWildcard (#;Some [bound-kind bound]))))) @@ -704,7 +704,7 @@ ## else (wrap (#GenericClass name (list)))))) (s;form (do s;Monad<Syntax> - [name (s;this! (' Array)) + [name (s;this (' Array)) component (generic-type^ imports type-vars)] (case component (^template [<class> <name>] @@ -736,7 +736,7 @@ (wrap [param-name (list)])) (s;tuple (do s;Monad<Syntax> [param-name s;local-symbol - _ (s;this! (' <)) + _ (s;this (' <)) bounds (s;many (generic-type^ imports (list)))] (wrap [param-name bounds]))))) @@ -780,7 +780,7 @@ (def: (annotations^' imports) (-> ClassImports (Syntax (List Annotation))) (do s;Monad<Syntax> - [_ (s;this! (' #ann))] + [_ (s;this (' #ann))] (s;tuple (s;some (annotation^ imports))))) (def: (annotations^ imports) @@ -792,7 +792,7 @@ (def: (throws-decl'^ imports type-vars) (-> ClassImports (List TypeParam) (Syntax (List GenericType))) (do s;Monad<Syntax> - [_ (s;this! (' #throws))] + [_ (s;this (' #throws))] (s;tuple (s;some (generic-type^ imports type-vars))))) (def: (throws-decl^ imports type-vars) @@ -818,14 +818,14 @@ (def: state-modifier^ (Syntax StateModifier) ($_ s;alt - (s;this! (' #volatile)) - (s;this! (' #final)) + (s;this (' #volatile)) + (s;this (' #final)) (:: s;Monad<Syntax> wrap []))) (def: (field-decl^ imports type-vars) (-> ClassImports (List TypeParam) (Syntax [MemberDecl FieldDecl])) (s;either (s;form (do s;Monad<Syntax> - [_ (s;this! (' #const)) + [_ (s;this (' #const)) name s;local-symbol anns (annotations^ imports) type (generic-type^ imports type-vars) @@ -863,7 +863,7 @@ strict-fp? (s;this? (' #strict)) method-vars (s;default (list) (type-params^ imports)) #let [total-vars (List/append class-vars method-vars)] - [_ arg-decls] (s;form (s;seq (s;this! (' new)) + [_ arg-decls] (s;form (s;seq (s;this (' new)) (arg-decls^ imports total-vars))) constructor-args (constructor-args^ imports total-vars) exs (throws-decl^ imports total-vars) @@ -916,7 +916,7 @@ (s;form (do s;Monad<Syntax> [pm privacy-modifier^ strict-fp? (s;this? (' #strict)) - _ (s;this! (' #static)) + _ (s;this (' #static)) method-vars (s;default (list) (type-params^ imports)) #let [total-vars method-vars] [name arg-decls] (s;form (s;seq s;local-symbol @@ -934,7 +934,7 @@ (-> ClassImports (Syntax [MemberDecl MethodDef])) (s;form (do s;Monad<Syntax> [pm privacy-modifier^ - _ (s;this! (' #abstract)) + _ (s;this (' #abstract)) method-vars (s;default (list) (type-params^ imports)) #let [total-vars method-vars] [name arg-decls] (s;form (s;seq s;local-symbol @@ -951,7 +951,7 @@ (-> ClassImports (Syntax [MemberDecl MethodDef])) (s;form (do s;Monad<Syntax> [pm privacy-modifier^ - _ (s;this! (' #native)) + _ (s;this (' #native)) method-vars (s;default (list) (type-params^ imports)) #let [total-vars method-vars] [name arg-decls] (s;form (s;seq s;local-symbol @@ -981,17 +981,17 @@ (def: class-kind^ (Syntax ClassKind) (s;either (do s;Monad<Syntax> - [_ (s;this! (' #class))] + [_ (s;this (' #class))] (wrap #Class)) (do s;Monad<Syntax> - [_ (s;this! (' #interface))] + [_ (s;this (' #interface))] (wrap #Interface)) )) (def: import-member-alias^ (Syntax (Maybe Text)) (s;opt (do s;Monad<Syntax> - [_ (s;this! (' #as))] + [_ (s;this (' #as))] s;local-symbol))) (def: (import-member-args^ imports type-vars) @@ -1004,19 +1004,19 @@ (def: primitive-mode^ (Syntax Primitive-Mode) - (s;alt (s;this! (' #manual)) - (s;this! (' #auto)))) + (s;alt (s;this (' #manual)) + (s;this (' #auto)))) (def: (import-member-decl^ imports owner-vars) (-> ClassImports (List TypeParam) (Syntax ImportMemberDecl)) ($_ s;either (s;form (do s;Monad<Syntax> - [_ (s;this! (' #enum)) + [_ (s;this (' #enum)) enum-members (s;some s;local-symbol)] (wrap (#EnumDecl enum-members)))) (s;form (do s;Monad<Syntax> [tvars (s;default (list) (type-params^ imports)) - _ (s;this! (' new)) + _ (s;this (' new)) ?alias import-member-alias^ #let [total-vars (List/append owner-vars tvars)] ?prim-mode (s;opt primitive-mode^) @@ -1034,7 +1034,7 @@ )) (s;form (do s;Monad<Syntax> [kind (: (Syntax ImportMethodKind) - (s;alt (s;this! (' #static)) + (s;alt (s;this (' #static)) (wrap []))) tvars (s;default (list) (type-params^ imports)) name s;local-symbol @@ -1224,7 +1224,7 @@ (#OverridenMethod strict-fp? class-decl type-vars arg-decls return-type body exs) (let [super-replacer (parser->replacer (s;form (do s;Monad<Syntax> - [_ (s;this! (' .super!)) + [_ (s;this (' .super!)) args (s;tuple (s;exactly (list;size arg-decls) s;any)) #let [arg-decls' (: (List Text) (map (. (simple-class$ (list)) product;right) arg-decls))]] diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 869d80de4..fef8945c3 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -309,7 +309,7 @@ type-vars') )))) -(syntax: #export (poly: [_ex-lev common;export-level] +(syntax: #export (poly: [_ex-lev common;export] [[name env inputs] (s;form ($_ s;seq s;local-symbol s;local-symbol @@ -319,7 +319,7 @@ (let [g!inputs (List/map (|>. [""] code;symbol) inputs) g!name (code;symbol ["" name]) g!env (code;symbol ["" env])] - (wrap (;list (` (syntax: (~@ (common;gen-export-level _ex-lev)) ((~ g!name) (~@ (List/map (;function [g!input] (` [(~ g!input) s;symbol])) + (wrap (;list (` (syntax: (~@ (common;gen-export _ex-lev)) ((~ g!name) (~@ (List/map (;function [g!input] (` [(~ g!input) s;symbol])) g!inputs))) (do Monad<Lux> [(~@ (List/join (List/map (;function [g!input] (;list g!input (` (macro;find-type-def (~ g!input))))) @@ -343,7 +343,7 @@ (#;Some (List/fold (text;replace-once "?") poly args)) #;None)) -(syntax: #export (derived: [_ex-lev common;export-level] +(syntax: #export (derived: [_ex-lev common;export] [?name (s;opt s;local-symbol)] [[poly-func poly-args] (s;form (s;seq s;symbol (s;many s;symbol)))] [?custom-impl (s;opt s;any)]) @@ -366,7 +366,7 @@ #;None (` ((~ (code;symbol poly-func)) (~@ (List/map code;symbol poly-args)))))]] - (wrap (;list (` (def: (~@ (common;gen-export-level _ex-lev)) + (wrap (;list (` (def: (~@ (common;gen-export _ex-lev)) (~ (code;symbol ["" name])) {#;struct? true} (~ impl))))))) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 53ec26009..f5742d6ef 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -123,7 +123,7 @@ _ (#R;Success [tokens false])))) -(def: #export (this! ast) +(def: #export (this ast) {#;doc "Ensures the given Code is the next input."} (-> Code (Syntax Unit)) (function [tokens] @@ -410,6 +410,19 @@ (function [inputs] (run inputs (syntax (rec syntax))))) +(def: #export (after param subject) + (All [p s] (-> (Syntax p) (Syntax s) (Syntax s))) + (do Monad<Syntax> + [_ param] + subject)) + +(def: #export (before param subject) + (All [p s] (-> (Syntax p) (Syntax s) (Syntax s))) + (do Monad<Syntax> + [output subject + _ param] + (wrap output))) + ## [Syntax] (def: #hidden text.join-with text;join-with) diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index 1aa43c7cf..a4b6928c9 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -3,7 +3,7 @@ The goal is to be able to reuse common syntax in macro definitions across libraries."} lux (lux (control monad) - (data (coll [list]) + (data (coll [list "L/" Functor<List>]) text/format [ident "Ident/" Eq<Ident>] [product]) @@ -12,21 +12,21 @@ ["s" syntax #+ syntax: Syntax]))) ## Exports -(type: #export Export-Level +(type: #export Export #Exported #Hidden) -(def: #export export-level +(def: #export export {#;doc (doc "A parser for export levels." "Such as:" #export #hidden)} - (Syntax (Maybe Export-Level)) - (s;opt (s;alt (s;this! (' #export)) - (s;this! (' #hidden))))) + (Syntax (Maybe Export)) + (s;opt (s;alt (s;this (' #export)) + (s;this (' #hidden))))) -(def: #export (gen-export-level ?el) - (-> (Maybe Export-Level) (List Code)) +(def: #export (gen-export ?el) + (-> (Maybe Export) (List Code)) (case ?el #;None (list) @@ -38,61 +38,61 @@ (list (' #hidden)))) ## Declarations -(type: #export Decl - {#decl-name Text - #decl-args (List Text)}) +(type: #export Declaration + {#declaration-name Text + #declaration-args (List Text)}) -(def: #export decl +(def: #export declaration {#;doc (doc "A parser for declaration syntax." "Such as:" quux (foo bar baz))} - (Syntax Decl) + (Syntax Declaration) (s;either (s;seq s;local-symbol (:: s;Monad<Syntax> wrap (list))) (s;form (s;seq s;local-symbol (s;many s;local-symbol))))) ## Definitions -(type: #export Def-Syntax - {#def-name Text - #def-type (Maybe Code) - #def-value Code - #def-anns (List [Ident Code]) - #def-args (List Text) +(type: #export Definition + {#definition-name Text + #definition-type (Maybe Code) + #definition-value Code + #definition-anns (List [Ident Code]) + #definition-args (List Text) }) (def: check^ (Syntax [(Maybe Code) Code]) (s;either (s;form (do s;Monad<Syntax> - [_ (s;this! (' lux;_lux_:)) + [_ (s;this (' lux;_lux_:)) type s;any value s;any] (wrap [(#;Some type) value]))) (s;seq (:: s;Monad<Syntax> wrap #;None) s;any))) -(def: _def-anns-tag^ +(def: _definition-anns-tag^ (Syntax Ident) (s;tuple (s;seq s;text s;text))) -(def: (_def-anns^ _) +(def: (_definition-anns^ _) (-> Top (Syntax (List [Ident Code]))) - (s;alt (s;this! (' #lux;Nil)) + (s;alt (s;this (' #lux;Nil)) (s;form (do s;Monad<Syntax> - [_ (s;this! (' #lux;Cons)) - [head tail] (s;seq (s;tuple (s;seq _def-anns-tag^ s;any)) - (_def-anns^ []))] + [_ (s;this (' #lux;Cons)) + [head tail] (s;seq (s;tuple (s;seq _definition-anns-tag^ s;any)) + (_definition-anns^ []))] (wrap [head tail]))) )) (def: (flat-list^ _) (-> Top (Syntax (List Code))) (s;either (do s;Monad<Syntax> - [_ (s;this! (' #lux;Nil))] + [_ (s;this (' #lux;Nil))] (wrap (list))) (s;form (do s;Monad<Syntax> - [_ (s;this! (' #lux;Cons)) + [_ (s;this (' #lux;Cons)) [head tail] (s;tuple (s;seq s;any s;any)) tail (s;local (list tail) (flat-list^ []))] (wrap (#;Cons head tail)))))) @@ -100,16 +100,16 @@ (def: list-meta^ (Syntax (List Code)) (s;form (do s;Monad<Syntax> - [_ (s;this! (' #lux;ListA))] + [_ (s;this (' #lux;ListA))] (flat-list^ [])))) (def: text-meta^ (Syntax Text) (s;form (do s;Monad<Syntax> - [_ (s;this! (' #lux;TextA))] + [_ (s;this (' #lux;TextA))] s;text))) -(def: (find-def-args meta-data) +(def: (find-definition-args meta-data) (-> (List [Ident Code]) (List Text)) (default (list) (case (list;find (|>. product;left (Ident/= ["lux" "func-args"])) meta-data) @@ -124,53 +124,64 @@ #;None) )) -(def: #export (def compiler) +(def: #export (definition compiler) {#;doc "A parser that first macro-expands and then analyses the input Code, to ensure it's a definition."} - (-> Compiler (Syntax Def-Syntax)) + (-> Compiler (Syntax Definition)) (do s;Monad<Syntax> - [def-raw s;any - me-def-raw (s;on compiler - (macro;macro-expand-all def-raw))] - (s;local me-def-raw + [definition-raw s;any + me-definition-raw (s;on compiler + (macro;macro-expand-all definition-raw))] + (s;local me-definition-raw (s;form (do @ - [_ (s;this! (' lux;_lux_def)) - def-name s;local-symbol - [?def-type def-value] check^ - def-anns s;any - def-anns (s;local (list def-anns) - (_def-anns^ [])) - #let [def-args (find-def-args def-anns)]] - (wrap {#def-name def-name - #def-type ?def-type - #def-anns def-anns - #def-value def-value - #def-args def-args})))))) - -(def: #export (typed-def compiler) + [_ (s;this (' lux;_lux_def)) + definition-name s;local-symbol + [?definition-type definition-value] check^ + definition-anns s;any + definition-anns (s;local (list definition-anns) + (_definition-anns^ [])) + #let [definition-args (find-definition-args definition-anns)]] + (wrap {#definition-name definition-name + #definition-type ?definition-type + #definition-anns definition-anns + #definition-value definition-value + #definition-args definition-args})))))) + +(def: #export (typed-definition compiler) {#;doc "A parser for definitions that ensures the input syntax is typed."} - (-> Compiler (Syntax Def-Syntax)) + (-> Compiler (Syntax Definition)) (do s;Monad<Syntax> - [_def (def compiler) - _ (case (get@ #def-type _def) + [_definition (definition compiler) + _ (case (get@ #definition-type _definition) (#;Some _) (wrap []) #;None - (s;fail "Typed def must have a type!") + (s;fail "Typed definition must have a type!") )] - (wrap _def))) + (wrap _definition))) -(def: #export def-anns +(type: #export Annotations + (List [Ident Code])) + +(def: #export empty-annotations + Annotations + (list)) + +(def: #export annotations {#;doc "Parser for the common annotations syntax used by def: statements."} - (Syntax (List [Ident Code])) + (Syntax Annotations) (s;record (s;some (s;seq s;tag s;any)))) -(def: #export typed-arg +(def: #export (gen-annotations annotations) + (-> Annotations Code) + (|> annotations (L/map (product;both code;tag id)) code;record)) + +(def: #export typed-input {#;doc "Parser for the common typed-argument syntax used by many macros."} (Syntax [Text Code]) (s;tuple (s;seq s;local-symbol s;any))) -(def: #export type-params +(def: #export type-variables {#;doc "Parser for the common type var/param used by many macros."} (Syntax (List Text)) (s;tuple (s;some s;local-symbol))) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index b89747622..64a40867e 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -115,7 +115,7 @@ (s/map code;tag s;tag)) (s;form (s;many s;any)) (s;tuple (s;either (do s;Monad<Syntax> - [_ (s;this! (' #and)) + [_ (s;this (' #and)) init-subject (infix^ []) init-op s;any init-param (infix^ []) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 4e63a8b28..b104df4f9 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -131,10 +131,10 @@ (def: config^ (Syntax Test-Config) (s;alt (do s;Monad<Syntax> - [_ (s;this! (' #seed))] + [_ (s;this (' #seed))] s;nat) (do s;Monad<Syntax> - [_ (s;this! (' #times))] + [_ (s;this (' #times))] s;nat))) (def: property-test^ diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 0badc67f3..9982dc01b 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -68,7 +68,7 @@ [(assert <assertion> (and (is? <Eq> <value> <get> (list (<ctor> <value>))) (found? (s;this? (<ctor> <value>)) (list (<ctor> <value>))) - (enforced? (s;this! (<ctor> <value>)) (list (<ctor> <value>)))))] + (enforced? (s;this (<ctor> <value>)) (list (<ctor> <value>)))))] ["Can parse Bool syntax." true code;bool bool;Eq<Bool> s;bool] ["Can parse Nat syntax." +123 code;nat number;Eq<Nat> s;nat] @@ -247,8 +247,8 @@ (assert "Can parse while taking separators into account." (and (match (list 123 456 789) (s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;text "YOLO") (code;int 789)) - (s;sep-by (s;this! (' "YOLO")) s;int))) + (s;sep-by (s;this (' "YOLO")) s;int))) (match (list 123 456) (s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;int 789)) - (s;sep-by (s;this! (' "YOLO")) s;int))))) + (s;sep-by (s;this (' "YOLO")) s;int))))) )) |