1 files changed, 150 insertions, 0 deletions
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
new file mode 100644
index 000000000..9ab6d6381
--- /dev/null
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -0,0 +1,150 @@
+(;module: {#;doc "Commons syntax readers."}
+  lux
+  (lux (control monad
+                ["p" parser])
+       (data (coll [list])
+             [ident "ident/" Eq<Ident>]
+             [product]
+             [maybe])
+       [macro]
+       (macro ["s" syntax #+ syntax: Syntax]))
+  [.. #*])
+
+## Exports
+(def: #export export
+  {#;doc (doc "A reader for export levels."
+              "Such as:"
+              #export
+              #hidden)}
+  (Syntax (Maybe Export))
+  (p;maybe (p;alt (s;this (' #export))
+                  (s;this (' #hidden)))))
+
+## Declarations
+(def: #export declaration
+  {#;doc (doc "A reader for declaration syntax."
+              "Such as:"
+              quux
+              (foo bar baz))}
+  (Syntax Declaration)
+  (p;either (p;seq s;local-symbol
+                   (:: p;Monad<Parser> wrap (list)))
+            (s;form (p;seq s;local-symbol
+                           (p;many s;local-symbol)))))
+
+## Annotations
+(def: #export annotations
+  {#;doc "Reader for the common annotations syntax used by def: statements."}
+  (Syntax Annotations)
+  (s;record (p;some (p;seq s;tag s;any))))
+
+## Definitions
+(def: check^
+  (Syntax [(Maybe Code) Code])
+  (p;either (s;form (do p;Monad<Parser>
+                      [_ (s;this (' "lux check"))
+                       type s;any
+                       value s;any]
+                      (wrap [(#;Some type) value])))
+            (p;seq (:: p;Monad<Parser> wrap #;None)
+                   s;any)))
+
+(def: _definition-anns-tag^
+  (Syntax Ident)
+  (s;tuple (p;seq s;text s;text)))
+
+(def: (_definition-anns^ _)
+  (-> Top (Syntax Annotations))
+  (p;alt (s;this (' #lux;Nil))
+         (s;form (do p;Monad<Parser>
+                   [_ (s;this (' #lux;Cons))
+                    [head tail] (p;seq (s;tuple (p;seq _definition-anns-tag^ s;any))
+                                       (_definition-anns^ []))]
+                   (wrap [head tail])))
+         ))
+
+(def: (flat-list^ _)
+  (-> Top (Syntax (List Code)))
+  (p;either (do p;Monad<Parser>
+              [_ (s;this (' #lux;Nil))]
+              (wrap (list)))
+            (s;form (do p;Monad<Parser>
+                      [_ (s;this (' #lux;Cons))
+                       [head tail] (s;tuple (p;seq s;any s;any))
+                       tail (s;local (list tail) (flat-list^ []))]
+                      (wrap (#;Cons head tail))))))
+
+(do-template [<name> <type> <tag> <then>]
+  [(def: <name>
+     (Syntax <type>)
+     (<| s;tuple
+         (p;after s;any)
+         s;form
+         (do p;Monad<Parser>
+           [_ (s;this (' <tag>))]
+           <then>)))]
+
+  [tuple-meta^ (List Code) #lux;Tuple (flat-list^ [])]
+  [text-meta^  Text        #lux;Text  s;text]
+  )
+
+(def: (find-definition-args meta-data)
+  (-> (List [Ident Code]) (List Text))
+  (<| (maybe;default (list))
+      (case (list;find (|>. product;left (ident/= ["lux" "func-args"])) meta-data)
+        (^multi (#;Some [_ value])
+                [(p;run (list value) tuple-meta^)
+                 (#;Right [_ args])]
+                [(p;run args (p;some text-meta^))
+                 (#;Right [_ args])])
+        (#;Some args)
+
+        _
+        #;None)
+      ))
+
+(def: #export (definition compiler)
+  {#;doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."}
+  (-> Compiler (Syntax Definition))
+  (do p;Monad<Parser>
+    [definition-raw s;any
+     me-definition-raw (s;on compiler
+                             (macro;expand-all definition-raw))]
+    (s;local me-definition-raw
+             (s;form (do @
+                       [_ (s;this (' "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 reader for definitions that ensures the input syntax is typed."}
+  (-> Compiler (Syntax Definition))
+  (do p;Monad<Parser>
+    [_definition (definition compiler)
+     _ (case (get@ #..;definition-type _definition)
+         (#;Some _)
+         (wrap [])
+
+         #;None
+         (p;fail "Typed definition must have a type!")
+         )]
+    (wrap _definition)))
+
+(def: #export typed-input
+  {#;doc "Reader for the common typed-argument syntax used by many macros."}
+  (Syntax [Text Code])
+  (s;tuple (p;seq s;local-symbol s;any)))
+
+(def: #export type-variables
+  {#;doc "Reader for the common type var/param used by many macros."}
+  (Syntax (List Text))
+  (s;tuple (p;some s;local-symbol)))