(;module:
  lux
  (lux (control monad)
       (data ["R" result]
             [text "T/" Eq<Text>]
             text/format
             [number]
             [product])
       [macro #+ Monad<Lux>]
       [type]
       (type ["TC" check]))
  (luxc ["&" base]
        (lang ["la" analysis])
        ["&;" module]
        ["&;" env])
  (. ["&&;" common]
     ["&&;" function]
     ["&&;" primitive]
     ["&&;" reference]
     ["&&;" type]
     ["&&;" structure]
     ["&&;" case]
     ["&&;" procedure]))

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

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

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

(def: #export (analyser eval)
  (-> &;Eval &;Analyser)
  (: (-> Code (Lux 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]
              [#;Real &&primitive;analyse-real]
              [#;Char &&primitive;analyse-char]
              [#;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)

             (^ (#;Form (list [_ (#;Symbol ["" "_lux_check"])]
                              type
                              value)))
             (&&type;analyse-check analyse eval type value)

             (^ (#;Form (list [_ (#;Symbol ["" "_lux_coerce"])]
                              type
                              value)))
             (&&type;analyse-coerce analyse eval type value)

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

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

             (^ (#;Form (list [_ (#;Nat tag)]
                              value)))
             (&&structure;analyse-sum analyse tag value)

             (^ (#;Form (list [_ (#;Tag tag)]
                              value)))
             (&&structure;analyse-tagged-sum analyse tag value)

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

                        ##                     (#R;Error error)
                        ##                     ((&;fail error) compiler)))
                        macro-expansion (: (Lux (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)))
             ))))))