(** <summary>
  Marshals (aka. genlets) a module <c>M</c>
  of frduino expressions.
</summary>
<editorconfig>
  vi: set expandtab ts=2 sw=2:
</editorconfig> *)
namespace Frduino.Genlet

open Stdlib.Asyncseq

type CodeExpr<'T>() =
  let mutable s_ = ""
  let mutable x_: option<'T> = None
  member __.n with get () = s_ and set x = s_ <- x
  member this.x with get () = (match x_ with Some x_ -> x_ | None -> failwithf "someone's trying to get the 'x' of %A which is currently none" this) and set p = x_ <- Some p
  interface expr<'T>

type CodeAsyn<'T>() =
  let mutable s_ = ""
  let mutable extension_: string list option = None
  member __.u with get () = s_ and set x = s_ <- x
  member __.extension with get () = extension_ and set x = extension_ <- x
  interface Asyn<'T>

type CodeAsynN<'T>() =
  let mutable s_ = ""
  let mutable ls_: string list = []
  let mutable extension_: string list option = None
  member __.u with get () = s_ and set x = s_ <- x
  member __.ls with get () = ls_ and set x = ls_ <- x
  member __.extension with get () = extension_ and set x = extension_ <- x
  interface asyn_n<'T>

type decl =
  | DeclFun of
    ( string // return type expr
    * string // fun name
    * (string * string) list // pairs of (argtype * arg)
    * (string list) // statements
    )

type Store =
  { mutable u: (string * decl) list }
  static member Make () = { u = [] }

type Code<'T, 'K> =
  { g: string list
  ; s_0: string list
  ; s: string list
  }
  interface M<'T, 'K>
  static member Init<'T, 'K>(): Code<'T, 'K> =
    { g = []; s_0 = []; s = [] }

#nowarn "3370"
module Gen =
  let last = ref 0
  let reset () = last := 0
  let make () =
    let v = last.Value
    last := last.Value + 1
    v.ToString ()

type J() =
  member this.Bind (x: Asyn<'a>, f) =
    (this :> AsynBuilder).Bind_0 (x, f)

  member this.Bind (x: asyn_n<'a>, f) =
    (this :> AsynBuilder).Bind_n (x, f)

  member this.Bind (x: Asyn<unit>, f) =
    (this :> AsynBuilder).Bind_1 (x, f)

  member this.Bind (x: Asyn<('a * 'b * 'c)>, f) =
    (this :> AsynBuilder).Bind_3 (x, f)

  member this.Return x =
    (this :> AsynBuilder).Return x

  static member Make () =
    new J()

  interface AsynBuilder with
    override this.Bind (x: Asyn<'a>, f) = 
      (this :> AsynBuilder).Bind_0 (x, f)

    override __.Bind_0 (x: Asyn<'a>, f) = 
      let x' = x :?> CodeAsyn<'a>
      let id = "sym" + Gen.make ()
      let x'_g' = new CodeExpr<'a>(n = id)
      let body = f x'_g'
      let body' = body :?> CodeAsyn<'b>
      let extension = x'.extension
      let extension =
        let v = [$"auto {id} = /* await */ {x'.u}"]
        match extension with
        | Some extension -> Some (extension @ v)
        | None -> Some v
      let extension =
        match extension, body'.extension with
        | Some a, Some b -> Some (a @ b)
        | Some a, None -> Some a
        | None, Some b -> Some b
        | None, None -> None
      new CodeAsyn<'b>(u = $"{body'.u}", extension = extension)

    override this.Bind (x: Asyn<unit>, f) = 
      (this :> AsynBuilder).Bind_1 (x, f)

    override __.Bind_n (x: asyn_n<'a>, f) = 
      let x' = x :?> CodeAsynN<'a>
      let vals' = x'.ls |> List.map (fun fcall ->
        let id = "sym" + Gen.make ()
        id, new CodeExpr<'a>(n = id), fcall
      )
      let body =
        let vals = vals' |> List.map (fun (id, codeexpr, fcall) ->
          codeexpr :> expr<'a>)
        f vals
      let body' = body :?> CodeAsyn<'b>
      body'.extension <-
        let vals = vals' |> List.map (fun (id, codeexpr, fcall) ->
          $"auto {id} = /* await */ {fcall}")
        match body'.extension with
        | None -> Some vals
        | Some acc -> Some (vals @ acc)
      let extension = x'.extension
      let extension =
        let v = [$"/* await */ {x'.u}"]
        match extension with
        | Some extension -> Some (extension @ v)
        | None -> Some v
      let extension =
        match extension, body'.extension with
        | Some a, Some b -> Some (a @ b)
        | Some a, None -> Some a
        | None, Some b -> Some b
        | None, None -> None
      new CodeAsyn<'b>(u = $"{body'.u}", extension = extension)

    override this.Bind (x: asyn_n<'a>, f) = 
      (this :> AsynBuilder).Bind_n (x, f)

    override __.Bind_1 (x: Asyn<unit>, f) = 
      let x' = x :?> CodeAsyn<unit>
      let body = f ()
      let body' = body :?> CodeAsyn<'b>
      let extension = x'.extension
      let extension =
        (*
          when a promise has unit return value, it implies two cases:
          1. if it has extensions.. this is weird. Extensions are reserved for when there's some prependage procedure from which you "pull" a value. If there's no value to "pull" (pure procedure), then this promise doesn't need to exist. Indeed, the only justification is that this is not a promise at all, but rather a dummy value. I really should use ADT for this. This kind of value shouldn't be Asyn<unit>, but idk maybe like Adummy<_>
          2. if it has no extensions, it is an async procedure that can be awaited
        *)
        match extension with
        | Some extension when x'.u = "NAN" -> Some extension
        | None ->
          let v = [$"/* await */ {x'.u}"]
          Some v
        | _ -> failwith "wtf"
      let extension =
        match extension, body'.extension with
        | Some a, Some b -> Some (a @ b)
        | Some a, None -> Some a
        | None, Some b -> Some b
        | None, None -> None
      new CodeAsyn<'b>(u = $"{body'.u}", extension = extension)

    override this.Bind (x: Asyn<('a * 'b * 'c)>, f) : Asyn<'d> = 
      (this :> AsynBuilder).Bind_3<'a, 'b, 'c, 'd> (x, f)

    override __.Bind_3<'a, 'b, 'c, 'd> (x: Asyn<('a * 'b * 'c)>, f) = 
      let x' = x :?> CodeAsyn<('a * 'b * 'c)>
      let tuple_col_id = "sym" + Gen.make ()
      let arg1, arg2, arg3 =
        ( let id = "sym" + Gen.make ()
          new CodeExpr<'a>(n = id) ),
        ( let id = "sym" + Gen.make ()
          new CodeExpr<'b>(n = id) ),
        ( let id = "sym" + Gen.make ()
          new CodeExpr<'c>(n = id) )
      let body = f (arg1, arg2, arg3)
      let body' = body :?> CodeAsyn<'d>
      let extension = x'.extension
      let extension =
        let v = [$"auto {tuple_col_id} = /* await */ {x'.u}"]
        let elgetters = [
          $"auto {arg1.n} = ({tuple_col_id}).itemA";
          $"auto {arg2.n} = ({tuple_col_id}).itemB";
          $"auto {arg3.n} = ({tuple_col_id}).itemC"]
        match extension with
        | Some extension -> Some (extension @ v @ elgetters)
        | None -> Some (v @ elgetters)
      let extension =
        match extension, body'.extension with
        | Some a, Some b -> Some (a @ b)
        | Some a, None -> Some a
        | None, Some b -> Some b
        | None, None -> None
      new CodeAsyn<'d>(u = $"{body'.u}", extension = extension)

    override __.Return (x: expr<'a>): Asyn<'a> = 
      let x = x :?> CodeExpr<'a>
      let id = "sym" + Gen.make ()
      let extension = Some [$"auto {id} = {x.n}"]
      new CodeAsyn<'a>(u = id, extension = extension)

    override __.Return (x: expr<unit>): Asyn<unit> = 
      ignore x
      let extension = None
      new CodeAsyn<unit>(u = "NAN", extension = extension)

type Json = System.Text.Json.JsonSerializer

type A<'T, 'TParam, 'TSerializer when 'TSerializer :> Stdlib.Serializable<'T, 'TParam>>(env: ('TSerializer * string * string)) =
  member __.Float (x: float) =
    new CodeExpr<float>(x = x, n = sprintf "%ff" x)

  member __.Int (x: int) =
    new CodeExpr<int>(x = x, n = sprintf "%d" x)

  member __.Lit<'a> (x: 'a) =
    new CodeExpr<'a>(x = x, n = sprintf "%A" x)

  member __.Tup<'a, 'b, 'c> (x: 'a expr, y: 'b expr, z: 'c expr) : expr<('a * 'b * 'c)> =
    let x = x :?> CodeExpr<'a>
    let y = y :?> CodeExpr<'b>
    let z = z :?> CodeExpr<'c>
    new CodeExpr<('a * 'b * 'c)>(n = "make_tuple3((" + x.n + "), (" + y.n + "), (" + z.n + "))")

  member this.Bind (x: Asyn<'a>, f): M<'T, 'K> =
    (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).Bind_0 (x, f)

  member this.Bind (x: Asyn<unit>, f) =
    (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).Bind_1 (x, f)

  member this.Bind (x: Asyn<('a * 'b * 'c)>, f): M<'T, 'K> =
    (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).Bind_3 (x, f)

  member this.Return<'K> x =
    (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).Return<'K> x

  member this.Return x =
    (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).Return x

  member this.Yield<'K> (x: 'TParam) : M<'T, 'K> =
    let o_, _, serial_name = env
    let o, varargs =
      o_.lit x
    // TODO(kinten) fuck me
    let formatter = Json.Serialize o
    let formatter = formatter.Replace("\"", "\\\"")
    let id = Gen.make ()
    { Code.Init () with s = [$"char __line_{id}[64]"; $"sprintf(__line_{id}, \"{formatter}\", {varargs})"; $"/* await */ {serial_name}.println(__line_{id})"] }

  member this.YieldFrom<'K> (x: unit -> M<'T, 'K>) =
    (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).YieldFrom<'K> x

  member this.YieldFrom<'K> (x: M<'T, 'K>) =
    (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).YieldFrom<'K> x

  member this.Combine (a, b) =
    (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).Combine<'K> (a, b)

  member this.Delay f =
    (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).Delay<'K> f

  static member Make env =
    new A<'T, 'TParam, 'TSerializer>(env)

  interface AsyncseqBuilder<'T, 'TParam, 'TSerializer> with
    member this.Bind<'K, 'a> (x : Asyn<'a>, f : expr<'a> -> M<'T, 'K>) : M<'T, 'K> =
      (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).Bind_0<'K, 'a> (x, f)

    member _.Bind_0<'K, 'a> (x : Asyn<'a>, f : expr<'a> -> M<'T, 'K>) : M<'T, 'K> =
      let x' = x :?> CodeAsyn<'a>
      let id = "sym" + Gen.make ()
      let x'_g' = new CodeExpr<'a>(n = id)
      let body = f x'_g'
      let body' = body :?> Code<'T, 'K>
      let ext =
        match x'.extension with
        | Some ext -> ext
        | None -> []
      { body' with s = ext @ [sprintf "auto %s = /* await */ %s" id x'.u] @ body'.s }

    member this.Bind<'K> (x : Asyn<unit>, f : unit -> M<'T, 'K>) : M<'T, 'K> =
      (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).Bind_1<'K> (x, f)

    member _.Bind_1<'K> (x : Asyn<unit>, f : unit -> M<'T, 'K>) : M<'T, 'K> =
      let x' = x :?> CodeAsyn<unit>
      let body = f ()
      let body' = body :?> Code<'T, 'K>
      match x'.extension with
      | Some ext ->
        { body' with s = ext @ body'.s }
      | None ->
        let ext = []
        { body' with s = ext @ [sprintf "/* await */ %s" x'.u] @ body'.s }

    member this.Bind<'K, 'a, 'b, 'c> (x : Asyn<('a * 'b * 'c)>, f : (expr<'a> * expr<'b> * expr<'c>) -> M<'T, 'K>) : M<'T, 'K> =
      (this :> AsyncseqBuilder<'T, 'TParam, 'TSerializer>).Bind_3<'K, 'a, 'b, 'c> (x, f)

    member _.Bind_3<'K, 'a, 'b, 'c> (x : Asyn<('a * 'b * 'c)>, f : (expr<'a> * expr<'b> * expr<'c>) -> M<'T, 'K>) : M<'T, 'K> =
      let x' = x :?> CodeAsyn<('a * 'b * 'c)>
      let tuple_col_id = "sym" + Gen.make ()
      let arg1, arg2, arg3 =
        ( let id = "sym" + Gen.make ()
          new CodeExpr<'a>(n = id) ),
        ( let id = "sym" + Gen.make ()
          new CodeExpr<'b>(n = id) ),
        ( let id = "sym" + Gen.make ()
          new CodeExpr<'c>(n = id) )
      let body = f (arg1, arg2, arg3)
      let body' = body :?> Code<'T, 'K>
      let ext =
        match x'.extension with
        | Some ext -> ext
        | None -> []
      let elgetters = [
        $"auto {arg1.n} = ({tuple_col_id}).itemA";
        $"auto {arg2.n} = ({tuple_col_id}).itemB";
        $"auto {arg3.n} = ({tuple_col_id}).itemC"]
      { body' with s = ext @ [$"auto {tuple_col_id} = /* await */ {x'.u}" ] @ elgetters @ body'.s }

    member _.Return<'K> (x: expr<'K>) : M<'T, 'K> =
      let x = x :?> CodeExpr<'K>
      ignore x
      { Code.Init () with s = ["exit(0)"] }

    member _.Return (x: expr<unit>) : M<'T, unit> =
      let x = x :?> CodeExpr<unit>
      ignore x
      { Code.Init () with s = ["exit(0)"] }

    member this.Yield<'K> (x: 'TParam) : M<'T, 'K> =
      (this :> A<'T, 'TParam, 'TSerializer>).Yield<'K> x

    member _.YieldFrom<'K> (x: unit -> M<'T, 'K>) : M<'T, 'K> =
      ignore x
      { Code.Init () with s = ["return"] }

    member _.YieldFrom<'K> (x: M<'T, 'K>) : M<'T, 'K> =
      (x :?> Code<'T, 'K>) :> M<'T, 'K>

    member _.Combine<'K> (a : M<'T, 'K>, b: M<'T, 'K>) : M<'T, 'K> =
      let a = a :?> Code<'T, 'K>
      let b = b :?> Code<'T, 'K>
      { g = a.g @ b.g; s_0 = a.s_0 @ b.s_0; s = a.s @ b.s }

    member _.Delay<'K> (f: unit -> M<'T, 'K>) : M<'T, 'K> =
      let x = f ()
      (x :?> Code<'T, 'K>) :> M<'T, 'K>

    member _.Zero<'K> (): M<'T,'K> = 
      Code.Init ()

type B<'T>(Seq : unit -> Code<'T, unit>) =
  static member Make<'T> (f: unit -> Code<'T, unit>): B<'T> =
    new B<'T>(f)

  member __.a with get() =
    let code = Seq ()
    let code = { code with s = code.s @ ["exit(-1)"] }
    let makefn fnname code =
      code
      |> List.map (fun x -> "\t" + x + ";")
      |> String.concat "\n"
      |> fun x -> "void " + fnname + "() {\n" + x + "\n}"
    let preamble =
      code.g
      |> String.concat "\n"
    let setupFn =
      makefn "setup" code.s_0
    let loopFn =
      makefn "loop" code.s
    [preamble; setupFn; loopFn]
    |> String.concat "\n"