Source

OCamlRuby / rbInt.ml

open Util
open Ast

let to_int obj =
  match get_fun obj.ctx "__body" with
  | (_, Literal (LInt x)) -> x
  | _ -> failwith @@ "RbInt.to_int: " ^ obj.class_name

let of_int i parent =
  let ctx = create_ctx () in
  let fmake args f = (args, External (fun self ->
    let xs = List.map (to_int $ get_var self.ctx) args in
    f i xs))
  in
  set_var ctx (string_of_int i) (null_obj "int");
  set_fun ctx "to_s" ([], Literal (LString (string_of_int i)));
  set_fun ctx "__body" ([], Literal (LInt i));
  set_fun ctx "+" @@ fmake ["__x"] (fun i ys -> Literal (LInt (i + List.hd ys)));
  set_fun ctx "-" @@ fmake ["__x"] (fun i ys -> Literal (LInt (i - List.hd ys)));
  set_fun ctx "*" @@ fmake ["__x"] (fun i ys -> Literal (LInt (i * List.hd ys)));
  set_fun ctx "/" @@ fmake ["__x"] (fun i ys -> Literal (LInt (i / List.hd ys)));
  set_fun ctx "==" @@ fmake ["__x"] (fun x xs -> Literal (LBool (x = List.hd xs)));
  set_fun ctx "!=" @@ fmake ["__x"] (fun x xs -> Literal (LBool (x != List.hd xs)));
  set_fun ctx "<=" @@ fmake ["__x"] (fun x xs -> Literal (LBool (x <= List.hd xs)));
  set_fun ctx "<"  @@ fmake ["__x"] (fun x xs -> Literal (LBool (x <  List.hd xs)));
  set_fun ctx ">=" @@ fmake ["__x"] (fun x xs -> Literal (LBool (x >= List.hd xs)));
  set_fun ctx ">"  @@ fmake ["__x"] (fun x xs -> Literal (LBool (x >  List.hd xs)));
  { parent=parent; class_name="Int"; ctx=ctx }