スポンサーサイト

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

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

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