(;module:
  lux
  (lux (data text/format
             [number]
             (coll [list "L/" Functor<List> Fold<List>]
                   ["d" dict])))
  (luxc ["&" base]
        (lang ["la" analysis]
              ["ls" synthesis])
        (synthesizer ["&&;" structure]
                     ["&&;" function])
        ))

## (def: (has-self-reference? exprS)
##   (-> ls;Synthesis Bool)
##   (case exprS
##     (#ls;Tuple membersS)
##     (list;any? has-self-reference? membersS)

##     (#ls;Procedure name argsS)
##     (list;any? has-self-reference? argsS)

##     (#ls;Variant tag last? memberS)
##     (has-self-reference? memberS)

##     (#ls;Variable idx)
##     (i.= 0 idx)

##     (#ls;Recur offset argsS)
##     (list;any? has-self-reference? argsS)

##     (#ls;Call funcS argsS)
##     (or (has-self-reference? funcS)
##         (list;any? has-self-reference? argsS))

##     (#ls;Let register inputS bodyS)
##     (or (has-self-reference? inputS)
##         (has-self-reference? bodyS))

##     (#ls;If inputS thenS elseS)
##     (or (has-self-reference? inputS)
##         (has-self-reference? thenS)
##         (has-self-reference? elseS))

##     (#ls;Function num-args scope bodyS)
##     (not (list;any? (i.= 0) scope))

##     (#ls;Loop offset argsS bodyS)
##     (or (list;any? has-self-reference? argsS)
##         (has-self-reference? bodyS))

##     _
##     false
##     ))

## (def: (shift-loop-variables scope offset exprS)
##   (-> (List Int) Nat ls;Synthesis ls;Synthesis)
##   (loop [exprS exprS]
##     (case exprS
##       (#ls;Tuple members)
##       (#ls;Tuple (L/map recur members))

##       (#ls;Procedure name argsS)
##       (#ls;Procedure name (L/map recur argsS))

##       (#ls;Variant tag last? valueS)
##       (#ls;Variant tag last? (recur valueS))

##       (#ls;Variable idx)
##       (if (captured-ref? idx)
##         (let [scope-idx (|> idx (n.+ 1) (n.* -1) int-to-nat)]
##           (|> scope (list;nth scope-idx) assume #ls;Variable))
##         (#ls;Variable (i.+ idx (nat-to-int offset))))

##       (#ls;Recur _offset argsS)
##       (#ls;Recur (n.+ offset _offset) (L/map recur argsS))

##       (#ls;Call funcS argsS)
##       (#ls;Call (recur funcS) (L/map recur argsS))

##       (#ls;Let register inputS bodyS)
##       (#ls;Let (n.+ offset register) (recur inputS) (recur bodyS))

##       (#ls;If inputS thenS elseS)
##       (#ls;If (recur inputS) (recur thenS) (recur elseS))

##       (#ls;Function _num-args _scope _bodyS)
##       ...

##       (#ls;Loop _offset _argsS _bodyS)
##       (#ls;Loop (n.+ offset _offset) (L/map recur _argsS) (recur _bodyS))

##       _
##       exprS
##       )))

(def: init-env (List ls;Variable) (list))
(def: init-resolver (d;Dict Int Int) (d;new number;Hash<Int>))

(def: #export (synthesize analysis)
  (-> la;Analysis ls;Synthesis)
  (loop [scope-args +0
         resolver init-resolver
         exprA analysis]
    (case exprA
      (^template [<from> <to>]
        (<from> value)
        (<to> value))
      ([#la;Unit     #ls;Unit]
       [#la;Bool     #ls;Bool]
       [#la;Nat      #ls;Nat]
       [#la;Int      #ls;Int]
       [#la;Deg      #ls;Deg]
       [#la;Real     #ls;Real]
       [#la;Char     #ls;Char]
       [#la;Text     #ls;Text]
       [#la;Absolute #ls;Definition])

      (#la;Product _)
      (#ls;Tuple (L/map (recur +0 resolver) (&&structure;unfold-tuple exprA)))

      (#la;Sum choice)
      (let [[tag last? value] (&&structure;unfold-variant choice)]
        (#ls;Variant tag last? (recur +0 resolver value)))

      (#la;Relative ref)
      (if (&&function;nested-function? scope-args)
        (case ref
          (#;Local local)
          (if (n.= +0 local)
            (<| (#ls;Call (#ls;Variable 0))
                (L/map (|>. nat-to-int #ls;Variable))
                (list;n.range +1 (n.dec scope-args)))
            (#ls;Variable (&&function;adjust-var scope-args (nat-to-int local))))
          
          (#;Captured register)
          (#ls;Variable (default (&&function;to-captured register)
                          (d;get (&&function;to-captured register) resolver))))
        (case ref
          (#;Local local)
          (#ls;Variable (nat-to-int local))
          
          (#;Captured register)
          (#ls;Variable (&&function;to-captured register))))

      (#la;Function scope bodyA)
      (let [num-args (n.inc scope-args)
            raw-env (&&function;environment scope)
            env (L/map (function [var] (default var (d;get var resolver))) raw-env)
            env-vars (let [env-size (list;size raw-env)]
                       (: (List ls;Variable)
                          (case env-size
                            +0 (list)
                            _ (L/map &&function;to-captured (list;n.range +0 (n.dec env-size))))))
            resolver' (if (&&function;nested-function? num-args)
                        (L/fold (function [[from to] resolver']
                                  (d;put from to resolver'))
                                init-resolver
                                (list;zip2 env-vars env))
                        (L/fold (function [var resolver']
                                  (d;put var var resolver'))
                                init-resolver
                                env-vars))]
        (case (recur num-args resolver' bodyA)
          (#ls;Function args' env' bodyS')
          (#ls;Function (n.inc args') env bodyS')

          bodyS
          (#ls;Function +1 env bodyS)))
      
      (#la;Apply _)
      (let [[funcA argsA] (&&function;unfold-apply exprA)
            funcS (recur +0 resolver funcA)
            argsS (L/map (recur +0 resolver) argsA)]
        (case funcS
          ## (^multi (#ls;Variable idx)
          ##         (and (|> scope-args n.dec nat-to-int (i.* -1) (i.= idx))
          ##              tail?))
          ## (#ls;Recur +1 argsS)

          ## (^multi (#ls;Function _scope-args _scope _bodyS)
          ##         (and (n.= _scope-args (list;size argsS))
          ##              (not (has-self-reference? _bodyS))))
          ## (#ls;Loop local-offset argsS (shift-loop-variables local-offset _bodyS))

          _
          (#ls;Call funcS argsS)))

      (#la;Procedure name args)
      (#ls;Procedure name (L/map (recur +0 resolver) args))

      _
      (undefined)
      
      ## (#la;Case inputA branchesA)
      ## (let [inputS (recur +0 local-offset false inputA)]
      ##   (case branchesA
      ##     (^multi (^ (list [(#lp;Bind input-register)
      ##                       (#la;Variable (#;Local output-register))]))
      ##             (n.= input-register output-register))
      ##     inputS

      ##     (^ (list [(#lp;Bind register) bodyA]))
      ##     (#ls;Let register inputS (recur +0 local-offset tail? bodyA))
      
      ##     (^or (^ (list [(#lp;Bool true) thenA] [(#lp;Bool false) elseA]))
      ##          (^ (list [(#lp;Bool false) elseA] [(#lp;Bool true) thenA])))
      ##     (#ls;If inputS
      ##             (recur +0 local-offset tail? thenA)
      ##             (recur +0 local-offset tail? elseA))

      ##     (#;Cons [headP headA] tailPA)
      ##     (let [headP+ (|> (recur +0 local-offset tail? headA)
      ##                      #ls;ExecP
      ##                      (#ls;SeqP (&&case;path headP)))
      ##           tailP+ (L/map (function [[pattern bodyA]]
      ##                           (|> (recur +0 local-offset tail? bodyA)
      ##                               #ls;ExecP
      ##                               (#ls;SeqP (&&case;path pattern))))
      ##                         tailPA)]
      ##       (#ls;Case inputS (&&case;weave-paths headP+ tailP+)))
      ##     ))
      )))