(*
              minijoy.ml
             ------------ 
  
  A simple REPL for a subset of Joy:
  
  - int values
  - 'dup', 'swap' and 'pop' keywords
  - (+) and (-) operations
  
*)

(********** Parsing **********)

type instr =
  | Num of int
  | Op of op
  | Key of key
and op =
  | Add
  | Mul
and key =
  | Dup
  | Swap
  | Pop
  
let read_op = parser
  | [< ''+' >] -> Op Add
  | [< ''*' >] -> Op Mul
  
let read_keyw = parser
  | [< ''d'; ''u'; ''p' >] -> Key Dup
  | [< ''s'; ''w'; ''a'; ''p' >] -> Key Swap
  | [< ''p'; ''o'; ''p' >] -> Key Pop
  
let read_digit = parser
  | [< ' ('0' .. '9') as d >] -> Char.code d - Char.code '0'
  
let rec read_int acc = parser
  | [< d = read_digit; ss >] -> read_int (acc * 10 + d) ss
  | [< >] -> Num acc

let rec parse = parser
  | [< ' (' ' | '\n' | '\r'); ss >] -> [< parse ss >]
  | [< d = read_digit; n = read_int d; ss >] -> [< 'n; parse ss >]
  | [< op = read_op; ss >] -> [< 'op; parse ss >]
  | [< k = read_keyw; ss >] -> [< 'k; parse ss >]
  | [< >] -> [< >]

(********** Evaluation and execution **********)

let stack = (Stack.create () : int Stack.t)

let get_op = function
  | Add -> (+)
  | Mul -> ( * )

let rec eval = parser
  | [< 'Num n; ss >] -> Stack.push n stack; eval ss
  | [< 'Op op; ss >] ->
      let n1 = Stack.pop stack and                (* pop first item *)
          n2 = Stack.pop stack and                (* pop second item *)
          f = get_op op in
              Stack.push (f n1 n2) stack ;        (* push f(item1, item2) *)
      eval ss ;
  | [< 'Key Dup; ss >] ->
      let n = Stack.pop stack in
          Stack.push n stack ;
          Stack.push n stack ;
      eval ss ;
  | [< 'Key Swap; ss >] ->
      let n1 = Stack.pop stack and
          n2 = Stack.pop stack in
              Stack.push n1 stack ;
              Stack.push n2 stack ;
      eval ss;
  | [< 'Key Pop; ss >] -> Stack.pop stack; eval ss
  | [< >] -> ()

(********** Read-eval-print loop **********)

  (* looks like: "item1 ] item2 ] item3 ]" *)
let print s = 
    let prn s = print_int s ; print_string " ] " in
        print_string "Stack: " ; Stack.iter prn stack

let () =
  let input = Stream.of_channel stdin in
      let prg = parse input in eval prg ;
  Stream.empty input ;
  print stack ;
  print_newline () ;