スポンサーサイト

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

F#で入門 コンパイラ 、インタプリタ編 上向き構文解析 LR(0) (4)

 さて、ここまでで考えてきた文法は 
1:Program=LPAR Seq RPAR  
2:Program = NUM  
3:Seq = Program  
4:Seq = Seq COMMA Program  
  
というもので、これは入れ子をなす整数の並びを表す文法です。  
例(1,(2,3),5,(4,((2,3),2),9))  
 
これらの文法にさらにマーカーを付け足したものを考えるのでした。 
たとえばIL(0)項 (0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"])とは、状態として 
文法2から ["@"; "NUM"]という状態、文法3から["@"; "LPAR"; "Seq"; "RPAR"]という状態もありえます。 
このような同じ状態であるものをIL(0)項 ["@"; "Program"; "EOF"]のClosureというのでした。 
このような同じ状態である可能性のあるIL(0)項の集合を、渡り歩いて構文解析をしていきます。 
次にどの状態に遷移するか(渡り歩くか)の指針となるのが、読み込むトークンで、読み込むトークンによってどの状態に遷移するかを返すのが、goto集合というものでした。 
 
このような、状態集合から読み込むトークンによって、→をつけたグラフをLR(0)オートマトンといいます。 
上の文法では状態集合は 
 
--------------------1---------------------- 
 
Z → ["@"; "Program"; "EOF"]  
Program → ["@"; "LPAR"; "Seq"; "RPAR"]  
Program → ["@"; "NUM"]  
 
--------------------2---------------------- 
 
Program → ["@"; "LPAR"; "Seq"; "RPAR"]  
Program → ["LPAR"; "@"; "Seq"; "RPAR"]  
Program → ["@"; "NUM"]  
Seq → ["@"; "Program"]  
Seq → ["@"; "Seq"; "COMMA"; "Program"]  
 
--------------------3---------------------- 
 
Program → ["NUM"; "@"]  
 
--------------------4---------------------- 
 
Z → ["Program"; "@"; "EOF"]  
 
--------------------5---------------------- 
 
Seq → ["Program"; "@"]  
 
--------------------6---------------------- 
 
Program → ["LPAR"; "Seq"; "@"; "RPAR"]  
Seq → ["Seq"; "@"; "COMMA"; "Program"]  
 
--------------------7---------------------- 
 
Program → ["@"; "LPAR"; "Seq"; "RPAR"]  
Program → ["@"; "NUM"]  
Seq → ["Seq"; "COMMA"; "@"; "Program"]  
 
--------------------8---------------------- 
 
Program → ["LPAR"; "Seq"; "RPAR"; "@"]  
 
--------------------9---------------------- 
 
Seq → ["Seq"; "COMMA"; "Program"; "@"]  
 
となり、例えば1からLPARで2へ矢印をかきます。 
1からProgramでは4へ、1からNUMでは3に矢印をかきます。 
 
マーカーが終端記号の直前に現れるLR項をシフト項(shift item)、右辺の末尾に現れるLR項を還元項(reduce item)といいます。 
 
上の文法でのシフト項は 
    [(0, 2, "Z", "Program", "EOF", ["Program"; "@"; "EOF"]);  
     (1, 1, "Program", "NULL", "LPAR", ["@"; "LPAR"; "Seq"; "RPAR"]);  
     (1, 3, "Program", "Seq", "RPAR", ["LPAR"; "Seq"; "@"; "RPAR"]);  
     (2, 1, "Program", "NULL", "NUM", ["@"; "NUM"]);  
     (4, 2, "Seq", "Seq", "COMMA", ["Seq"; "@"; "COMMA"; "Program"])]  
です。 
上の文法の還元項は 
    [(0, 3, "Z", "EOF", "NULL", ["Program"; "EOF"; "@"]);  
     (1, 4, "Program", "RPAR", "NULL", ["LPAR"; "Seq"; "RPAR"; "@"]);  
     (2, 2, "Program", "NUM", "NULL", ["NUM"; "@"]);  
     (3, 2, "Seq", "Program", "NULL", ["Program"; "@"]);  
     (4, 4, "Seq", "Program", "NULL", ["Seq"; "COMMA"; "Program"; "@"])]  
です。 
 
「状態(LR状態といいます)を遷移していくときに、LR状態に還元項が含まれるときは必ず還元しなければならない」というのが、状態を遷移していくときのルールです。 
(還元というのは「文法の右辺全体」を「左辺の非終端記号」で置き換えることです。つまり、抽象度を上げる作用をもたらします。) 
(また、非終端記号をひとつ読み込んで、次の状態に移ることをシフトすると言います。とれはトークンの消費をもたらします。) 
結局のところ終端記号の集まり(トークン列)から、シフトおよび還元を繰り返し、トータルとして非終端記号を増やしていき、最後にProgramという一つの非終端記号に直せれば、構文解析完成ということになります。 
 
一つのLR状態に複数の還元項が含まれる場合を「還元/還元 衝突」といい、一つのLR状態に還元項とシフト項がが含まれる場合を「シフト/還元 衝突」といいます。 
LR(0)オートマトンに衝突のないような文法をLR(0)文法といいます。 
 
なお「マーカーが非終端記号の直前に現れるLR項(これはシフト項ではない)と還元項がひとつのLR状態に混在する場合は、非終端記号によるシフト動作を優先します。 
 
では、LR状態(遷移していく状態)が求まった状態で、次のトークンによりどのような動作をするかの表を作っていきたいと思います。求めたいのは次のような形の表です。 
 
1023-1.jpg
 
まずは、この表の見方から説明します。 
LR状態は前回までで求めました。(例えば、LR状態の1,2,3,4は次のようなものです。) 
 
--------------------1---------------------- 
 
Z → ["@"; "Program"; "EOF"]  
Program → ["@"; "LPAR"; "Seq"; "RPAR"]  
Program → ["@"; "NUM"]  
 
--------------------2---------------------- 
 
Program → ["@"; "LPAR"; "Seq"; "RPAR"]  
Program → ["LPAR"; "@"; "Seq"; "RPAR"]  
Program → ["@"; "NUM"]  
Seq → ["@"; "Program"]  
Seq → ["@"; "Seq"; "COMMA"; "Program"]  
 
--------------------3---------------------- 
 
Program → ["NUM"; "@"]  
 
--------------------4---------------------- 
 
Z → ["Program"; "@"; "EOF"]  
 
表の1の欄のLPARの部分にはS<2>と書かれています。これはLR状態1にいるとき、次のトークンがLPARならLPARを読み込んで(この動作はシフトです。),LR状態2に移るということです。 
(1のProgram → ["@"; "LPAR"; "Seq"; "RPAR"] から、2のProgram → ["LPAR"; "@"; "Seq"; "RPAR"] になるということです。) 
S<2>は、シフトして、状態2に移るということを表しています。 
同様に表の1の欄のNUMの部分はS<3>となります。 
 
また状態3にある場合は、還元することになるので、非終端記号の欄にはR[2]1と書かれています。これは文法2(2:Program = NUM)で還元することを表します。R[2]1の1は文法の右辺の記号数であり、状態を逆向きに1個戻すことを表します。 
 
表の4のEOFの欄のAは「ここで文法解析完了」の印です。 
 
前回までのコードに付け加えて、二つの型と表を作る関数を定義します。 
 
> type LR0State = 
    SHIFT of int  //構文番号(オートマトンの番号) 
    |REDUCE of int*int*string //構文番号(オートマトンの番号ではない)* 還元項の右辺の要素数(@は含まない)* 構文の左辺の非終端名 
    |ACCEPT 
    |NUL 
 
type REDUCABLE = 
    |REDU of LR0State    //reduceするべきで,その状態はLR0Stateである 
    |NO                  //reduceする項(還元項)はクロージャーに含まれない 
    |YET                 //まだ調べていない 
 
let makeLR0Map (inGrams:list<string>) = 
     
    let (ntnSet,tnSet) = getNTN_TN__Sets  inGrams 
    let wholeNtnAndTnLst = List.ofSeq(ntnSet + tnSet) 
    let (wholeItemsSet,shiftItemsSet,reduceItemsSet,topM_ItemsSet,ntnAftM_ItemsSet,lr0TItemsMap) = getLR0Terms inGrams 
     
    //受理状態のみを含むClosureか  
    let isFinalLR0Item (cls:Set<LR0ItemType>)  =  
           (Set.exists (fun (_,_,lh,bfr,aft,_) ->lh = "Z" && bfr = "Program" && aft = "EOF") cls)  && (Set.count cls = 1) 
     
    //引数のmapに受理状態のみを含むClosureについての行を付け加えて返す。(「noは受理状態のみを含むClosure」の番号を渡す) 
    let addFinalRow2map (idNo:int) (seedMap:Map<int*string,LR0State>) = 
           List.fold  (fun stateMap ele -> 
                            if ele <> "EOF" then Map.add (idNo,ele) NUL stateMap 
                            else Map.add (idNo,"EOF") ACCEPT stateMap 
                      ) 
                      seedMap 
                      wholeNtnAndTnLst 
    
    //シフト/還元衝突を調べる 
    let isSRConflict  (cls:Set<LR0ItemType>)  =  
           let reduceItems = Set.filter (fun ele -> Set.contains ele reduceItemsSet) cls 
           let shiftItems = Set.filter (fun ele -> Set.contains ele shiftItemsSet) cls 
           if Set.count reduceItems >= 1 && Set.count shiftItems >= 1 then true else false 
     
    let getGotoPA = getGoto ntnAftM_ItemsSet topM_ItemsSet lr0TItemsMap 
     
    //還元項を持つかを調べ、持った場合は還元/還元衝突を調べREDU(REDUCE(構文番号*還元項の項数))を返す。ないときはNO 
    let getReduceState (cls:Set<LR0ItemType>)  =  
           let reduceItems = Set.filter (fun ele -> Set.contains ele reduceItemsSet) cls 
           let reduceItemsCount = Set.count reduceItems 
           if reduceItemsCount = 0 then  
                NO 
           elif reduceItemsCount = 1 then 
                match (List.head (List.ofSeq reduceItems)) with  //要素が一個だから頭にくるものが還元項 
                |(gNo,_,lhName,_,_,lst) -> (REDU(REDUCE(gNo,(List.length lst) - 1, lhName))) //-1はマーカー分 
                 
           else raise (MyGramExcp (sprintf "還元/還元衝突 %A" cls )) //還元/還元衝突 
            
     
    let rec makeMapSub (ntn_tnLst:List<string>) (curProcessingClsNo:int) (curExistClsNum:int) (reducable:REDUCABLE) 
                       (accCls2IdMap:Map<Set<LR0ItemType>,int>) (accId2ClsMap:Map<int,Set<LR0ItemType>>)  
                       (accMap:Map<int*string,LR0State>) = 
        //表の右下まで到達 
        if ntn_tnLst = [] && curProcessingClsNo = curExistClsNum then  
                (accId2ClsMap,accMap) 
        //表の右端まで到達 
        elif ntn_tnLst = [] && curProcessingClsNo < curExistClsNum then 
                makeMapSub wholeNtnAndTnLst (curProcessingClsNo + 1)  curExistClsNum YET  accCls2IdMap accId2ClsMap accMap 
        //受理状態のみを含むClosureの左端の場合 
        elif  isFinalLR0Item  accId2ClsMap.[curProcessingClsNo] = true then  
                let addedMap = addFinalRow2map curProcessingClsNo accMap 
                makeMapSub wholeNtnAndTnLst (curProcessingClsNo + 1) curExistClsNum YET  accCls2IdMap accId2ClsMap addedMap 
        //一般状態 
        else     
            let cur_reducable:REDUCABLE =  //処理中のclosureにreducableなLR0項が含まれるか 
                if reducable = YET then 
                    getReduceState accId2ClsMap.[curProcessingClsNo]  //還元/還元衝突はここでチェック 
                else 
                    reducable //調べてある場合は引数として渡されてくる 
            match ntn_tnLst with 
            |[] -> //右端に来る場合は最初の2つの場合でチェック済み 
                failwith "neverOccurable Error" 
            |hd::tl when cur_reducable <> NO  && Set.contains hd tnSet  ->  //reducableかつ終端記号の場合(自動的に動作記号はR[?]) 
                  match cur_reducable with 
                  |REDU(reduceVal) ->makeMapSub tl curProcessingClsNo curExistClsNum cur_reducable 
                                               accCls2IdMap accId2ClsMap (Map.add (curProcessingClsNo,hd)  reduceVal accMap) 
                  |_ -> failwith "neverOccurable Error"                               
            |hd::tl -> 
                let newGoto = getGotoPA accId2ClsMap.[curProcessingClsNo] hd //処理中のclosureとtermからGoto集合を求める 
                if newGoto = Set.empty then //行先なし(表として空欄になる)場合 
                       makeMapSub tl curProcessingClsNo curExistClsNum cur_reducable 
                                       accCls2IdMap accId2ClsMap (Map.add (curProcessingClsNo,hd)  NUL accMap) 
                elif isSRConflict newGoto then  
                    failwith (sprintf "シフト/還元衝突\r\n%A" newGoto)   
                else 
                    match (Map.tryFind newGoto accCls2IdMap) with 
                    //newGotoがすでに、Closureとして存在する場合 
                    |Some(i) -> makeMapSub tl curProcessingClsNo curExistClsNum cur_reducable 
                                           accCls2IdMap accId2ClsMap (Map.add (curProcessingClsNo,hd)  (SHIFT(i)) accMap) 
                    //newGotoがまだ、Closureとして存在しない場合 
                    |None    ->let newAccCls2IdMap = Map.add newGoto (curExistClsNum + 1) accCls2IdMap 
                               let newAccId2ClsdMap = Map.add (curExistClsNum + 1) newGoto accId2ClsMap 
                               makeMapSub tl curProcessingClsNo (curExistClsNum + 1) cur_reducable 
                                           newAccCls2IdMap newAccId2ClsdMap (Map.add (curProcessingClsNo,hd)  (SHIFT(curExistClsNum + 1)) accMap)  
 
 
    let initI = (0,1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]) 
    let cls1 = getClosure  ntnAftM_ItemsSet topM_ItemsSet (Set.ofList [initI])  
    //  上でcls1は例えば次のようになる。 
    //  set[(0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]); 
    //     (1, 1, "Program", "NULL", "LPAR", ["@"; "LPAR"; "Seq"; "RPAR"]); 
    //     (2, 1, "Program", "NULL", "NUM", ["@"; "NUM"])] 
    let initAccCls2IdMap = Map.ofList [(cls1,1)] 
    let initId2accCls = Map.ofList [(1,cls1)] 
    makeMapSub wholeNtnAndTnLst 1 1 YET initAccCls2IdMap initId2accCls Map.empty;; 
 
(返答) 
 
type LR0State = 
  | SHIFT of int 
  | REDUCE of int * int * string 
  | ACCEPT 
  | NUL 
type REDUCABLE = 
  | REDU of LR0State 
  | NO 
  | YET 
val makeLR0Map : 
  string list -> Map<int,Set<LR0ItemType>> * Map<(int * string),LR0State> 
   
なおmakeRL0Mapの返り値は「LR状態番号からLR状態のmap」と「(LR状態番号と記号のタプル)からLR0Stateへのmap」のタプルです。 
   
  let grams = ["0:Z=Program EOF";"1:Program=LPAR Seq RPAR";"2:Program = NUM";"3:Seq = Program";"4:Seq = Seq COMMA Program"]としておいて使用してみます。 
   
 > makeLR0Map grams;; 
val it : Map<int,Set<LR0ItemType>> * Map<(int * string),LR0State> = 
  (map 
     [(1, 
       set 
         [(0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]); 
          (1, 1, "Program", "NULL", "LPAR", ["@"; "LPAR"; "Seq"; "RPAR"]); 
          (2, 1, "Program", "NULL", "NUM", ["@"; "NUM"])]); 
      (2, 
       set 
         [(1, 1, "Program", "NULL", "LPAR", ["@"; "LPAR"; "Seq"; "RPAR"]); 
          (1, 2, "Program", "LPAR", "Seq", ["LPAR"; "@"; "Seq"; "RPAR"]); 
          (2, 1, "Program", "NULL", "NUM", ["@"; "NUM"]); 
          (3, 1, "Seq", "NULL", "Program", ["@"; "Program"]); 
          (4, 1, "Seq", "NULL", "Seq", ["@"; "Seq"; "COMMA"; "Program"])]); 
      (3, set [(2, 2, "Program", "NUM", "NULL", ["NUM"; "@"])]); 
      (4, set [(0, 2, "Z", "Program", "EOF", ["Program"; "@"; "EOF"])]); 
      (5, set [(3, 2, "Seq", "Program", "NULL", ["Program"; "@"])]); 
      (6, 
       set 
         [(1, 3, "Program", "Seq", "RPAR", ["LPAR"; "Seq"; "@"; "RPAR"]); 
          (4, 2, "Seq", "Seq", "COMMA", ["Seq"; "@"; "COMMA"; "Program"])]); 
      (7, 
       set 
         [(1, 1, "Program", "NULL", "LPAR", ["@"; "LPAR"; "Seq"; "RPAR"]); 
          (2, 1, "Program", "NULL", "NUM", ["@"; "NUM"]); 
          (4, 3, "Seq", "COMMA", "Program", ["Seq"; "COMMA"; "@"; "Program"])]); 
      (8, 
       set [(1, 4, "Program", "RPAR", "NULL", ["LPAR"; "Seq"; "RPAR"; "@"])]); 
      (9, 
       set 
         [(4, 4, "Seq", "Program", "NULL", ["Seq"; "COMMA"; "Program"; "@"])])], 
   map 
     [((1, "COMMA"), NUL); ((1, "EOF"), NUL); ((1, "LPAR"), SHIFT 2); 
      ((1, "NUM"), SHIFT 3); ((1, "Program"), SHIFT 4); ((1, "RPAR"), NUL); 
      ((1, "Seq"), NUL); ((1, "Z"), NUL); ((2, "COMMA"), NUL); ...]) 
       
今回までの全コードは以下の通りです。 
 open System    
 
//文法定義のエラー 
exception MyGramExcp of string 
 
let STR_EPS ="EPSILON" 
 
///////////////////////////////// 
 
//splitOneLineGram "5:Program = DeclStmts PrintStmts" 
//結果 (5,"Program", ["DeclStmts"; "PrintStmts"]) 
let splitOneLineGram (inStr:string)= 
    let (lhdIndex,rhd) =  
        match inStr.Split([|':'|]) with 
        [|mlhd;mrhd|]  ->  (mlhd.Trim(),mrhd) 
        | _             ->  raise <| MyGramExcp(inStr)  
    let (lhd,rhd2) = 
        match rhd.Split([|'='|]) with 
        |[|mlhd;mrhd|]  ->  (mlhd.Trim(),mrhd) 
        | _             ->  raise <| MyGramExcp(inStr)  
    let rhdElems =  
        rhd2.Split([|' '|]) 
            |> List.ofArray 
            |> List.map (fun s -> s.Trim()) 
            |> List.filter (fun s -> s <> "") 
    (System.Int32.Parse(lhdIndex),lhd,rhdElems) 
 
//非終端記号と終端記号のSetを返す 
//getNTN_TN_Sets ["1:Program = DeclStmts PrintStmts";"2:DeclStmts = VAR SEMI";"3:PrintStmts = EPSILON"] 
//(set ["DeclStmts"; "PrintStmts"; "Program"], set ["SEMI"; "VAR"]) 
let getNTN_TN__Sets (inStrLst:list<string>) = 
    let (sumUpLhdSet,sumUpRhdSet) = 
        inStrLst 
            |> List.map splitOneLineGram 
            |> List.fold (fun (acclh,accrh)  (_,lhd,rhdLst) -> (lhd :: acclh,rhdLst @ accrh)) ([],[]) 
            |> (fun (hdLst,rhLst) -> (Set.ofList hdLst, Set.ofList rhLst)) 
    (sumUpLhdSet,sumUpRhdSet - sumUpLhdSet - (Set.ofList [STR_EPS])) 
 
 
/////////////////////////////////////////////////////////////////////////////////////////////////////////////// 
 
let grams = ["0:Z=Program EOF";"1:Program=LPAR Seq RPAR";"2:Program = NUM";"3:Seq = Program";"4:Seq = Seq COMMA Program"] 
 
 
type LR0ItemType = int * int * string * string * string * string list 
//                (1,3, "Program", "RPAR", "NULL", ["LPAR"; "Seq"; "RPAR"; "@"]) 
//タプルの第二成分は同一構文規則内の通し番号、一つ大きいのがマーカーを一つ後ろにずらしたもの 
 
//マーカーを付けて、マーカーの前後の記号とそれのタプルを返す 
//> addMarkers (1,"Program",["LPAR";"Seq";"RPAR"]);; 
//val it : (int * int * string * string * string * string list) list = 
//  [(1, 1, "Program", "NULL", "LPAR", ["@"; "LPAR"; "Seq"; "RPAR"]); 
//   (1, 2, "Program", "LPAR", "Seq", ["LPAR"; "@"; "Seq"; "RPAR"]); 
//   (1, 3, "Program", "Seq", "RPAR", ["LPAR"; "Seq"; "@"; "RPAR"]); 
//   (1, 4, "Program", "RPAR", "NULL", ["LPAR"; "Seq"; "RPAR"; "@"])] 
let addMarkers (idNum:int, lhName:string, inLst:list<string>) = 
    let withSenti ="NULL"::inLst @ ["NULL"] 
    let rec addMarkerSub (lst:list<string>) (acchd:list<string>) accLst (counter) = 
        match lst with 
        |hd::tl when tl <> []  
            -> addMarkerSub tl (acchd @ [hd]) ((idNum,counter,lhName,hd, List.head tl,((acchd @ [hd] @ ["@"] @ tl)))::accLst) (counter+1) 
        |_ ->  accLst |> List.map (fun (id,cnt,lh,bef,aft,resLst) -> (id,cnt,lh,bef,aft,resLst |> List.rev |> List.tail |> List.rev |> List.tail)) 
     
    List.rev (addMarkerSub withSenti [] [] 1) 
 
//> getGramWithMarker "3:Seq = Program";; 
//val it : (int * int * string * string * string * string list) list = 
//  [(3, 1, "Seq", "NULL", "Program", ["@"; "Program"]); 
//   (3, 2, "Seq", "Program", "NULL", ["Program"; "@"])] 
let getGramWithMarker (inStr:string) = 
    splitOneLineGram inStr   
      |> addMarkers 
 
//> getLR0Terms grams;; //結果は中略してある 
// (set 
//     [(0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]); 
//      (2, 2, "Program", "NUM", "NULL", ["NUM"; "@"]); ...], 
//   set 
//     [(0, 2, "Z", "Program", "EOF", ["Program"; "@"; "EOF"]); 
//      (4, 2, "Seq", "Seq", "COMMA", ["Seq"; "@"; "COMMA"; "Program"])], 
//   set 
//     [(0, 3, "Z", "EOF", "NULL", ["Program"; "EOF"; "@"]); 
//      (4, 4, "Seq", "Program", "NULL", ["Seq"; "COMMA"; "Program"; "@"])], 
//   set 
//     [(0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]); 
//      (4, 1, "Seq", "NULL", "Seq", ["@"; "Seq"; "COMMA"; "Program"])], 
//   set 
//     [(0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]); 
//      (4, 3, "Seq", "COMMA", "Program", ["Seq"; "COMMA"; "@"; "Program"])], 
//   map 
//     [((0, 1), (0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"])); 
//      ((2, 2), (2, 2, "Program", "NUM", "NULL", ["NUM"; "@"])); ...]) 
let getLR0Terms (inStrLst:list<string>) = 
   let (ntnSet,ntSet) = getNTN_TN__Sets  inStrLst 
   let lr0TermsSet = 
        inStrLst 
            |> List.map getGramWithMarker 
            |> List.concat 
            |> Set.ofList 
   let shiftItemsSet = //markerの直後が終端記号 
        Set.filter (fun (_,_,_,_,aft,_) -> Set.contains aft ntSet) lr0TermsSet 
   let reduceItemsSet = //markerが末尾 
        Set.filter (fun (_,_,_,_,aft,_) -> aft = "NULL") lr0TermsSet 
   let topMarker_ItemsSet = //markerが先頭 
       Set.filter (fun (_,_,_,bfr,_,_) -> bfr = "NULL") lr0TermsSet 
   let ntnAfterMarkerItemsSet = //markerの直後が非終端記号 
      Set.filter (fun (_,_,_,_,aft,_) -> Set.contains aft ntnSet) lr0TermsSet 
 
   let lr0TItemsMap = 
        lr0TermsSet  
          |> Set.map (fun (id,subId,lhName,bfr,aft,lst) -> ((id,subId),(id,subId,lhName,bfr,aft,lst))) 
          |> Map.ofSeq   
 
   (lr0TermsSet,shiftItemsSet,reduceItemsSet,topMarker_ItemsSet,ntnAfterMarkerItemsSet,lr0TItemsMap) 
 
//let (whole,shift,reduce,topM,ntnAftM,_) = getLR0Terms grams 
//let initI = (0,1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]) 
//let t = getClosure  ntnAftM topM (Set.ofList [initI]) 
//val t : Set<LR0ItemType> = 
//  set 
//    [(0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]); 
//     (1, 1, "Program", "NULL", "LPAR", ["@"; "LPAR"; "Seq"; "RPAR"]); 
//     (2, 1, "Program", "NULL", "NUM", ["@"; "NUM"])] 
let getClosure  (inNtnAfterMarkerItemsSet:Set<LR0ItemType>) (inTopMarker_ItemSet:Set<LR0ItemType>) (initI :Set<LR0ItemType>) = 
    let rec getClosureSub oldClosureSet = 
                                  //oldClosureSetの中で非終端記号の前にマーカーがついている形のもの 
        let shouldAddedLRItems  = Set.filter (fun ele -> Set.contains ele inNtnAfterMarkerItemsSet) oldClosureSet 
        let newClosureSet = 
            Set.fold  (fun oldSet (_,_,_,_,aft,_) -> //aftはマーカーの直後の非終端記号 
                            let addLRItems = Set.filter (fun (_,_,lh,_,_,_ ) -> lh = aft) inTopMarker_ItemSet 
                            oldSet + addLRItems) 
                       oldClosureSet 
                       shouldAddedLRItems 
        if newClosureSet = oldClosureSet then 
             newClosureSet 
        else  
            getClosureSub newClosureSet 
 
    getClosureSub initI 
 
 
let (whole,shift,reduce,topM,ntnAftM,rlMap) = getLR0Terms grams 
let initI = (0,1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]) 
let t = getClosure  ntnAftM topM (Set.ofList [initI]) 
//let u = getGoto ntnAftM topM rlMap t "LPAR" 
//val u : Set<LR0ItemType> = 
//  set 
//    [(1, 1, "Program", "NULL", "LPAR", ["@"; "LPAR"; "Seq"; "RPAR"]); 
//     (1, 2, "Program", "LPAR", "Seq", ["LPAR"; "@"; "Seq"; "RPAR"]); 
//     (2, 1, "Program", "NULL", "NUM", ["@"; "NUM"]); 
//     (3, 1, "Seq", "NULL", "Program", ["@"; "Program"]); 
//     (4, 1, "Seq", "NULL", "Seq", ["@"; "Seq"; "COMMA"; "Program"])] 
let getGoto (inNtnAfterMarkerItemsSet:Set<LR0ItemType>) (inTopMarker_ItemSet:Set<LR0ItemType>)  
            (inIRItemMap:Map<(int*int),LR0ItemType>)  
            (inLRItemSet:Set<LR0ItemType>) (inStr:string) = 
    let getClosurePA = getClosure inNtnAfterMarkerItemsSet inTopMarker_ItemSet 
    let shouldAddGredienceLRItems = Set.filter (fun (_,_,_,_,aft,_) -> aft = inStr) inLRItemSet  
    let tempSet = //マーカーをずらしたものの集合 
            shouldAddGredienceLRItems 
                |> Set.fold (fun accSet (i,j,_,_,_,_) ->   
                                let addItem =inIRItemMap.[(i,j+1)] //(マーカーを一つ進めたもの(マーカーの次はinStr)) 
                                Set.add addItem accSet   
                            ) 
                   Set.empty  
    getClosurePA tempSet 
 
 
type LR0State = 
    SHIFT of int  //構文番号(オートマトンの番号) 
    |REDUCE of int*int*string //構文番号(オートマトンの番号ではない)* 還元項の右辺の要素数(@は含まない)* 構文の左辺の非終端名 
    |ACCEPT 
    |NUL 
 
type REDUCABLE = 
    |REDU of LR0State    //reduceするべきで,その状態はLR0Stateである 
    |NO                  //reduceする項(還元項)はクロージャーに含まれない 
    |YET                 //まだ調べていない 
 
let makeLR0Map (inGrams:list<string>) = 
     
    let (ntnSet,tnSet) = getNTN_TN__Sets  inGrams 
    let wholeNtnAndTnLst = List.ofSeq(ntnSet + tnSet) 
    let (wholeItemsSet,shiftItemsSet,reduceItemsSet,topM_ItemsSet,ntnAftM_ItemsSet,lr0TItemsMap) = getLR0Terms inGrams 
     
    //受理状態のみを含むClosureか  
    let isFinalLR0Item (cls:Set<LR0ItemType>)  =  
           (Set.exists (fun (_,_,lh,bfr,aft,_) ->lh = "Z" && bfr = "Program" && aft = "EOF") cls)  && (Set.count cls = 1) 
     
    //引数のmapに受理状態のみを含むClosureについての行を付け加えて返す。(「noは受理状態のみを含むClosure」の番号を渡す) 
    let addFinalRow2map (idNo:int) (seedMap:Map<int*string,LR0State>) = 
           List.fold  (fun stateMap ele -> 
                            if ele <> "EOF" then Map.add (idNo,ele) NUL stateMap 
                            else Map.add (idNo,"EOF") ACCEPT stateMap 
                      ) 
                      seedMap 
                      wholeNtnAndTnLst 
    
    //シフト/還元衝突を調べる 
    let isSRConflict  (cls:Set<LR0ItemType>)  =  
           let reduceItems = Set.filter (fun ele -> Set.contains ele reduceItemsSet) cls 
           let shiftItems = Set.filter (fun ele -> Set.contains ele shiftItemsSet) cls 
           if Set.count reduceItems >= 1 && Set.count shiftItems >= 1 then true else false 
     
    let getGotoPA = getGoto ntnAftM_ItemsSet topM_ItemsSet lr0TItemsMap 
     
    //還元項を持つかを調べ、持った場合は還元/還元衝突を調べREDU(REDUCE(構文番号*還元項の項数))を返す。ないときはNO 
    let getReduceState (cls:Set<LR0ItemType>)  =  
           let reduceItems = Set.filter (fun ele -> Set.contains ele reduceItemsSet) cls 
           let reduceItemsCount = Set.count reduceItems 
           if reduceItemsCount = 0 then  
                NO 
           elif reduceItemsCount = 1 then 
                match (List.head (List.ofSeq reduceItems)) with  //要素が一個だから頭にくるものが還元項 
                |(gNo,_,lhName,_,_,lst) -> (REDU(REDUCE(gNo,(List.length lst) - 1, lhName))) //-1はマーカー分 
                 
           else raise (MyGramExcp (sprintf "還元/還元衝突 %A" cls )) //還元/還元衝突 
            
     
    let rec makeMapSub (ntn_tnLst:List<string>) (curProcessingClsNo:int) (curExistClsNum:int) (reducable:REDUCABLE) 
                       (accCls2IdMap:Map<Set<LR0ItemType>,int>) (accId2ClsMap:Map<int,Set<LR0ItemType>>)  
                       (accMap:Map<int*string,LR0State>) = 
        //表の右下まで到達 
        if ntn_tnLst = [] && curProcessingClsNo = curExistClsNum then  
                (accId2ClsMap,accMap) 
        //表の右端まで到達 
        elif ntn_tnLst = [] && curProcessingClsNo < curExistClsNum then 
                makeMapSub wholeNtnAndTnLst (curProcessingClsNo + 1)  curExistClsNum YET  accCls2IdMap accId2ClsMap accMap 
        //受理状態のみを含むClosureの左端の場合 
        elif  isFinalLR0Item  accId2ClsMap.[curProcessingClsNo] = true then  
                let addedMap = addFinalRow2map curProcessingClsNo accMap 
                makeMapSub wholeNtnAndTnLst (curProcessingClsNo + 1) curExistClsNum YET  accCls2IdMap accId2ClsMap addedMap 
        //一般状態 
        else     
            let cur_reducable:REDUCABLE =  //処理中のclosureにreducableなLR0項が含まれるか 
                if reducable = YET then 
                    getReduceState accId2ClsMap.[curProcessingClsNo]  //還元/還元衝突はここでチェック 
                else 
                    reducable //調べてある場合は引数として渡されてくる 
            match ntn_tnLst with 
            |[] -> //右端に来る場合は最初の2つの場合でチェック済み 
                failwith "neverOccurable Error" 
            |hd::tl when cur_reducable <> NO  && Set.contains hd tnSet  ->  //reducableかつ終端記号の場合(自動的に動作記号はR[?]) 
                  match cur_reducable with 
                  |REDU(reduceVal) ->makeMapSub tl curProcessingClsNo curExistClsNum cur_reducable 
                                               accCls2IdMap accId2ClsMap (Map.add (curProcessingClsNo,hd)  reduceVal accMap) 
                  |_ -> failwith "neverOccurable Error"                               
            |hd::tl -> 
                let newGoto = getGotoPA accId2ClsMap.[curProcessingClsNo] hd //処理中のclosureとtermからGoto集合を求める 
                if newGoto = Set.empty then //行先なし(表として空欄になる)場合 
                       makeMapSub tl curProcessingClsNo curExistClsNum cur_reducable 
                                       accCls2IdMap accId2ClsMap (Map.add (curProcessingClsNo,hd)  NUL accMap) 
                elif isSRConflict newGoto then  
                    failwith (sprintf "シフト/還元衝突\r\n%A" newGoto)   
                else 
                    match (Map.tryFind newGoto accCls2IdMap) with 
                    //newGotoがすでに、Closureとして存在する場合 
                    |Some(i) -> makeMapSub tl curProcessingClsNo curExistClsNum cur_reducable 
                                           accCls2IdMap accId2ClsMap (Map.add (curProcessingClsNo,hd)  (SHIFT(i)) accMap) 
                    //newGotoがまだ、Closureとして存在しない場合 
                    |None    ->let newAccCls2IdMap = Map.add newGoto (curExistClsNum + 1) accCls2IdMap 
                               let newAccId2ClsdMap = Map.add (curExistClsNum + 1) newGoto accId2ClsMap 
                               makeMapSub tl curProcessingClsNo (curExistClsNum + 1) cur_reducable 
                                           newAccCls2IdMap newAccId2ClsdMap (Map.add (curProcessingClsNo,hd)  (SHIFT(curExistClsNum + 1)) accMap)  
 
 
    let initI = (0,1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]) 
    let cls1 = getClosure  ntnAftM_ItemsSet topM_ItemsSet (Set.ofList [initI])  
    //  上でcls1は例えば次のようになる。 
    //  set[(0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]); 
    //     (1, 1, "Program", "NULL", "LPAR", ["@"; "LPAR"; "Seq"; "RPAR"]); 
    //     (2, 1, "Program", "NULL", "NUM", ["@"; "NUM"])] 
    let initAccCls2IdMap = Map.ofList [(cls1,1)] 
    let initId2accCls = Map.ofList [(1,cls1)] 
    makeMapSub wholeNtnAndTnLst 1 1 YET initAccCls2IdMap initId2accCls Map.empty      
スポンサーサイト

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

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

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

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

この人とブロともになる

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