スポンサーサイト

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

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

 今回からフロー制御関連の命令の内ジャンプ関連のものを実装していきます。 
 
ジャンプというのは、特定の場所の命令に状態を引き連れて移動することです。 
もちろんジャンプ先はコード内にマークしておく必要があります。マークする具体的方法としては、ラベルというものを使います。(行番号付きのBasicではgoto 210とかという方法でジャンプしていました。)ジャンプを利用するコードは例えば次のような感じになります。 
 
ラベル どしたらこしたら 
どうする 
jump なんとかかんとか 
ああする 
ラベル なんとかかんとか 
こうする 
jump どしたらこしたら 
 
上のコードを上から実行すると, どうする->こうする->どうする->こうする->...と無限ループに陥ります。 
 
さてラベルをつける(場所をマークする)命令はnssで表され,続けて「s,t(nはダメ)の任意の並び+最後はn」という形のラベル名を付けることになっています。 
例えばnssttnでttnというラベル名でその命令の場所をマークするという意味となります。 
さて作成中のプログラムでは、命令の場所はプログラムカウンタ(pc,Command[]のindex)で処理するようにしていましたので、ラベルとプログラムカウンタの対応表を作っておけばこれを使用して簡単にジャンプすることができます。 
ということでprocessCmd関数を実行する前に、対応表を作りこれもprocessCmd関数に渡して実行することにします。 
 
空白コード--visualize ->("tn.......")--makeCArray-->[|SDup;NMarkLoc ttn;...l|] --> 対応表としておいて 
[|SDup;NMarkLoc ttn;...l|]+対応表-->processCmd 
という流れにします。 
 
ではコードを追加していきます。まずCommand Type への追加をします。(NMarkという名前にします。) 
type Command = 
    |SPush of int 
    ........... 
    |NMark of string   //stringはラベル名("ttns"等)を保持するため 
 
次にComKindLstへの追加ですがnssttnsならばttnsも切り出してNMark("ttns")という値を生成しなくてはならないのでで、SPush(5)等を生成する方法と同様(今回は数値ではなく文字列対象)の手順で関数を作成していきます。 
 
次のような補助関数を定義します。 
> let createFromString (partStr:string) (rg:Regex) (str:string) (creStr:string->Command) = 
         let wholeMatch = rg.Match(str) 
         let partMatch = wholeMatch.Groups.[partStr] 
         if partMatch.Value.Length > 0 then 
            Some(creStr( partMatch.Value),wholeMatch.Length) 
         else 
            None;; 
 
val createFromString : 
  string -> Regex -> string -> (string -> Command) -> (Command * int) option 
 
こうしておいてComKindLstへの追加部分を次の様にします。 
 
      ( new Regex("^nss(?<str_part>(s|t)+)n"), 
        (fun (rg:Regex) str -> createFromString "str_part" rg str (fun str -> NMark(str)))); 
 
ここまででmakeCArray関数でテストしてみます。 
 
>makeCArray ComKindLst "snsnssttnsssstsn";; 
val it : Command [] = [|SDup; NMark "ttn"; SPush 5|] 
 
>  makeCArray ComKindLst "snsnssttnsssstsnnsststsntsst";; 
val it : Command [] = [|SDup; NMark "ttn"; SPush 5; NMark "tstsn"; TSSub|] 
 
テスト成功です。 
 
次に[|SDup; NMark "ttn"; SPush 5; NMark "tstsn"; TSSub|]等から、マークしたラベル名とプログラムカウンタ(配列のindex)の対応のMapを作る関数を定義します。 
 
> let makeLabelMap (cmdArr:Command[]) = 
    let rec makeLabelMapSub cmdLst index res = 
        match cmdLst with 
        | [] -> res 
        |NMark(label)::tl ->makeLabelMapSub tl (index+1) (Map.add label index res) 
        |hd::tl           ->makeLabelMapSub tl (index+1)  res 
    makeLabelMapSub (List.ofArray cmdArr) 0 (Map.empty) ;;    
 
val makeLabelMap : Command [] -> Map<string,int> 
 
テストしてみます。 
 
> makeLabelMap [|SDup; NMark "ttn"; SPush 5; NMark "tstsn"; TSSub|];; 
val it : Map<string,int> = map [("tstsn", 3); ("ttn", 1)] 
 
では次に対応する関数の追加です。 
ラベルをマークするという行は、状態(pc,stcLst,heapMap,rIndexLst)の変化としてはプログラムカウンタが一つ増えるだけです。 
 
> let do_NMark (label:string) ((pc,stcLst,heapMap,rIndexLst):WState) = 
    (pc+1,stcLst,heapMap,rIndexLst);; 
 
val do_NMark : 
  string -> 
    int * int list * Map<int,int> * int list -> 
      int * int list * Map<int,int> * int list 
 
最後にprocessCmd関数への登録ですが、いままでは再帰関数として定義してコードのリストを表すCommand[]も引数でしたが、今後はラベルの対応表も使う必要があるので、少し構成を変えて次の様にします。 
 
> let rec processCmd (cmds :Command[]) (startWState:WState) = 
    let labelMap = makeLabelMap cmds //ジャンプ命令等で使用する  
    printfn "ラベル::pc対応Map %A" labelMap //デバック用 
    let rec processCmdSub  ((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  |> processCmdSub 
        |SDup        -> do_SDup t       |> processCmdSub 
        |SCopy (n)   -> do_SCopy n t    |> processCmdSub 
        |SSwap       -> do_SSwap t      |> processCmdSub 
        |SDiscard    -> do_SDiscard t   |> processCmdSub 
        |SSlide (n)  -> do_SSlide n t   |> processCmdSub 
        |TSAdd       -> do_TSAdd t      |> processCmdSub 
        |TSSub       -> do_TSSub t      |> processCmdSub 
        |TSMul       -> do_TSMul t      |> processCmdSub 
        |TSDiv       -> do_TSDiv t      |> processCmdSub 
        |TSMod       -> do_TSMod t      |> processCmdSub 
        |TTStore     -> do_TTStore t    |> processCmdSub 
        |TTRetrieve  -> do_TTRetrieve t |> processCmdSub 
        |NMark(lb)   -> do_NMark lb t   |> processCmdSub 
        |FExit       -> do_FExit t 
    processCmdSub startWState;; 
 
val processCmd : 
  Command [] -> int * int list * Map<int,int> * int list -> unit 
 
 
ではテストです。 
 
>  processCmd [|SPush(1001);SPush(56);TTStore;NMark("tsttt");SPush(7);FExit|] (0,[],Map.empty,[]);; 
ラベル::pc対応Map map [("tsttt", 3)] 
(0, [], map [], []) 
SPush 1001 
(1, [1001], map [], []) 
SPush 56 
(2, [56; 1001], map [], []) 
TTStore 
(3, [], map [(1001, 56)], []) 
NMark "tsttt" 
(4, [], map [(1001, 56)], []) 
SPush 7 
(5, [7], map [(1001, 56)], []) 
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" 
 
/////////////s,t,nによる数値表現をintに変換する関数// 
 
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 
    |TSAdd 
    |TSSub 
    |TSMul 
    |TSDiv 
    |TSMod 
    |TTStore 
    |TTRetrieve 
    |NMark of string 
    |FExit 
 
/////////////正規表現で切り出す補助関数群///////// 
 
let createFromInt (partStr:string) (rg:Regex) (str:string) (creInt:int->Command) = 
         let wholeMatch = rg.Match(str) 
         let partMatch = wholeMatch.Groups.[partStr] 
         if partMatch.Value.Length > 0 then 
            Some(creInt(wToNum partMatch.Value),wholeMatch.Length) 
         else 
            None 
 
let createFromNothing (rg:Regex) (str:string) (cre:unit->Command) = 
        let wholeMatch = rg.Match(str) 
        if wholeMatch.Success = true then 
               Some(cre(),wholeMatch.Length) 
        else None 
 
let createFromString (partStr:string) (rg:Regex) (str:string) (creStr:string->Command) = 
         let wholeMatch = rg.Match(str) 
         let partMatch = wholeMatch.Groups.[partStr] 
         if partMatch.Value.Length > 0 then 
            Some(creStr( partMatch.Value),wholeMatch.Length) 
         else 
            None 
 
 
/////////////正規表現での切り出し対応タプルリスト// 
 
let ComKindLst = 
     [(new Regex("^ss(?<num_part>(s|t)(s|t)+)n"), 
        (fun (rg:Regex) str -> createFromInt "num_part" rg str (fun num -> SPush(num)))); 
      ( new Regex("^sns"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> SDup))); 
      ( new Regex("^sts(?<num_part>(s|t)(s|t)+)n"), 
        (fun (rg:Regex) str -> createFromInt "num_part" rg str (fun num -> SCopy(num)))); 
      ( new Regex("^snt"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> SSwap))); 
      ( new Regex("^snn"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> SDiscard))); 
      ( new Regex("^stn(?<num_part>(s|t)(s|t)+)n"), 
        (fun (rg:Regex) str -> createFromInt "num_part" rg str (fun num -> SSlide(num)))); 
      ( new Regex("^tsss"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> TSAdd))); 
      ( new Regex("^tsst"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> TSSub))); 
      ( new Regex("^tssn"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> TSMul))); 
      ( new Regex("^tsts"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> TSDiv))); 
      ( new Regex("^tstt"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> TSMod))); 
      ( new Regex("^tts"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> TTStore))); 
      ( new Regex("^ttt"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> TTRetrieve))); 
      ( new Regex("^nss(?<str_part>(s|t)+n)"), 
        (fun (rg:Regex) str -> createFromString "str_part" rg str (fun str -> NMark(str)))); 
      ( new Regex("^nnn"), 
        (fun (rg:Regex) str -> createFromNothing rg str (fun () -> FExit))); 
     ] 
 
 
////////上のComKindLstの要素の型の別名///////////////////////// 
 
type CKL = System.Text.RegularExpressions.Regex * 
                         (System.Text.RegularExpressions.Regex -> string -> (Command * int) option) 
 
///////下のmakeCLSubの補助関数///////////////////////////////// 
 
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 
///////下のmakeCArrayの補助関数///////////////////////////////// 
 
let rec makeCASub (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 
            makeCASub cmdLst (str.Substring(len)) (index + len) (com::res)  
 
//////"stss.."等のstringから [|SDup; SPush 5...|]のような配列を作る関数//////////////////////                  
 
let makeCArray (cmdLst:list<CKL>) (src:string) = 
    makeCASub cmdLst src 0 [] 
    |> List.rev 
    |> Array.ofList 
 
/////[|SDup; NMark "ttn";..|]のような配列から、map [("ttn",1;..]というような対応表を作る関数/// 
 
let makeLabelMap (cmdArr:Command[]) = 
    let rec makeLabelMapSub cmdLst index res = 
        match cmdLst with 
        | [] -> res 
        |NMark(label)::tl ->makeLabelMapSub tl (index+1) (Map.add label index res) 
        |hd::tl           ->makeLabelMapSub tl (index+1)  res 
    makeLabelMapSub (List.ofArray cmdArr) 0 (Map.empty)     
 
///////状態を表すタプルの別名//////////////////////////////////// 
 
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_OpSub (op:int->int->int) ((pc,stcLst,heapMap,rIndexLst):WState) = 
    match stcLst with 
    |v1::v2::rem -> (pc+1,(op v2 v1)::rem,heapMap,rIndexLst) 
    | _     ->failwith(sprintf "index:%d スタックの要素数がたりずに演算できません。" pc) 
     
let do_TSAdd (t:WState) =  
    do_OpSub (+) t   
 
let do_TSSub (t:WState) =  
    do_OpSub (-) t   
 
let do_TSMul (t:WState) =  
    do_OpSub (*) t   
 
let do_TSDiv (t:WState) =  
    do_OpSub (/) t   
 
let do_TSMod (t:WState) =  
    do_OpSub (%) t   
 
let do_TTStore ((pc,stcLst,heapMap,rIndexLst):WState) = 
    match stcLst with 
    |v1::v2::rem -> (pc+1,rem,Map.add v2 v1 heapMap,rIndexLst) 
    |_    ->failwith(sprintf "index:%d スタックの要素数がたりずにStoreできません。" pc) 
 
let do_TTRetrieve ((pc,stcLst,heapMap,rIndexLst):WState) = 
    match stcLst with 
    |v::rem -> let retreivedVal = Map.tryFind v heapMap 
               if retreivedVal.IsSome then 
                    (pc+1,retreivedVal.Value::rem,heapMap,rIndexLst) 
               else failwith(sprintf "index:%d 指定されたアドレスにデータがないためRetrieveできません。" pc) 
    |_    ->failwith(sprintf "index:%d スタックの要素数がたりずにRetrieveできません。" pc) 
 
let do_NMark (label:string) ((pc,stcLst,heapMap,rIndexLst):WState) = 
    (pc+1,stcLst,heapMap,rIndexLst) 
 
let do_FExit ((pc,stcLst,heapMap,rIndexLst):WState) =     
    () 
 
////////命令を解釈しながら状態を変化させていく中心の関数//////////////// 
 
let rec processCmd (cmds :Command[]) (startWState:WState) = 
    let labelMap = makeLabelMap cmds //ジャンプ命令等で使用する  
    printfn "ラベル::pc対応Map %A" labelMap //デバック用 
    let rec processCmdSub  ((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  |> processCmdSub 
        |SDup        -> do_SDup t       |> processCmdSub 
        |SCopy (n)   -> do_SCopy n t    |> processCmdSub 
        |SSwap       -> do_SSwap t      |> processCmdSub 
        |SDiscard    -> do_SDiscard t   |> processCmdSub 
        |SSlide (n)  -> do_SSlide n t   |> processCmdSub 
        |TSAdd       -> do_TSAdd t      |> processCmdSub 
        |TSSub       -> do_TSSub t      |> processCmdSub 
        |TSMul       -> do_TSMul t      |> processCmdSub 
        |TSDiv       -> do_TSDiv t      |> processCmdSub 
        |TSMod       -> do_TSMod t      |> processCmdSub 
        |TTStore     -> do_TTStore t    |> processCmdSub 
        |TTRetrieve  -> do_TTRetrieve t |> processCmdSub 
        |NMark(lb)   -> do_NMark lb t   |> processCmdSub 
        |FExit       -> do_FExit t 
    processCmdSub startWState
スポンサーサイト

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

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

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

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

この人とブロともになる

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