spooky/lib/ast.ml

type typ =
  | TInt
  | TBool
  | TVoid
  | TStruct of string
  | TArray of typ
  | TComptime of typ        (* #type  — comptime-only *)
  | TCombo of typ * typ     (* type#type — linked runtime+comptime pair *)

type binop =
  | Add
  | Sub
  | Mul
  | Div
  | Mod
  | And
  | Or
  | Eq
  | Ne
  | Lt
  | Le
  | Gt
  | Ge

type unop = Neg | Not

type expr =
  | IntLit of int
  | BoolLit of bool
  | Var of string
  | Binop of binop * expr * expr
  | Unop of unop * expr
  | Assign of expr * expr
  | Call of expr * expr list
  | ArrayGet of expr * expr
  | StructGet of expr * string

type stmt =
  | VarDecl of bool * string * typ option * expr option
    (* is_mut, name, type_annotation, init *)
  | Expr of expr
  | If of expr * stmt list * stmt list
  | ForEach of typ * string * expr * stmt list
  | Return of expr option
  | Block of stmt list

type func = {
  name : string;
  params : (string * typ) list;   (* name, type *)
  ret : typ;
  body : stmt list;
}

type struct_def = {
  sname : string;
  fields : (typ * string) list;
}

type top =
  | TopStruct of struct_def
  | TopFunc of func
  | TopGlobalVar of bool * string * typ option * expr option
    (* is_mut, name, type_annotation, init *)

type program = top list

let string_of_typ =
  let rec go = function
    | TInt -> "int"
    | TBool -> "bool"
    | TVoid -> "void"
    | TStruct n -> "struct " ^ n
    | TArray t -> go t ^ "[]"
    | TComptime t -> "#" ^ go t
    | TCombo (t1, t2) -> go t1 ^ "#" ^ go t2
  in
  go

let string_of_binop = function
  | Add -> "+"
  | Sub -> "-"
  | Mul -> "*"
  | Div -> "/"
  | Mod -> "%"
  | And -> "&&"
  | Or -> "||"
  | Eq -> "=="
  | Ne -> "!="
  | Lt -> "<"
  | Le -> "<="
  | Gt -> ">"
  | Ge -> ">="

let string_of_unop = function Neg -> "-" | Not -> "!"

let rec string_of_expr = function
  | IntLit n -> Printf.sprintf "IntLit(%d)" n
  | BoolLit b -> Printf.sprintf "BoolLit(%b)" b
  | Var v -> Printf.sprintf "Var(%s)" v
  | Binop (op, a, b) ->
      Printf.sprintf "Binop(%s, %s, %s)" (string_of_binop op) (string_of_expr a) (string_of_expr b)
  | Unop (op, e) -> Printf.sprintf "Unop(%s, %s)" (string_of_unop op) (string_of_expr e)
  | Assign (lhs, rhs) -> Printf.sprintf "Assign(%s, %s)" (string_of_expr lhs) (string_of_expr rhs)
  | Call (callee, args) ->
      let args_s = String.concat ", " (List.map string_of_expr args) in
      Printf.sprintf "Call(%s, [%s])" (string_of_expr callee) args_s
  | ArrayGet (arr, idx) -> Printf.sprintf "ArrayGet(%s, %s)" (string_of_expr arr) (string_of_expr idx)
  | StructGet (obj, fld) -> Printf.sprintf "StructGet(%s, %s)" (string_of_expr obj) fld

let indent n = String.make (2 * n) ' '

let rec string_of_stmt ?(level = 0) st =
  let i = indent level in
  match st with
    | VarDecl (mut, n, t_opt, init_opt) ->
      let mut_s = if mut then "mut " else "" in
      let t_s = match t_opt with Some t -> ": " ^ string_of_typ t | None -> "" in
      let init_s = match init_opt with Some e -> " = " ^ string_of_expr e | None -> "" in
      Printf.sprintf "%sVarDecl(let %s%s%s%s)" i mut_s n t_s init_s
  | Expr e -> Printf.sprintf "%sExpr(%s)" i (string_of_expr e)
  | Return None -> Printf.sprintf "%sReturn" i
  | Return (Some e) -> Printf.sprintf "%sReturn(%s)" i (string_of_expr e)
  | Block body ->
      let body_s = String.concat "\n" (List.map (string_of_stmt ~level:(level + 1)) body) in
      if String.equal body_s "" then Printf.sprintf "%sBlock" i
      else Printf.sprintf "%sBlock\n%s" i body_s
  | If (cond, tbranch, ebranch) ->
      let then_s = String.concat "\n" (List.map (string_of_stmt ~level:(level + 1)) tbranch) in
      let else_s = String.concat "\n" (List.map (string_of_stmt ~level:(level + 1)) ebranch) in
      if ebranch = [] then Printf.sprintf "%sIf(%s)\n%s" i (string_of_expr cond) then_s
      else Printf.sprintf "%sIf(%s)\n%s\n%sElse\n%s" i (string_of_expr cond) then_s i else_s
  | ForEach (it_t, it_name, iterable, body) ->
      let body_s = String.concat "\n" (List.map (string_of_stmt ~level:(level + 1)) body) in
      Printf.sprintf "%sForEach(%s %s in %s)\n%s" i (string_of_typ it_t) it_name (string_of_expr iterable)
        body_s

let string_of_top = function
  | TopStruct s ->
      let fields =
        s.fields |> List.map (fun (t, n) -> Printf.sprintf "  Field(%s %s)" (string_of_typ t) n)
        |> String.concat "\n"
      in
      if String.equal fields "" then Printf.sprintf "Struct %s" s.sname
      else Printf.sprintf "Struct %s\n%s" s.sname fields
  | TopGlobalVar (mut, n, t_opt, init_opt) ->
      let mut_s = if mut then "mut " else "" in
      let t_s = match t_opt with Some t -> ": " ^ string_of_typ t | None -> "" in
      let init_s = match init_opt with Some e -> " = " ^ string_of_expr e | None -> "" in
      Printf.sprintf "GlobalVar(let %s%s%s%s)" mut_s n t_s init_s
  | TopFunc f ->
      let params =
        f.params
        |> List.map (fun (n, t) -> Printf.sprintf "%s: %s" n (string_of_typ t))
        |> String.concat ", "
      in
      let body = String.concat "\n" (List.map (string_of_stmt ~level:1) f.body) in
      if String.equal body "" then Printf.sprintf "Function %s(%s) -> %s" f.name params (string_of_typ f.ret)
      else Printf.sprintf "Function %s(%s) -> %s\n%s" f.name params (string_of_typ f.ret) body

let string_of_program (prog : program) = prog |> List.map string_of_top |> String.concat "\n\n"

let rec equal_typ a b =
  match (a, b) with
  | TInt, TInt | TBool, TBool | TVoid, TVoid -> true
  | TStruct x, TStruct y -> String.equal x y
  | TArray x, TArray y -> equal_typ x y
  | TComptime x, TComptime y -> equal_typ x y
  | TCombo (a1, a2), TCombo (b1, b2) -> equal_typ a1 b1 && equal_typ a2 b2
  | _ -> false