(;module:
  lux
  (lux (control [monad #+ do]
                ["ex" exception #+ exception:])
       (data ["e" error]
             [product]
             text/format)
       [meta]
       (meta [type]
             (type ["tc" check]))
       [host])
  (luxc ["&" base]
        [";L" host]
        (lang ["la" analysis])
        ["&;" module]
        (generator [";G" common]))
  (.. [";A" common]
      [";A" function]
      [";A" primitive]
      [";A" reference]
      [";A" structure]
      [";A" procedure]))

(for {"JVM" (as-is (host;import java.lang.reflect.Method
                     (invoke [Object (Array Object)] #try Object))
                   (host;import (java.lang.Class c)
                     (getMethod [String (Array (Class Object))] #try Method))
                   (host;import java.lang.Object
                     (getClass [] (Class Object))
                     (toString [] String))
                   (def: _object-class (Class Object) (host;class-for Object))
                   (def: _apply-args
                     (Array (Class Object))
                     (|> (host;array (Class Object) +2)
                         (host;array-write +0 _object-class)
                         (host;array-write +1 _object-class)))
                   (def: (call-macro macro inputs)
                     (-> Macro (List Code) (Meta (List Code)))
                     (do meta;Monad<Meta>
                       [class (commonG;load-class hostL;function-class)]
                       (function [compiler]
                         (do e;Monad<Error>
                           [apply-method (Class.getMethod ["apply" _apply-args] class)
                            output (Method.invoke [(:! Object macro)
                                                   (|> (host;array Object +2)
                                                       (host;array-write +0 (:! Object inputs))
                                                       (host;array-write +1 (:! Object compiler)))]
                                                  apply-method)]
                           (:! (e;Error [Compiler (List Code)])
                               output))))))
      })

(exception: #export Macro-Expression-Must-Have-Single-Expansion)
(exception: #export Unrecognized-Syntax)

(def: #export (analyser eval)
  (-> &;Eval &;Analyser)
  (: (-> Code (Meta la;Analysis))
     (function analyse [ast]
       (do meta;Monad<Meta>
         [expectedT meta;expected-type]
         (let [[cursor ast'] ast]
           ## The cursor must be set in the compiler for the sake
           ## of having useful error messages.
           (&;with-cursor cursor
             (case ast'
               (^template [<tag> <analyser>]
                 (<tag> value)
                 (<analyser> value))
               ([#;Bool primitiveA;analyse-bool]
                [#;Nat  primitiveA;analyse-nat]
                [#;Int  primitiveA;analyse-int]
                [#;Deg  primitiveA;analyse-deg]
                [#;Frac primitiveA;analyse-frac]
                [#;Text primitiveA;analyse-text])

               (^ (#;Tuple (list)))
               primitiveA;analyse-unit

               ## Singleton tuples are equivalent to the element they contain.
               (^ (#;Tuple (list singleton)))
               (analyse singleton)

               (^ (#;Tuple elems))
               (structureA;analyse-product analyse elems)

               (^ (#;Record pairs))
               (structureA;analyse-record analyse pairs)

               (#;Symbol reference)
               (referenceA;analyse-reference reference)

               (^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
               (procedureA;analyse-procedure analyse eval proc-name proc-args)

               (^template [<tag> <analyser>]
                 (^ (#;Form (list& [_ (<tag> tag)]
                                   values)))
                 (case values
                   (#;Cons value #;Nil)
                   (<analyser> analyse tag value)

                   _
                   (<analyser> analyse tag (` [(~@ values)]))))
               ([#;Nat structureA;analyse-sum]
                [#;Tag structureA;analyse-tagged-sum])

               (#;Tag tag)
               (structureA;analyse-tagged-sum analyse tag (' []))
               
               (^ (#;Form (list& func args)))
               (do meta;Monad<Meta>
                 [[funcT =func] (commonA;with-unknown-type
                                  (analyse func))]
                 (case =func
                   [_ (#;Symbol def-name)]
                   (do @
                     [[def-type def-anns def-value] (meta;find-def def-name)]
                     (if (meta;macro? def-anns)
                       (do @
                         [expansion (function [compiler]
                                      (case (call-macro (:! Macro def-value) args compiler)
                                        (#e;Success [compiler' output])
                                        (#e;Success [compiler' output])

                                        (#e;Error error)
                                        ((&;fail error) compiler)))]
                         (case expansion
                           (^ (list single))
                           (analyse single)

                           _
                           (&;throw Macro-Expression-Must-Have-Single-Expansion (%code ast))))
                       (functionA;analyse-apply analyse funcT =func args)))

                   _
                   (functionA;analyse-apply analyse funcT =func args)))

               _
               (&;throw Unrecognized-Syntax (%code ast))
               )))))))