スポンサーサイト

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

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

 さて紹介する予定の構文解釈方法も今回のLALR(1)で最後です。 
LALR(1)はLR(1)に、さらに解釈の精密さを加えたものではなく、少し簡略化したものになります。 
(構文解釈能力ではLR(1)の方がLALR(1)より上です。) 
なぜ、簡略化するかというと、LR(1)では状態数が大きくなりすぎる傾向があるからです。 
では簡略化の方法を説明します。 
 
LR(1)項i=[X→α@β,t]から、先読み記号を除いたLR(0)項[X→α@β]をiの核といいます。 
LALR(1)ではLR(1)状態で核が同じものをすべて併合します。 
 
前回の例の文法 
0:Z = Program EOF 
1:Program = Exp EQ2 Exp 
2:Program = ID 
3:Exp = Exp ADD Term 
4:Exp = Term 
5:Term = ID 
で説明すると 
 
LR1状態 
 
--------------------1---------------------- 
 
Z → ["@"; "Program"; "EOF"]  set ["EOF"] 
Program → ["@"; "Exp"; "EQ2"; "Exp"]  set ["EOF"] 
Program → ["@"; "ID"]  set ["EOF"] 
Exp → ["@"; "Exp"; "ADD"; "Term"]  set ["ADD"; "EQ2"] 
Exp → ["@"; "Term"]  set ["ADD"; "EQ2"] 
Term → ["@"; "ID"]  set ["ADD"; "EQ2"] 
 
--------------------2---------------------- 
 
Program → ["Exp"; "@"; "EQ2"; "Exp"]  set ["EOF"] 
Exp → ["Exp"; "@"; "ADD"; "Term"]  set ["ADD"; "EQ2"] 
 
--------------------3---------------------- 
 
Program → ["ID"; "@"]  set ["EOF"] 
Term → ["ID"; "@"]  set ["ADD"; "EQ2"] 
 
--------------------4---------------------- 
 
Z → ["Program"; "@"; "EOF"]  set ["EOF"] 
 
--------------------5---------------------- 
 
Exp → ["Term"; "@"]  set ["ADD"; "EQ2"] 
 
--------------------6---------------------- 
 
Exp → ["Exp"; "ADD"; "@"; "Term"]  set ["ADD"; "EQ2"] 
Term → ["@"; "ID"]  set ["ADD"; "EQ2"] 
 
--------------------7---------------------- 
 
Program → ["Exp"; "EQ2"; "@"; "Exp"]  set ["EOF"] 
Exp → ["@"; "Exp"; "ADD"; "Term"]  set ["ADD"; "EOF"] 
Exp → ["@"; "Term"]  set ["ADD"; "EOF"] 
Term → ["@"; "ID"]  set ["ADD"; "EOF"] 
 
--------------------8---------------------- 
 
Term → ["ID"; "@"]  set ["ADD"; "EQ2"] 
 
--------------------9---------------------- 
 
Exp → ["Exp"; "ADD"; "Term"; "@"]  set ["ADD"; "EQ2"] 
 
--------------------10---------------------- 
 
Program → ["Exp"; "EQ2"; "Exp"; "@"]  set ["EOF"] 
Exp → ["Exp"; "@"; "ADD"; "Term"]  set ["ADD"; "EOF"] 
 
--------------------11---------------------- 
 
Term → ["ID"; "@"]  set ["ADD"; "EOF"] 
 
--------------------12---------------------- 
 
Exp → ["Term"; "@"]  set ["ADD"; "EOF"] 
 
--------------------13---------------------- 
 
Exp → ["Exp"; "ADD"; "@"; "Term"]  set ["ADD"; "EOF"] 
Term → ["@"; "ID"]  set ["ADD"; "EOF"] 
 
--------------------14---------------------- 
 
Exp → ["Exp"; "ADD"; "Term"; "@"]  set ["ADD"; "EOF"] 
 
1029-0.jpg 

でしたがLALR(1)では、次のようになります。 
 
--------------------1---------------------- 
 
Z → ["@"; "Program"; "EOF"]  set ["EOF"] 
Program → ["@"; "Exp"; "EQ2"; "Exp"]  set ["EOF"] 
Program → ["@"; "ID"]  set ["EOF"] 
Exp → ["@"; "Exp"; "ADD"; "Term"]  set ["ADD"; "EQ2"] 
Exp → ["@"; "Term"]  set ["ADD"; "EQ2"] 
Term → ["@"; "ID"]  set ["ADD"; "EQ2"] 
 
--------------------2---------------------- 
 
Program → ["Exp"; "@"; "EQ2"; "Exp"]  set ["EOF"] 
Exp → ["Exp"; "@"; "ADD"; "Term"]  set ["ADD"; "EQ2"] 
 
--------------------3---------------------- 
 
Program → ["ID"; "@"]  set ["EOF"] 
Term → ["ID"; "@"]  set ["ADD"; "EQ2"] 
 
--------------------4---------------------- 
 
Z → ["Program"; "@"; "EOF"]  set ["EOF"] 
 
--------------------5---------------------- 
 
Exp → ["Term"; "@"]  set ["ADD"; "EOF"; "EQ2"] 
 
--------------------6---------------------- 
 
Exp → ["Exp"; "ADD"; "@"; "Term"]  set ["ADD"; "EOF"; "EQ2"] 
Term → ["@"; "ID"]  set ["ADD"; "EOF"; "EQ2"] 
 
--------------------7---------------------- 
 
Program → ["Exp"; "EQ2"; "@"; "Exp"]  set ["EOF"] 
Exp → ["@"; "Exp"; "ADD"; "Term"]  set ["ADD"; "EOF"] 
Exp → ["@"; "Term"]  set ["ADD"; "EOF"] 
Term → ["@"; "ID"]  set ["ADD"; "EOF"] 
 
--------------------8---------------------- 
 
Term → ["ID"; "@"]  set ["ADD"; "EOF"; "EQ2"] 
 
--------------------9---------------------- 
 
Exp → ["Exp"; "ADD"; "Term"; "@"]  set ["ADD"; "EOF"; "EQ2"] 
 
--------------------10---------------------- 
 
Program → ["Exp"; "EQ2"; "Exp"; "@"]  set ["EOF"] 
Exp → ["Exp"; "@"; "ADD"; "Term"]  set ["ADD"; "EOF"] 
 
 
1030-0.jpg  
併合されて状態が4つ減っています。 
 
コードとしては、LR1用のdataのセット(accMap,accId2ClsMap,accId2ClsMap)をLALR1用にコンバートする関数 cnvLR12LALR1 を定義してそれを使う部分が変更点になります。 
 
なお、yaccもLALR(1)構文解析器を自動生成するツールです。(恥ずかしながら自動生成ツールは使ったことがありませんが。) 
 
今回も前回と同じようなソフトを作ってみました。 
(実行図) 
 
1030-1.jpg
 
コードは次の通りです。 
 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か(空リストでもtrue) 
           
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=Exp EQ2 Exp";"2:Program = ID"; 
//             "3:Exp = Exp ADD Term";"4:Exp = Term";"5:Term = ID"] 
 
 
 
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 
 
//> getLR1Terms grams;; //結果は中略してある 
// (set 
//     [(0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]); 
//      (2, 2, "Program", "ID", "NULL", ["ID"; "@"]); ...], 
//   set 
//     [(0, 2, "Z", "Program", "EOF", ["Program"; "@"; "EOF"]); 
//      (5, 1, "Term", "NULL", "ID", ["@"; "ID"])], 
//   set 
//     [(0, 3, "Z", "EOF", "NULL", ["Program"; "EOF"; "@"]); 
//       (5, 2, "Term", "ID", "NULL", ["ID"; "@"])], 
//   set 
//     [(0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]); 
//      (5, 1, "Term", "NULL", "ID", ["@"; "ID"])], 
//   set 
//     [(0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]); 
//      (4, 1, "Exp", "NULL", "Term", ["@"; "Term"])], 
//   map 
//     [((0, 1), (0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"])); 
//       ((2, 2), (2, 2, "Program", "ID", "NULL", ["ID"; "@"])); ...], 
//   map 
//     [((0, 1), ["EOF"]); ((1, 1), ["EQ2"; "Exp"]); ((1, 3), []); 
//      ((3, 1), ["ADD"; "Term"]); ((3, 3), []); ((4, 1), [])]) 
//  
let getLR1Terms (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   
 
    
   //markerの直後が非終端記号のものについては、その要素とmarkerの直後の非終端記号の後のリストを組にする 
   //補助関数 
   let rec ntnAMSub lst  = 
        match lst with 
        |hd::tl when hd = "@" -> List.tail tl 
        |hd::tl -> ntnAMSub tl  
        | [] -> failwith "neverOccurableError" 
    
   let rec makeMap inLst accMap = 
        match inLst with 
        |[] -> accMap 
        |(id,subId,_,_,_,lst)::tl ->makeMap tl (Map.add (id,subId) (ntnAMSub lst) accMap) 
 
 
   let idSubId2AfterAfterMarkerMap = makeMap (List.ofSeq ntnAfterMarkerItemsSet) Map.empty 
 
       
   (lr0TermsSet,shiftItemsSet,reduceItemsSet,topMarker_ItemsSet,ntnAfterMarkerItemsSet,lr0TItemsMap,idSubId2AfterAfterMarkerMap) 
 
    
type LR1ItemType = LR0ItemType*Set<string> //Set<string>は先読み記号 
//例 ((3, 1, "Exp", "NULL", "Exp", ["@"; "Exp"; "ADD"; "Term"]),["EOF"]) 
 
 
//let (whole,shift,reduce,topM,ntnAftM,_,idSubId2AfterAfterMarkerMap) = getLR1Terms grams 
//let (ntn,tn) = getNTN_TN__Sets grams 
//let ntnNullableMap = getNTN_NullableMap grams 
//let firstSetMap = getNTN_FirstMap grams 
//let initI = ((0,1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]),Set.ofList ["EOF"]) 
//let t = getClosure  (ntn,tn) ntnNullableMap firstSetMap idSubId2AfterAfterMarkerMap ntnAftM topM (Set.ofList [initI]) 
//val t :Set<(int * int * string * string * string * string list) * Set<string>> = 
//  set 
//    [((0, 1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]), set ["EOF"]); 
//     ((1, 1, "Program", "NULL", "Exp", ["@"; "Exp"; "EQ2"; "Exp"]), 
//      set ["EOF"]); 
//     ((2, 1, "Program", "NULL", "ID", ["@"; "ID"]), set ["EOF"]); 
//     ((3, 1, "Exp", "NULL", "Exp", ["@"; "Exp"; "ADD"; "Term"]), 
//      set ["ADD"; "EQ2"]); 
//     ((4, 1, "Exp", "NULL", "Term", ["@"; "Term"]), set ["ADD"; "EQ2"]); 
//     ((5, 1, "Term", "NULL", "ID", ["@"; "ID"]), set ["ADD"; "EQ2"])] 
let getClosure  ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>) 
                (in_firstSetMap:Map<string,Set<string>>)  
                (inIdSubId2AfterAfterMarkerMap:Map<(int * int),string list>) (inNtnAfterMarkerItemsSet:Set<LR0ItemType>)  
                (inTopMarker_ItemSet:Set<LR0ItemType>) (initI :Set<LR1ItemType>) = 
    let rec getClosureSub oldClosureSet = 
                                  //oldClosureSetの中で非終端記号の前にマーカーがついている形のもの 
        let shouldAddedLR1Items  = Set.filter (fun (ele,_) -> Set.contains ele inNtnAfterMarkerItemsSet) oldClosureSet 
        let newClosureSet = 
            Set.fold  (fun oldClosureSet ((id,subId,_,_,aft0,_),lookAheads) -> //aftはマーカーの直後の非終端記号 
                            let addLRItemBases:Set<LR0ItemType> = Set.filter (fun (_,_,lh,_,_,_ ) -> lh = aft0) inTopMarker_ItemSet 
                            let addLR1Items = 
                                addLRItemBases 
                                  |> Set.map (fun lr0Item -> 
                                                let afterAfterMarkerLst = inIdSubId2AfterAfterMarkerMap.[(id,subId)]  
                                                let afterAfterMarkerNullable = 
                                                    isNullableTokenLst (in_ntn,in_tn) in_ntnNullableMap afterAfterMarkerLst 
                                                let afterAfterMarkerFirst = 
                                                     getFirstSetOfTokenLst (in_ntn,in_tn) in_ntnNullableMap in_firstSetMap afterAfterMarkerLst 
                                                let addLR1ItemLookAheads = 
                                                      if afterAfterMarkerNullable = true then  
                                                            afterAfterMarkerFirst + lookAheads 
                                                      else 
                                                            afterAfterMarkerFirst 
                                                (lr0Item,addLR1ItemLookAheads) 
                                              ) 
                            oldClosureSet + addLR1Items 
                        ) 
                       oldClosureSet 
                       shouldAddedLR1Items 
        if newClosureSet = oldClosureSet then 
             newClosureSet 
        else  
            getClosureSub newClosureSet 
 
    let res0Lst = List.sort (List.ofSeq (getClosureSub initI))  
    //ここまででは(5, 1, "Term", "NULL", "ID", ["@"; "ID"]), set ["ADD"]);((5, 1, "Term", "NULL", "ID", ["@"; "ID"]), set ["EQ2"] 
    //とまとめるべきものがバラバラになっているのでこれをまとめる。 
     
    let dummyEle = ((-1,-1,"","","",[]),Set.empty) 
    
    let (res,_) =  //最後のdummyEleが_にくる 
          (res0Lst @ [dummyEle]) |>   
          List.fold (fun (acc:Set<LR1ItemType>,(oldlr0Part:LR0ItemType,oldLookAheadsPart:Set<string>)) (lr0Part:LR0ItemType,lookAhedsPart:Set<string>) 
                                ->if oldlr0Part = lr0Part then 
                                        (acc, (oldlr0Part,oldLookAheadsPart + lookAhedsPart)) 
                                  else       
                                        ((Set.add (oldlr0Part,oldLookAheadsPart) acc),(lr0Part,lookAhedsPart)) 
                        ) 
             (Set.empty,dummyEle) 
 
      
    Set.filter (fun ((a,_,_,_,_,_),_) -> a <> -1) res //最初のdummyEleを除く 
 
 
//let (whole,shift,reduce,topM,ntnAftM,rlMap,idSubId2AfterAfterMarkerMap) = getLR1Terms grams 
//let (ntn,tn) = getNTN_TN__Sets grams 
//let ntnNullableMap = getNTN_NullableMap grams 
//let firstSetMap = getNTN_FirstMap grams 
//let initI = ((0,1, "Z", "NULL", "Program", ["@"; "Program"; "EOF"]),Set.ofList ["EOF"]) 
//let t = getClosure  (ntn,tn) ntnNullableMap firstSetMap idSubId2AfterAfterMarkerMap ntnAftM topM (Set.ofList [initI]) 
//let u = getGoto (ntn,tn) ntnNullableMap firstSetMap idSubId2AfterAfterMarkerMap ntnAftM topM rlMap t "Exp" 
//val u :  Set<(int * int * string * string * string * string list) * Set<string>> = 
//  set 
//    [((1, 2, "Program", "Exp", "EQ2", ["Exp"; "@"; "EQ2"; "Exp"]), set ["EOF"]); 
//     ((3, 2, "Exp", "Exp", "ADD", ["Exp"; "@"; "ADD"; "Term"]),set ["ADD"; "EQ2"])] 
let getGoto  ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>) 
                (in_firstSetMap:Map<string,Set<string>>)  
                (inIdSubId2AfterAfterMarkerMap:Map<(int * int),string list>) (inNtnAfterMarkerItemsSet:Set<LR0ItemType>)  
                (inTopMarker_ItemSet:Set<LR0ItemType>)  (inIRItemMap:Map<(int*int),LR0ItemType>) 
                (inLR1ItemSet:Set<LR1ItemType>) (inStr:string) = 
 
 
    let getClosurePA = getClosure (in_ntn,in_tn) in_ntnNullableMap in_firstSetMap inIdSubId2AfterAfterMarkerMap 
                                    inNtnAfterMarkerItemsSet inTopMarker_ItemSet 
    let shouldAddGredienceLR1Items = Set.filter (fun ((_,_,_,_,aft,_),_) -> aft = inStr) inLR1ItemSet  
    let tempSet = //マーカーをずらしたものの集合 
            shouldAddGredienceLR1Items 
                |> Set.fold (fun accSet ((i,j,_,_,_,_),lookAheads) ->   
                                let addItemLR0Part = inIRItemMap.[(i,j+1)] //(マーカーを一つ進めたもの(マーカーの次はinStr))  
                                let addLR1Item = (addItemLR0Part,lookAheads) 
                                Set.add addLR1Item accSet   
                            ) 
                   Set.empty  
     
    getClosurePA tempSet 
 
 
//StateとしてはLR0と同じものを使用 
type LR0State = 
    SHIFT of int  //構文番号(オートマトンの番号) 
    |REDUCE of int*int*string //構文番号(オートマトンの番号ではない)* 還元項の右辺の要素数(@は含まない)* 構文の左辺の非終端名 
    |ACCEPT 
    |NUL 
 
 
let makeLR1Map (inGrams:list<string>) = 
     
    let (ntnSet,tnSet) = getNTN_TN__Sets  inGrams 
    let wholeNtnAndTnLst = List.ofSeq(ntnSet + tnSet) 
    let (whole,shift,reduce,topM,ntnAftM,lr0TItemsMap,idSubId2AfterAfterMarkerMap) = getLR1Terms inGrams 
     
    let (ntn,tn) = getNTN_TN__Sets inGrams 
    let ntnNullableMap = getNTN_NullableMap inGrams 
    let firstSetMap = getNTN_FirstMap inGrams 
 
    //受理状態のみを含むClosureか  
    let isFinalLR1Item (cls:Set<LR1ItemType>)  =  
           (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 (ntn,tn) ntnNullableMap firstSetMap idSubId2AfterAfterMarkerMap ntnAftM topM lr0TItemsMap 
 
 
    let rec makeMapSub (ntn_tnLst:List<string>) (curProcessingClsNo:int) (curExistClsNum:int)  
                       (accCls2IdMap:Map<Set<LR1ItemType>,int>) (accId2ClsMap:Map<int,Set<LR1ItemType>>)  
                       (accMap:Map<int*string,LR0State>) = 
        //表の右下まで到達 
        if ntn_tnLst = [] && curProcessingClsNo = curExistClsNum then  
                (accId2ClsMap,accMap,accCls2IdMap) 
        //表の右端まで到達 
        elif ntn_tnLst = [] && curProcessingClsNo < curExistClsNum then 
                makeMapSub wholeNtnAndTnLst (curProcessingClsNo + 1)  curExistClsNum  accCls2IdMap accId2ClsMap accMap 
        //受理状態のみを含むClosureの左端の場合 
        elif  isFinalLR1Item  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 -> 
                //還元の可能性を調べる(ここの扱いがSLRと異なる) 
                let reduceItems = 
                   accId2ClsMap.[curProcessingClsNo] 
                    |> Set.filter (fun ((_,_,_,_,aft,_),lookAheads) -> aft = "NULL" && Set.contains hd lookAheads ) 
                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"]),Set.ofList ["EOF"]) 
    let cls1 = getClosure  (ntn,tn) ntnNullableMap firstSetMap idSubId2AfterAfterMarkerMap ntnAftM topM (Set.ofList [initI]) 
    let initAccCls2IdMap = Map.ofList [(cls1,1)] 
    let initId2accCls = Map.ofList [(1,cls1)] 
    makeMapSub wholeNtnAndTnLst 1 1  initAccCls2IdMap initId2accCls Map.empty 
 
 
//(5, 1, "Term", "NULL", "ID", ["@"; "ID"]), set ["ADD"]);((5, 1, "Term", "NULL", "ID", ["@"; "ID"]), set ["EQ2"] 
//を(5, 1, "Term", "NULL", "ID", ["@"; "ID"]), set ["ADD""EQ2"])とまとめる//Setはソート済みであることに留意 
let mergeLR1ItemsInSet (inLR1Items:Set<LR1ItemType>) = 
    let dummyEle = ((-1,-1,"","","",[]),Set.empty) 
    let mergedLst = List.ofSeq inLR1Items 
    let (res,_) =  //最後のdummyEleが_にくる 
          (mergedLst @ [dummyEle]) |>   
          List.fold (fun (acc:Set<LR1ItemType>,(oldlr0Part:LR0ItemType,oldLookAheadsPart:Set<string>)) (lr0Part:LR0ItemType,lookAhedsPart:Set<string>) 
                                ->if oldlr0Part = lr0Part then 
                                        (acc, (oldlr0Part,oldLookAheadsPart + lookAhedsPart)) 
                                  else       
                                        ((Set.add (oldlr0Part,oldLookAheadsPart) acc),(lr0Part,lookAhedsPart)) 
                        ) 
             (Set.empty,dummyEle) 
    Set.filter (fun ((a,_,_,_,_,_),_) -> a <> -1) res //最初のdummyEleを除く 
 
 
//LR1ItemのSetからLR0部分のidの組だけを抜き出したSetを返す(idの組の重複はなくなる) 
let extractLR0IdsFromLR1ItemsSet (in_lr1ItemsSet:Set<LR1ItemType>) = 
    in_lr1ItemsSet 
        |> Set.fold (fun acc (lr1Item:LR1ItemType) -> 
                        let ((id,subId,_,_,_,_),_) = lr1Item  
                        Set.add (id,subId) acc ) 
                    Set.empty 
 
//LR1用のdataのセット(accMap,accId2ClsMap,accId2ClsMap)をLALR1用にコンバートする関数。 
 
//(accId2ClsMap,accMap,accCls2IdMap) 
 
let cnvLR12LALR1 ((inId2ClsMap:Map<int,Set<LR1ItemType>>),(inGramanMap:Map<int*string,LR0State>),  
                   (inCls2IdMap:Map<Set<LR1ItemType>,int>)) = 
        //次に定義するcoreIds2ClsAndClsIdPairMapの一部は次のようになる 
        // (set [(4, 2)], 
        // (set 
        //  [((4, 2, "Exp", "Term", "NULL", ["Term"; "@"]), set ["ADD"; "EOF"]); 
        //   ((4, 2, "Exp", "Term", "NULL", ["Term"; "@"]), set ["ADD"; "EQ2"])], 
        //  set [5; 12])) 
        // (set [(5, 2)], 
        // (set 
        // [((5, 2, "Term", "ID", "NULL", ["ID"; "@"]), set ["ADD"; "EOF"]); 
        //  ((5, 2, "Term", "ID", "NULL", ["ID"; "@"]), set ["ADD"; "EQ2"])], 
        //  set [8; 11])) //LR1のクロージャーId 8と11が合併したことを表している 
        let coreIds2ClsAndClsIdPairMap:Map<Set<int*int>,Set<LR1ItemType>*Set<int>> = 
              inCls2IdMap 
                |> Map.toList //[(Set[((1,2,"","","",[]),[]),1)(2,3,"","","",[]),[])),1);........] 
                |> List.fold (fun accMap (lr1ItemsSet,clsNo) -> 
                                  let  LR0Ids = extractLR0IdsFromLR1ItemsSet lr1ItemsSet 
                                  let lr1ItemsInMap = Map.tryFind LR0Ids accMap 
                                  match lr1ItemsInMap with 
                                  |Some((alreadyExistLr1Part,alreadyExistClsIds)) 
                                        ->Map.add LR0Ids (alreadyExistLr1Part + lr1ItemsSet,alreadyExistClsIds + Set.ofList [clsNo]) accMap 
                                  |None  
                                        ->Map.add LR0Ids (lr1ItemsSet, (Set.ofList [clsNo])) accMap 
                             )        
                             Map.empty 
        //次に定義するcoreIds2ClsAndClsIdPairMapの一部は次のようになる 
        //(set [5; 12], set [((4, 2, "Exp", "Term", "NULL", ["Term"; "@"]), set ["ADD"; "EOF"; "EQ2"])] 
        //(set [8; 11], set [((5, 2, "Term", "ID", "NULL", ["ID"; "@"]), set ["ADD"; "EOF"; "EQ2"])]) 
        let coreIds2ClsMap = 
                coreIds2ClsAndClsIdPairMap 
                    |> Map.toList  
                    |> List.map (fun (_,(lr1Items,coreId)) ->(coreId,(mergeLR1ItemsInSet lr1Items))) 
                    |> Map.ofList 
 
        //coreを一体化したものの新しい連番ID番号を対応させるMap                                     
        //(set [1], 1)(set [2], 2)(set [3], 3)(set [4], 4)(set [5; 12], 5)(set [6; 13], 6) 
        //(set [7], 7)(set [8; 11], 8)(set [9; 14], 9)(set [10], 10) 
        let newClsIdMap = 
                coreIds2ClsMap 
                    |> Map.toList 
                    |> List.mapi(fun i (idSet,_) -> (idSet,i+1)) 
                    |> Map.ofList 
 
        //上の逆の対応のMap 
        //(1, 1)(2, 2)(3, 3)(4, 4)(5, 5)(6, 6)(7, 7)(8, 8)(9, 9)(10, 10)(11, 8)(12, 5)(13, 6)(14, 9) 
        let oldClsId2NewClsIdMap = 
                let newClsIdList= Map.toList newClsIdMap 
                let corrspondList = 
                    [ for (idSet,newId) in newClsIdList do 
                        for id in idSet do 
                            yield (id,newId) 
                    ]     
                Map.ofList corrspondList 
         
        //新しいクロージャー番号から新しいクロージャーへのMap 
        let newId2ClsMap =   
                coreIds2ClsMap 
                    |> Map.toList 
                    |> List.map (fun (key,cls) -> (newClsIdMap.[key],cls)) 
                    |> Map.ofList 
 
        //新しいクロージャーから新しいクロージャー番号へのMap 
        let newCls2Id2Map =   
                coreIds2ClsMap 
                    |> Map.toList 
                    |> List.map (fun (key,cls) -> (cls,newClsIdMap.[key])) 
                    |> Map.ofList 
 
        let newGramanMap:Map<int*string,LR0State> = 
            let oldGramLst = Map.toList inGramanMap 
            let newMap =  
                    oldGramLst 
                        |>List.fold  
                            (fun accMap ((oldClsNo,termName),lr0State) -> 
                                let newClsNo = oldClsId2NewClsIdMap.[oldClsNo] 
                                match lr0State with 
                                |NUL ->  match Map.tryFind (newClsNo,termName) accMap with 
                                            |None      -> Map.add (newClsNo,termName) NUL accMap 
                                            |Some(NUL) -> Map.add (newClsNo,termName) NUL accMap 
                                            |_         -> accMap //すでにNUL以外のものが登録済みの場合は何もしない 
                                |ACCEPT->Map.add (newClsNo,termName) ACCEPT accMap 
                                |SHIFT(atmtnNo) 
                                        ->let newAtmtnNo =oldClsId2NewClsIdMap.[atmtnNo] 
                                          Map.add (newClsNo,termName) (SHIFT(newAtmtnNo)) accMap                                                     
                                |REDUCE(graNo,eleNum,lhName) //還元/還元衝突を調べる 
                                        -> match Map.tryFind (newClsNo,termName) accMap with 
                                            |None      
                                            |Some(NUL) -> Map.add (newClsNo,termName) (REDUCE(graNo,eleNum,lhName)) accMap 
                                            |Some(REDUCE(graNo2,_,_)) when graNo <> graNo2 //異なる文法番号の還元がすでに登録済み 
                                                    ->failwith (sprintf "LALR変換時 還元/還元衝突"  ) 
                                            | _     ->Map.add (newClsNo,termName) (REDUCE(graNo,eleNum,lhName)) accMap//その他の衝突は起こらない 
                                    ) 
                        Map.empty 
            newMap 
         
        (newId2ClsMap,newGramanMap,newCls2Id2Map) 
 
 
//リストから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 "ソースが文法にのっとっていません" 
 
//LR1オートマトン表示用 
let atmtnMap2Str (inMap:Map<int,Set<LR1ItemType>>)  (inGrams:list<string>)     = 
    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,_,_,lst),lookAheads) -> 
                                                           state + (sprintf "%s → %A  %A\r\n" lhName lst lookAheads) 
                                                  )            
                                                  ""  
                                                  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のものを併用(LR0をLR1に変更) 
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 <- "LALR1オートマトン" 
label2.Text <- "LALR1構文解析表" 
label9.Text <- "EPSILONは使用可" 
mainForm.Text <- "LALR1 " 
 
 
let mutable GL_base_gram_lst:list<string> = [] 
let mutable GL_no2GramEleMap:Map<int,string> = Map.empty 
let mutable GL_no2AutomatonMap:Map<int,Set<LR1ItemType>> = 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() 
    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,res3) =cnvLR12LALR1 ( makeLR1Map  GL_base_gram_lst) //ここがLALR変換を入れる 
                     
                     
                    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ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。