Emmental/emmental.ml

An Emmental interpreter in Ocaml, written by User:Koen in 2012.

Overview
val s : int Stack.t val q : int Queue.t val mci_main : (int * int list) list ref val find : ('a * 'b) list -> 'a -> ('b * ('a * 'b) list) option val pushnumber : int -> unit val ( mod ) : int -> int -> int val log2 : int -> int val pop_a_program : int list -> int list val supplant : unit -> unit val execute_init : int -> unit val execute : (int * int list) list -> int -> unit The meta-circular interpreter is stored as a list of pairs (symbol, definition); the empty list represents the initial mci. When a symbol is executed, the function  looks for it in the mci, and returns the list of symbols it was defined as, along with the mc interpreter that was used at the time of that definition (which happens to be the remaining of the current interpreter, when everything above the definition has been discarded).

Note that input doesn't handle end of file.

Source
let s = Stack.create let q = Queue.create let mci_main = ref []

let rec find mci c = match mci with | (hc, hl) :: t -> if hc = c then Some (hl, t) else find t c | [] -> None

let pushnumber c = Stack.push ((Stack.pop s * 10 - 48 + c) mod 256) s

let (mod) a b = let m = a mod b in if m < 0 then m + b else m

let rec log2 n = if n < 0 || n > 255 then log2 (n mod 256) else if n = 0 then 8 else if n = 1 then 0 else if n < 4 then 1 else if n < 8 then 2 else if n < 16 then 3 else if n < 32 then 4 else if n < 64 then 5 else if n < 128 then 6 else 7

let rec pop_a_program acc = let c = (Stack.pop s) in if c = 59 then acc else pop_a_program (c :: acc)

let supplant = let c = (Stack.pop s) in let t = pop_a_program [] in  mci_main := (c, t) :: !mci_main

let rec execute_init c = match c with | 35 (* # *) -> Stack.push 0 s | c when 47 < c && c < 58 -> pushnumber c  | 43 (* + *) -> let x = Stack.pop s in let y = Stack.pop s in   Stack.push ((x + y) mod 256) s  | 45 (* - *) -> let x = Stack.pop s in let y = Stack.pop s in   Stack.push ((y - x) mod 256) s  | 126 (* ~ *) -> Stack.push (log2 (Stack.pop s)) s  | 46 (* . *) -> print_char (Char.chr (Stack.pop s)) | 44 (*, *) -> Stack.push (Char.code (input_char stdin)) s | 94 (* ^ *) -> Queue.push (Stack.top s) q  | 118 (* v *) -> Stack.push (Queue.pop q) s  | 58 (* : *) -> Stack.push (Stack.top s) s  | 33 (* ! *) -> supplant | 63 (* ? *) -> execute !mci_main (Stack.pop s) | 59 (* ; *) -> Stack.push 59 s  | _ -> and execute mci c = match find mci c with | Some (m, mci_) -> List.iter (execute mci_) m | None -> execute_init c;;

let p = Sys.argv.(1) in for k = 0 to String.length p - 1 do execute !mci_main (Char.code p.[k]) done;;