(.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]
              [".L" extension]
              ["la" analysis]
              (translation [".T" common])))
  (// [".A" common]
      [".A" function]
      [".A" primitive]
      [".A" reference]
      [".A" structure]))

(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)))
               (do macro.Monad<Meta>
                 [procedure (extensionL.find-analysis proc-name)]
                 (procedure analyse eval 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 (: (Meta (List Code))
                                       (function [compiler]
                                         (case (macroL.expand macro args compiler)
                                           (#e.Error error)
                                           ((&.throw Macro-Expansion-Failed error) compiler)

                                           output
                                           output)))]
                         (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))
               )))))))