104 lines
3.3 KiB
OCaml
104 lines
3.3 KiB
OCaml
|
|
(* This file implements native functions of the VM runtime.
|
|
Stuff like printing to the screen, file I/O etc will be implemented
|
|
here.
|
|
*)
|
|
open Types
|
|
|
|
type numeric_val =
|
|
| NInt of int
|
|
| NDouble of float
|
|
|
|
let to_numeric = function
|
|
| Int x -> NInt x
|
|
| Double x -> NDouble x
|
|
| v -> failwith ((print_value v) ^ " is not a numeric value")
|
|
let of_numeric = function
|
|
| NInt x -> Int x
|
|
| NDouble x -> Double x
|
|
|
|
let float_of_numeric = function
|
|
| NInt x -> float_of_int x
|
|
| NDouble x -> x
|
|
|
|
let numeric_generic fi fd = function
|
|
| NInt x -> (function
|
|
| NInt y -> NInt (fi x y)
|
|
| NDouble y -> NDouble (fd (float_of_int x) y))
|
|
| NDouble x -> (function
|
|
| NInt y -> NDouble (fd x (float_of_int y))
|
|
| NDouble y -> NDouble (fd x y))
|
|
let numeric_add = numeric_generic (+) (+.)
|
|
let numeric_sub = numeric_generic (-) (-.)
|
|
let numeric_mul = numeric_generic ( * ) ( *. )
|
|
let numeric_div x y =
|
|
NDouble ((float_of_numeric x) /. (float_of_numeric y))
|
|
|
|
module type Num = sig
|
|
type t
|
|
val add : t -> t -> t
|
|
val zero : t
|
|
val rem : t -> t -> t
|
|
end
|
|
|
|
let aux_mod (type a) (module M : Num with type t = a) (x:a) (y:a) =
|
|
let z = M.rem x y in
|
|
if z < M.zero then M.add z y else z
|
|
let numeric_mod = numeric_generic (aux_mod (module Int)) (aux_mod (module Float))
|
|
let numeric_rem = numeric_generic (Int.rem) (Float.rem)
|
|
|
|
|
|
let builtin_print (v : Types.value ref list) =
|
|
List.iter (fun r -> print_endline (print_value !r)) v;
|
|
Types.Nil
|
|
|
|
let builtin_add (vs : Types.value ref list) =
|
|
of_numeric (List.fold_left numeric_add (NInt 0) (List.map (fun r -> to_numeric !r) vs))
|
|
let builtin_sub (vs : Types.value ref list) =
|
|
match vs with
|
|
| f :: [] -> of_numeric (match (to_numeric !f) with
|
|
| NInt x -> NInt (Int.neg x)
|
|
| NDouble x -> NDouble (Float.neg x))
|
|
| f :: rest -> of_numeric (List.fold_left numeric_sub (to_numeric !f) (List.map (fun r -> to_numeric !r) rest))
|
|
| [] -> failwith "invalid number of arguments for subtraction: 0"
|
|
|
|
let builtin_mul vs =
|
|
of_numeric (List.fold_left numeric_mul (NInt 1) (List.map (fun r -> to_numeric !r) vs))
|
|
|
|
let builtin_div vs =
|
|
match vs with
|
|
| f :: [] -> of_numeric (numeric_div (NDouble 1.0) (to_numeric !f))
|
|
| f :: rest -> of_numeric (List.fold_left numeric_div (to_numeric !f) (List.map (fun r -> to_numeric !r) rest))
|
|
| [] -> failwith "invalid number of arguments for division: 0"
|
|
|
|
let make_single_func s f = function
|
|
| first :: [] -> f first
|
|
| v -> failwith ("invalid number of arguments for " ^s ^ ": " ^ (string_of_int (List.length v)))
|
|
|
|
let make_two_func s f = function
|
|
| first :: second :: [] -> f first second
|
|
| v -> failwith ("invalid number of arguments for " ^ s ^ ": " ^ (string_of_int (List.length v)))
|
|
|
|
|
|
let builtin_abs = make_single_func "ABS" (fun f -> of_numeric (match to_numeric !f with
|
|
| NInt x -> NInt (Int.abs x)
|
|
| NDouble x -> NDouble (Float.abs x)))
|
|
let builtin_mod =
|
|
make_two_func "MOD" (fun x y -> of_numeric (numeric_mod (to_numeric !x) (to_numeric !y)))
|
|
let builtin_rem =
|
|
make_two_func "REM" (fun x y -> of_numeric (numeric_rem (to_numeric !x) (to_numeric !y)))
|
|
|
|
let table = [|
|
|
builtin_print;
|
|
builtin_add;
|
|
builtin_sub;
|
|
builtin_mul;
|
|
builtin_div;
|
|
builtin_abs;
|
|
builtin_mod;
|
|
builtin_rem
|
|
|]
|
|
|
|
|
|
|