スポンサーサイト

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

F#で入門 コンパイラ、インタプリタ編 befunge93(1)

 今回はbefunge93という言語のインタプリタを実装してみました。言語の説明はこちらです。
 
ではコードです。 
 
> ////////////////入出力用関数ホルダ////////////////  
let mutable forInputIntFunc :(unit->int)    = (fun () -> 0)  
let mutable forInputCharFunc :(unit->int)   = (fun () -> 0) 
let mutable forOutputIntFunc:(int->unit) = (fun _ -> ())  
let mutable forOutputCharFunc:(int->unit) = (fun _ -> ())  
 
 
let MaxRowNum = 80 
let MaxColNum = 25 
let MaxRowIndex = MaxRowNum - 1 
let MaxColIndex = MaxColNum - 1 
 
//次の二つの命令に対処するために実行モードを定義する 
//" 次に"が出現するまで、文字の命令を実行する代わりに文字のASCIIコードをスタックにプッシュする  
//# 次の文字が表す命令を実行しない  
 
type ExecMode = 
    |ONCE_EXEC_STOP 
    |ASCII_PUSH 
    |DEFAULT 
    |EXIT 
 
//プログラムポインタの向き 
type Direct = 
    |UP  
    |DOWN 
    |RIGHT 
    |LEFT 
 
//list<string>を2DArrayに変換 
let makeCode2DArr (inpStrLst:list<string>) = 
    let (codeArr:char[,]) = Array2D.create  MaxRowNum MaxColNum ' ' 
    inpStrLst 
       |> List.mapi (fun i st -> let cArr = st.ToCharArray()  
                                 for index in [0 .. ((Array.length cArr) - 1)] do 
                                      codeArr.[i,index] <- cArr.[index] 
                  )  
       |> ignore 
                                 
    codeArr    
 
//方向とindexの組から次のindexを返す 
//getNextCoord UP (3,2)  ->  (2, 2) 
let getNextCoord (dir:Direct) ((c,r):int*int) = 
    match dir with 
    |UP when c = 0              -> (MaxRowIndex,r) 
    |UP                         -> (c - 1 ,r) 
    |DOWN when c = MaxRowIndex  -> (0,r) 
    |DOWN                       -> (c + 1,r) 
    |LEFT when r = 0            -> (c,MaxRowIndex) 
    |LEFT                       -> (c, r - 1) 
    |RIGHT when r = MaxColIndex -> (c,0) 
    |RIGHT                      -> (c, r + 1)  
 
//スタック関連のエラー int*intはエラーの発生したコードの行と列 
exception MyStackExcp of int*int 
//ソース中に不正なcharactorが含まれていた時のエラー int*intはエラーの発生したコードの行と列 
exception MyCodeExcp of int*int 
 
//スタック処理用の補助関数 
let listOnePopAppFuncResPush (lst:list<int>)  (f:int->int) (r:int) (c:int) = 
    match lst with 
    |hd::tl -> (f hd)::tl 
    | _ -> raise <| MyStackExcp(r,c)  
 
//スタック処理用の補助関数 
let listTwoPopAppFuncResPush (lst:list<int>)  (g:int->int ->int) (r:int) (c:int) = 
    match lst with 
    |y::x::tl -> (g x y)::tl 
    | _ -> raise <| MyStackExcp(r,c)  
 
//一文字読み込む度に変化する可能性のあるものをまとめるための型 
//      モード  向き コード2Darray スタック   (行、列)  
type state = ExecMode*Direct* char[,] *     list<int>*(int*int) 
 
//処理のワンスステップ毎の処理 引数も返り値もstate型 
let oneStepProc ((excMode,dir,code,stack,(r,c)):state) = 
    let tarChar = code.[r,c] 
    match excMode with 
    // # 次の文字が表す命令を実行しない  
    |DEFAULT when tarChar = '#' 
                         -> (ONCE_EXEC_STOP,dir,code,stack,(getNextCoord dir (r,c)))  
    |ONCE_EXEC_STOP  -> (DEFAULT ,dir ,code, stack, (getNextCoord dir (r,c))) 
     
    // " 次に"が出現するまで、文字の命令を実行する代わりに文字のASCIIコードをスタックにプッシュする 
    |DEFAULT when tarChar = '\"' 
                         -> (ASCII_PUSH, dir, code, stack ,(getNextCoord dir (r,c))) 
    |ASCII_PUSH when tarChar = '\"' 
                         -> (DEFAULT, dir, code, stack, (getNextCoord dir (r,c))) 
    |ASCII_PUSH          -> (ASCII_PUSH ,dir, code, (int(tarChar) :: stack), (getNextCoord dir (r,c))) 
    // @ プログラムの実行を停止する  
    |DEFAULT when tarChar = '@' 
                         -> (EXIT,dir,code,stack,(r,c))  
    // < 実行の向きを左にする   
    |DEFAULT when tarChar = '<' 
                         -> (DEFAULT,LEFT,code,stack, (getNextCoord LEFT (r,c))) 
    // > 実行の向きを右にする  
    |DEFAULT when tarChar = '>' 
                         -> (DEFAULT,RIGHT,code,stack,(getNextCoord RIGHT (r,c))) 
    // ^ 実行の向きを上にする  
    |DEFAULT when tarChar = '^' 
                         -> (DEFAULT,UP,code,stack, (getNextCoord UP (r,c))) 
    // v 実行の向きを下にする  
    |DEFAULT when tarChar = 'v' 
                         -> (DEFAULT, DOWN, code,stack, (getNextCoord DOWN (r,c))) 
    // _ スタックをポップして、その値が0ならば実行の向きを右に、そうでなければ左にする 
    |DEFAULT when tarChar = '_' 
                         -> match stack with 
                            |hd::tl when hd = 0 ->  (DEFAULT,RIGHT,code,tl,(getNextCoord RIGHT (r,c))) 
                            |hd::tl             ->  (DEFAULT,LEFT,code,tl,(getNextCoord LEFT (r,c))) 
                            | _                 ->   raise <| MyStackExcp(r,c) 
    // | スタックをポップして、その値が0ならば実行の向きを下に、そうでなければ上にする  
    |DEFAULT when tarChar = '|' 
                         -> match stack with 
                            |hd::tl when hd = 0 ->  (DEFAULT,DOWN,code,tl,(getNextCoord DOWN (r,c))) 
                            |hd::tl             ->  (DEFAULT,  UP,code,tl,(getNextCoord UP   (r,c))) 
                            | _                 ->  raise <| MyStackExcp(r,c) 
    // ? 実行の向きを上下左右のいずれかにランダムで変更する。  
    |DEFAULT when tarChar = '?' 
                        ->let rnd = new System.Random() 
                          let rndNum = rnd.Next(4) 
                          if   rndNum = 0 then (DEFAULT,UP,   code,stack,(getNextCoord UP    (r,c))) 
                          elif rndNum = 1 then (DEFAULT,DOWN, code,stack,(getNextCoord DOWN  (r,c))) 
                          elif rndNum = 2 then (DEFAULT,RIGHT,code,stack,(getNextCoord RIGHT (r,c))) 
                          else                 (DEFAULT,LEFT, code,stack,(getNextCoord LEFT  (r,c))) 
    // (空白) 何もしない  
    |DEFAULT when tarChar = ' ' 
                         -> (DEFAULT,dir,code,stack,(getNextCoord dir (r,c))) 
    // 0-9 数値をスタックにプッシュする  
    |DEFAULT when tarChar >= '0'&& tarChar <= '9' 
                         -> (DEFAULT,dir,code,((int(tarChar) - int('0'))::stack),(getNextCoord dir (r,c))) 
     
    // & ユーザに数値を入力させ、その値をスタックにプッシュする  
    |DEFAULT when tarChar = '&'  
                        -> (DEFAULT,dir,code,((forInputIntFunc ())::stack),(getNextCoord dir (r,c)))                
 
    // ~ ユーザにchar値を入力させ、その値をスタックにプッシュする  
    |DEFAULT when tarChar = '~'  
                        -> (DEFAULT,dir,code,((forInputCharFunc ())::stack),(getNextCoord dir (r,c)))                
 
    //. スタックをポップして、その値を十進表示し、続けて半角スペースを出力する  
    |DEFAULT when tarChar = '.'  
                         -> match stack with 
                            |hd::tl      -> forOutputIntFunc hd  
                                            (DEFAULT,  dir,code,tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
                          
    // ,スタックをポップして、その値をASCIIコードに持つ文字を表示する  
    |DEFAULT when tarChar = ','  
                         -> match stack with 
                            |hd::tl      -> forOutputCharFunc hd  
                                            (DEFAULT,  dir,code,tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
                         
                                 
    // + スタックから y, x をポップして、x + y の値をプッシュする  
    |DEFAULT when tarChar = '+' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (+) r c, 
                             (getNextCoord dir (r,c))) 
 
    // - スタックから y, x をポップして、x - y の値をプッシュする  
    |DEFAULT when tarChar = '-' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (-) r c, 
                             (getNextCoord dir (r,c))) 
 
    // * スタックから y, x をポップして、x × y の値をプッシュする  
    |DEFAULT when tarChar = '*' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (*) r c, 
                             (getNextCoord dir (r,c))) 
 
    // / スタックから y, x をポップして、x / y の値をプッシュする  
    |DEFAULT when tarChar = '/' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (/) r c, 
                             (getNextCoord dir (r,c))) 
 
    // % スタックから y, x をポップして、x を y で割ったときの余りをプッシュする   
    |DEFAULT when tarChar = '%' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (%) r c, 
                             (getNextCoord dir (r,c))) 
 
    // ` スタックから y, x をポップして、x > y ならば 1 を、そうでなければ 0 をプッシュする  
    |DEFAULT when tarChar = '`' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (fun x y -> if x > y then 1 else 0) r c, 
                             (getNextCoord dir (r,c))) 
 
     // ! スタックをポップして、その値が 0 ならば 1 を、そうでなければ 0 をプッシュする   
    |DEFAULT when tarChar = '!' 
                         -> (DEFAULT,dir,code, 
                             listOnePopAppFuncResPush stack (fun x  -> if x =0 then 1 else 0) r c, 
                             (getNextCoord dir (r,c))) 
  
 
    // : スタックをポップして、その値を2回プッシュする 
    |DEFAULT when tarChar = ':'  
                         -> match stack with 
                            |hd::tl      ->  (DEFAULT,  dir,code,hd::hd::tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
  
    // \ スタックから y, x をポップして y をプッシュし、その後 x をプッシュする  
    |DEFAULT when tarChar = '\\'  
                         -> match stack with 
                            |y::x::tl    ->  (DEFAULT,  dir,code,x::y::tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
  
    // $ スタックをポップして、その値を使用しない  
    |DEFAULT when tarChar = '$'  
                         -> match stack with 
                            |hd::tl    ->  (DEFAULT,  dir,code,tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
  
    // g スタックから y, x をポップして、プログラムの y 行 x 桁目の文字のASCIIコードをスタックにプッシュする  
    |DEFAULT when tarChar = 'g'  
                         -> match stack with 
                            |y::x::tl    -> (DEFAULT,  dir,code,((int code.[y,x])::tl),(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
 
    // p スタックから y, x, v をポップして、プログラムの y 行 x 桁目を、v をASCIIコードに持つ文字に書き換える  
    |DEFAULT when tarChar = 'p'  
                         -> match stack with 
                            |y::x::v::tl    ->code.[y,x] <- char v  
                                              (DEFAULT,  dir,code,tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
     
    //対応するものがない 
    |_                   ->raise <| MyCodeExcp(r,c) 
 
 
let consoleMain (src:list<string>) = 
    //コンソールアプリ用の入出力関数  
    forInputIntFunc <- (fun () -> printfn "数値を入力してください"  
                                  System.Int32.Parse(System.Console.ReadLine () )  
                        ) 
 
    forInputCharFunc <- (fun () -> printfn "一文字入力してください"  
                                   System.Console.Read ()   
                        ) 
 
 
    forOutputIntFunc <- (fun i -> printf "%d " i)  
 
    forOutputCharFunc <- (fun i -> printf "%c" (char i)) 
 
    //oneStepProcを繰り返し適用していく関数 
    let rec doProcess ((excMode,dir,code,stack,(r,c)) as t :state) = 
        match excMode with 
        |EXIT -> () 
        | _ ->let (nextExcMode,nextDir,nextCode,nextStack,(nextR,nextC)) = oneStepProc t  
              //ここでstack,nextStack等を表示すれば、進捗を表示できる 
              //printfn "%d %d -> %c %A " r c code.[r,c] stack 
              doProcess (nextExcMode,nextDir,nextCode,nextStack,(nextR,nextC)) 
 
    //ソース(list<string>型)をchar[,]に変換 
    let codeOri = makeCode2DArr src 
     
    //doProcessを実行 
    try 
        doProcess (DEFAULT,RIGHT,codeOri,[],(0,0)) 
    with 
    |MyStackExcp(r,c) -> printfn "%d行%d列でスタックエラー" r c 
    |MyCodeExcp(r,c)  -> printfn "%d行%d列でコードの文字エラー" r c ;; 
 
val mutable forInputIntFunc : (unit -> int) 
val mutable forInputCharFunc : (unit -> int) 
val mutable forOutputIntFunc : (int -> unit) 
val mutable forOutputCharFunc : (int -> unit) 
val MaxRowNum : int = 80 
val MaxColNum : int = 25 
val MaxRowIndex : int = 79 
val MaxColIndex : int = 24 
type ExecMode = 
  | ONCE_EXEC_STOP 
  | ASCII_PUSH 
  | DEFAULT 
  | EXIT 
type Direct = 
  | UP 
  | DOWN 
  | RIGHT 
  | LEFT 
val makeCode2DArr : string list -> char [,] 
val getNextCoord : Direct -> int * int -> int * int 
exception MyStackExcp of int * int 
exception MyCodeExcp of int * int 
val listOnePopAppFuncResPush : 
  int list -> (int -> int) -> int -> int -> int list 
val listTwoPopAppFuncResPush : 
  int list -> (int -> int -> int) -> int -> int -> int list 
type state = ExecMode * Direct * char [,] * int list * (int * int) 
val oneStepProc : 
  ExecMode * Direct * char [,] * int list * (int * int) -> 
    ExecMode * Direct * char [,] * int list * (int * int) 
val consoleMain : string list -> unit 
 
>  
(実行例) 
 
> consoleMain ["v @_       v";">0\"!dlroW\"v ";"v  :#     < ";">\" ,olleH\" v";"   ^       <"];; 
Hello, World!val it : unit = () 
 
> consoleMain ["5 100p:v";"v *g00:_00g.@";">00p1-:^"];; 
120 val it : unit = () 
 
次回はこれをウィンドウソフト化してみます。
スポンサーサイト

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

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

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

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

この人とブロともになる

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