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

ほむ。F#でプログラミング言語「ほむほむ」して、さらに「ほむほむ」した

プログラミング F#2.0 F# ほむほむ Grass

元ネタは、ゆろよろさんの
プログラミング言語「ほむほむ」 - ゆろよろ日記(id:yuroyoro)
http://d.hatena.ne.jp/yuroyoro/20110601/1306908421


F#でプログラミング言語「ほむほむ」

以前実装したF#でGrassなプログラムをちょっと改造しただけの手抜きだが、
F#でプログラミング言語「ほむほむ」実装した。
https://gist.github.com/1002805

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) () 

open System.Text.RegularExpressions 
let rx = new Regex(@"\r\n|ほむ|(?<homu>[\s|\t]+[ほむ{1,}]+[\s$|\t$])")
let ReadFile filename = System.IO.File.ReadAllText(filename,System.Text.Encoding.GetEncoding("SHIFT-JIS")) 
let source = let source = @"c:\Code\ほむほむ\ほむほむ.txt" |>  ReadFile 
             seq { for s in rx.Matches(source) do 
                    let s = s.ToString()
                    if s = "ほむ" then
                      yield 'w'
                    elif Regex.IsMatch(s,"[\s|\t]+[ほむ{1,}]+[\s$|\t$]") then
                      for s in Regex.Matches(s,"ほむ") do
                        yield 'W' 
                    elif s = "\r\n" then 
                      yield 'v' } |> Seq.toArray 

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' -> i + 1, Tw
           | 'W' -> i + 1, TW
           | '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


以前、F#でちょっと草植えた記事はこちら
http://d.hatena.ne.jp/zecl/20100418/p1




オリジナルのほむほむのコードを書いてみる。

プログラミング言語「ほむほむ」で「ほむほむ」と出力してみる。


ほむほむ.txt

ほむ
ほむほむ ほむほむ ほむ ほむほむほむ ほむ
 ほむ ほむほむほむほむ ほむほむ ほむ ほむほむほむ ほむ ほむほむほむほむ ほむ ほむほむほむほむほむ ほむ ほむほむほむほむほむほむ ほむ ほむほむほむほむほむほむほむ ほむ ほむほむほむほむほむほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむ ほむ ほむほむほむほむ ほむ ほむほむほむほむほむほむほむ ほむ ほむほむほむほむほむほむほむほむほむほむ ほむ ほむほむほむほむほむほむほむほむほむほむほむほむほむ ほむ ほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむ ほむ ほむほむほむほむほむほむほむほむほむ ほむ ほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむ ほむ ほむほむほむほむほむほむほむほむほむほむほむ ほむ ほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむ ほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむほむ ほむほむほむほむ


実行結果

ほむほむ


ほむほむ。実にほむほむですね。
ほむほむでほむほむできました。わーいやたーー＼(^o^)／



追伸：オープンソースカンファレンス 2011 Hokkaidoに参加します。

のぶひささん(id:Nobuhisa)にお誘いいただきまして、OSC 2011 Hokkaidoに「F# User Group - Japan」のメンバーとして参加します。
セミナーを受講していないときは展示ブースにおりますのでので、ぜひお立ち寄りいただけたらと思います。
展示用のアプリ(F#+Silverlightな何か)を持参する予定です。よろしくお願いします。


もちろん、のぶひささんのセッションは見逃せません！！

これからの「言語」の話をしよう ―― 未来を生きるためのツール

http://d.hatena.ne.jp/Nobuhisa/20110528