Created
July 29, 2011 05:04
-
-
Save ytomino/1113165 to your computer and use it in GitHub Desktop.
ocaml implementation of http://www.blue.sky.or.jp/grass/
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| type value = char option * func | |
| and func = Func of (value -> value);; | |
| let sub_eq sub s i = ( | |
| let rec loop sub j s i c = ( | |
| if c <= 0 then true else | |
| if sub.[j] <> s.[i] then false else | |
| loop sub (j + 1) s (i + 1) (c - 1) | |
| ) in | |
| let sub_length = String.length sub in | |
| if i + sub_length > String.length s then false else | |
| loop sub 0 s i sub_length | |
| );; | |
| let peek half full s i = ( | |
| let length = String.length s in | |
| if i >= length then i else | |
| if s.[i] = half then i + 1 else | |
| let full_length = String.length full in | |
| if i + full_length > length then i else | |
| if sub_eq full s i then i + full_length else i | |
| );; | |
| let peek_w = peek 'w' "ｗ";; | |
| let peek_W = peek 'W' "Ｗ";; | |
| let peek_v = peek 'v' "ｖ";; | |
| let find_first peek s = ( | |
| let rec loop peek s i = ( | |
| if i >= String.length s then i else | |
| let r = peek s i in | |
| if r > i then i else | |
| loop peek s (i + 1) | |
| ) in | |
| loop peek s 0 | |
| );; | |
| let interpret stack source = ( | |
| let rec interpret stack source index = ( | |
| let rec read peek source index n = ( | |
| let r = peek source index in | |
| if r > index then ( | |
| read peek source r (n + 1) | |
| ) else if peek_w source index > index | |
| || peek_W source index > index | |
| || peek_v source index > index | |
| then ( | |
| index, n | |
| ) else if index < String.length source then ( | |
| read peek source (index + 1) n (* skip *) | |
| ) else ( | |
| index, n | |
| ) | |
| ) in | |
| let rec read_body source index body = ( | |
| let (index, f) = read peek_W source index 0 in | |
| if f = 0 then (index, List.rev body) else | |
| let (index, a) = read peek_w source index 0 in | |
| read_body source index ((f, a) :: body) | |
| ) in | |
| let apply stack f a = ( | |
| let (_, Func func) = List.nth stack (f - 1) in | |
| let arg = List.nth stack (a - 1) in | |
| func arg | |
| ) in | |
| if index >= String.length source then ( | |
| (* 最後に来たらApply(1,1)して終了 *) | |
| let _ = apply stack 1 1 in () | |
| ) else if peek_w source index > index then ( | |
| (* 関数定義 *) | |
| let (index, argc) = read peek_w source index 0 in | |
| (* Printf.printf "%d:\n" argc; flush stdout; *) | |
| let (index, body) = read_body source index [] in | |
| let rec make stack n = ( | |
| if n = 0 then ( | |
| let rec loop stack body = ( | |
| match body with | |
| | [] -> List.hd stack | |
| | (f, a) :: br -> loop ((apply stack f a) :: stack) br | |
| ) in loop stack body | |
| ) else ( | |
| None, Func (fun a -> make (a :: stack) (n - 1)) | |
| ) | |
| ) in | |
| let r = make stack argc in | |
| interpret (r :: stack) source index | |
| ) else if peek_W source index > index then ( | |
| (* 関数適用 *) | |
| let (index, f) = read peek_W source index 0 in | |
| let (index, a) = read peek_w source index 0 in | |
| (* Printf.printf " %d %d\n" f a; flush stdout; *) | |
| let r = apply stack f a in | |
| interpret (r :: stack) source index | |
| ) else ( | |
| (* 無視 *) | |
| interpret stack source (index + 1) | |
| ) | |
| ) in | |
| interpret stack source (find_first peek_w source); | |
| );; | |
| let true_f = None, Func (fun x -> None, Func (fun _ -> x));; | |
| let false_f = None, Func (fun _ -> None, Func (fun y -> y));; | |
| let char_f x = Some x, Func (fun y -> | |
| match y with | |
| | Some y, _ -> if x = y then true_f else false_f | |
| | _ -> raise (Failure "In equal, argument is not char!\n"));; | |
| let init_stack = [ | |
| None, Func (function | |
| | (Some c, _) as a -> print_char c; if c = '\n' then flush stdout; a | |
| | None, _ -> raise (Failure "In primitive out, argument is not char!\n")); | |
| None, Func (function | |
| | Some c, _ -> char_f (char_of_int ((int_of_char c + 1) mod 256)) | |
| | None, _ -> raise (Failure "In primitive succ, argument is not char!\n")); | |
| char_f 'w'; | |
| None, Func (fun x -> try char_f (input_char stdin) with End_of_file -> x)];; | |
| let read_all filename = ( | |
| let f = open_in_bin filename in | |
| let size = in_channel_length f in | |
| let result = String.make size '\x00' in | |
| really_input f result 0 size; | |
| close_in f; | |
| result | |
| );; | |
| let filename = Sys.argv.(1) in | |
| interpret init_stack (read_all filename);; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment