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が非常に調子悪いので移転します