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