So-net無料ブログ作成
検索選択

OCaml で書く Tcl インタプリタ 2 [OCaml]

ちょっと前に書いた Tcl インタプリタ [1] を Camlp4 のストリームパーサを使って書き直してみた。他にもスタイル的な部分でちょこちょこと変えた。

最初ガード条件をどうやって書けばいいのか分からなくて詰まった。

module StringMap = Map.Make(String)
exception Unknown_command

type interp = {
    result : string;
    g : string StringMap.t;
}

type state = {
    openBraces : int;
    argv : string list;
    buf : string;
    nest : bool;
}

let string_of_char c = String.make 1 c

let invoke interp argv = 
    let argv = List.rev argv in
    match argv with
    | "puts"::str::[] -> Printf.printf "%s\n" str; interp
    | "set"::name::[] -> {interp with result = StringMap.find name interp.g}
    | "set"::name::value::[] -> {g = StringMap.add name value interp.g; result = value}
    | _ -> raise Unknown_command

let backslash = parser
    | [< ''\n' >] -> ' '
    | [< ''n'  >] -> '\n'
    | [< ''t'  >] -> '\t'
    | [< 'c    >] -> c
    | [<       >] -> '\\'

let rec varsub interp name = parser
    | [< ''A'..'Z' | 'a'..'z' | '_' | '0'..'9' as c; strm>]
            -> varsub interp (name ^ string_of_char c) strm
    | [< >] -> if name = "" then "$" else StringMap.find name interp.g

let argv_of_state state =
    if state.buf="" then state.argv else state.buf::state.argv
let add_arg state =
    {state with argv = state.buf::state.argv; buf = ""}
let ($^) state c = 
    {state with buf = state.buf ^ string_of_char c}
let ($^^) state s = 
    {state with buf = state.buf ^ s}
let flush state =
    {state with argv = []; buf = ""}
let incrbrace state =
    {state with openBraces = state.openBraces + 1}
let decrbrace state =
    {state with openBraces = state.openBraces - 1}

let rec eval interp state = parser
    | [< '' '|'\t'|'\r'|'\n'|';'; strm >] -> eval interp state strm
    | [< ''#'; strm >] -> comment interp state strm
    | [< strm >] -> command interp state strm
and comment interp state = parser
    | [< ''\n'; strm >] -> eval interp state strm
    | [< ''\\'; strm >] -> ignore (backslash strm); comment interp state strm
    | [< '_;    strm >] -> comment interp state strm
    | [<        strm >] -> interp
and command interp state = parser
    | [< '']' when state.nest; >] -> invoke interp (argv_of_state state)
    | [< '';'|'\n'; strm >] ->
        eval (invoke interp (argv_of_state state)) (flush state) strm
    | [< ''\\'; strm >] ->
        command interp (state $^ backslash strm) strm
    | [< '' '|'\t'|'\r' when state.buf = ""; strm >] ->
        command interp state strm
    | [< '' '|'\t'|'\r'; strm >] -> command interp (add_arg state) strm
    | [< ''{'  when state.buf = ""; strm >] ->
        brace interp {state with openBraces = 1} strm
    | [< ''\"' when state.buf = ""; strm >] ->
        quote interp state strm
    | [< ''$'; strm >] ->
        command interp (state $^^ varsub interp "" strm) strm
    | [< ''['; strm >] ->
        let interp = cmdsub interp strm state in
        command interp (state $^^ interp.result) strm
    | [< 'c; strm >] -> command interp (state $^ c) strm
    | [< >] ->
        let argv = argv_of_state state in
        if argv = [] then
            interp
        else
            invoke interp argv
and brace interp state = parser
    | [< ''\\' as c; strm >] -> brace interp (state $^ c) strm
    | [< ''{'  as c; strm >] -> brace interp (incrbrace (state $^c)) strm
    | [< ''}'  as c; strm >] ->
        if state.openBraces = 1 then
            command interp (decrbrace (add_arg state)) strm
        else
            brace interp (decrbrace (state $^ c)) strm
    | [< 'c; strm >] -> brace interp (state $^ c) strm
    | [<     strm >] -> command interp state strm
and quote interp state = parser
    | [< ''\\'; strm >] -> quote interp (state $^ backslash strm) strm
    | [< ''\"'; strm >] -> command interp (add_arg state) strm
    | [< ''$';  strm >] -> quote interp (state $^^ varsub interp "" strm)  strm
    | [< ''[';  strm >] -> let interp = cmdsub interp strm state in
                           quote interp (state $^^ interp.result) strm
    | [< 'c;    strm >] -> quote interp (state $^ c) strm
    | [<        strm >] -> command interp state strm
and cmdsub interp strm state =
    eval interp {openBraces = 0; argv = []; buf= "" ; nest = true;} strm

let inch = open_in Sys.argv.(1);;
let instr = Stream.of_channel inch;;
let _ = eval {result = ""; g = StringMap.empty}
             {openBraces = 0; argv = []; buf=""; nest = false;}
             instr;;

[1] http://blog.so-net.ne.jp/rainyday/2006-09-25


nice!(0)  コメント(0)  トラックバック(0) 

nice! 0

コメント 0

コメントを書く

お名前:
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0

この記事のトラックバックURL:
※言及リンクのないトラックバックは受信されません。

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。