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

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

(def: #export (analyser eval)
  (-> &;Eval &;Analyser)
  (: (-> Code (Meta la;Analysis))
     (function analyse [code]
       (do macro;Monad<Meta>
         [expectedT macro;expected-type]
         (let [[cursor code'] code]
           ## The cursor must be set in the compiler for the sake
           ## of having useful error messages.
           (&;with-cursor cursor
             (case code'
               (^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 macro;Monad<Meta>
                 [[funcT funcA] (commonA;with-unknown-type
                                  (analyse func))]
                 (case funcA
                   [_ (#;Symbol def-name)]
                   (do @
                     [?macro (&;with-error-tracking
                               (macro;find-macro def-name))]
                     (case ?macro
                       (#;Some macro)
                       (do @
                         [expansion (function [compiler]
                                      (case (macroL;expand macro args compiler)
                                        (#e;Success [compiler' output])
                                        (#e;Success [compiler' output])

                                        (#e;Error error)
                                        ((&;throw Macro-Expansion-Failed error) compiler)))]
                         (case expansion
                           (^ (list single))
                           (analyse single)

                           _
                           (&;throw Macro-Expression-Must-Have-Single-Expansion (%code code))))

                       _
                       (functionA;analyse-apply analyse funcT funcA args)))

                   _
                   (functionA;analyse-apply analyse funcT funcA args)))

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