S式計算機

30分プログラム、その68。超簡単S式計算機

id:mzp:20070623:sexpの続き。

#load "camlp4o.cma";;

(* parsing *)
open Genlex;;
let ($) f g = f g;;
type s_exp =   Num of int 
	     | Symbol of string 
	     | List of s_exp list
	     | Proc of (s_exp list -> s_exp);;

let lexer = Genlex.make_lexer ["(";")";"*"];;
let stream = lexer (Stream.of_string "(1 2 3)");;
let make_stream x = lexer (Stream.of_string x);;
let rec many f s= 
  try 
    let x = f s in
      x::(many f s)
  with _ -> [];;


let rec parse =parser 
  | [<'Kwd"(" ; e = many parse ; 'Kwd")">] -> List e
  | [<'Ident name>] -> Symbol name
  | [<'Int n>] -> Num n;;

let read_string s = parse $ lexer (Stream.of_string s);;
let read _ = parse $ lexer (Stream.of_channel stdin);;

let s = lexer (Stream.of_string "(+ 1 3)");;

(* print *)
let rec show =
  function Num x -> Printf.sprintf "%d" x
    | Symbol x -> Printf.sprintf "%s" x
    | List l -> Printf.sprintf "(%s)" (List.fold_left (^) "" (List.map show l))
    | Proc _ -> "#<Proc>";;

(* evaluation *)
let plus (Num x) (Num y) = Num (x+y);;
let minus (Num x) (Num y) = Num (x-y);;
let mul (Num x) (Num y) = Num (x*y);;
let div (Num x) (Num y) = Num (x/y);;

let fold_left1 f = 
  function 
      x::xs -> List.fold_left f x xs
    |	_ -> failwith "[] is not accept";;

let rec eval = 
  function
    | Symbol "+" ->  Proc (fun x->fold_left1 plus x)
    | Symbol "-" ->  Proc (fun x->fold_left1 minus x)
    | Symbol "*" ->  Proc (fun x->fold_left1 mul x)
    | Symbol "x" ->  Proc (fun x->fold_left1 mul x)
    | Symbol "/" ->  Proc (fun x->fold_left1 div x)
    | Symbol _ -> failwith "symbol undefined"
    | List exps -> let (Proc f)::args = List.map eval exps in
		     f args
    | _ as exp -> exp;;

let test s = eval (read_string s);;
let _ = 
  while true do
    print_string (show (eval (read_string(read_line ()))))
  done;;

# Wikiが非常に調子悪いので移転します