(;module:
  lux
  (lux (control monad)
       (data ["e" error]
             text/format)
       [meta]
       (meta [type]
             (type ["tc" check])))
  (luxc ["&" base]
        (lang ["la" analysis])
        ["&;" module])
  (. ["&&;" common]
     ["&&;" function]
     ["&&;" primitive]
     ["&&;" reference]
     ["&&;" type]
     ["&&;" structure]
     ["&&;" case]
     ["&&;" procedure]))

(def: (to-branches raw)
  (-> (List Code) (Meta (List [Code Code])))
  (case raw
    (^ (list))
    (:: meta;Monad<Meta> wrap (list))

    (^ (list& patternH bodyH inputT))
    (do meta;Monad<Meta>
      [outputT (to-branches inputT)]
      (wrap (list& [patternH bodyH] outputT)))

    _
    (&;fail "Uneven expressions for pattern-matching.")))

(def: #export (analyser eval)
  (-> &;Eval &;Analyser)
  (: (-> Code (Meta la;Analysis))
     (function analyse [ast]
       (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 &&primitive;analyse-bool]
              [#;Nat  &&primitive;analyse-nat]
              [#;Int  &&primitive;analyse-int]
              [#;Deg  &&primitive;analyse-deg]
              [#;Frac &&primitive;analyse-frac]
              [#;Text &&primitive;analyse-text])

             (^ (#;Tuple (list)))
             &&primitive;analyse-unit

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

             (^ (#;Tuple elems))
             (&&structure;analyse-product analyse elems)

             (^ (#;Record pairs))
             (&&structure;analyse-record analyse pairs)

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

             (^ (#;Form (list [_ (#;Symbol ["" "_lux_function"])]
                              [_ (#;Symbol ["" func-name])]
                              [_ (#;Symbol ["" arg-name])]
                              body)))
             (&&function;analyse-function analyse func-name arg-name body)

             (^template [<proc> <analyser>]
               (^ (#;Form (list [_ (#;Symbol ["" <proc>])] type value)))
               (<analyser> analyse eval type value))
             (["_lux_check" &&type;analyse-check]
              ["_lux_coerce" &&type;analyse-coerce])
             
             (^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
             (&&procedure;analyse-procedure analyse proc-name proc-args)

             (^ (#;Form (list& [_ (#;Symbol ["" "_lux_case"])]
                               input
                               branches)))
             (do meta;Monad<Meta>
               [paired (to-branches branches)]
               (&&case;analyse-case analyse input paired))

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

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

             (^ (#;Form (list& func args)))
             (do meta;Monad<Meta>
               [[funcT =func] (&&common;with-unknown-type
                                (analyse func))]
               (case =func
                 (#la;Definition def-name)
                 (do @
                   [[def-type def-anns def-value] (meta;find-def def-name)]
                   (if (meta;macro? def-anns)
                     (do @
                       [## macro-expansion (function [compiler]
                        ##                   (case (macro-caller def-value args compiler)
                        ##                     (#e;Success [compiler' output])
                        ##                     (#e;Success [compiler' output])

                        ##                     (#e;Error error)
                        ##                     ((&;fail error) compiler)))
                        macro-expansion (: (Meta (List Code))
                                           (undefined))]
                       (case macro-expansion
                         (^ (list single-expansion))
                         (analyse single-expansion)

                         _
                         (&;fail (format "Macro expressions must expand to a single expression: " (%code ast)))))
                     (&&function;analyse-apply analyse funcT =func args)))

                 _
                 (&&function;analyse-apply analyse funcT =func args)))

             _
             (&;fail (format "Unrecognized syntax: " (%code ast)))
             ))))))