スポンサーサイト

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

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

 Whitespaceは「空白」「タブ」「改行」の三種類の文字から構成されたソースを読み込んで、動作するよう定義された、プログラミング言語でした。これのソースを目に見えるように変換する関数visualizeを定義しさらにCommand型の配列に変換する関数makeCArrayを定義しました。 
 
空白コード----visualize ------->("tssnsrrt")-------makeCArray------>[|SDup;SPush 5|] 
 
またソースを読み込み処理するときに変化していくものとして次のようなものを考えました。 
 
pc     次に実行するcomArrのインデックスを表す 型int 
stcLst スタックを表現するリスト     型list<int> 
heapMap ヒープ領域を表現するMap     型Map<int,int> 
rIndexLst リターンするべきインデックスを収めたリスト 型list<int> 
 
これらをまとめてタプルにして型の別名をつけておきました。 
type WState = int*list<int>*Map<int,int>*list<int> 
 
更にCommandを処理するときに実行する関数としてdo_SDup等を定義しました。 
 
例 
>do_SDup (0,[1;2],Map.empty,0,[]) 
val it : int * int list * Map<int,int> * int list = (0,[1; 1; 2], map [], [])   
 
今回はCommand[]を読み込んで、順次対応する関数を適用し状態WStateを変化させていく関数を定義します。 
 
その前にWhiltespaceでは、プログラムの終了に対応する命令"nnn"があるのでこれに対応するよう準備しておきます。追加変更場所は3か所です。 
 
(1)Command Type への追加 
type Command = 
    |SPush of int 
    ........... 
    |FExit 
 
(2)ComKindLstへの追加 
let ComKindLst = 
     [( new Regex("^ss(?<num_part>(s|t)(s|t)+)n"), 
     ........... 
      ); 
      ( new Regex("^nnn"), 
        (fun (rg:Regex) str -> let wholeMatch = rg.Match(str) 
                               if wholeMatch.Success = true then 
                                    Some(FExit,wholeMatch.Length) 
                               else None) 
      ) 
      ]      
 
(3)対応する関数の追加 
最後の命令なので、WStateではなくてunitを返すようにします。 
> let do_FExit ((pc,stcLst,heapMap,rIndexLst):WState) =     
    ();; 
 
val do_FExit : int * int list * Map<int,int> * int list -> unit 
 
ではCommand[]を読み込んで、順次対応する関数を適用し状態WStateを変化させていく関数の定義です。 
引数はCommand[]型の値とWState型の値とします。 
 
> let rec processCmd (cmds :Command[]) ((pc,stcLst,heapMap,rIndexLst) as t:WState) = 
    if pc < 0 || pc >= Array.length cmds then failwith (sprintf "index:%d pcが領域外です" pc) 
    printfn "%A" t  //デバック用 
    let cur_cmd = cmds.[pc] 
    printfn "%A" cur_cmd //デバック用 
    match cur_cmd with 
    |SPush(num)  -> do_SPush num t  |> (processCmd cmds) 
    |SDup        -> do_SDup t       |> (processCmd cmds) 
    |SCopy (n)   -> do_SCopy n t    |> (processCmd cmds) 
    |SSwap       -> do_SSwap t      |> (processCmd cmds) 
    |SDiscard    -> do_SDiscard t   |> (processCmd cmds) 
    |SSlide (n)  -> do_SSlide n t   |> (processCmd cmds) 
    |FExit       -> do_FExit t 
;; 
 
val processCmd : 
  Command [] -> int * int list * Map<int,int> * int list -> unit 
   
使用例 
 
> processCmd [|SPush(3);SPush(1);SDup;SCopy(1);SPush(5);SSwap;SDiscard;SSlide(1);FExit|] (0,[],Map.empty,[]);; 
(0, [], map [], []) 
SPush 3 
(1, [3], map [], []) 
SPush 1 
(2, [1; 3], map [], []) 
SDup 
(3, [1; 1; 3], map [], []) 
SCopy 1 
(4, [1; 1; 1; 3], map [], []) 
SPush 5 
(5, [5; 1; 1; 1; 3], map [], []) 
SSwap 
(6, [1; 5; 1; 1; 3], map [], []) 
SDiscard 
(7, [5; 1; 1; 3], map [], []) 
SSlide 1 
(8, [5; 1; 3], map [], []) 
FExit 
val it : unit = () 
 
ここまでのコードは以下の通り。 
 open System.Text.RegularExpressions 
 
let myReplace (regStr:string) (repStr:string) (oriSrcStr:string)= 
    (new Regex(regStr)).Replace(oriSrcStr,repStr) 
 
let visualize (src:string) = 
    src 
    |> myReplace "[^\s]" "" 
    |> myReplace " " "s" 
    |> myReplace "\t" "t" 
    |> myReplace "\n" "n" 
 
let wToNum (str:string) = 
    let strbiNum = 
        str.Substring(1) 
        |> myReplace "s" "0" 
        |> myReplace "t" "1" 
    let absPart10 = System.Convert.ToInt32 (strbiNum,2) 
    printfn "%A" (str.Substring(0)) 
    if str.Substring(0,1) = "s" then absPart10 
    elif str.Substring(0,1) = "t" then (-1)*absPart10 
    else failwith "数値表現エラー" 
 
type Command = 
    |SPush of int 
    |SDup 
    |SCopy of int 
    |SSwap 
    |SDiscard 
    |SSlide of int 
    |FExit 
     
 
let ComKindLst = 
     [( new Regex("^ss(?<num_part>(s|t)(s|t)+)n"), 
        (fun (rg:Regex) str -> let wholeMatch = rg.Match(str) 
                               let partMatch =  wholeMatch.Groups.["num_part"]  
                               if partMatch.Value.Length > 0 then 
                                    Some(SPush(wToNum partMatch.Value),wholeMatch.Length) 
                               else None) 
      ); 
      ( new Regex("^sns"), 
        (fun (rg:Regex) str -> let wholeMatch = rg.Match(str) 
                               if wholeMatch.Success = true then 
                                    Some(SDup,wholeMatch.Length) 
                               else None) 
      );  
     ( new Regex("^sts(?<num_part>(s|t)(s|t)+)n"), 
        (fun (rg:Regex) str -> let wholeMatch = rg.Match(str) 
                               let partMatch =  wholeMatch.Groups.["num_part"]  
                               if partMatch.Value.Length > 0 then 
                                    Some(SCopy(wToNum partMatch.Value),wholeMatch.Length) 
                               else None) 
      ); 
      ( new Regex("^snt"), 
        (fun (rg:Regex) str -> let wholeMatch = rg.Match(str) 
                               if wholeMatch.Success = true then 
                                    Some(SSwap,wholeMatch.Length) 
                               else None) 
      );  
      ( new Regex("^snn"), 
        (fun (rg:Regex) str -> let wholeMatch = rg.Match(str) 
                               if wholeMatch.Success = true then 
                                    Some(SDiscard,wholeMatch.Length) 
                               else None) 
      );  
     ( new Regex("^stn(?<num_part>(s|t)(s|t)+)n"), 
        (fun (rg:Regex) str -> let wholeMatch = rg.Match(str) 
                               let partMatch =  wholeMatch.Groups.["num_part"]  
                               if partMatch.Value.Length > 0 then 
                                    Some(SSlide(wToNum partMatch.Value),wholeMatch.Length) 
                               else None) 
      ); 
     ( new Regex("^nnn"), 
        (fun (rg:Regex) str -> let wholeMatch = rg.Match(str) 
                               if wholeMatch.Success = true then 
                                    Some(FExit,wholeMatch.Length) 
                               else None) 
      )  
      ] 
 
 
//上のComKindLstの要素の型 
type CKL = System.Text.RegularExpressions.Regex * 
                         (System.Text.RegularExpressions.Regex -> string -> (Command * int) option) 
 
let rec tryApply (cmdLst:list<CKL>) (str:string) = 
    match cmdLst with 
    | [] -> None 
    | (rg,f)::tl -> let res = f rg str 
                    if res.IsSome then 
                        res 
                    else 
                        tryApply tl str 
 
let rec makeCLSub (cmdLst:list<CKL>) (str:string) (index:int) (res:list<Command>) = 
    if str.Length = 0 then  
        res 
    else 
        let matchRes = tryApply cmdLst str 
        if matchRes = None then 
            failwith (sprintf "%d文字目からの部分でマッチするものが見つかりません" index) 
        else 
            let (com,len) = matchRes.Value 
            makeCLSub cmdLst (str.Substring(len)) (index + len) (com::res)  
                   
let makeCArray (cmdLst:list<CKL>) (src:string) = 
    makeCLSub cmdLst src 0 [] 
    |> List.rev 
    |> Array.ofList 
 
 
type WState = int*list<int>*Map<int,int>*list<int> 
 
let do_SDup ((pc,stcLst,heapMap,rIndexLst):WState) = 
    if List.length stcLst = 0 then failwith(sprintf "index:%d スタックが空でDupできません。" pc) 
    (pc+1,(List.head stcLst)::stcLst,heapMap,rIndexLst) 
 
let do_SSwap((pc,stcLst,heapMap,rIndexLst):WState) = 
    match stcLst with 
    |h1::h2::tl -> (pc+1,h2::h1::tl,heapMap,rIndexLst) 
    | _-> failwith(sprintf "index:%d スタックの要素の個数が1以下です" pc) 
   
let do_SDiscard ((pc,stcLst,heapMap,rIndexLst):WState) = 
    if List.length stcLst = 0 then failwith(sprintf "index:%d スタックが空でDiscardできません。" pc) 
    (pc+1,(List.tail stcLst),heapMap,rIndexLst) 
 
let do_SPush (num:int) ((pc,stcLst,heapMap,rIndexLst):WState) = 
    (pc+1,num::stcLst,heapMap,rIndexLst) 
 
let do_SCopy (n:int) ((pc,stcLst,heapMap,rIndexLst):WState) =     
    if (List.length stcLst) <= n then  failwith(sprintf "index:%d スタックの要素数がたりずにSCopyできません。" pc) 
    let tempArr = Array.ofList stcLst 
    (pc+1,(tempArr.[n])::stcLst,heapMap,rIndexLst) 
     
let do_SSlide (n:int) ((pc,stcLst,heapMap,rIndexLst):WState) = 
    if (List.length stcLst) <= n then  failwith(sprintf "index:%d スタックの要素数がたりずにSSlideできません。" pc) 
    let tempArr = Array.ofList stcLst 
    let slicedArr = tempArr.[(n + 1) ..] 
    let newStcLst = (List.head stcLst)::(List.ofArray slicedArr) 
    (pc+1,newStcLst,heapMap,rIndexLst) 
 
let do_FExit ((pc,stcLst,heapMap,rIndexLst):WState) =     
    () 
 
let rec processCmd (cmds :Command[]) ((pc,stcLst,heapMap,rIndexLst) as t:WState) = 
    if pc < 0 || pc >= Array.length cmds then failwith (sprintf "index:%d pcが領域外です" pc) 
    printfn "%A" t  //デバック用 
    let cur_cmd = cmds.[pc] 
    printfn "%A" cur_cmd //デバック用 
    match cur_cmd with 
    |SPush(num)  -> do_SPush num t  |> (processCmd cmds) 
    |SDup        -> do_SDup t       |> (processCmd cmds) 
    |SCopy (n)   -> do_SCopy n t    |> (processCmd cmds) 
    |SSwap       -> do_SSwap t      |> (processCmd cmds) 
    |SDiscard    -> do_SDiscard t   |> (processCmd cmds) 
    |SSlide (n)  -> do_SSlide n t   |> (processCmd cmds) 
    |FExit       -> do_FExit t
スポンサーサイト

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

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

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

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

この人とブロともになる

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