Carriage/carriage.ml

A Carriage interpreter in Ocaml, written by User:Koen in mid-november 2012.


 * The Carriage program should be passed as a command line argument.
 * Explosion during runtime will raise a  exception.
 * Explosion because of an invalid character will raise a  exception.
 * When execution halts without an explosion, the resulting stack is outputted, top-to-bottom. Note that there will be no distinction between the instruction 1 and the number 1.

Source
type instr = One | Pick | Swap | Pop | Size | Add | Sub | Slice | Apply type el = Instr of instr | Number of int | Funct of instr list

exception BOOM

let rec pick n s = match (n, s) with | (0, Instr _ :: _) -> raise BOOM | (0, h :: _) -> h | (_, h :: t) -> pick (pred n) t  | _ -> failwith "pick should have exploded already"

let slice k p s = let rec sl2 acc k s = match (k, s) with | (0, _) -> acc | (k, Instr h :: t) -> sl2 (h :: acc) (pred k) t   | (_, _ :: _) -> raise BOOM | _ -> raise BOOM in let rec sl1 p k s = match (p, s) with | (0, s) -> sl2 [] k s   | (p, h :: t) -> sl1 (pred p) k t    | _ -> failwith "sl1" in (sl1 p k s)

let print_instr i = match i with | One -> print_string "1" | Pick -> print_char '~' | Swap -> print_char '\\' | Pop -> print_char '$' | Size -> print_char '#' | Add -> print_char '+' | Sub -> print_char '-' | Slice -> print_char '@' | Apply -> print_char '!'

let rec print_stack s = match s with | Number n :: t -> print_int n; print_char ' '; print_stack t   | Instr i :: t -> print_instr i; print_char ' '; print_stack t    | Funct f :: t -> List.iter (print_instr) f; print_char ' '; print_stack t   | _ -> ; print_newline

let rec apply f (s, length) = List.fold_left (execute) (s, length) (f) and execute (s, length) i = match (i, s) with | (One, _) -> (Number 1 :: s, succ length) | (Pick, Number n :: t) when n < length && n >= 0 -> (pick n t :: t, length) | (Swap, a :: b :: t) -> (b :: a :: t, length) | (Pop, _ :: t) -> (t, pred length) | (Size, _) -> (Number length :: s, succ length) | (Add, Number a :: Number b :: t) -> (Number (a + b) :: t, pred length) | (Sub, Number a :: Number b :: t) -> (Number (b - a) :: t, pred length) | (Slice, Number k :: Number p :: t) when p >= 0 && k >= 0 && p + k - 1 < length -> let x = slice k (length - p - 4) t   in    (Funct x :: t, pred length) | (Apply, Funct f :: t) -> apply f (t, length) | _ -> raise BOOM

exception Syntax_EXPLOSION;;

let p = Sys.argv.(1) and s = ref [];;

for k = String.length p - 1 downto 0 do match p.[k] with | '1' -> s := One :: !s | '~' -> s := Pick :: !s | '\\' -> s := Swap :: !s | '$' -> s := Pop :: !s | '#' -> s := Size :: !s | '+' -> s := Add :: !s | '-' -> s := Sub :: !s | '@' -> s := Slice :: !s | '!' -> s := Apply :: !s | ' ' | '\n' | '\t' -> | _ -> raise Syntax_EXPLOSION done;;

let data = List.fold_left (fun (acc, n) i -> (Instr i :: acc, succ n)) ([], 0)   !s in print_stack (fst (apply !s data));;