ようこそ。睡眠不足なプログラマのチラ裏です。

C#とF#で、ちょっと草植えときますね型言語 Grassインタプリタを実装してみました。

第47回 CLR/H 勉強会(4/17)に参加しました。今回で6回目くらいですかね。
楽しく有意義な時間を過ごせました。講師の方、参加者のみなさんどうもありがとうございました!
今回はじめて、わたしもライトニングトークに登壇させて頂きました。
もともと人前で話すのは得意ではないのですが、うまくしゃべれなかったことに少しへこんでいます。


第47回 CLR/H 勉強会 zecl LT資料


ちょっと草植えときますね型言語 Grass 公式サイト


というわけで、.NET(C#とF#)で草を生やしてみました。前々から実装したいなと思っていたのが、ようやく実現です。
C#による実装は公式サイトにあるJavaの実装を真似てアレンジしただけなので、掲載は控えます。
以下に、F#による実装を掲載します。とりあえず動くようになった段階では180行近くあったのですが、
リファクタリングをすることでかなりスリムでシンプルなコードになりました。
関数プログラミングの理解をより深めるためにも、リファクタリングをすることはかなり有効だと思いました。



F#でちょっと草植えときますねwww

Console出力で、Shift-JISが文字化けしないように工夫してあります。

open System

type token = Tw | TW | Tv | EoF
type Value = Value of char option * (Value -> Value)

let Write =
  let queue = new System.Collections.Generic.Queue<byte> ()
  (fun _ (c : char) ->
  let (|HEIGHT|_|) x = match x with | x when x >= 0x81uy && x <= 0x9Fuy || x >= 0xE0uy -> Some x | _ -> None
  let (|LOW|_|) x = match x with | x when x >= 0x40uy && x <= 0x7Euy || x >= 0x80uy && x <= 0xFCuy -> Some x | _ -> None
  match c |> byte with
   | HEIGHT x when queue.Count = 0 -> x |> queue.Enqueue 
   | LOW x when queue.Count <> 0 -> [|queue.Dequeue (); x|] |> System.Text.Encoding.GetEncoding(932).GetString |> Console.Write 
   | _ -> Console.Write c) ()

let Char x = Value (Some x, fun y ->
  let True = Value (None, fun x -> Value (None, fun _ -> x))
  let False = Value (None, fun _ -> Value (None, fun y -> y))
  match y with 
   | Value (Some y, _) -> match x,y with | x,y when x = y -> True | _ -> False
   | _ -> raise (new ArgumentException("Char : char以外はだめ")))

let InitStack = [
  Value (None, function
    | Value (Some c, _) as v -> Write c; v
    | _ -> raise (new ArgumentException("primitive Out : char以外はだめ")));  
  Value (None, function
    | Value (Some c, _) -> (int c + 1) % 256 |> char |> Char
    | _ -> raise (new ArgumentException("primitive Succ : char以外はだめ"))); 
  Char 'w';
  Value (None, fun x -> try stdin.ToString() |> char |> Char with eof -> x)]  

let Stack = (fun _ -> let stack = ref InitStack
                      fun x -> match x with 
                                | [] -> !stack 
                                | _  -> stack := x @ !stack; !stack) () 

let ReadFile filename = System.IO.File.ReadAllText(filename,System.Text.Encoding.GetEncoding("SHIFT-JIS")) 
let source = @"c:\Code\Grass\はいはいわろすわろす.txt" |>  ReadFile 

let rec Analyze i = 
  let (|EOF|_|) x = match x with | x when x >= source.Length  -> Some x | _ -> None
  match i with 
   | EOF i -> i, EoF
   | _ -> match source.[i] with
           | 'w'|'w' -> i + 1, Tw
           | 'W'|'W' -> i + 1, TW
           | 'v'|'v' -> i + 1, Tv
           | _ -> Analyze (i + 1)

let rec Read target (index, token as position) i = 
  match token,target with 
    | token,target when token = target -> Read target (Analyze index) (i + 1)
    | _ -> position, i

let rec ReadBody position body = 
  let position, f = Read TW position 0 
  match f with 
   | 0 -> (position, List.rev body) 
   | _ -> let position, a = Read Tw position 0 
          ReadBody position ((f, a) :: body)

let rec App f a stack = 
  match stack with
   | [] -> raise (new ArgumentException("stack"))
   | v::st ->
    match a,f with
     | 1,_ -> let Value = List.nth stack (f - 1) 
              match Value with 
               | Value (c,func) -> func v
     | _,1 -> let arg = List.nth stack (a - 1) 
              let value  =  List.nth stack (f - 1)
              match value with 
               | Value (c,func) -> func arg
     | _   -> st |> App (f - 1) (a - 1)      

let Run = 
  let rec Run (index, token as position) = 
    match token with
      | EoF -> [] |> Stack |> App 1 1 |> ignore
      | Tw ->
        let position, argc = Read Tw position 0 
        let position, body = ReadBody position [] 
        let rec bind n stack arg = 
          let stack = arg :: stack
          match n with
           | 1 -> let rec loop stack body = 
                    match body with
                     | [] -> List.head stack
                     | (f, a) :: [] -> stack |> App f a
                     | (f, a) :: br -> loop ((stack |> App f a) :: stack) br
                  loop stack body
           | _ -> Value (None, bind (n - 1) stack)  
        [Value (None, bind argc (Stack[]))] |> Stack |> ignore
        Run position
      | TW ->
        let position, f = Read TW position 0 
        let position, a = Read Tw position 0
        [Stack [] |> App f a] |> Stack |> ignore
        Run position
      | Tv -> Run (Analyze index)

  let start = 
    let rec loop i = 
      let (index, token) as result = Analyze i 
      match token with
       | Tw | EoF -> result 
       | _ -> loop index
    loop 0
  start |> Run

[<STAThreadAttribute>]
do
  Run; stdin.ReadLine () |> ignore


はいはいわろすわろす.txt

----------------------------------------------------------------------------------------------
wwwwvwvwwWWwvwwWwwvwwwwWWWwwWwwWWWWWWwwwwWw
wvwWWwWwwvwWWWwwwwwWwwwwwwWWwWWWwWWWWWWwW
WWWWWWWwwwWwwWWWWWWWWWWwWwwwwwWWWWWWWW
WWWwwwwwWWWWWWWWWWWWwwwwWWWWWWWWWWWWW
wwwWWWWWWWWWWWWWWwwwWWWWWWWWWWWWWWWwW
WWWWWWWWWWWWWWWWWwwwWwwwwwwwwwwwwwwWWWW
WWWWWWWWWWWWWWWwwwwwwwwWwwWWWWWWWWWWW
WWWWWWWWWWWWWwwwwwwwwwwwwwwwwwwwwwwwwWwwww
wwwwwwwwwwwwwwwww             wwwwwwwwWWwwwwwww
wwwwwwwwwwwwwwwww          は   wwwwwWWWWWWWWWW
WWWWWwWwwwWWWW    わ   い   WWWWWWWwwwWwwWW
WWWWWWWWWWwwww    ろ   は    wWwwwwwwwWWWWWWW
WWWWWWWWWWwwww    す   い   wwwWwwWWWWWWWWW
WWWWWWWWWwwwww     わ       wwwwWwwWWWWWWWW
WWWWWWWWWWWWW    ろ       WWWWWWWWWwwwwww
wwwwwWwwWWWWWWW    す       WWWWWWWWWwwwwww
wwwwwwwWwwwwwwwww             wwwwwwWWWWWWWWW
WWWWWWWWwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
wwwwwwWwwwwwwwwwwwwwwWWwwwwwwwwwWWWwwWWWWwww
wwwwwwwwwwwwWWWWWwwWWWWWWwwwwWWWWWWWwwWWW
WWWWWwwwwWWWWWWWWWwwWWWWWWWWWWwwwwwwwww
wwwwWWWWWWWWWWWWWWWWWWWWWWWWWWWWwwwwww
wwwwwWwwwWWwwwwwwwwwwwwwwwwwwWWWwwWWWWwwwwww
wwwwwwwwwwwwwwwwwwWWWWWwwWWWWWWwwwwwwwWWWW
WWWwwWWWWWWWWwwwwwwWWWWWWWWWwwWWWWWWWW
WWwwwwwwWWWWWWWWWWWwwwwwwwwwwwwwwwwwwwwwww
----------------------------------------------------------------------------------------------


実行結果

はいはいわろすわろす


関数型言語F#の潜在能力を垣間見た気がします。
もっと修行を積めば、さらにシンプルさを追求できるかも!F#流行るといいな〜


おまけ
GUI版もつくりました。シンタックスハイライトきいてますw