スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

F#で入門 コンパイラ、インタプリタ編 BrainFuck

 今回は難解プログラミング言語BrainFuckを実装してみたいと思います。 
BrainFuckのF#での実装は,BLUEPIXYさんもこちらでされています。 
 
さてbrainFuckの詳しい仕様はこちらこちらを見て頂くことにして、 
まずはBrainFuckのソースコード中の[と]の対応をMapとして作成する補助関数を定義しておきます。 
 
> let makeMaps source_code = 
    let errorMes = "[と]の対応がとれていません。"  
    let rec makeMapsSub (map1:Map<int,int>) (map2:Map<int,int>) stackLst lst index = 
        match lst with 
        | [] when List.length stackLst = 0 ->(map1,map2) 
        | []                -> failwith errorMes 
        | h :: tl  when h = '[' -> makeMapsSub map1 map2 (index::stackLst) tl (index+1) 
        | h :: tl  when h = ']' -> match stackLst with 
                                   |[]      ->failwith errorMes 
                                   |sh::stl ->makeMapsSub (Map.add sh index map1) (Map.add index sh map2) stl tl (index+1) 
        | h :: tl               ->  makeMapsSub map1 map2 stackLst tl (index+1)   
    makeMapsSub  Map.empty Map.empty [] source_code 0     ;; 
 
val makeMaps : char list -> Map<int,int> * Map<int,int> 
 
(使用例) 
> makeMaps ['0';'[';'2';'[';'4';']';']';'7'];; 
val it : Map<int,int> * Map<int,int> = 
  (map [(1, 6); (3, 5)], map [(5, 3); (6, 1)]) 
 
これは1番目の[が6番目の]に対応し、3番目の[が5番目の]に対応するというmapと、その逆の 
5番目の]が3番目の[に対応し、6番目の]が1番目の[に対応するというmapを返します。 
 
次に記憶領域ですが、これは配列ではなくてMapで表現することにします。たとえば 
map[(1,3);(2,40)]というMapは番地1に3という値が記録されており、番地2に40という値が記録されているという意味になります。その他の番地は0が記録されていると解釈することにします。 
コード上ではこのMapにtapeという名前をつけています。またtape上の番地はtape_pという名前をつけています。 
 
ではコードです。 
 
> let makeMaps source_code = 
    let errorMes = "[と]の対応がとれていません。"  
    let rec makeMapsSub (map1:Map<int,int>) (map2:Map<int,int>) stackLst lst index = 
        match lst with 
        | [] when List.length stackLst = 0 ->(map1,map2) 
        | []                -> failwith errorMes 
        | h :: tl  when h = '[' -> makeMapsSub map1 map2 (index::stackLst) tl (index+1) 
        | h :: tl  when h = ']' -> match stackLst with 
                                   |[]      ->failwith errorMes 
                                   |sh::stl ->makeMapsSub (Map.add sh index map1) (Map.add index sh map2) stl tl (index+1) 
        | h :: tl               ->  makeMapsSub map1 map2 stackLst tl (index+1)   
    makeMapsSub  Map.empty Map.empty [] source_code 0                                 
 
//番地(ポインタ)に対応する記憶領域の値を返す 
let getTapeValue (tape:Map<int,int>) i = 
    let res = tape.TryFind i 
    if res.IsNone then 0 
    else tape.[i]  
 
//////////////         ソース  [と]の対応   ]と[の対応  ソースポンタ    tape  tape_p 
type state = (char[] * Map<int,int>*Map<int,int>)*int*             (Map<int,int>*int)  
     
let do_biggerThan (((source,map1,map2),source_pc,(tape,tape_p)):state)  = 
    ((source,map1,map2),(source_pc+1),(tape,tape_p + 1)) 
 
let do_smallerThan (((source,map1,map2),source_pc,(tape,tape_p)):state)  = 
    ((source,map1,map2),(source_pc+1),(tape,tape_p - 1)) 
 
let do_plus (((source,map1,map2),source_pc,(tape,tape_p)):state) = 
    ((source,map1,map2),(source_pc+1),(Map.add tape_p ((getTapeValue tape tape_p) + 1) tape, tape_p))      
 
let do_minus (((source,map1,map2),source_pc,(tape,tape_p)):state) = 
    ((source,map1,map2),(source_pc+1),(Map.add tape_p ((getTapeValue tape tape_p) - 1) tape, tape_p))      
 
let do_dot (((source,map1,map2),source_pc,(tape,tape_p)):state) = 
     printf "%c" (char (getTapeValue tape tape_p))     
     ((source,map1,map2),(source_pc+1),(tape,tape_p)) 
 
let do_comma (((source,map1,map2),source_pc,(tape,tape_p)):state) = 
    ((source,map1,map2),(source_pc+1),(Map.add tape_p (stdin.Read()) tape,tape_p)) 
 
let do_leftBracket (((source,map1,map2),source_pc,(tape,tape_p)):state) = 
    if getTapeValue tape tape_p <> 0 then 
       ((source,map1,map2),(source_pc+1),(tape,tape_p)) 
    else 
       ((source,map1,map2),(map1.[source_pc]+1),(tape,tape_p))   
 
let do_rightBracket (((source,map1,map2),source_pc,(tape,tape_p)):state) = 
    if getTapeValue tape tape_p = 0 then 
       ((source,map1,map2),(source_pc+1),(tape,tape_p)) 
    else 
       ((source,map1,map2),(map2.[source_pc]+1),(tape,tape_p))   
 
let do_nothing (((source,map1,map2),source_pc,(tape,tape_p)):state) = 
     ((source,map1,map2),(source_pc+1),(tape,tape_p)) 
 
let runBrain (sourceStr:string) = 
    let rec runBrainSub (t:state) = 
        let (((source:array<char>),_,_),source_pc,(tape,tape_p)) = t 
         
        if  source_pc >= source.Length then () 
        elif source.[source_pc] = '>' then t |> do_biggerThan  |> runBrainSub 
        elif source.[source_pc] = '<' then t |> do_smallerThan |> runBrainSub 
        elif source.[source_pc] = '+' then t |> do_plus        |> runBrainSub 
        elif source.[source_pc] = '-' then t |> do_minus       |> runBrainSub 
        elif source.[source_pc] = '.' then t |> do_dot         |> runBrainSub 
        elif source.[source_pc] = ',' then t |> do_comma       |> runBrainSub 
        elif source.[source_pc] = '[' then t |> do_leftBracket |> runBrainSub 
        elif source.[source_pc] = ']' then t |> do_rightBracket|> runBrainSub 
        else                               t |> do_nothing     |> runBrainSub    
    let sourceCharLst = sourceStr.ToCharArray() 
    let map1,map2 = makeMaps (sourceCharLst |> List.ofArray ) 
    let tapeOri = Map.empty 
    runBrainSub ((sourceCharLst,map1,map2),0,(tapeOri,0)) 
    printfn "";; 
 
val makeMaps : char list -> Map<int,int> * Map<int,int> 
val getTapeValue : Map<int,int> -> int -> int 
中略 
val runBrain : string -> unit 
 
(実行例) 
 
> runBrain ">+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]>++++++++[<++ 
++>-]<.>+++++++++++[<+++++>-]<.>++++++++[<+++>-]<.+++.------.--------.[-]> 
++++++++[<++++>-]<+.[-]++++++++++.";; 
Hello World! 
 
val it : unit = () 
スポンサーサイト

テーマ : プログラミング
ジャンル : コンピュータ

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

Author:T GYOUTEN
F#と英単語とフリーソフトと読書に興味があります。
ホームページでフリーソフトも公開しています。どぞ御贔屓に。

最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
フリーエリア
フリーエリア
blogram投票ボタン
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる

QRコード
QRコード
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。