mlox/lib/expr.ml

open Error

type literal = String of string | Number of float | Bool of bool | Nil
[@@deriving show { with_path = false }]

let show_literal literal =
  match literal with
  | String s -> "\"" ^ s ^ "\""
  | Number x -> string_of_float x
  | Bool b -> string_of_bool b
  | Nil -> "nil"

type binary_op =
  | Plus
  | Minus
  | Mul
  | Div
  | Equal
  | Less
  | Greater
  | LessEqual
  | GreaterEqual
  | And
  | Or
[@@deriving show { with_path = false }]

type unary_op = Neg | Not [@@deriving show { with_path = false }]
type logical_op = And | Or [@@deriving show { with_path = false }]

type expr =
  | Literal of literal
  | Variable of string
  | Assignment of { name : string; expr : expr_node }
  | Unary of { op : unary_op; expr : expr_node }
  | Binary of { op : binary_op; left : expr_node; right : expr_node }
  | Logical of { op : logical_op; left : expr_node; right : expr_node }
  | Call of { callee : expr_node; args : expr_node list }

and expr_node = { expr : expr; pos : code_pos }

let rec show_expr ?(indent = 0) expr =
  let show_indented ?(add = 2) = show_expr ~indent:(indent + add) in
  let indent_s = String.make indent ' ' in
  match expr with
  | Literal literal -> indent_s ^ show_literal literal
  | Variable name -> indent_s ^ "Variable " ^ name
  | Assignment { name; expr } -> indent_s ^ name ^ " = \n" ^ show_indented expr.expr
  | Unary { op; expr } -> indent_s ^ show_unary_op op ^ "\n" ^ show_indented expr.expr
  | Binary { op; left; right } ->
      indent_s ^ show_binary_op op ^ "\n" ^ show_indented left.expr ^ "\n"
      ^ show_indented right.expr
  | Logical { op; left; right } ->
      indent_s ^ show_logical_op op ^ "\n" ^ show_indented left.expr ^ "\n"
      ^ show_indented right.expr
  | Call { callee; args } ->
      let callee_s = show_indented ~add:4 callee.expr in
      let args_s =
        List.map (fun arg -> show_indented ~add:4 arg.expr) args
        |> List.fold_left (fun acc s -> acc ^ s) ""
      in
      indent_s ^ "Call\n" ^ indent_s ^ "  Callee\n" ^ callee_s ^ "\n" ^ indent_s ^ "  Args\n"
      ^ args_s

let show_expr_node expr_node = show_expr expr_node.expr
let make_expr_node (pos : code_pos) (expr : expr) : expr_node = { expr; pos }
let make_string (pos : code_pos) (s : string) : expr_node = Literal (String s) |> make_expr_node pos
let make_number (pos : code_pos) (x : float) : expr_node = Literal (Number x) |> make_expr_node pos
let make_bool (pos : code_pos) (b : bool) : expr_node = Literal (Bool b) |> make_expr_node pos
let make_nil (pos : code_pos) = Literal Nil |> make_expr_node pos
let make_variable (pos : code_pos) (name : string) : expr_node = Variable name |> make_expr_node pos

let make_assignment (pos : code_pos) (name : string) (expr : expr_node) : expr_node =
  Assignment { name; expr } |> make_expr_node pos

let make_unary (pos : code_pos) (op : unary_op) (expr : expr_node) =
  Unary { op; expr } |> make_expr_node pos

let make_binary (pos : code_pos) (op : binary_op) (left : expr_node) (right : expr_node) =
  Binary { op; left; right } |> make_expr_node pos

let make_logical (pos : code_pos) (op : logical_op) (left : expr_node) (right : expr_node) =
  Logical { op; left; right } |> make_expr_node pos

let make_call (pos : code_pos) (callee : expr_node) (args : expr_node list) =
  Call { callee; args } |> make_expr_node pos