スポンサーサイト

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

F#で入門 コンパイラ 、インタプリタ編 記号表(9)

 今回は前回までの内容を、Winソフト化します。   
実行画面は次の通りです。 
 
1042.jpg
 
使用方法等は前回のソフトとまったく同様なので略します。 
 
コードは以下の通りです。
 コードは以下の通りです。 
 
open System 
open System.Text.RegularExpressions    
open System.Windows.Forms    
open System.Drawing    
 
//文法定義のエラー 
exception MyGramExcp of string 
 
let STR_EPS ="EPSILON" 
 
//引数分の空白文字を作る補助関数 
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 Token(kind:string,img:string,row:int,col:int) = 
    member this.Kind = kind 
    member this.Img = img 
    member this.Row = row 
    member this.Col = col 
 
    override this.ToString() = 
        sprintf "[%s %s (%d,%d)] " kind img row col 
 
//一行をトークン化したときの結果用の型 
type TokenizeOneLineResult = 
    |TOLSuccess of list<Token> 
    |TOLFail of int*int //トークン化失敗したときの行と列 
 
    member this.IsSuccess () = 
        match this with 
        |TOLSuccess(_) -> true 
        | _ -> false 
 
 
type LR0ItemType = int * int * string * string * string * string list 
//                (1,3, "Program", "RPAR", "NULL", ["LPAR"; "Seq"; "RPAR"; "@"]) 
//タプルの第二成分は同一構文規則内の通し番号、一つ大きいのがマーカーを一つ後ろにずらしたもの 
 
type LR1ItemType = LR0ItemType*Set<string> //Set<string>は先読み記号 
//例 ((3, 1, "Exp", "NULL", "Exp", ["@"; "Exp"; "ADD"; "Term"]),["EOF"]) 
 
//StateとしてはLR0と同じものを使用 
type LR0State = 
    SHIFT of int  //構文番号(オートマトンの番号) 
    |REDUCE of int*int*string //構文番号(オートマトンの番号ではない)* 還元項の右辺の要素数(@は含まない)* 構文の左辺の非終端名 
    |ACCEPT 
 
              //文法番号スタック*入力トークン種別の残り 
type anaState = list<int>*list<string> 
 
 
//具象構文木 
type embodyST = 
    |EPS_Leaf of Token //tokenは存在しないので、εの直後のtokenを与える 
    |Leaf of Token  
    |Node of (int* string * list<embodyST>) //intは構文規則番号,stringは "(1, "Program", ["DeclStmts"; "PrintStmts"])"等 
 
    //表示用 
    member this.dispStr (inc :int)  = //inc = インシデント 
            match this with 
            |EPS_Leaf (token) 
                -> spaceStr(inc) +  "ε" + (sprintf "(%d,%d)の前" token.Row token.Col ) + "\r\n" 
            |Leaf(token) 
                -> spaceStr(inc) +  token.ToString() + "\r\n"  
            |Node(index,str,lst)  
                -> spaceStr(inc) + (sprintf "(%d)" index) + str + "\r\n"  
                   + List.fold (fun state (ele:embodyST) -> state + (ele.dispStr (inc + 4)) ) "" lst  
 
///////////////////////////////// 
 
type LR1TokenizeAndParse (inDefLst:list<string*string>, inStrLst:list<string>) = 
 
    let initStrLst = "0:Z = Program EOF" :: inStrLst 
    let initDefLst =  ("EOF","EOF"):: inDefLst 
 
    let makeTokenizeRules (inDefLst:list<string*string>) = 
        inDefLst 
            |> List.map(fun (name,rgText) ->(name,(new Regex ( @"^(?<sPart>\s*)(?<parts>" + rgText + @")")))) 
 
    let tokenizeTopPart (textPart:string) (trl:list<string*Regex>) (row:int) (col:int) = 
        trl 
          |>List.fold (fun (curToken:Token,curLongestLength:int) (name,rg) -> 
                            let wholeMatch = rg.Match(textPart) 
                            let partMatch = wholeMatch.Groups.["parts"]  //必要な部分 
                            let sPartMatch = wholeMatch.Groups.["sPart"] //先頭の空白部分 
                            if wholeMatch.Value.Length > curLongestLength then //最長マッチ 
                                (new Token(name,partMatch.Value,row, col + sPartMatch.Value.Length),wholeMatch.Value.Length ) 
                            else 
                                (curToken,curLongestLength) 
                      ) 
                      (new Token("","",0,0),0) 
 
 
    let tokenizeOneLine (inDefLst:list<string*string>) (inRow:int) (inOneLineStr:string) = 
        let trs = makeTokenizeRules inDefLst 
        let rec tokenizeOneLineSub (curCol:int) (remainStr:string) res = 
            if remainStr.Trim().Length = 0 then 
                TOLSuccess(List.rev res) 
            else 
               let (slicedToken,length) = tokenizeTopPart remainStr trs inRow curCol 
               if length = 0 then 
                    let topBlankNum = remainStr.Length - remainStr.TrimStart().Length 
                    TOLFail(inRow,curCol+topBlankNum) 
               else 
                  tokenizeOneLineSub (curCol + length) (remainStr.Substring(length)) (slicedToken::res)        
        tokenizeOneLineSub 1 inOneLineStr [] 
 
    let tokenizer  (source:list<string>) = 
        let oneLineTokenizer = tokenizeOneLine initDefLst 
        let isTOLSuccess (x:TokenizeOneLineResult) = 
            match x with 
            |TOLSuccess(_) -> true 
            |_             -> false 
        let sucLst,failLst = 
            source 
            |>List.map (fun str -> str.TrimEnd()) 
            |>List.mapi (fun i str -> oneLineTokenizer (i+1) str ) 
            |>List.partition (fun tr -> tr.IsSuccess () ) 
        if failLst.Length > 0 then  
            failwith (sprintf "%A" failLst) 
        else  
            sucLst 
              |>List.map (fun tolr -> match tolr with 
                                         |TOLSuccess(tol) -> tol 
                                         | _ -> failwith "error" //これは起こらない 
                         ) 
              |>List.fold (fun s lst -> s @ lst) [] 
         
    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) 
 
 
    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 (ntnSet,tnSet) =  getNTN_TN__Sets initStrLst   
 
 
    let isNullableToken ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)(inTokenName:string) = 
        if inTokenName = STR_EPS then  
             true 
        elif Set.contains inTokenName in_tn then 
             false 
        else 
            in_ntnNullableMap.[inTokenName] 
 
    let isNullableTokenLst ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)(inTokenNameLst:list<string>) = 
          List.forall (isNullableToken (in_ntn,in_tn) in_ntnNullableMap )inTokenNameLst //リスト中のすべてのtokenがnullableか 
           
    let isNullableTokenLstLst ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)(inTokenNameLstLst:list<list<string>>) = 
          List.exists (isNullableTokenLst (in_ntn,in_tn) in_ntnNullableMap ) inTokenNameLstLst//リスト中のどれかのtokenリストがnullableか 
 
    let grams = initStrLst 
                    |> List.map splitOneLineGram 
                    |> List.map (fun (_,lh,rhEles) -> (lh,rhEles)) //[("Program",["DeclStmts";"PrintStmts"]);("DeclStmts",["VAR";"SEMI"])] 
  
    let getNTN_NullableMap (inStrLst:list<string>) = 
     
    
        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 
 
 
    let ntnNullableMap = getNTN_NullableMap initStrLst 
 
 
    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] 
 
    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 
 
    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 
 
    let getNTN_FirstMap  (inStrLst:list<string>) = 
     
        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 
 
    let ntnFirstMap = getNTN_FirstMap initStrLst 
     
    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 isNullableTokensLstPA (tokenLst:list<string>) = isNullableTokenLst (ntnSet,tnSet) ntnNullableMap tokenLst 
        let getFirstSetOfTokenLstPA (tokenLst:list<string>) = getFirstSetOfTokenLst (ntnSet,tnSet) ntnNullableMap  ntnFirstMap tokenLst 
  
        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 ntnFollowMap = getNTN_FollowMap initStrLst 
 
    ///////////////////////////////////////////LR1部分//////////////////////////////////////////////////////////////////////// 
    //マーカーを付けて、マーカーの前後の記号とそれのタプルを返す 
    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) 
 
    let getGramWithMarker (inStr:string) = 
        splitOneLineGram inStr   
          |> addMarkers 
 
    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) 
 
 
    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を除く(これがgetClosureの返り値) 
 
 
    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 
 
 
    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についてEOFの欄だけの項を付け加えて返す。(「noは受理状態のみを含むClosure」の番号を渡す) 
        let addFinalRow2map (idNo:int) (seedMap:Map<int*string,LR0State>) = 
               List.fold  (fun stateMap ele -> 
                                if ele <> "EOF" then 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) 
            //表の右端まで到達 
            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 //還元としてMapに追加 
                            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 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 
 
 
    //リストから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 
 
    /////////////////id2gramRuleMapは構文番号->構文内容へのMap 
    let getTree (id2gramRuleMap:Map<int,string>) (in_idTerm2VLR1Map:Map<int*string,LR0State>) (inTokenLst:list<Token>) = 
         
        let rec getTreeSub  ((stk,rem):anaState) (stkOfTree:list<embodyST>,remOfTree:list<embodyST>)= 
            let curAtmtnst = List.head stk 
            let topRemain = List.head rem 
            let nextMove = Map.tryFind   (curAtmtnst,topRemain) in_idTerm2VLR1Map 
            let topRemainNode = List.head remOfTree 
            match nextMove with 
            |Some(SHIFT(nextAtmtnNo)) -> 
                        getTreeSub (nextAtmtnNo::stk,List.tail rem) (topRemainNode::stkOfTree,List.tail remOfTree) 
             
            |Some(REDUCE(ruleNo,graEleNum,lhName)) -> 
                        let (popNodes,remT) = getPopN stkOfTree graEleNum 
                        getTreeSub (popN stk graEleNum ,lhName::rem) (remT,(Node(ruleNo,id2gramRuleMap.[ruleNo],(List.rev popNodes)))::remOfTree) 
            |Some(ACCEPT)->      //終了の場合は状態を変えない 
                    List.head stkOfTree 
            |None   -> 
                    failwith "ソースが文法にのっとっていません" 
         
        let initTokenKindLst = inTokenLst |> List.map (fun tkn -> tkn.Kind) 
        let initNodeLst = inTokenLst |> List.map (fun tkn -> Leaf(tkn)) 
 
        getTreeSub ([1],initTokenKindLst) ([],initNodeLst) 
 
  
    let id2gramRuleMap = //[(5,"5:Program = DeclStmts PrintStmts");.....という形 
          initStrLst 
            |> List.map (fun s ->  
                            let (no,lhName,_) = splitOneLineGram s 
                            (no,s) 
                        ) 
            |> Map.ofList 
 
    //このMapを使ってトークン列を解析する 
    let (_,lr1Map) = makeLR1Map initStrLst 
    let getTreePA = getTree id2gramRuleMap lr1Map 
 
    member this.GetTokens (sourceLst:list<string>) =   
        tokenizer sourceLst   
 
 
    member this.GetEBASTtree (sourceLst:list<string>) =   
        let forTokenizedLst =  sourceLst @ ["EOF"] 
        let tokens = tokenizer forTokenizedLst 
        getTreePA tokens 
 
///////////////type LR1TokenizeAndParse end/////////////////////////////////////////////////////////////////////////// 
 
let tnR1 = 
   [("SEMI","\;"); 
    ("EQ","="); 
    ("LPAR","\("); 
    ("RPAR","\)"); 
    ("LBRA","\{"); 
    ("RBRA","\}"); 
    ("COMMA","\,"); 
    ("DOT","\."); 
    ("STRUCT","struct");  
    ("ID","[a-zA-Z][a-zA-Z0-9]*"); 
    ("NUM","0|[1-9][0-9]*") 
      ] 
 
let grammersStrLst1 = 
   ["1:Program = DeclStmts "; 
     
    "11:DeclStmts = DeclStmt SEMI DeclStmts2"; 
    "21:DeclStmts = FuncDeclStmt SEMI DeclStmts2"; 
    "26:DeclStmts = StructDeclStmt SEMI DeclStmts2";  
 
    "31:DeclStmts2  = EPSILON"; 
    "41:DeclStmts2  = DeclStmts"; 
 
    "51:DeclStmt = ID ID InitDefs"; 
    "61:InitDefs =  EPSILON"; 
    "71:InitDefs = EQ Expression"; 
    "81:Expression = ID"; 
    "91:Expression = NUM"; 
 
    "93:Expression = DotExps"; 
    "96:DotExps = ID DOT Fields"  
    "97:Fields = ID" 
    "99:Fields = ID DOT Fields" 
 
    "101:FuncDeclStmt = ID ID LPAR ArgLists RPAR LBRA BodyStmts RBRA"; 
    "111:ArgLists = EPSILON"; 
    "121:ArgLists = ID ID ArgLists2"; 
    "131:ArgLists2 = EPSILON"; 
    "141:ArgLists2 = COMMA ID ID ArgLists2"; 
  
    "151:StructDeclStmt = STRUCT ID LBRA StructMembers RBRA"; 
    "161:StructMembers = StructMember SEMI StructMember2"; 
    "166:StructMember2 = EPSILON"; 
    "171:StructMember2 = StructMembers"; 
    "176:StructMember = ID ID"; 
    "181:StructMember = StructDeclStmt " 
 
    "201:BodyStmts = BodyStmt SEMI BodyStmts2"; 
    "202:BodyStmts = BlockBodyStmt BodyStmts2"; 
 
    "211:BodyStmts2  = EPSILON"; 
    "221:BodyStmts2  = BodyStmts"; 
    "231:BlockBodyStmt  = LBRA BodyStmts RBRA"; 
    "241:BodyStmt  = ID ID InitDefs"; 
    "251:BodyStmt = CallFuncStmt"; 
    "261:CallFuncStmt = ID LPAR CallFuncArgLists RPAR"; 
    "271:CallFuncArgLists = EPSILON"; 
    "281:CallFuncArgLists = Expression CallFuncArgLists2"; 
    "291:CallFuncArgLists2 = EPSILON"; 
    "301:CallFuncArgLists2 = COMMA Expression CallFuncArgLists2"; 
 
    ] 
  
  
  //Symbolの型(名)を返すインターフェイス 
type IType = 
  interface 
       abstract GetName : unit -> string 
  end 
 
type Symbol(in_name:string,in_sType:option<IType>) = 
    let mutable scope = None 
    member this.Name = in_name 
    member this.SType = in_sType 
    member this.SetScope(in_scope:option<IScope>) = 
        scope <- in_scope 
    override this.ToString ()= 
        if this.SType  = None then 
            in_name 
        else 
            "<" + this.Name + ":" + this.SType.Value.GetName () + ">" 
 
//Scope概念を表すインターフェイス 
and IScope = 
    abstract getScopeName :unit -> option<string> //スコープ名を返す 
    abstract getEnclosingScope :unit -> option<IScope>     //このスコープを包含する直近のスコープを返す 
    abstract define : Symbol -> unit              //このスコープ内で引数である記号を定義する 
    abstract resolve :string -> option<Symbol>            //スコープ内で引数(name)を探す  
 
 
type VariableSymbol (name:string,in_sType:option<IType>) = 
    inherit Symbol(name,in_sType) 
 
type BuiltInTypeSymbol (name:string) = 
    inherit Symbol(name,None) 
    interface IType with 
        member this.GetName () = 
            name 
 
type BaseScope (in_enclosingScope : option<IScope>) = 
    let symbolDic = new System.Collections.Generic.Dictionary<String,Symbol> () 
    let enclosingScope = in_enclosingScope 
     
    interface IScope with 
        member this.getEnclosingScope () =  
            enclosingScope  
        member this.define(sym:Symbol) = 
            symbolDic.Add(sym.Name,sym);//同じ名前のものを登録しようとすると例外発生 
            sym.SetScope(Some(this :> IScope)) 
        member this.resolve(name:string) = 
            if symbolDic.ContainsKey(name) then  
                Some(symbolDic.[name]) 
             else 
                let ecs = (this :> IScope).getEnclosingScope() 
                if ecs.IsSome then 
                    (ecs.Value).resolve(name) 
                else 
                    None 
        member this.getScopeName () = //とりあえずこう定義しておいて派生クラスでオーバーライド 
            None 
     
    member this.getSymbolDic () = symbolDic 
    override this.ToString () = 
       let sb = System.Text.StringBuilder() 
       let t = Seq.zip symbolDic.Keys symbolDic.Values 
       Seq.iter (fun (key,valu) -> sb.Append(sprintf " %A %A \n" key valu) |> ignore) t 
       sb.ToString()      
 
type GlobalScope () = 
    inherit BaseScope (None) 
    member this.getScopeName () = 
            Some("global") 
 
type LocalScope (in_enclosintScope:IScope) = 
    inherit BaseScope (Some(in_enclosintScope)) 
    member this.getScopeName () = 
            Some("local") 
 
type UndefinedScope () = 
    inherit BaseScope (None) 
    member this.getScopeName () = 
            Some("undefined") 
 
[<AbstractClass>] 
type ScopedSymbol(name:string,in_sType:option<IType>,in_enclosingScope : option<IScope>) = 
    inherit Symbol(name,in_sType) 
    let enclosingScope = in_enclosingScope 
    abstract member getStrToSymbolDic : unit -> System.Collections.Generic.Dictionary<string,Symbol> 
    interface IScope with 
        member this.getEnclosingScope () =  
            enclosingScope  
        member this.define(sym:Symbol) = 
            (this.getStrToSymbolDic()).Add(sym.Name,sym);//同じ名前のものを登録しようとすると例外発生 
            sym.SetScope(Some(this :> IScope)) //symbol毎にスコープを登録 
        member this.resolve(name:string) = 
            if (this.getStrToSymbolDic()).ContainsKey(name) then 
                Some((this.getStrToSymbolDic()).[name]) 
            else 
                let ecs = (this :> IScope).getEnclosingScope() 
                if ecs.IsSome then 
                    (ecs.Value).resolve(name) 
                else 
                    None 
        member this.getScopeName () =  
            Some(name) 
 
 
type MethodSymbol (name:string,in_sType:option<IType>,in_enclosingScope : option<IScope>) = 
    inherit ScopedSymbol(name,in_sType,in_enclosingScope) 
    let argsSymbolDic = new System.Collections.Generic.Dictionary<String,Symbol> ()//argsが入る 
     
    override this.getStrToSymbolDic () = //抽象memberの実装  
        argsSymbolDic 
  
    override this.ToString () = 
       let sb = System.Text.StringBuilder("method:" + name  ) 
       let t = Seq.zip argsSymbolDic.Keys argsSymbolDic.Values 
       sb.Append(": args ")|>ignore 
       Seq.iter (fun (key,valu) -> sb.Append(sprintf "(%A %A )" key valu) |> ignore) t 
       sb.ToString()         
     
type StructSymbol (name:string,in_enclosingScope : option<IScope>) =   
    inherit ScopedSymbol(name,None,in_enclosingScope) //type部分はNone 
    let fieldsSymbolDic = new System.Collections.Generic.Dictionary<String,Symbol> ()//fieldsが入る 
   
    override this.getStrToSymbolDic () = //抽象memberの実装  
        fieldsSymbolDic 
   
    interface IType with 
        member this.GetName () =  
            name 
     
    //この辞書内で、名前を探す(親スコープまで探しに行かない) 
    member this.resolveMember (search_name:string) = 
        if (this.getStrToSymbolDic()).ContainsKey(search_name) then 
            Some((this.getStrToSymbolDic()).[search_name]) 
        else 
            None 
 
    override this.ToString () = 
       let sb = System.Text.StringBuilder("struct:" + name  ) 
       let t = Seq.zip fieldsSymbolDic.Keys fieldsSymbolDic.Values 
       sb.Append(": field and struct :")|>ignore 
       Seq.iter (fun (key,valu) -> sb.Append(sprintf "(%A %A )" key valu) |> ignore) t 
       sb.ToString()         
 
  
 //抽象木 
 
type PosAST0 = int*int //ソース内の位置 
 
                 
type ExpAST0 =  
     |VarExpAST0 of string * PosAST0    
     |IntExpAST0 of string * PosAST0 
     |DotExpAST0 of string * PosAST0 * list<string * PosAST0> 
                //a.x.yのa                 [x;y]        
and 
    VarDecElesAST0 = string * PosAST0 * string * PosAST0 * option<ExpAST0>  //typeName typPos varName varPos initExp 
 
and DecAST0 = 
     |VarDecAST0  of VarDecElesAST0 
     |FuncDecAST0 of string * PosAST0 * string * PosAST0 * list<string * PosAST0 * string * PosAST0> * BodyStmtAST0 * (IScope ref)               
                  //funcType * functypePos *funcName funcPos list<typeName typPos varName varPos>  //実際にはBlockStmtAST0 
     |StructDecAST0 of  string * PosAST0 * list<DecAST0> * (IScope ref)  
                      //structName pos    //実際にはFuncDecAST0は使えない 
and BodyStmtAST0 = 
    |VarDecStmtAST0 of VarDecElesAST0  
    |CallFuncAST0 of string * PosAST0 * list<ExpAST0> //funcName funcPos argList 
    |BlockStmtAST0 of list<BodyStmtAST0> * (IScope ref)   
     
let rec embodyStToAST0 (in_eb:embodyST) : list<DecAST0> = 
    match in_eb with 
    //1:Program = DeclStmts  
    |Node(1,_,dssNd::_) 
        -> embodyStToAST0 dssNd 
    //11:DeclStmts = DeclStmt SEMI DeclStmts2 
    |Node(11,_,dsNd::_::dsNd2::_) 
        -> (embodyStToAST0 dsNd) @ ( embodyStToAST0 dsNd2) 
    //21:DeclStmts = FuncDeclStmt SEMI DeclStmts2 
    |Node(21,_,fdsNd::_::dsNd2::_) 
        ->(embodyStToAST0 fdsNd) @ ( embodyStToAST0 dsNd2) 
    //26:DeclStmts = StructDeclStmt SEMI DeclStmts2 
    |Node(26,_,strcNd::_::dsNd2::_) 
        ->(embodyStToAST0 strcNd)  @ ( embodyStToAST0 dsNd2) 
    //31:DeclStmts2  = EPSILON 
    |Node(31,_,_) 
        -> [] 
    //41:DeclStmts2  = DeclStmts 
    |Node(41,_,dssNd::_) 
        ->embodyStToAST0 dssNd 
    //51:DeclStmt = ID ID InitDefs 
    //61:InitDefs =  EPSILON 
    //71:InitDefs = EQ Expression 
    |Node(51,_,Leaf(tyTkn)::Leaf(varTkn)::initNd::_) 
        ->match initNd with 
          |Node(61,_,_)  
                ->[VarDecAST0(tyTkn.Img,(tyTkn.Row,tyTkn.Col),varTkn.Img,(varTkn.Row,varTkn.Col),None)] 
          |Node(71,_,_::expNd::_)       
                ->[VarDecAST0(tyTkn.Img,(tyTkn.Row,tyTkn.Col),varTkn.Img,(varTkn.Row,varTkn.Col),Some(embodyStToExpAST0 expNd))] 
          | _ -> failwith("unoccurable error in embodyStToAST0 ") 
    //101:FuncDeclStmt = ID ID LPAR ArgLists RPAR LBRA BodyStmts RBRA 
    |Node(101,_, Leaf(tyTkn)::Leaf(funNameTkn)::_::argListNd::_::_::bodyStmtsNd::_) 
        ->  let t  =  new UndefinedScope() :> IScope  
            [FuncDecAST0(tyTkn.Img,(tyTkn.Row,tyTkn.Col),funNameTkn.Img,(funNameTkn.Row,funNameTkn.Col), 
              embodyStToArgAST0 argListNd, BlockStmtAST0((embodyStToBodyStmtsAST0 bodyStmtsNd),ref t),ref t)]  
    //151:StructDeclStmt = STRUCT ID LBRA StructMembers RBRA 
    |Node(151,_,_::Leaf(idTkn)::_::strctMemsNode::_) 
        ->let t  =  new UndefinedScope() :> IScope 
          [StructDecAST0(idTkn.Img,(idTkn.Row,idTkn.Col),embodySMNToDecAST0 strctMemsNode,ref t)] 
 
    |_ ->failwith("unoccurable error in embodyStToAST0 ")   
 
and embodySMNToDecAST0 (in_eb:embodyST) :list<DecAST0> =   
    match in_eb with     
    //161:StructMembers = StructMember SEMI StructMember2 
    //166:StructMember2 = EPSILON 
    //171:StructMember2 = StructMembers 
    //176:StructMember = ID ID 
    //181:StructMember = StructDeclStmt    
    |Node(161,_,strctMemNode::_::strctMem2Node::_) 
        ->match (strctMemNode,strctMem2Node) with 
           |Node(176,_,Leaf(tyTkn)::Leaf(varTkn)::_),Node(166,_,_) 
             ->[VarDecAST0(tyTkn.Img,(tyTkn.Row,tyTkn.Col),varTkn.Img,(varTkn.Row,varTkn.Col),None)] 
           |Node(176,_,Leaf(tyTkn)::Leaf(varTkn)::_),Node(171,_,strctMemsNode::_) 
             ->(VarDecAST0(tyTkn.Img,(tyTkn.Row,tyTkn.Col),varTkn.Img,(varTkn.Row,varTkn.Col),None))::(embodySMNToDecAST0 strctMemsNode) 
           |Node(181,_,strctDclStmNode::_),Node(166,_,_) 
             ->embodyStToAST0 strctDclStmNode 
           |Node(181,_,strctDclStmNode::_),Node(171,_,strctMemsNode::_) 
             -> (embodyStToAST0 strctDclStmNode) @ (embodySMNToDecAST0 strctMemsNode) 
           | _ -> failwith("unoccurable error in embodySMNToDecAST0 ")  
    | _ -> failwith("unoccurable error in embodySMNToDecAST0 ")  
  
 
 
and embodyStToExpAST0 (in_eb:embodyST) : ExpAST0 = //expノード部分の変換を担当 
    match in_eb with 
    //81:Expression = ID 
    |Node(81,_,Leaf(idTkn)::_) 
        ->VarExpAST0(idTkn.Img,(idTkn.Row,idTkn.Col)) 
    //91:Expression = NUM 
    |Node(91,_,Leaf(numTkn)::_) 
        ->IntExpAST0(numTkn.Img,(numTkn.Row,numTkn.Col)) 
    //93:Expression = DotExps 
    |Node(93,_,dtExpNd::_) 
        ->embodyStToDotExpAST0 dtExpNd 
 
    |_ ->failwith("unoccurable error in embodyStToExpAST0 ")   
 
and embodyStToDotExpAST0 (in_eb:embodyST) : ExpAST0 = //DotExpノード部分の最初の変数部分の変換を担当 
    match in_eb with 
    //96:DotExps = ID DOT Fields  
    |Node(96,_,Leaf(idTkn1)::_::fieldsNd::_) 
        ->DotExpAST0(idTkn1.Img,(idTkn1.Row,idTkn1.Col),embodyStToDotFieldExpAST0 fieldsNd ) 
    |_ ->failwith("unoccurable error in embodyStToDotExpAST0 ") 
 
and embodyStToDotFieldExpAST0 (in_eb:embodyST) : list<string*PosAST0> = 
    match in_eb with 
    //97:Fields = ID 
    |Node(97,_,Leaf(idTkn2)::_)  
        ->[(idTkn2.Img,(idTkn2.Row,idTkn2.Col))] 
    //99:Fields = ID DOT Fields 
    |Node(99,_,Leaf(idTkn3)::_::fieldsNd::_)   
        ->(idTkn3.Img,(idTkn3.Row,idTkn3.Col))::(embodyStToDotFieldExpAST0 fieldsNd ) 
    |_ ->failwith("unoccurable error in embodyStToDotFieldExpAST0 ") 
     
 
and embodyStToArgAST0  (in_eb:embodyST) : list<string * PosAST0 * string * PosAST0> = //関数定義の引数部分の変換を担当    
    match in_eb with 
    //111:ArgLists = EPSILON 
    |Node(111,_,_) 
        ->[] 
    //121:ArgLists = ID ID ArgLists2 
    |Node(121,_,Leaf(tyTkn)::Leaf(varTkn)::argLstNd::_) 
        ->[(tyTkn.Img,(tyTkn.Row,tyTkn.Col),varTkn.Img,(varTkn.Row,varTkn.Col))] @ (embodyStToArgAST0 argLstNd) 
    //131:ArgLists2 = EPSILON 
    |Node(131,_,_) 
        -> [] 
    //141:ArgLists2 = COMMA ID ID ArgLists2 
    |Node(141,_,_::Leaf(tyTkn)::Leaf(varTkn)::argLstNd::_) 
        ->[(tyTkn.Img,(tyTkn.Row,tyTkn.Col),varTkn.Img,(varTkn.Row,varTkn.Col))] @ (embodyStToArgAST0 argLstNd) 
    |_ ->failwith("unoccurable error in embodyStToArgAST0 ")  
 
and embodyStToBodyStmtsAST0 (in_eb:embodyST) :list<BodyStmtAST0> =  
    match in_eb with 
    //201:BodyStmts = BodyStmt SEMI BodyStmts2 
    |Node(201,_,bdstmtNd::_::bdstmtsNd2::_) 
        -> (embodyStToBodyStmtUniAST0 bdstmtNd)::(embodyStToBodyStmtsAST0 bdstmtsNd2) 
    //202:BodyStmts = BlockBodyStmt BodyStmts2 
    |Node(202,_,blockstmtNd::bdstmtsNd2::_) 
        ->(embodyStToBodyStmtUniAST0 blockstmtNd)::(embodyStToBodyStmtsAST0 bdstmtsNd2) 
    //211:BodyStmts2  = EPSILON 
    |Node(211,_,_) 
        -> [] 
    //221:BodyStmts2  = BodyStmts 
    |Node(221,_,bodyStmtsNd::_) 
        -> embodyStToBodyStmtsAST0 bodyStmtsNd 
    |_ ->failwith("unoccurable error in embodyStToBodyStmtsST0 ") 
 
and embodyStToBodyStmtUniAST0 (in_eb:embodyST) : BodyStmtAST0 = 
    match in_eb with     
    //231:BlockBodyStmt  = LBRA BodyStmts RBRA 
    |Node(231,_,_::bodyStmtsNd::_::_) 
        ->let t  =  new UndefinedScope() :> IScope 
          BlockStmtAST0(embodyStToBodyStmtsAST0 bodyStmtsNd,ref t) 
    //241:BodyStmt  = ID ID InitDefs 
    //"61:InitDefs =  EPSILON"; 
    //"71:InitDefs = EQ Expression"; 
    |Node(241,_,Leaf(tyTkn)::Leaf(varTkn)::initNd::_) 
        ->match initNd with 
          |Node(61,_,_)  
                ->VarDecStmtAST0(tyTkn.Img,(tyTkn.Row,tyTkn.Col),varTkn.Img,(varTkn.Row,varTkn.Col),None) 
          |Node(71,_,_::expNd::_)       
                ->VarDecStmtAST0(tyTkn.Img,(tyTkn.Row,tyTkn.Col),varTkn.Img,(varTkn.Row,varTkn.Col),Some(embodyStToExpAST0 expNd)) 
          | _ -> failwith("unoccurable error in  embodyStToBodyStmtUniAST0 ") 
    //251:BodyStmt = CallFuncStmt 
    //261:CallFuncStmt = ID LPAR CallFuncArgLists RPAR 
    |Node(251,_,callfNd::_) 
        ->match callfNd with 
          |Node(261,_,Leaf(fNameTkn)::_::callfArgListNd::_) 
            ->CallFuncAST0(fNameTkn.Img,(fNameTkn.Row,fNameTkn.Col),(embodyStToCfArgsAST0 callfArgListNd)) 
          | _ -> failwith("unoccurable error in  embodyStToBodyStmtUniAST0 ") 
    | _ -> failwith("unoccurable error in  embodyStToBodyStmtUniAST0 ") 
 
and embodyStToCfArgsAST0 (in_eb:embodyST) :list<ExpAST0> = 
    match in_eb with 
    //271:CallFuncArgLists = EPSILON 
    |Node(271,_,_) 
        ->[] 
    //281:CallFuncArgLists = Expression CallFuncArgLists2 
    |Node(281,_,expNd::cfalNd::_) 
        -> (embodyStToExpAST0 expNd) :: (embodyStToCfArgsAST0 cfalNd) 
    //291:CallFuncArgLists2 = EPSILON 
    |Node(291,_,_) 
        -> [] 
    //301:CallFuncArgLists2 = COMMA Expression CallFuncArgLists2 
    |Node(301,_,_::expNd::cfalNd::_) 
        -> (embodyStToExpAST0 expNd) :: (embodyStToCfArgsAST0 cfalNd) 
    | _ -> failwith("unoccurable error in  embodyStToCfArgsAST0 ") 
    
     
//let tp1 = new LR1TokenizeAndParse (tnR1,grammersStrLst1) 
// 
//let src0 = ["struct A {int x; struct B {int y;}; B z;};A k;int u = k.z.y;"] 
// 
//let edst = tp1.GetEBASTtree(src0) 
//let ast0 = embodyStToAST0 edst 
//printfn "%A" ast0 
//   
 
 
    
let mkSymtbl (cur_scope: IScope ref)(in_sb :System.Text.StringBuilder) (in_decLst :list<DecAST0>) = 
     
    let checkAndResistVarDef (tyName:string) (tyPos:PosAST0) (varName:string) (varPos:PosAST0) = 
        let tyRef = (!cur_scope).resolve(tyName) 
        if tyRef.IsNone then 
            in_sb.Append(sprintf "%A %A この型名が登録されていないため参照を解決できません。\r\n" tyName tyPos) |> ignore 
        else 
            let tyrv = tyRef.Value 
            match tyrv with 
            | :? BuiltInTypeSymbol -> 
                in_sb.Append(sprintf "%A %A は 参照 ref:%A として解決しました。\r\n" tyName tyPos tyrv.Name ) |> ignore 
                let t = (tyrv :?> BuiltInTypeSymbol) :> IType 
                (!cur_scope).define (new VariableSymbol(varName,Some(t) )) 
                in_sb.Append(sprintf "変数 %A %Aを定義しました\r\n" varName varPos) |> ignore 
  
            | :? StructSymbol ->                                                            // 
                in_sb.Append(sprintf "%A %A は 参照 ref:%A として解決しました。\r\n" tyName tyPos tyrv.Name  ) |> ignore 
                let t = (tyrv :?> StructSymbol) :> IType                                    //  
                (!cur_scope).define (new VariableSymbol(varName,Some(t) ))                  //  
                in_sb.Append(sprintf "変数 %A %Aを定義しました\r\n" varName varPos  ) |> ignore                         // 
  
            | _ ->  
                in_sb.Append(sprintf "%A %A は %Aが型名でないため解決できません。\r\n" tyName tyPos tyName) |> ignore 
     
    let rec mkSymtblDecLst  (decLst :list<DecAST0>) = 
        for ele in decLst do 
            mkSymtblDec ele 
     
    and mkSymtblDec  (dec : DecAST0) = 
        match dec with 
        |VarDecAST0(tyName,tyPos,varName,varPos,initExp)  
            ->  if initExp.IsSome then  mkSymtblExp (initExp.Value) 
                checkAndResistVarDef  tyName tyPos varName varPos 
 
        |FuncDecAST0(funcTypeName,functypePos,funcName,funcPos,argList,bodyStmts,scpRef) 
            ->  let ftyRef = (!cur_scope).resolve(funcTypeName) 
                if ftyRef.IsNone then 
                    in_sb.Append(sprintf "%A %A この型名が登録されていないため参照を解決できません。\r\n" funcTypeName functypePos) |> ignore 
                else 
                   let ftyrv = ftyRef.Value 
                   match ftyrv with 
                   | :? BuiltInTypeSymbol -> 
                        in_sb.Append(sprintf "%A %A は 参照 ref:%A として解決しました。\r\n" funcTypeName functypePos ftyrv.Name ) |> ignore 
                        let t = (ftyrv :?> BuiltInTypeSymbol) :> IType 
                        let newMSym = new MethodSymbol(funcName,Some(t),Some(!cur_scope)) 
                        (!cur_scope).define(newMSym)//関数symbloの登録 
                        scpRef := (newMSym :> IScope) //FuncdexAST0 へのスコープ登録 
                        in_sb.Append(sprintf "関数 %A %Aを定義しました\r\n" funcName funcPos) |> ignore 
                        in_sb.Append(sprintf "メソッドスコープに移動します\r\n" ) |> ignore 
                        cur_scope := (newMSym :> IScope) //メソッドスコープへの移動 
                        for (tN,tP,vN,vP) in argList do //引数リストの処理 
                            checkAndResistVarDef  tN tP vN vP 
                        match bodyStmts with 
                        |BlockStmtAST0(blockeles,blockRefScp) 
                            ->mkSymtblBlockStmtAST0 blockeles blockRefScp 
                        |_ -> failwith "unoccurrable error in  mkSymtblDec" 
                        in_sb.Append(sprintf "メソッドスコープを上にもどります。できたscope内の登録は次の通りです  \r\n%A\r\n" ((!cur_scope).ToString())  ) |> ignore     
                        cur_scope := ((!cur_scope).getEnclosingScope()).Value //メソッドスコープの取り外し    
                   | _ ->  
                        in_sb.Append(sprintf "%A %A は %Aが型名でないため解決できません。\r\n" funcTypeName functypePos funcTypeName) |> ignore 
     
        |StructDecAST0(strctName,strctNamePos,declList,strcutScpRef)       //////////この部分全部追加///////////////////////////////////////////// 
            ->  let newSSym = new StructSymbol(strctName,Some(!cur_scope))       
                (!cur_scope).define(newSSym)//structSymbolの登録 
                strcutScpRef := (newSSym :> IScope) //StructDecAST0へのスコープ登録 
                in_sb.Append(sprintf "struct %A %Aを定義しました\r\n" strctName strctNamePos) |> ignore 
                in_sb.Append(sprintf "structスコープに移動します\r\n" ) |> ignore 
                cur_scope := (newSSym :> IScope) //structスコープへの移動 
                mkSymtblDecLst declList 
                in_sb.Append(sprintf "structスコープを上にもどります。できたscope内の登録は次の通りです  \r\n%A\r\n" ((!cur_scope).ToString()) ) |> ignore      
                cur_scope := ((!cur_scope).getEnclosingScope()).Value //structスコープの取り外し    
 
 
    and mkSymtblExp (exp : ExpAST0) = 
        match exp with 
        |VarExpAST0(varName,varPos)  
            ->  let varRef = (!cur_scope).resolve(varName) 
                if varRef.IsNone then 
                    in_sb.Append(sprintf "%A %A この変数名が登録されていないため参照を解決できません。\r\n" varName varPos) |> ignore 
                else 
                    let varrv = varRef.Value 
                    match varrv with 
                    | :? VariableSymbol -> 
                        in_sb.Append(sprintf "%A %A は 型名 %Aへの参照として解決しました。\r\n" varName varPos varrv.SType.Value ) |> ignore 
                    | _ ->  
                        in_sb.Append(sprintf "%A %A は %Aが変数名でないため解決できません。" varName varPos varName) |> ignore 
        |IntExpAST0(_) 
            -> () 
 
        |DotExpAST0(dotExpName,dotExpPos,fieldListExp)  //////////この部分全部追加///////////////////////////////////////////// 
            ->  //一つ目の参照演算 現スコープでdotExpNameの型を求める a.x.yならaの、b.xならbの処理 
                let varRef = (!cur_scope).resolve(dotExpName) 
                if varRef.IsNone then 
                    in_sb.Append(sprintf "%A %A この変数名が登録されていないため参照を解決できません。\r\n" dotExpName dotExpPos) |> ignore 
                else 
                    let varrv = varRef.Value //型を得る 
                    match varrv with 
                    | :? VariableSymbol -> 
                        in_sb.Append(sprintf "%A %A は 型名 %Aへの参照として解決しました。\r\n" dotExpName dotExpPos varrv.SType.Value ) |> ignore 
                        //fieldList部分の処理 
                        let mutable parentType = varrv.SType.Value //a.x.yならxのparentType は aのtype,yのparentType は xのtype 
                        for (fldName,fldPos) in fieldListExp do 
                            let strctSymScope = parentType :?> StructSymbol  
                            let sym = strctSymScope.resolveMember(fldName) 
                            if sym.IsNone then      
                                in_sb.Append(sprintf "%A %A このfield名が登録されていないため参照を解決できません。\r\n" fldName fldPos) |> ignore 
                            else 
                                in_sb.Append(sprintf "field %A %A は 型名 %Aへの参照として解決しました。\r\n" fldName fldPos (sym.Value.SType.Value)) |> ignore 
                            parentType<- sym.Value.SType.Value 
  
                    | _ ->  
                        in_sb.Append(sprintf "%A %A は %Aが変数名でないため解決できません。\r\n" dotExpName dotExpPos dotExpName) |> ignore 
 
 
    and mkSymtblBlockStmtAST0 (bStmtLst :list<BodyStmtAST0>) (blockRefScp:IScope ref) = 
        let newLocal = new LocalScope((!cur_scope)) 
        in_sb.Append(sprintf "ローカルスコープに移動します\r\n") |> ignore 
        blockRefScp := (newLocal :> IScope)//blockStmtAST0 へのスコープ登録 
        cur_scope := (newLocal :> IScope) //ローカルスコープへの移動 
        for ele in bStmtLst do 
            match ele with 
            |VarDecStmtAST0(varDecEle) 
                -> mkSymtblDec (VarDecAST0(varDecEle)) 
             
            |CallFuncAST0 (funcName,funcPos,argList) 
                -> //関数の名前部分の処理 
                  let funcNameRef = (!cur_scope).resolve(funcName) 
                  if funcNameRef.IsNone then 
                    in_sb.Append(sprintf "%A %A この関数名が登録されていないため参照を解決できません。\r\n" funcName funcPos) |> ignore 
                  else 
                    let funcnv = funcNameRef.Value 
                    match funcnv with 
                    | :? MethodSymbol -> 
                        in_sb.Append(sprintf "%A %A は %A型の関数への参照として解決しました。\r\n" funcName funcPos funcnv.SType.Value ) |> ignore 
                    | _ ->  
                        in_sb.Append(sprintf "%A %A は %Aが関数名でないため解決できません。\r\n" funcName funcPos funcName) |> ignore 
                  //引数部分の処理 
                  for argEle in argList do 
                    mkSymtblExp argEle   
             
            |BlockStmtAST0 (bodyStmtList,refScp)  
                ->mkSymtblBlockStmtAST0 bodyStmtList refScp 
        in_sb.Append(sprintf "スコープを上に戻ります。できたscope内の登録は次の通りです \r\n%A\r\n" ((!cur_scope).ToString()) ) |> ignore 
        cur_scope := ((!cur_scope).getEnclosingScope()).Value //ローカルスコープの取り外し 
 
    mkSymtblDecLst in_decLst 
    ((!cur_scope),in_sb)     
 
 
//ASTをトラバースしながら、スコープを文字列にしていく 
 
let mkSymtblText (in_sb :System.Text.StringBuilder) (in_decLst :list<DecAST0>) = 
     
    let rec mkSymtblTextDecLst  (decLst :list<DecAST0>) (depth :int) = 
        for ele in decLst do 
            mkSymtblTextDec ele depth 
     
    and mkSymtblTextDec  (dec : DecAST0) (depth :int)  = 
        match dec with 
        |VarDecAST0(tyName,tyPos,varName,varPos,initExp)  
            ->  () 
 
        |FuncDecAST0(funcTypeName,functypePos,funcName,funcPos,argList,bodyStmts,scpRef) 
            -> let tStr =  spaceStr(depth) 
               let tStr2 =  spaceStr(depth + 4) 
               in_sb.Append(tStr).Append((!scpRef).ToString()).Append("\r\n") |> ignore  
               match bodyStmts with 
                        |BlockStmtAST0(blockeles,blockScpRef) 
                            ->in_sb.Append(tStr2).Append((!blockScpRef).ToString()).Append("\r\n") |> ignore  
                              mkSymtblTextBlockStmtAST0 blockeles (depth + 8) 
                        |_ -> failwith "unoccurrable error in  mkSymtblTestDec" 
 
        |StructDecAST0(strctName,strctNamePos,declList,strcutScpRef)  
            ->let tStr =  spaceStr(depth) 
              in_sb.Append(tStr).Append((!strcutScpRef).ToString()).Append("\r\n") |> ignore  
              mkSymtblTextDecLst declList (depth + 4) 
 
   
    and mkSymtblTextExp (exp : ExpAST0) (depth :int) = 
        match exp with 
        |VarExpAST0(varName,varPos)  
            -> () 
        |IntExpAST0(_) 
            -> () 
        |DotExpAST0(_) 
            ->() 
 
    and mkSymtblTextBlockStmtAST0 (bStmtLst :list<BodyStmtAST0>)  (depth :int)= 
        for ele in bStmtLst do 
            match ele with 
            |VarDecStmtAST0(varDecEle) 
                -> mkSymtblTextDec (VarDecAST0(varDecEle)) (depth + 4) 
             
            |CallFuncAST0 (funcName,funcPos,argList) 
                -> //引数部分の処理 
                  for argEle in argList do 
                    mkSymtblTextExp argEle (depth + 4) //呼び出してもなにもしないけど   
             
            |BlockStmtAST0 (bodyStmtList,refScp) 
                ->  let tStr =  spaceStr(depth) 
                    in_sb.Append(tStr).Append((!refScp).ToString()).Append("\r\n") |> ignore  
                    mkSymtblTextBlockStmtAST0 bodyStmtList (depth + 4) 
 
    mkSymtblTextDecLst in_decLst 0 
    in_sb.ToString() 
 
 
let f2c x = x :> System.Windows.Forms.Control  
let conv_btn= new Button(Location = new Point(193, 288),Name = "conv_btn",Size = new Size(103, 28),TabIndex = 75,Text = "↓",UseVisualStyleBackColor = true) 
let ast_tb= new TextBox(Location = new Point(12, 322),Multiline = true,Name = "ast_tb",ScrollBars = ScrollBars.Both,Size = new Size(512, 317),TabIndex = 74) 
let base_gram_tb= new TextBox(Location = new Point(230, 26),Multiline = true,Name = "base_gram_tb",ReadOnly = true,ScrollBars = ScrollBars.Both,Size = new Size(294, 87),TabIndex = 61) 
let label6= new Label(AutoSize = true,Location = new Point(15, 651),Name = "label6",Size = new Size(32, 12),TabIndex = 60,Text = "エラー") 
let error_tb= new TextBox(Location = new Point(17, 671),Multiline = true,Name = "error_tb",ScrollBars = ScrollBars.Both,Size = new Size(490, 73),TabIndex = 59) 
let label5= new Label(AutoSize = true,Location = new Point(16, 134),Name = "label5",Size = new Size(33, 12),TabIndex = 58,Text = "ソース") 
let sourceSave_btn= new Button(Location = new Point(406, 125),Name = "sourceSave_btn",Size = new Size(101, 23),TabIndex = 57,Text = "ソースのSave",UseVisualStyleBackColor = true) 
let sourceLoad_btn= new Button(Location = new Point(299, 125),Name = "sourceLoad_btn",Size = new Size(101, 23),TabIndex = 56,Text = "ソースのLoad",UseVisualStyleBackColor = true) 
let source_tb= new TextBox(Location = new Point(12, 154),Multiline = true,Name = "source_tb",ScrollBars = ScrollBars.Both,Size = new Size(512, 124),TabIndex = 55) 
let tokenRule_tb= new TextBox(Location = new Point(12, 26),Multiline = true,Name = "tokenRule_tb",ReadOnly = true,ScrollBars = ScrollBars.Both,Size = new Size(203, 87),TabIndex = 48) 
let label1= new Label(AutoSize = true,Location = new Point(16, 6),Name = "label1",Size = new Size(82, 12),TabIndex = 76,Text = "トークン化ルール") 
let label8= new Label(AutoSize = true,Location = new Point(232, 5),Name = "label8",Size = new Size(53, 12),TabIndex = 77,Text = "構文規則") 
let mkSymtbl_btn= new Button(Location = new Point(548, 26),Name = "mkSymtbl_btn",Size = new Size(30, 720),TabIndex = 78,Text = "→",UseVisualStyleBackColor = true) 
let label2= new Label(AutoSize = true,Location = new Point(16, 299),Name = "label2",Size = new Size(30, 12),TabIndex = 79,Text = "AST") 
let symbolTbl_tb= new TextBox(Location = new Point(606, 526),Multiline = true,Name = "symbolTbl_tb",ScrollBars = ScrollBars.Both,Size = new Size(512, 218),TabIndex = 80) 
let label3= new Label(AutoSize = true,Location = new Point(608, 497),Name = "label3",Size = new Size(70, 12),TabIndex = 81,Text = "SymbolTable") 
let label4= new Label(AutoSize = true,Location = new Point(608, 2),Name = "label4",Size = new Size(23, 12),TabIndex = 83,Text = "Log") 
let log_tb= new TextBox(Location = new Point(606, 26),Multiline = true,Name = "log_tb",ScrollBars = ScrollBars.Both,Size = new Size(512, 181),TabIndex = 82) 
let label7= new Label(AutoSize = true,Location = new Point(610, 217),Name = "label7",Size = new Size(114, 12),TabIndex = 85,Text = "AST(スコープ登録後)") 
let ast_tb2= new TextBox(Location = new Point(606, 240),Multiline = true,Name = "ast_tb2",ScrollBars = ScrollBars.Both,Size = new Size(512, 237),TabIndex = 84) 
let Form1= new Form(AutoScaleDimensions = new SizeF(6.0f, 12.0f),AutoScaleMode = AutoScaleMode.Font,ClientSize = new Size(1173, 804),Name = "Form1",Text = "Symbol Table Struct") 
[ f2c label7; f2c ast_tb2; f2c label4; f2c log_tb; f2c label3; f2c symbolTbl_tb; f2c label2; f2c mkSymtbl_btn; f2c label8; f2c label1; f2c conv_btn; f2c ast_tb; f2c base_gram_tb; f2c label6; f2c error_tb; f2c label5; f2c sourceSave_btn; f2c sourceLoad_btn; f2c source_tb; f2c tokenRule_tb] |> List.iter(fun cnt -> Form1.Controls.Add cnt) 
 
let tp1 = new LR1TokenizeAndParse (tnR1,grammersStrLst1) 
 
let show_tkn_gram_rules () = 
    let sb = new Text.StringBuilder ("") 
    tnR1 |> List.iter (fun (s1,s2) -> sb.Append (sprintf "%s :%s \r\n" s1 s2) |> ignore ) 
    tokenRule_tb.Text <- sb.ToString() 
    sb.Clear() |> ignore 
    grammersStrLst1 |> List.iter (fun s1 -> sb.Append (sprintf "%s \r\n" s1 ) |> ignore ) 
    base_gram_tb.Text <- sb.ToString() 
 
show_tkn_gram_rules () 
 
 
let clear_tb () = 
                error_tb.Text <- "" 
                ast_tb.Text <- "" 
                ast_tb2.Text <- "" 
                log_tb.Text <- "" 
                symbolTbl_tb.Text <- "" 
                 
 
conv_btn.Click.Add 
    (fun _ -> try 
                clear_tb () 
                let sourceTextArr = source_tb.Text.Replace("\r\n", "\n").Split([|'\n'|]) 
                let sourceLst  = List.ofArray sourceTextArr 
                let sourceLst  = List.ofArray sourceTextArr 
                ast_tb.Text <- sprintf "%A" (embodyStToAST0 (tp1.GetEBASTtree(sourceLst))) 
 
              with 
              |MyGramExcp(str) -> error_tb.Text <- sprintf "ソースが構文にのっとっていません:%s" str   
              | ex -> error_tb.Text <- ex.Message  
    ) 
 
mkSymtbl_btn.Click.Add 
    (fun _ -> try 
                clear_tb () 
                let sourceTextArr = source_tb.Text.Replace("\r\n", "\n").Split([|'\n'|]) 
                let sourceLst  = List.ofArray sourceTextArr 
                let sourceLst  = List.ofArray sourceTextArr 
                let ast0 = embodyStToAST0 (tp1.GetEBASTtree(sourceLst)) 
                ast_tb.Text <- sprintf "%A" ast0 
 
           
                let globalScope = new GlobalScope() 
                (globalScope :> IScope).define(new BuiltInTypeSymbol("int")) 
                (globalScope :> IScope).define(new BuiltInTypeSymbol("float")) 
                (globalScope :> IScope).define(new BuiltInTypeSymbol("void")) 
                let castedGlobalScope = globalScope :> IScope 
                let cur_scope = ref castedGlobalScope  
                let (globalSymtbl,madeSb) =   mkSymtbl cur_scope (new System.Text.StringBuilder()) ast0 
                let localAndFuncSymtlbText = mkSymtblText (new System.Text.StringBuilder()) ast0  
                 
                ast_tb2.Text <- sprintf "%A" ast0 
                symbolTbl_tb.Text <- "global\r\n" + globalSymtbl.ToString() + "\r\n\r\n" + localAndFuncSymtlbText 
                log_tb.Text <- madeSb.ToString() 
              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)  
                    source_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(source_tb.Text)  
              with  
                | ex -> error_tb.Text <- ex.Message  
                  
    )  
 
[<STAThread()>]   
do Application.Run( Form1) 
 
スポンサーサイト

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

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

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

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

この人とブロともになる

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