(* SPDX-License-Identifier: MPL-2.0 *)
(* SPDX-FileCopyrightText: 2026 Jonathan D.A. Jewell *)

(** Nickel emitter (config-language target).

    Lowers a subset of AffineScript to Nickel, which is a typed
    configuration language with first-class records and merging.

    Nickel is *config*, not a general-purpose target — control flow is
    expressions only, no loops, no mutation. This emitter handles the
    natural overlap: pure functions over Int/Float/Bool/String/Record. *)

open Ast

let nickel_reserved = [
  "if"; "then"; "else"; "let"; "in"; "fun"; "match"; "true"; "false"; "null";
  "import"; "merge"; "default"; "force"; "doc"; "Number"; "String"; "Bool";
  "Array"; "Dyn"; "switch";
]

let mangle s = if List.mem s nickel_reserved then s ^ "_" else s

let rec gen_expr (e : expr) : string =
  match e with
  | ExprLit lit -> gen_lit lit
  | ExprVar id -> mangle id.name
  | ExprApp (callee, args) ->
      List.fold_left (fun acc a -> "(" ^ acc ^ " " ^ gen_expr a ^ ")")
        (gen_expr callee) args
  | ExprBinary (a, op, b) ->
      let s = match op with
        | OpAdd -> "+" | OpSub -> "-" | OpMul -> "*" | OpDiv -> "/" | OpMod -> "%"
        | OpEq  -> "==" | OpNe -> "!="
        | OpLt  -> "<" | OpLe -> "<=" | OpGt -> ">" | OpGe -> ">="
        | OpAnd -> "&&" | OpOr -> "||"
        | OpConcat -> "++"
        | OpBitAnd | OpBitOr | OpBitXor | OpShl | OpShr ->
            failwith "Nickel backend: bitwise ops not supported"
      in
      "(" ^ gen_expr a ^ " " ^ s ^ " " ^ gen_expr b ^ ")"
  | ExprUnary (OpNeg, x) -> "(-" ^ gen_expr x ^ ")"
  | ExprUnary (OpNot, x) -> "(!" ^ gen_expr x ^ ")"
  | ExprUnary _ -> failwith "Nickel backend: unsupported unary op"
  | ExprIf { ei_cond; ei_then; ei_else } ->
      let c = gen_expr ei_cond in
      let t = gen_expr ei_then in
      let f = match ei_else with Some e -> gen_expr e | None -> "null" in
      Printf.sprintf "(if %s then %s else %s)" c t f
  | ExprLet { el_pat; el_value; el_body; _ } ->
      let var = match el_pat with PatVar id -> mangle id.name | _ -> "_" in
      let v = gen_expr el_value in
      let body = match el_body with Some e -> gen_expr e | None -> "null" in
      Printf.sprintf "(let %s = %s in %s)" var v body
  | ExprBlock blk -> gen_block blk
  | ExprRecord { er_fields; _ } ->
      let f = List.map (fun (id, e_opt) ->
        let v = match e_opt with Some e -> gen_expr e | None -> mangle id.name in
        Printf.sprintf "%s = %s" (mangle id.name) v
      ) er_fields in
      "{ " ^ String.concat ", " f ^ " }"
  | ExprField (r, f) -> gen_expr r ^ "." ^ mangle f.name
  | ExprSpan (inner, _) -> gen_expr inner
  | ExprReturn (Some e) -> gen_expr e
  | _ -> "(error \"Nickel backend: unsupported expression\")"

and gen_lit = function
  | LitInt (n, _) -> string_of_int n
  | LitFloat (f, _) ->
      let s = string_of_float f in
      if String.length s > 0 && s.[String.length s - 1] = '.' then s ^ "0" else s
  | LitBool (true, _) -> "true"
  | LitBool (false, _) -> "false"
  | LitString (s, _) -> "\"" ^ String.escaped s ^ "\""
  | LitChar (c, _) -> "\"" ^ Char.escaped c ^ "\""
  | LitUnit _ -> "null"

and gen_block (blk : block) : string =
  (* Nickel has no statements — only let-chains. Fold StmtLet into nested
     let..in expressions; everything else is unsupported. *)
  let rec fold = function
    | [] ->
        (match blk.blk_expr with
         | Some e -> gen_expr e
         | None   -> "null")
    | StmtLet { sl_pat = PatVar id; sl_value; _ } :: rest ->
        Printf.sprintf "(let %s = %s in %s)" (mangle id.name)
          (gen_expr sl_value) (fold rest)
    | _ :: _ -> "(error \"Nickel: only let-bindings allowed in a block\")"
  in
  fold blk.blk_stmts

let gen_function (fd : fn_decl) : string =
  let name = mangle fd.fd_name.name in
  let body = match fd.fd_body with
    | FnExpr e -> gen_expr e
    | FnBlock b -> gen_block b
  in
  match fd.fd_params with
  | [] -> Printf.sprintf "  %s = %s,\n" name body
  | _  ->
      let params = String.concat " => "
        (List.map (fun (p : param) -> "fun " ^ mangle p.p_name.name) fd.fd_params)
        ^ " => " in
      Printf.sprintf "  %s = %s%s,\n" name params body

let generate (program : program) (_symbols : Symbol.t) : string =
  let buf = Buffer.create 1024 in
  Buffer.add_string buf "# Generated by AffineScript compiler\n";
  Buffer.add_string buf "# SPDX-License-Identifier: MPL-2.0\n";
  Buffer.add_string buf "{\n";
  List.iter (function
    | TopFn fd -> Buffer.add_string buf (gen_function fd)
    | TopConst { tc_name; tc_value; _ } ->
        Buffer.add_string buf
          (Printf.sprintf "  %s = %s,\n" (mangle tc_name.name) (gen_expr tc_value))
    | _ -> ()
  ) program.prog_decls;
  Buffer.add_string buf "}\n";
  Buffer.contents buf

let codegen_nickel (program : program) (symbols : Symbol.t) : (string, string) result =
  try Ok (generate program symbols)
  with
  | Failure msg -> Error ("Nickel codegen error: " ^ msg)
  | e           -> Error ("Nickel codegen error: " ^ Printexc.to_string e)
