(.module:
  [lux (#- i64 Scope)
   [control [monad (#+ do)]]
   [data
    [error (#+ Error)]
    [collection
     ["dict" dictionary (#+ Dictionary)]]]]
  ["." //
   ["." analysis (#+ Environment Arity Analysis)]
   ["." extension (#+ Extension)]
   [//
    ["." reference (#+ Register Variable Reference)]]])

(type: #export Resolver (Dictionary Variable Variable))

(type: #export State
  {#scope-arity Arity
   #resolver Resolver
   #direct? Bit
   #locals Nat})

(def: #export fresh-resolver
  Resolver
  (dict.new reference.Hash<Variable>))

(def: #export init
  State
  {#scope-arity 0
   #resolver fresh-resolver
   #direct? #0
   #locals 0})

(type: #export Primitive
  (#Bit Bit)
  (#I64 (I64 Any))
  (#F64 Frac)
  (#Text Text))

(type: #export (Structure a)
  (#Variant (analysis.Variant a))
  (#Tuple (analysis.Tuple a)))

(type: #export Side
  (Either Nat Nat))

(type: #export Member
  (Either Nat Nat))

(type: #export Access
  (#Side Side)
  (#Member Member))

(type: #export (Path' s)
  #Pop
  (#Test Primitive)
  (#Access Access)
  (#Bind Register)
  (#Alt (Path' s) (Path' s))
  (#Seq (Path' s) (Path' s))
  (#Then s))

(type: #export (Abstraction' s)
  {#environment Environment
   #arity Arity
   #body s})

(type: #export (Apply' s)
  {#function s
   #arguments (List s)})

(type: #export (Branch s)
  (#Let s Register s)
  (#If s s s)
  (#Case s (Path' s)))

(type: #export (Scope s)
  {#start Register
   #inits (List s)
   #iteration s})

(type: #export (Loop s)
  (#Scope (Scope s))
  (#Recur (List s)))

(type: #export (Function s)
  (#Abstraction (Abstraction' s))
  (#Apply s (List s)))

(type: #export (Control s)
  (#Branch (Branch s))
  (#Loop (Loop s))
  (#Function (Function s)))

(type: #export #rec Synthesis
  (#Primitive Primitive)
  (#Structure (Structure Synthesis))
  (#Reference Reference)
  (#Control (Control Synthesis))
  (#Extension (Extension Synthesis)))

(type: #export State+
  (extension.State ..State Analysis Synthesis))

(type: #export Operation
  (extension.Operation ..State Analysis Synthesis))

(type: #export Phase
  (extension.Phase ..State Analysis Synthesis))

(type: #export Path
  (Path' Synthesis))

(def: #export path/pop
  Path
  #Pop)

(do-template [<name> <tag>]
  [(template: #export (<name> content)
     (#..Test (<tag> content)))]

  [path/bit  #..Bit]
  [path/i64  #..I64]
  [path/f64  #..F64]
  [path/text #..Text]
  )

(do-template [<name> <kind>]
  [(template: #export (<name> content)
     (.<| #..Access
          <kind>
          content))]

  [path/side   #..Side]
  [path/member #..Member]
  )

(do-template [<name> <kind> <side>]
  [(template: #export (<name> content)
     (.<| #..Access
          <kind>
          <side>
          content))]

  [side/left    #..Side   #.Left]
  [side/right   #..Side   #.Right]
  [member/left  #..Member #.Left]
  [member/right #..Member #.Right]
  )

(do-template [<name> <tag>]
  [(template: #export (<name> content)
     (<tag> content))]

  [path/bind #..Bind]
  [path/alt  #..Alt]
  [path/seq  #..Seq]
  [path/then #..Then]
  )

(type: #export Abstraction
  (Abstraction' Synthesis))

(type: #export Apply
  (Apply' Synthesis))

(def: #export unit Text "")

(do-template [<name> <value>]
  [(def: #export <name>
     (All [a] (-> (Operation a) (Operation a)))
     (extension.temporary (set@ #direct? <value>)))]

  [indirectly #0]
  [directly   #1]
  )

(do-template [<name> <type> <tag>]
  [(def: #export (<name> value)
     (-> <type> (All [a] (-> (Operation a) (Operation a))))
     (extension.temporary (set@ <tag> value)))]

  [with-scope-arity Arity    #scope-arity]
  [with-resolver    Resolver #resolver]
  [with-locals      Nat      #locals]
  )

(def: #export (with-abstraction arity resolver)
  (-> Arity Resolver
      (All [a] (-> (Operation a) (Operation a))))
  (extension.with-state {#scope-arity arity
                         #resolver resolver
                         #direct? #1
                         #locals arity}))

(do-template [<name> <tag> <type>]
  [(def: #export <name>
     (Operation <type>)
     (extension.read (get@ <tag>)))]

  [scope-arity #scope-arity Arity]
  [resolver    #resolver    Resolver]
  [direct?     #direct?     Bit]
  [locals      #locals      Nat]
  )

(def: #export with-new-local
  (All [a] (-> (Operation a) (Operation a)))
  (<<| (do //.Monad<Operation>
         [locals ..locals])
       (..with-locals (inc locals))))

(do-template [<name> <tag>]
  [(template: #export (<name> content)
     (#..Primitive (<tag> content)))]

  [bit  #..Bit]
  [i64  #..I64]
  [f64  #..F64]
  [text #..Text]
  )

(do-template [<name> <tag>]
  [(template: #export (<name> content)
     (<| #..Structure
         <tag>
         content))]

  [variant #..Variant]
  [tuple   #..Tuple]
  )

(do-template [<name> <tag>]
  [(template: #export (<name> content)
     (.<| #..Reference
          <tag>
          content))]

  [variable/local   reference.local]
  [variable/foreign reference.foreign]
  )

(do-template [<name> <tag>]
  [(template: #export (<name> content)
     (.<| #..Reference
          <tag>
          content))]

  [variable reference.variable]
  [constant reference.constant]
  )

(do-template [<name> <family> <tag>]
  [(template: #export (<name> content)
     (.<| #..Control
          <family>
          <tag>
          content))]

  [branch/case          #..Branch   #..Case]
  [branch/let           #..Branch   #..Let]
  [branch/if            #..Branch   #..If]

  [loop/recur           #..Loop     #..Recur]
  [loop/scope           #..Loop     #..Scope]

  [function/abstraction #..Function #..Abstraction]
  [function/apply       #..Function #..Apply]
  )