(;module:
  lux
  (lux (control monad)
       (data [text "T/" Eq<Text>]
             text/format
             [maybe #+ Monad<Maybe> "Maybe/" Monad<Maybe>]
             [product]
             ["E" error]
             (coll [list "L/" Fold<List> Monoid<List>]))
       [macro])
  (luxc ["&" base]))

(type: Locals (Bindings Text [Type Nat]))
(type: Captured (Bindings Text [Type Ref]))

(def: (pl::contains? key mappings)
  (All [a] (-> Text (List [Text a]) Bool))
  (case mappings
    #;Nil
    false

    (#;Cons [k v] mappings')
    (or (T/= key k)
        (pl::contains? key mappings'))))

(def: (pl::get key mappings)
  (All [a] (-> Text (List [Text a]) (Maybe a)))
  (case mappings
    #;Nil
    #;None

    (#;Cons [k v] mappings')
    (if (T/= key k)
      (#;Some v)
      (pl::get key mappings'))))

(def: (pl::put key value mappings)
  (All [a] (-> Text a (List [Text a]) (List [Text a])))
  (case mappings
    #;Nil
    (list [key value])

    (#;Cons [k v] mappings')
    (if (T/= key k)
      (#;Cons [key value] mappings')
      (#;Cons [k v]
              (pl::put key value mappings')))))

(do-template [<slot> <is> <get> <then>]
  [(def: (<is> name scope)
     (-> Text Scope Bool)
     (|> scope
         (get@ [<slot> #;mappings])
         (pl::contains? name)))

   (def: (<get> name scope)
     (-> Text Scope (Maybe [Type Ref]))
     (|> scope
         (get@ [<slot> #;mappings])
         (pl::get name)
         (Maybe/map (function [[type value]]
                      [type (<then> value)]))))]

  [#;locals   is-local?    get-local    #;Local]
  [#;captured is-captured? get-captured id]
  )

(def: (is-ref? name scope)
  (-> Text Scope Bool)
  (or (is-local? name scope)
      (is-captured? name scope)))

(def: (get-ref name scope)
  (-> Text Scope (Maybe [Type Ref]))
  (case (get-local name scope)
    (#;Some type)
    (#;Some type)

    _
    (get-captured name scope)))

(def: #export (find name)
  (-> Text (Lux (Maybe [Type Ref])))
  (function [compiler]
    (let [[inner outer] (|> compiler
                            (get@ #;scopes)
                            (list;split-with (|>. (is-ref? name) not)))]
      (case outer
        #;Nil
        (#;Right [compiler #;None])

        (#;Cons top-outer _)
        (let [[ref-type init-ref] (default (undefined)
                                    (get-ref name top-outer))
              [ref inner'] (L/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)])
                                      (function [scope [ref inner]]
                                        [(#;Captured (get@ [#;captured #;counter] scope))
                                         (#;Cons (update@ #;captured
                                                          (: (-> Captured Captured)
                                                             (|>. (update@ #;counter n.inc)
                                                                  (update@ #;mappings (pl::put name [ref-type ref]))))
                                                          scope)
                                                 inner)]))
                                   [init-ref #;Nil]
                                   (list;reverse inner))
              scopes (L/append inner' outer)]
          (#;Right [(set@ #;scopes scopes compiler)
                    (#;Some [ref-type ref])]))
        ))))

(def: #export (with-local [name type] action)
  (All [a] (-> [Text Type] (Lux a) (Lux a)))
  (function [compiler]
    (case (get@ #;scopes compiler)
      (#;Cons head tail)
      (let [old-mappings (get@ [#;locals #;mappings] head)
            new-var-id (get@ [#;locals #;counter] head)
            new-head (update@ #;locals
                              (: (-> Locals Locals)
                                 (|>. (update@ #;counter n.inc)
                                      (update@ #;mappings (pl::put name [type new-var-id]))))
                              head)]
        (case (macro;run' (set@ #;scopes (#;Cons new-head tail) compiler)
                          action)
          (#E;Success [compiler' output])
          (case (get@ #;scopes compiler')
            (#;Cons head' tail')
            (let [scopes' (#;Cons (set@ #;locals (get@ #;locals head) head')
                                  tail')]
              (#E;Success [(set@ #;scopes scopes' compiler')
                           output]))

            _
            (error! "Invalid scope alteration."))

          (#E;Error error)
          (#E;Error error)))

      _
      (#E;Error "Cannot create local binding without a scope."))
    ))