(* The interpreter for the simple image processing DSL *) open Imgdsl (* DSL definition *) open Grayimg (* Basic image processing lib *) ;; (* #load "bigarray.cma";; #load "grayimg.cmo";; *) (* Types of values in our DSL *) type value = | Int of int | Bool of bool | Img of img (* The type of expressions: the function that receives a value associated with `it' and computes a value *) type exp = value -> value let int x = fun _ -> Int x let load x = fun _ -> Img (read_pgm x) let display e = fun itv -> match e itv with | Img x -> Grayimg.display ~cmd: "xv" x; Int 0 | _ -> failwith "Display: type error" let it = fun itv -> itv let binintop op x y : exp = fun itv -> match (x itv, y itv) with | (Int x, Int y) -> op x y | _ -> failwith "binop: type error" let ( +% ) = binintop (fun x y -> Int (x+y)) let ( -% ) = binintop (fun x y -> Int (x-y)) let ( *% ) = binintop (fun x y -> Int (x*y)) let ( <% ) = binintop (fun x y -> Bool (x% ) = binintop (fun x y -> Bool (x>y)) let ( =% ) = binintop (fun x y -> Bool (x=y)) let if_ e et ef = fun itv -> match e itv with | Bool true -> et itv | Bool false -> ef itv | _ -> failwith "if: type error" let iterate e body = fun itv -> match e itv with | Img img -> let pxs = pixels img in let open Bigarray.Array1 in for i = 0 to dim pxs - 1 do let p = unsafe_get pxs i in match body (Int p) with | Int v -> unsafe_set pxs i v | _ -> failwith "iterate: updater must return an int" done; Img img | _ -> failwith "iterate: first argument must be an image" ;; let run : exp -> value = fun e -> e (Int 0)