スポンサーサイト

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

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

 LR(0)構文解析は、適用できる文法の範囲が狭いので、実用に耐えません。 
例えば前回のソフトで、 
1:Program = NUM 
2:Program = NUM Program 
という文法(これは単なる数字の並びを表現してます。)を構文解釈しようとするとシフト/還元衝突エラー」がでます。 
 
このような衝突を回避し、さらに構文解釈の精度を上げるために、還元を行うための条件を次のように付け加えます。 
 
[x→α@]による還元は、先読み記号がFollow(x)に含まれるときに限る 
 
LR(0)構文解釈に、このようなルールを付け加えたものをSLR構文解釈といいます。 
 
LR(0)状態の還元項[x→α@]に、xのFollow集合を付け加えて、SRL状態を構築します。 
Follow(x) = {t1,t2,..,tn}のとき、SLR状態の還元項は[x→α@,{t1,t2,..,tn}]と書きます。 
 
例えば、文法 
1:Program = NUM 
2:Program = NUM Program 
のSLR状態は次のようになります。 
 
 
--------------------1---------------------- 
 
Z → ["@"; "Program"; "EOF"]   
Program → ["@"; "NUM"]   
Program → ["@"; "NUM"; "Program"]   
 
--------------------2---------------------- 
 
Program → ["@"; "NUM"]   
Program → ["NUM"; "@"]  set ["EOF"] 
Program → ["@"; "NUM"; "Program"]   
Program → ["NUM"; "@"; "Program"]   
 
--------------------3---------------------- 
 
Z → ["Program"; "@"; "EOF"]   
 
--------------------4---------------------- 
 
Program → ["NUM"; "Program"; "@"]  set ["EOF"] 
 
2の上から二つ目の還元項にはProgramのFollow集合であるset ["EOF"]が右に書いてあり、 
4の還元項にもProgramのFollow集合であるset ["EOF"]が右に書いてあります。 
 
この文法の構文解析表は次のようになります。 
 
1027-1.jpg 
 
2の欄をみてもらうと、次のトークンがEOFの部分では、還元をおこない、NUM,Programの部分ではシフトをおこなうようになっています。 
(LR(0)解析では、この部分でシフト還元衝突がおこります。) 
 
ちなみに、ソースを"NUM NUM NUM"として構文解析を行うと、解析過程は 
 
10 ["1"; "Program"; "3"] <<->>["EOF"]  
9 ["1"] <<->>["Program"; "EOF"]  
8 ["1"; "NUM"; "2"; "Program"; "4"] <<->>["EOF"]  
7 ["1"; "NUM"; "2"] <<->>["Program"; "EOF"]  
6 ["1"; "NUM"; "2"; "NUM"; "2"; "Program"; "4"] <<->>["EOF"]  
5 ["1"; "NUM"; "2"; "NUM"; "2"] <<->>["Program"; "EOF"]  
4 ["1"; "NUM"; "2"; "NUM"; "2"; "NUM"; "2"] <<->>["EOF"]  
3 ["1"; "NUM"; "2"; "NUM"; "2"] <<->>["NUM"; "EOF"]  
2 ["1"; "NUM"; "2"] <<->>["NUM"; "NUM"; "EOF"]  
1 ["1"] <<->>["NUM"; "NUM"; "NUM"; "EOF"]  
 
となり(下から順にみてください)、抽象木は 
 
    2:Program = NUM Program 
        NUM 
        2:Program = NUM Program 
            NUM 
            1:Program = NUM 
                NUM 
                 
が生成されます。 
 
ではSLR解析する関数のソースですが、LR(0)のものとほとんど同じです。主な変更(追加)点は 
 
(1)follow集合を求める関数の追加(これはLL1解析のものと同じものを使います。) 
 
(2)還元項とfollow集合のpairを集合として定義する。(この部分のコードの抜粋は以下の通りです。) 
 
......... 
   let reduceTermPairSet = 
         let temp =  
             [for  (clNo,subNo,lh,bfr,agt,lst) in reduceItemsSet do 
                for tn in NTN_FollowMap.[lh] do 
                     yield ((clNo,subNo,lh,bfr,agt,lst),tn) 
             ] 
         Set.ofList temp        
......... 
 
(3)還元の可能性を調べる部分で、follow集合を考えに入れる。(この部分のコードの抜粋は以下の通りです。) 
 
......... 
            |hd::tl -> 
                //還元の可能性を調べる 
                let reduceItems = 
                   accId2ClsMap.[curProcessingClsNo] 
                    |> Set.filter (fun item -> Set.contains (item,hd) reduceTermPairSet) 
                if  Set.count reduceItems > 1 then 
                    failwith (sprintf "還元/還元衝突 %s  %A " hd reduceItems ) 
                 
                elif Set.count reduceItems = 1 then //還元項がある場合 
                    //シフトの可能性を調べる 
                    let shiftableItems =  
 ......... 
 
前回のLR(0)解析と同様に次のようなソフトも作ってみました。 
 
1027-2.jpg
 
 
なおこのソフトは Seq=ε というような、空文字を含む文法も解析可能なのですが、それについては次回説明します。 
 
今回のコードは以下の通りです。 
 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 isNullableToken ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)(inTokenName:string) = 
    if inTokenName = STR_EPS then  
         true 
    elif Set.contains inTokenName in_tn then 
         false 
    else 
        in_ntnNullableMap.[inTokenName] 
 
let isNullableTokenLst ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)(inTokenNameLst:list<string>) = 
      List.forall (isNullableToken (in_ntn,in_tn) in_ntnNullableMap )inTokenNameLst //リスト中のすべてのtokenがnullableか 
           
let isNullableTokenLstLst ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)(inTokenNameLstLst:list<list<string>>) = 
      List.exists (isNullableTokenLst (in_ntn,in_tn) in_ntnNullableMap ) inTokenNameLstLst//リスト中のどれかのtokenリストがnullableか 
 
//getNTN_NullableMap ["1:Program = DeclStmts SEMI PrintStmts";"2:DeclStmts = EPSILON";"3:PrintStmts = EPSILON";"4:PrintStmts = PRINT"] 
// map [("DeclStmts", true); ("PrintStmts", true); ("Program", false)] 
let getNTN_NullableMap (inStrLst:list<string>) = 
     
    let (ntnSet,tnSet) = getNTN_TN__Sets inStrLst 
     
    let grams = inStrLst 
                  |> List.map splitOneLineGram 
                  |> List.map (fun (_,lh,rhEles) -> (lh,rhEles)) //[("Program",["DeclStmts";"PrintStmts"]);("DeclStmts",["VAR";"SEMI"])] 
     
    let rec getNTN_NullableMapSub (inOldNullableMap:Map<string,bool>) (count:int) =  
        let nextNullableMap = 
            ntnSet 
                |> Set.fold (fun stateMap ele -> 
                                let targetGramsLstLst = 
                                    grams 
                                        |>List.filter (fun (ntnName,_) -> ntnName = ele) 
                                        |>List.map (fun (_,lst) -> lst) 
                                let thisEleNullable = 
                                    isNullableTokenLstLst(ntnSet,tnSet) inOldNullableMap targetGramsLstLst 
                                Map.add ele thisEleNullable stateMap 
                             ) 
                             Map.empty 
        if count > 10000 then 
            failwith "count error" 
        elif nextNullableMap = inOldNullableMap then 
            nextNullableMap 
        else 
            getNTN_NullableMapSub nextNullableMap (count + 1) 
     
    let initNullableMap = 
                ntnSet 
                    |> Set.map (fun ele -> (ele,false)) 
                    |> Map.ofSeq 
     
    getNTN_NullableMapSub initNullableMap 0 
 
//first集合を求める(トークン一つ用) 
let getFirstSetOfToken ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnFirstSetMap:Map<string,Set<string>>)(inTokenName:string) = 
    if inTokenName = STR_EPS then  
         Set.empty 
    elif Set.contains inTokenName in_tn then 
         Set.ofList ([inTokenName]) 
    else 
        in_ntnFirstSetMap.[inTokenName] 
 
//first集合を求める(トークンリスト用) 
let getFirstSetOfTokenLst ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>) 
                           (in_firstSetMap:Map<string,Set<string>>) (inTokenNameLst:list<string>) = 
      let isNullableTokenPartApply = isNullableToken (in_ntn,in_tn) in_ntnNullableMap    
       
      let rec getFirstSetOfTokenLstSub (tokenLst:list<string>)  = 
        match tokenLst with 
        |[] -> Set.empty 
        |hd::tl when isNullableTokenPartApply hd -> (getFirstSetOfToken (in_ntn,in_tn) in_firstSetMap hd) + (getFirstSetOfTokenLstSub tl) 
        |hd::tl                                  -> (getFirstSetOfToken (in_ntn,in_tn) in_firstSetMap hd) 
 
      getFirstSetOfTokenLstSub inTokenNameLst 
 
//first集合を求める(トークンリストのリスト) 
let getFirstSetOfTokenLstLst ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>) 
                          (in_firstSetMap:Map<string,Set<string>>) (inTokenNameLstLst:list<list<string>>) =   
 
    let getFirstSetOfTokenLstPartApply = getFirstSetOfTokenLst (in_ntn,in_tn) in_ntnNullableMap in_firstSetMap 
     
    List.fold (fun acc ele -> acc + (getFirstSetOfTokenLstPartApply ele)) Set.empty inTokenNameLstLst 
 
//first集合を求める 
let getNTN_FirstMap  (inStrLst:list<string>) = 
     
    let (ntnSet,tnSet) = getNTN_TN__Sets inStrLst 
    let ntnNullableMap = getNTN_NullableMap inStrLst 
 
    let grams = inStrLst 
                  |> List.map splitOneLineGram 
                  |> List.map (fun (_,lh,rhEles) -> (lh,rhEles)) //[("Program",["DeclStmts";"PrintStmts"]);("DeclStmts",["VAR";"SEMI"])] 
     
    let FisrtSetOfTokenLstLstPA = getFirstSetOfTokenLstLst (ntnSet,tnSet) ntnNullableMap 
     
    let rec getNTN_FirstMapSub (inOldFirstMap:Map<string,Set<string>>) (count:int) =  
        let nextFirstMap = 
            ntnSet 
                |> Set.fold (fun stateMap ele -> 
                                let targetGramsLstLst = 
                                    grams 
                                        |>List.filter (fun (ntnName,_) -> ntnName = ele) 
                                        |>List.map (fun (_,lst) -> lst) 
                                let thisEleFisrtSet = 
                                     FisrtSetOfTokenLstLstPA inOldFirstMap targetGramsLstLst 
                                Map.add ele thisEleFisrtSet stateMap 
                             ) 
                             Map.empty 
        if count > 10000 then 
            failwith "count error" 
        elif nextFirstMap = inOldFirstMap then 
            nextFirstMap 
        else 
            getNTN_FirstMapSub nextFirstMap (count + 1) 
     
    let initFirstMap = 
                ntnSet 
                    |> Set.map (fun ele -> (ele,Set.empty)) 
                    |> Map.ofSeq 
     
    getNTN_FirstMapSub initFirstMap 0 
 
//follow補助 
 
// getAfterTokens "DeclStmts1" ("PrintStmts1",["VarDef1";"DeclStmts1";"VarDef2";"VarDef3";"DeclStmts1";"VarDef4"]);; 
//val it : (string list * string) list = 
//  [(["VarDef4"], "PrintStmts1"); 
//   (["VarDef2"; "VarDef3"; "DeclStmts1"; "VarDef4"], "PrintStmts1")] 
let getAfterTokens (inStr:string) ((lhdStr,rhStrLst):string*list<string>) = 
    let rec getAfterTokensSub strLst res = 
        match strLst with 
        |hd::tl when hd = inStr -> getAfterTokensSub tl ((tl,lhdStr)::res) 
        |hd::tl                 -> getAfterTokensSub tl res 
        | [] -> res 
    getAfterTokensSub rhStrLst [] 
 
 
let getNTN_FollowMap  (inStrLst:list<string>) = 
    let (ntnSet,tnSet) = getNTN_TN__Sets inStrLst 
    let ntnNullableMap = getNTN_NullableMap inStrLst 
    let ntnFirstMap = getNTN_FirstMap inStrLst 
    let isNullableTokensLstPA (tokenLst:list<string>) = isNullableTokenLst (ntnSet,tnSet) ntnNullableMap tokenLst 
    let getFirstSetOfTokenLstPA (tokenLst:list<string>) = getFirstSetOfTokenLst (ntnSet,tnSet) ntnNullableMap  ntnFirstMap tokenLst 
    let grams = inStrLst 
                  |> List.map splitOneLineGram 
                  |> List.map (fun (_,lh,rhEles) -> (lh,rhEles)) //[("Program",["DeclStmts";"PrintStmts"]);("DeclStmts",["VAR";"SEMI"])] 
  
    let rec getNTN_FollowMapSub (inOldFollowMap:Map<string,Set<string>>) (count:int) =  
       let getFollowSet (afterTokens:list<string>,ntnName:string) = 
                if isNullableTokensLstPA afterTokens then 
                    (getFirstSetOfTokenLstPA afterTokens) + (inOldFollowMap.[ntnName]) 
                else 
                    (getFirstSetOfTokenLstPA afterTokens)                 
       let nextFollowMap = 
            ntnSet 
                |> Set.fold (fun stateMap ele -> 
                                let includeEleGrams = 
                                    grams 
                                      |> List.fold (fun state2 (ntnName2,tokenLst) 
                                                        -> state2 @ (getAfterTokens ele (ntnName2,tokenLst))) 
                                                    [] 
                                                     
                                let followSet = 
                                    includeEleGrams 
                                      |> List.fold (fun (state3:Set<string>) (afterTokens,ntnName) -> 
                                                    state3 + (getFollowSet (afterTokens,ntnName))) 
                                                    Set.empty 
                                Map.add ele followSet stateMap 
                             ) 
                             Map.empty 
       if count > 10000 then 
            failwith "count error" 
       elif nextFollowMap = inOldFollowMap then 
            nextFollowMap 
       else 
            getNTN_FollowMapSub nextFollowMap (count + 1) 
 
 
    let initFollowMap = 
                ntnSet 
                    |> Set.map (fun ele -> (ele,Set.empty)) 
                    |> Map.ofSeq 
     
    getNTN_FollowMapSub initFollowMap 0 
 
 
 
///////////////////////////////////////////ここから//////////////////////////////////////////////////////////////////////// 
 
//テスト用//let grams = ["0:Z=Program EOF";"1:Program=EPSILON";"2:Program = NUM 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>) = 
    if inLst = [STR_EPS] then 
        [(idNum,1,lhName,"NULL","NULL",["@"])] 
    else 
        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) = getLR0Terms grams 
//let initI = (0,1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]) 
//let t = getClosure  ntnAftM topM (Set.ofList [initI]) 
//let u = getGoto ntnAftM topM whole t "NUM" 
//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 
 
 
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 
     
    let NTN_FollowMap =  getNTN_FollowMap 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 getGotoPA = getGoto ntnAftM_ItemsSet topM_ItemsSet lr0TItemsMap 
     
///////ここがLR0と異なる 
 
    //reducableなitemとfollow集合のpairのセット  
    let reduceTermPairSet = 
         let temp =  
             [for  (clNo,subNo,lh,bfr,agt,lst) in reduceItemsSet do 
                for tn in NTN_FollowMap.[lh] do 
                     yield ((clNo,subNo,lh,bfr,agt,lst),tn) 
             ] 
         Set.ofList temp        
      
////////LR0と異なる部分ここまで! 
  
    let rec makeMapSub (ntn_tnLst:List<string>) (curProcessingClsNo:int) (curExistClsNum:int)  
                       (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  accCls2IdMap accId2ClsMap accMap 
        //受理状態のみを含むClosureの左端の場合 
        elif  isFinalLR0Item  accId2ClsMap.[curProcessingClsNo] = true then  
                let addedMap = addFinalRow2map curProcessingClsNo accMap 
                makeMapSub wholeNtnAndTnLst (curProcessingClsNo + 1) curExistClsNum  accCls2IdMap accId2ClsMap addedMap 
        //一般状態 
        else     
           match ntn_tnLst with 
            |[] -> //右端に来る場合は最初の2つの場合でチェック済み 
                failwith "neverOccurable Error" 
            |hd::tl -> 
                //還元の可能性を調べる 
                let reduceItems = 
                   accId2ClsMap.[curProcessingClsNo] 
                    |> Set.filter (fun item -> Set.contains (item,hd) reduceTermPairSet) 
                if  Set.count reduceItems > 1 then 
                    failwith (sprintf "還元/還元衝突 %s  %A " hd reduceItems ) 
                 
                elif Set.count reduceItems = 1 then //還元項がある場合 
                    //シフトの可能性を調べる 
                    let shiftableItems =  
                        accId2ClsMap.[curProcessingClsNo]  
                            |>Set.filter (fun (_,_,_,_,aft,_) -> aft = hd)   
                     
                    if Set.count shiftableItems >= 1 then 
                        failwith (sprintf "シフト/還元衝突 %s  reduceItems = %A \n shiftItem = %A" hd reduceItems shiftableItems ) 
                    else 
                        match List.head (List.ofSeq reduceItems) with 
                        |(gramNo,_,lhName,_,_,lstWithMarker) ->  
                                makeMapSub tl curProcessingClsNo curExistClsNum accCls2IdMap accId2ClsMap  
                                        (Map.add (curProcessingClsNo,hd) (REDUCE(gramNo,((List.length lstWithMarker) - 1),lhName))  accMap)  
                 
                else //還元しない場合(シフトもしくは対象なしの場合) 
                    let newGoto = getGotoPA accId2ClsMap.[curProcessingClsNo] hd //処理中のclosureとtermからGoto集合を求める 
                    if newGoto = Set.empty then //行先なし(表として空欄になる)場合 
                           makeMapSub tl curProcessingClsNo curExistClsNum accCls2IdMap accId2ClsMap 
                                            (Map.add (curProcessingClsNo,hd)  NUL accMap) 
                    else 
                        match (Map.tryFind newGoto accCls2IdMap) with 
                        //newGotoがすでに、Closureとして存在する場合 
                        |Some(i) -> makeMapSub tl curProcessingClsNo curExistClsNum  
                                               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)  
                                               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  initAccCls2IdMap initId2accCls Map.empty 
 
//リストからn個の要素をpopして残りを返す補助関数 
let popN in_lst in_n = 
    let rec popNSub lst count = 
        if count = in_n then 
            lst 
        else 
            popNSub (List.tail lst) (count + 1) 
    popNSub in_lst 0 
 
 
//リストからn個の要素をpopしてpopしたものと残りを返す補助関数 
let getPopN in_lst in_n = 
    let rec popNSub lst acc count = 
        if count = in_n then 
            (List.rev acc,lst) 
        else 
            popNSub (List.tail lst) ((List.head lst)::acc) (count + 1) 
    popNSub in_lst [] 0 
 
              //stepNo*スタック*入力記号の残り 
type anaState = int*list<string>*list<string> 
 
let analizeOneStep (idTerm2VLR0Map:Map<int*string,LR0State>) ((no,stk,rem):anaState) = 
    let curAtmtnst:int =  System.Int32.Parse(List.head stk) 
    let topRemain:string = List.head rem 
    let nextMove = idTerm2VLR0Map.[curAtmtnst,topRemain] 
    match nextMove with 
    |SHIFT(nextAtmtnNo) -> 
                (no+1,nextAtmtnNo.ToString()::topRemain::stk,List.tail rem) 
    |REDUCE(ruleNo,graEleNum,lhName) -> 
                (no+1,popN stk (2*graEleNum) ,lhName::rem) 
    |ACCEPT->      //終了の場合は状態を変えない 
            (no,stk,rem) 
    |NUL   -> 
            failwith "ソースが文法にのっとっていません" 
 
let analizeOneStepSimple (idTerm2VLR0Map:Map<int*string,LR0State>) ((no,stk,rem):anaState) = 
    let curAtmtnst:int =  System.Int32.Parse(List.head stk) 
    let topRemain:string = List.head rem 
    let nextMove = idTerm2VLR0Map.[curAtmtnst,topRemain] 
    match nextMove with 
    |SHIFT(nextAtmtnNo) -> 
                (no+1,nextAtmtnNo.ToString()::stk,List.tail rem) 
    |REDUCE(ruleNo,graEleNum,lhName) -> 
                (no+1,popN stk graEleNum ,lhName::rem) 
    |ACCEPT->      //終了の場合は状態を変えない 
            (no,stk,rem) 
    |NUL   -> 
            failwith "ソースが文法にのっとっていません" 
 
 
 
//SLRオートマトン表示用(SLRオートマトンは構文解析表をつくるのには使いません。単に表示用です。) 
//LR0Itemのマーカーが最後のものについて後ろにFollowSetを付け加えます。 
let atmtnMap2Str (inMap:Map<int,Set<LR0ItemType>>)  (inGrams:list<string>)     = 
    let NTN_FollowMap =  getNTN_FollowMap inGrams 
    let accSb = new System.Text.StringBuilder() 
    inMap 
        |> Map.toList 
        |> List.sortBy (fun (i,_) ->i) 
        |> List.iter (fun (i,sets) -> 
                        let accSetStr = Set.fold (fun state (_,_,lhName,_,aft,lst) -> 
                                                        if aft = "NULL" then  
                                                             state + (sprintf "%s → %A  %A\r\n" lhName lst NTN_FollowMap.[lhName]) 
                                                        else 
                                                             state + (sprintf "%s → %A  \r\n" lhName lst ) 
                                                  )            
                                                  ""  
                                                  sets  
                        accSb.Append(sprintf "\r\n--------------------%d----------------------\r\n\r\n" i ).Append(accSetStr) |> ignore 
                     ) 
    accSb.ToString() 
 
/////構文木関連//////////////////////////////////////// 
 
//引数分の空白文字を作る補助関数 
let spaceStr(i) =  
    let sb = new System.Text.StringBuilder() 
    let rec addSpace count = 
        if count = i then sb.ToString() 
        else 
            sb.Append(" ") |> ignore 
            addSpace (count + 1) 
    addSpace 0  
 
 
type embodyST = 
    |Atmtn_Leaf of int //オートマトン番号 
    |Leaf of string //トークン文字列 
    |Node of (int* string * list<embodyST>) //intは構文規則番号,stringは "(1, "Program", ["DeclStmts"; "PrintStmts"])"等 
 
     
    //表示用 
    member this.dispStr (inc :int)  = //inc = インシデント 
            match this with 
            |Atmtn_Leaf (atmtnNo) 
                -> spaceStr(inc) +  (sprintf "atmtn = %d" atmtnNo) + "\r\n" 
 
            |Leaf(str) 
                -> spaceStr(inc) +  str + "\r\n"  
            |Node(index,str,lst)  
                -> spaceStr(inc) + str + "\r\n"  
                   + List.fold (fun state (ele:embodyST) -> state + (ele.dispStr (inc + 4)) ) "" lst  
 
    member this.getAtmtnNo () = 
            match this with 
            |Atmtn_Leaf (atmtnNo) 
                -> atmtnNo 
 
            |_  -> failwith "neverOccurableError"  
 
    member this.getTerminalName () = 
            match this with 
            |Leaf(tntName) 
                -> tntName 
            |Node(_,gramStr,childNodes) 
                ->let (_,lhName,_) = splitOneLineGram gramStr 
                  lhName   
            |_  -> failwith "neverOccurableError"  
 
//スタック内のembodySTを表示用文字列に変換する時の向き 
type ST_DISP_Direction = 
    |ST_DISP_FORWARD  //スタックの先頭から 
    |ST_DISP_BACKWARD //スタックの末尾から 
 
//スタック内のembodySTを表示用文字列に変換する 
let cnvEmbodyStList2Str (inLst:list<embodyST>) (dirc: ST_DISP_Direction) = 
    let sb = new System.Text.StringBuilder() 
    let copeLst = 
        if dirc = ST_DISP_FORWARD then 
            inLst 
        else 
            List.rev inLst 
 
    copeLst 
        |> List.iter (fun node -> sb.Append(node.dispStr 4) |> ignore)  
     
    sb.ToString() 
 
               //stepNo*スタック*入力記号の残り 
type treeState = int*list<embodyST>*list<embodyST> 
 
//構文木作成表示用////構文番号->"1:Program = DeclStmts PrintStmts";//構文解析map////////////////////状態////////////////////////////// 
let analizeOneStepTree (id2gramRuleMap:Map<int,string>) (idTerm2VLR0Map:Map<int*string,LR0State>) ((no,stkOfTree,remOfTree):treeState) = 
    let curAtmtnst:int = (List.head stkOfTree).getAtmtnNo() 
    let topRemainNode = List.head remOfTree 
    let topRemainNodeTerminalName:string = topRemainNode.getTerminalName() 
    let nextMove = idTerm2VLR0Map.[curAtmtnst,topRemainNodeTerminalName] 
    match nextMove with 
    |SHIFT(nextAtmtnNo) -> 
                (no+1, Atmtn_Leaf(nextAtmtnNo):: topRemainNode::stkOfTree,List.tail remOfTree) 
    |REDUCE(ruleNo,graEleNum,lhName) -> 
                let (popNodes,remT) = getPopN stkOfTree (2*graEleNum) 
                //偶数番だけとりだす。(Atmtn_Leafを取り除く ) 
                let nesNodes = popNodes |>  List.mapi(fun i x -> (i,x)) |> List.filter(fun (i,_) -> i % 2 = 1) |> List.map (fun (_,x) -> x) |> List.rev 
                (no+1,remT, (Node(ruleNo,id2gramRuleMap.[ruleNo],nesNodes))::remOfTree) 
    |ACCEPT->      //終了の場合は状態を変えない 
            (no,stkOfTree,remOfTree) 
    |NUL   -> 
            failwith "ソースが文法にのっとっていません" 
 
 
open System.Windows.Forms    
open System.Drawing  
 
//LR0Winのものを併用(LRをSLRに変更) 
let f2c x = x :> System.Windows.Forms.Control  
let term_lb= new ListBox(FormattingEnabled = true,ItemHeight = 12,Location = new Point(536, 42),Name = "term_lb",Size = new Size(78, 148),TabIndex = 41) 
let ntn_lb= new ListBox(FormattingEnabled = true,ItemHeight = 12,Location = new Point(646, 42),Name = "ntn_lb",Size = new Size(95, 148),TabIndex = 40) 
let gram_lb= new ListBox(FormattingEnabled = true,ItemHeight = 12,Location = new Point(763, 42),Name = "gram_lb",Size = new Size(279, 148),TabIndex = 39) 
let save_btn= new Button(Location = new Point(322, 11),Name = "save_btn",Size = new Size(75, 23),TabIndex = 38,Text = "Save",UseVisualStyleBackColor = true) 
let load_btn= new Button(Location = new Point(241, 11),Name = "load_btn",Size = new Size(75, 23),TabIndex = 37,Text = "Load",UseVisualStyleBackColor = true) 
let label7= new Label(AutoSize = true,Location = new Point(12, 14),Name = "label7",Size = new Size(53, 12),TabIndex = 36,Text = "構文規則") 
let label6= new Label(AutoSize = true,Location = new Point(766, 16),Name = "label6",Size = new Size(53, 12),TabIndex = 35,Text = "構文規則") 
let label5= new Label(AutoSize = true,Location = new Point(660, 16),Name = "label5",Size = new Size(65, 12),TabIndex = 34,Text = "非終端記号") 
let label4= new Label(AutoSize = true,Location = new Point(539, 16),Name = "label4",Size = new Size(53, 12),TabIndex = 33,Text = "終端記号") 
let apply_btn= new Button(Location = new Point(416, 71),Name = "apply_btn",Size = new Size(107, 52),TabIndex = 32,Text = "適用",UseVisualStyleBackColor = true) 
let base_gram_tb= new TextBox(Location = new Point(18, 42),Multiline = true,Name = "base_gram_tb",ScrollBars = ScrollBars.Vertical,Size = new Size(379, 99),TabIndex = 31) 
let atmtn_tb= new TextBox(Location = new Point(18, 174),Multiline = true,Name = "atmtn_tb",ScrollBars = ScrollBars.Both,Size = new Size(505, 198),TabIndex = 42,WordWrap = false) 
let label1= new Label(AutoSize = true,Location = new Point(16, 149),Name = "label1",Size = new Size(86, 12),TabIndex = 43,Text = "SLR状態") 
let parsing_lv= new ListView(Location = new Point(536, 233),Name = "parsing_lv",Size = new Size(609, 198),TabIndex = 44,UseCompatibleStateImageBehavior = false) 
let label2= new Label(AutoSize = true,Location = new Point(542, 205),Name = "label2",Size = new Size(93, 12),TabIndex = 45,Text = "SLR構文解析表") 
let error_tb= new TextBox(Location = new Point(18, 396),Multiline = true,Name = "error_tb",ScrollBars = ScrollBars.Vertical,Size = new Size(505, 35),TabIndex = 46) 
let label3= new Label(AutoSize = true,Location = new Point(19, 378),Name = "label3",Size = new Size(32, 12),TabIndex = 47,Text = "エラー") 
let src_tb= new TextBox(Location = new Point(6, 50),Multiline = true,Name = "src_tb",ScrollBars = ScrollBars.Vertical,Size = new Size(502, 55),TabIndex = 48) 
let groupBox1= new GroupBox(Location = new Point(21, 447),Name = "groupBox1",Size = new Size(1124, 453),TabIndex = 49,TabStop = false,Text = "構文解析") 
let sourceSave_btn= new Button(Location = new Point(407, 18),Name = "sourceSave_btn",Size = new Size(101, 23),TabIndex = 54,Text = "ソースのSave",UseVisualStyleBackColor = true) 
let sourceLoad_btn= new Button(Location = new Point(300, 18),Name = "sourceLoad_btn",Size = new Size(101, 23),TabIndex = 53,Text = "ソースのLoad",UseVisualStyleBackColor = true) 
let oneStepFor_btn= new Button(Location = new Point(541, 60),Name = "oneStepFor_btn",Size = new Size(234, 34),TabIndex = 52,Text = "解析状態をワンステップ進める",UseVisualStyleBackColor = true) 
let anaInit_btn= new Button(Location = new Point(971, 60),Name = "anaInit_btn",Size = new Size(123, 34),TabIndex = 51,Text = "解析状態を初期化",UseVisualStyleBackColor = true) 
let tabControl1= new TabControl(Location = new Point(8, 121),Name = "tabControl1",SelectedIndex = 0,Size = new Size(1099, 314),TabIndex = 50) 
let tabPage1= new TabPage(Location = new Point(4, 22),Name = "tabPage1",Padding = new Padding(3),Size = new Size(1091, 288),TabIndex = 0,Text = "解析状態(詳細)",UseVisualStyleBackColor = true) 
let tabPage2= new TabPage(Location = new Point(4, 22),Name = "tabPage2",Padding = new Padding(3),Size = new Size(1091, 288),TabIndex = 1,Text = "解析状態(簡易)",UseVisualStyleBackColor = true) 
let tabPage3= new TabPage(Location = new Point(4, 22),Name = "tabPage3",Size = new Size(1091, 288),TabIndex = 2,Text = "解析状態(抽象木)",UseVisualStyleBackColor = true) 
let anaTreeStk_tb= new TextBox(Location = new Point(15, 15),Multiline = true,Name = "anaTreeStk_tb",ScrollBars = ScrollBars.Vertical,Size = new Size(520, 253),TabIndex = 50) 
let label8= new Label(AutoSize = true,Location = new Point(10, 26),Name = "label8",Size = new Size(33, 12),TabIndex = 49,Text = "ソース") 
let anaDisp_lv= new ListView(Location = new Point(15, 15),Name = "anaDisp_lv",Size = new Size(1057, 244),TabIndex = 0,UseCompatibleStateImageBehavior = false) 
let anaDispSim_lv= new ListView(Location = new Point(15, 15),Name = "anaDispSim_lv",Size = new Size(1057, 244),TabIndex = 0,UseCompatibleStateImageBehavior = false) 
let anaTreeRem_tb= new TextBox(Location = new Point(551, 15),Multiline = true,Name = "anaTreeRem_tb",ScrollBars = ScrollBars.Vertical,Size = new Size(520, 253),TabIndex = 51) 
let tabPage4= new TabPage(Location = new Point(4, 22),Name = "tabPage4",Size = new Size(1091, 288),TabIndex = 3,Text = "解析状態(テキスト形式)",UseVisualStyleBackColor = true) 
let anaTextFormat_tb= new TextBox(Location = new Point(15, 15),Multiline = true,Name = "anaTextFormat_tb",ScrollBars = ScrollBars.Vertical,Size = new Size(1067, 253),TabIndex = 51) 
let labbel1= new Label(AutoSize = true,Location = new Point(81, 26),Name = "labbel1",Size = new Size(73, 12),TabIndex = 51,Text = "EOFは不必要") 
let label9= new Label(AutoSize = true,Location = new Point(70, 7),Name = "label9",Size = new Size(109, 12),TabIndex = 50,Text = "EPSILONは使用可") 
let labbel12= new Label(AutoSize = true,Location = new Point(71, 22),Name = "labbel12",Size = new Size(140, 12),TabIndex = 52,Text = "0:Z=Program EOFは不必要") 
let mainForm= new Form(AutoScaleDimensions = new SizeF(6.0f, 12.0f),AutoScaleMode = AutoScaleMode.Font,ClientSize = new Size(1169, 912),Name = "mainForm",Text = "SLR with EPSILON") 
[ f2c sourceSave_btn; f2c labbel1; f2c sourceLoad_btn; f2c oneStepFor_btn; f2c anaInit_btn; f2c tabControl1; f2c label8; f2c src_tb] |> List.iter(fun cnt -> groupBox1.Controls.Add cnt) 
[ f2c labbel12; f2c label9; f2c groupBox1; f2c label3; f2c error_tb; f2c label2; f2c parsing_lv; f2c label1; f2c atmtn_tb; f2c term_lb; f2c ntn_lb; f2c gram_lb; f2c save_btn; f2c load_btn; f2c label7; f2c label6; f2c label5; f2c label4; f2c apply_btn; f2c base_gram_tb] |> List.iter(fun cnt -> mainForm.Controls.Add cnt) 
[ f2c tabPage1; f2c tabPage2; f2c tabPage3; f2c tabPage4] |> List.iter(fun cnt -> tabControl1.Controls.Add cnt) 
[ f2c anaDisp_lv] |> List.iter(fun cnt -> tabPage1.Controls.Add cnt) 
[ f2c anaDispSim_lv] |> List.iter(fun cnt -> tabPage2.Controls.Add cnt) 
[ f2c anaTreeRem_tb; f2c anaTreeStk_tb] |> List.iter(fun cnt -> tabPage3.Controls.Add cnt) 
[ f2c anaTextFormat_tb] |> List.iter(fun cnt -> tabPage4.Controls.Add cnt) 
 
label1.Text <- "SLRオートマトン" 
label2.Text <- "SLR構文解析表" 
label9.Text <- "EPSILONは使用可" 
mainForm.Text <- "SLR" 
 
 
let mutable GL_base_gram_lst:list<string> = [] 
let mutable GL_no2GramEleMap:Map<int,string> = Map.empty 
let mutable GL_no2AutomatonMap:Map<int,Set<LR0ItemType>> = Map.empty 
let mutable GL_idTerm2VLR0Map:Map<int*string,LR0State> = Map.empty 
let mutable GL_curAtmtnState:anaState = (0,[],[]) 
let mutable GL_curAtmtnStateSimple:anaState = (0,[],[]) 
let mutable GL_curTreeState:treeState = (0,[],[]) 
 
 
let cnvCurAtmtnState2Arr ((no,stk,rem): anaState) = 
    [| (sprintf "%d" no) ; (sprintf "%A" (List.rev stk)) ;(sprintf "%A" rem) |] 
 
let anliznPartClear () =  
    error_tb.Text <- "" 
    anaDisp_lv.Clear() 
    anaDispSim_lv.Clear() 
    anaTreeStk_tb.Text <- "" 
    anaTreeRem_tb.Text <- "" 
    anaTextFormat_tb.Text <- "" 
 
let clear () = 
    ntn_lb.Items.Clear() 
    term_lb.Items.Clear() 
    gram_lb.Items.Clear() 
    parsing_lv.Clear() 
    atmtn_tb.Text <- "" 
    anliznPartClear () 
 
let showCurAtmtnStateOnanaTextFormat_tb () =   
    let (no,stk,rem) = GL_curAtmtnState 
    let str = sprintf "%d %A <<->>%A \r\n" no (List.rev stk) rem  
    anaTextFormat_tb.Text <-  str  + anaTextFormat_tb.Text   
 
apply_btn.Click.Add 
    (fun _ ->   clear() 
                try 
                    let tempLst =  base_gram_tb.Text.Split([|'\n'|]) 
                                     |> Array.map (fun str -> str.Trim()) 
                                     |> Array.filter(fun str -> str <> "") 
                                     |> List.ofArray  
               
                    GL_base_gram_lst <-  ( "0:Z = Program EOF" :: tempLst)  
                    //非終端記号、終端記号の表示 
                    let (ntnSet,tnSet) = getNTN_TN__Sets  GL_base_gram_lst 
                    Set.iter (fun ele -> ntn_lb.Items.Add(ele) |> ignore ) ntnSet 
                    Set.iter (fun ele -> term_lb.Items.Add(ele) |> ignore ) tnSet 
                    //構文規則の表示 
                    List.iter(fun str -> gram_lb.Items.Add(str) |> ignore ) GL_base_gram_lst 
  
                    //広域変数への代入 
                    let (res1,res2) = makeLR0Map  GL_base_gram_lst 
                    GL_no2AutomatonMap <- res1 
                    GL_idTerm2VLR0Map <-  res2 
 
                    //オートマトンの表示 
                    atmtn_tb.Text <- atmtnMap2Str GL_no2AutomatonMap GL_base_gram_lst 
                    
                    //構文解析表の表示 
                    parsing_lv.View <- View.Details 
                    parsing_lv.GridLines <- true 
                    let wholeTerm = tnSet + ntnSet 
                    wholeTerm 
                        |> List.ofSeq 
                        |> List.map (fun str -> new ColumnHeader(Text = str,Width = 60)) 
                        |> List.append  [ new ColumnHeader(Text = "",Width = 30)] 
                        |> List.iter (fun col ->parsing_lv.Columns.Add col |> ignore) 
                     
                    let autoMatonNum = List.length (List.ofSeq GL_no2AutomatonMap) 
                     
                    let parsingRealtionArrArr = 
                        [| for i in [1 .. autoMatonNum] do 
                              yield [| 
                                        yield (sprintf "%3d" i) 
                                        for str in wholeTerm do 
                                            let findRelation = Map.find (i,str) GL_idTerm2VLR0Map 
                                            match findRelation with 
                                            |NUL -> yield ""         
                                            |SHIFT(k)   -> yield (sprintf "S<%d>" k) 
                                            |REDUCE(u,v,_) -> yield (sprintf "R[%d]%d" u v) 
                                            |ACCEPT      -> yield "A" 
                                    |] 
                        |] 
 
                    parsingRealtionArrArr 
                      |> Array.map (fun (subArr:string[]) -> new ListViewItem(subArr)) 
                      |> Array.iter (fun lvItem -> parsing_lv.Items.Add(lvItem) |> ignore)  
 
                    //文法番号から文字列へのマップの作成と登録 
                    let relLst = //[(5,"5:Program = DeclStmts PrintStmts");.....という形 
                       GL_base_gram_lst 
                          |> List.map (fun s ->  
                                            let (no,lhName,_) = splitOneLineGram s 
                                            (no,s) 
                                      ) 
                    GL_no2GramEleMap <- Map.ofList relLst 
 
 
                with 
                |MyGramExcp(str) -> error_tb.Text <- sprintf "構文規則の表記が不正です:%s" str   
                | ex -> error_tb.Text <- ex.Message  
    ) 
 
 
anaInit_btn.Click.Add 
    (fun _ -> try 
                let initSrcLst = src_tb.Text.Replace("\r\n", "\n").Split[|' ';'\n'|]  
                                 |> List.ofArray |>  List.map(fun s-> s.Trim()) |> List.filter (fun s -> s <> "") 
                let srcLst = initSrcLst @ ["EOF"] 
                anliznPartClear () 
                GL_curAtmtnState <- (1,["1"],srcLst)  
                GL_curAtmtnStateSimple <- (1,["1"],srcLst) 
                GL_curTreeState <-  ( 1,[Atmtn_Leaf(1)], (List.map(fun s -> Leaf(s)) srcLst) ) 
 
 
                //解析状態(詳細)用 
                anaDisp_lv.View <- View.Details 
                anaDisp_lv.GridLines <- true 
                ["スタック";"入力記号の残り"] 
                    |> List.map (fun str -> new ColumnHeader(Text = str,Width = 500)) 
                    |> List.append  [ new ColumnHeader(Text = "",Width = 57)] 
                    |> List.iter (fun col ->anaDisp_lv.Columns.Add col |> ignore) 
 
                (cnvCurAtmtnState2Arr GL_curAtmtnState) 
                      |> (fun x -> new ListViewItem(x)) 
                      |> (fun lvItem -> anaDisp_lv.Items.Add(lvItem) |> ignore)  
 
                //解析状態(簡易)用 
                anaDispSim_lv.View <- View.Details 
                anaDispSim_lv.GridLines <- true 
                ["スタック";"入力記号の残り"] 
                    |> List.map (fun str -> new ColumnHeader(Text = str,Width = 500)) 
                    |> List.append  [ new ColumnHeader(Text = "",Width = 57)] 
                    |> List.iter (fun col ->anaDispSim_lv.Columns.Add col |> ignore) 
 
                (cnvCurAtmtnState2Arr GL_curAtmtnStateSimple) 
                      |> (fun x -> new ListViewItem(x)) 
                      |> (fun lvItem -> anaDispSim_lv.Items.Add(lvItem)  |> ignore)  
 
                //解析状態(構文木) 用 
                let (_,treeStk,remTree) = GL_curTreeState 
                anaTreeStk_tb.Text <- cnvEmbodyStList2Str treeStk ST_DISP_BACKWARD 
                anaTreeRem_tb.Text <- cnvEmbodyStList2Str remTree ST_DISP_FORWARD 
                 
                //解析状態文字列表示(dataは詳細用のものを使用) 
                showCurAtmtnStateOnanaTextFormat_tb () 
 
 
              with 
                |MyGramExcp(str) -> error_tb.Text <- sprintf "構文規則の表記が不正です:%s" str   
                | ex -> error_tb.Text <- ex.Message  
    ) 
 
oneStepFor_btn.Click.Add 
    (fun _ -> try 
                //解析状態(詳細)更新 
                let nextAtmtnState = analizeOneStep GL_idTerm2VLR0Map GL_curAtmtnState 
                GL_curAtmtnState <- nextAtmtnState 
                //解析状態(簡易)更新 
                let nextAtmtnStateSimple = analizeOneStepSimple GL_idTerm2VLR0Map GL_curAtmtnStateSimple 
                GL_curAtmtnStateSimple <- nextAtmtnStateSimple 
                //解析状態(構文木)更新 
                let nextAtmtnTreeState  = analizeOneStepTree  GL_no2GramEleMap GL_idTerm2VLR0Map GL_curTreeState 
                GL_curTreeState <- nextAtmtnTreeState 
                 
                //解析状態(詳細)表示 
                (cnvCurAtmtnState2Arr GL_curAtmtnState) 
                      |> (fun x -> new ListViewItem(x)) 
                      |> (fun lvItem -> anaDisp_lv.Items.Insert(0,lvItem) |> ignore)  
   
                //解析状態(簡易)表示 
                (cnvCurAtmtnState2Arr GL_curAtmtnStateSimple) 
                      |> (fun x -> new ListViewItem(x)) 
                      |> (fun lvItem -> anaDispSim_lv.Items.Insert(0,lvItem) |> ignore)  
                //解析状態(構文木) 表示 
                let (_,treeStk,remTree) = GL_curTreeState 
                anaTreeStk_tb.Text <- cnvEmbodyStList2Str treeStk ST_DISP_BACKWARD 
                anaTreeRem_tb.Text <- cnvEmbodyStList2Str remTree ST_DISP_FORWARD 
 
                //解析状態文字列表示(dataは詳細用のものを使用) 
                showCurAtmtnStateOnanaTextFormat_tb () 
 
              with 
                |MyGramExcp(str) -> error_tb.Text <- sprintf "構文規則の表記が不正です:%s" str   
                | ex -> error_tb.Text <- ex.Message  
    ) 
 
//Load  
load_btn.Click.Add  
    (fun _ -> try  
                let ofd = new OpenFileDialog(Filter = "GRA3ファイル(*.gra3)|*.gra3|すべてのファイル(*.*)|*.*")  
                if(ofd.ShowDialog() = DialogResult.OK) then  
                    use sr = new System.IO.StreamReader(ofd.FileName)  
                    base_gram_tb.Text <- sr.ReadToEnd()  
              with  
                | ex -> error_tb.Text <- ex.Message  
    )  
 
//Save  
save_btn.Click.Add  
    (fun _ -> try  
                let sfd = new SaveFileDialog(Filter = "GRA3ファイル(*.gra3)|*.gra3|すべてのファイル(*.*)|*.*",  
                                              RestoreDirectory = true)  
                if (sfd.ShowDialog() = DialogResult.OK) then  
                    use sw = new System.IO.StreamWriter(sfd.FileName)  
                    sw.Write(base_gram_tb.Text)  
              with  
                | ex -> error_tb.Text <- ex.Message  
                  
    )  
 
 
 
sourceLoad_btn.Click.Add 
    (fun _ -> error_tb.Text <- ""  
              try  
                let ofd = new OpenFileDialog(Filter = "srcファイル(*.src)|*.src|すべてのファイル(*.*)|*.*")  
                if(ofd.ShowDialog() = DialogResult.OK) then  
                    use sr = new System.IO.StreamReader(ofd.FileName)  
                    src_tb.Text <- sr.ReadToEnd()  
              with  
                | ex -> error_tb.Text <- ex.Message  
    )  
 
sourceSave_btn.Click.Add  
    (fun _ -> error_tb.Text <- ""   
              try  
                let sfd = new SaveFileDialog(Filter = "srcファイル(*.src)|*.src|すべてのファイル(*.*)|*.*",  
                                              RestoreDirectory = true)  
                if (sfd.ShowDialog() = DialogResult.OK) then  
                    use sw = new System.IO.StreamWriter(sfd.FileName)  
                    sw.Write(src_tb.Text)  
              with  
                | ex -> error_tb.Text <- ex.Message  
                  
    )  
 
 
[<STAThread()>]   
do Application.Run(mainForm)   
 
スポンサーサイト

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

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

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

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

この人とブロともになる

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