(.module:
  lux
  (lux (control monad)
       (data [text "text/" Eq<Text>]
             text/format
             [maybe "maybe/" Monad<Maybe>]
             [product]
             ["e" error]
             (coll [list "list/" Functor<List> Fold<List> Monoid<List>]))
       [macro])
  (luxc ["&" lang]
        (lang [".L" variable #+ Variable])))

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

(def: (is-local? name scope)
  (-> Text Scope Bool)
  (|> scope
      (get@ [#.locals #.mappings])
      (&.pl-contains? name)))

(def: (get-local name scope)
  (-> Text Scope (Maybe [Type Ref]))
  (|> scope
      (get@ [#.locals #.mappings])
      (&.pl-get name)
      (maybe/map (function (_ [type value])
                   [type (#.Local value)]))))

(def: (is-captured? name scope)
  (-> Text Scope Bool)
  (|> scope
      (get@ [#.captured #.mappings])
      (&.pl-contains? name)))

(def: (get-captured name scope)
  (-> Text Scope (Maybe [Type Ref]))
  (loop [idx +0
         mappings (get@ [#.captured #.mappings] scope)]
    (case mappings
      #.Nil
      #.None

      (#.Cons [_name [_source-type _source-ref]] mappings')
      (if (text/= name _name)
        (#.Some [_source-type (#.Captured idx)])
        (recur (n/inc idx) mappings')))))

(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 (Meta (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] (maybe.default (undefined)
                                                 (get-ref name top-outer))
              [ref inner'] (list/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 (product.left ref+inner)]))))
                                                             scope)
                                                    (product.right ref+inner))]))
                                      [init-ref #.Nil]
                                      (list.reverse inner))
              scopes (list/compose inner' outer)]
          (#.Right [(set@ #.scopes scopes compiler)
                    (#.Some [ref-type ref])]))
        ))))

(def: #export (with-local [name type] action)
  (All [a] (-> [Text Type] (Meta a) (Meta 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."))
    ))

(do-template [<name> <val-type>]
  [(def: <name>
     (Bindings Text [Type <val-type>])
     {#.counter +0
      #.mappings (list)})]

  [init-locals   Nat]
  [init-captured Ref]
  )

(def: (scope parent-name child-name)
  (-> (List Text) Text Scope)
  {#.name     (list& child-name parent-name)
   #.inner    +0
   #.locals   init-locals
   #.captured init-captured})

(def: #export (with-scope name action)
  (All [a] (-> Text (Meta a) (Meta a)))
  (function (_ compiler)
    (let [parent-name (case (get@ #.scopes compiler)
                        #.Nil
                        (list)
                        
                        (#.Cons top _)
                        (get@ #.name top))]
      (case (action (update@ #.scopes
                             (|>> (#.Cons (scope parent-name name)))
                             compiler))
        (#e.Error error)
        (#e.Error error)

        (#e.Success [compiler' output])
        (#e.Success [(update@ #.scopes
                              (|>> list.tail (maybe.default (list)))
                              compiler')
                     output])
        ))
    ))

(def: #export next-local
  (Meta Nat)
  (function (_ compiler)
    (case (get@ #.scopes compiler)
      #.Nil
      (#e.Error "Cannot get next reference when there is no scope.")
      
      (#.Cons top _)
      (#e.Success [compiler (get@ [#.locals #.counter] top)]))))