スポンサーサイト

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

F#で入門 コンパイラ、インタプリタ編 簡易言語 (VM版)

 今回は前回の言語のVM版を作ります。 
 
実行場面は次のようになります。 
 
1018-1.jpg 
トークン、文法の定義は前回と同じですが、VMに解釈実行させる命令を次のように定義します。 
 
type CommandCode  = 
    |ADD        //s[p-1] = s[p-1] + s[p]; p <- p - 1   
    |SUB        //s[p-1] = s[p-1] - s[p]; p <- p - 1 
    |MUL        //s[p-1] = s[p-1] * s[p]; p <- p - 1 
    |DIV        //s[p-1] = s[p-1] / s[p]; p <- p - 1 
    |NEG        //s[p] = -s[p] 
    |LDI of int //s[p] <- int値; p <- p + 1 
    |STOP       //プログラムを正常終了 
    |LOD of int //int番地の内容をスタックにいれる s[++p] = 番地内容 
    |DISP       //s[p]を表示;p <- p - 1 
    |LDA of int //int番地そのものをスタックに入れる s[++p] = 番地  
    |ASS        //番地、さらにその上に値が載った状態で実行すると値を番地の示すところへ移す s[p-1]番地=s[p] ;p <- p - 2 
    |NULL 
 
    override  this.ToString() = 
        match this with 
        |ADD        -> "ADD"   
        |SUB        -> "SUB" 
        |MUL        -> "MUL" 
        |DIV        -> "DIV" 
        |NEG        -> "NEG" 
        |LDI(intNum)-> sprintf "LDI %d" intNum 
        |STOP       -> "STOP"  
        |LOD(intAdr)-> sprintf "LOD adr(%d)" intAdr 
        |DISP       -> "DISP" 
        |LDA(intAdr)-> sprintf "LDA adr(%d)" intAdr 
        |ASS        -> "ASS"     
        |NULL       -> "  " 
 
構文木をトラバースしてメモリ配列と記号表を返す関数を次の様に定義します。 
 
let makeSymbolTB (in_eb:embodyST)= 
    let memArr :int[]= Array.zeroCreate 100 
    let varCnt = ref 0 
    let symbolDic = new System.Collections.Generic.Dictionary<string,int>() 
  
    let rec makeSymbolTB_Sub (eb:embodyST) = 
        match eb with 
        //0: Z = Program EOF 
        |Node(0,_,proNd::_)      
            ->  for i in [0 .. ((Array.length memArr) - 1)] do memArr.[i] <- 0 
                varCnt :=  0 
                symbolDic.Clear()   
                makeSymbolTB_Sub  proNd  
        //1:Program = DeclStmts Stmts 
        |Node(1,_,decStmsNd::_) 
            -> makeSymbolTB_Sub  decStmsNd  
        //21:DeclStmts = DeclStmt SEMI DeclStmts2 
        |Node(21,_,declStmNd::_::declStm2Nd::_) 
            -> makeSymbolTB_Sub declStmNd  
               makeSymbolTB_Sub declStm2Nd  
        //22:DeclStmts2  = EPSILON 
        |Node(22,_,_) 
            -> () 
        //23:DeclStmts2  = DeclStmts 
        |Node(23,_,declStmtsNd::_) 
            -> makeSymbolTB_Sub declStmtsNd 
        //24:DeclStmt = INT VarDefs 
        |Node(24,_,_::varDefsNd::_) 
            -> makeSymbolTB_Sub varDefsNd 
        //25:VarDefs = ID EQ NUM VarDefs2 
        |Node(25,_,Leaf(id_tk)::_::Leaf(num_tk)::varDefs2Nd::_) 
            ->symbolDic.Add(id_tk.Img,!varCnt) //例えばx -> 1となる(1はアドレス=配列の添え字) 
                                              //2重登録はここでエラー  
              memArr.[!varCnt] <- System.Int32.Parse(num_tk.Img) //memへの初期値登録                                  
              varCnt :=  !varCnt + 1 
              makeSymbolTB_Sub varDefs2Nd 
        //26:VarDefs2 = COMMA ID EQ NUM VarDefs2 
        |Node(26,_,_::Leaf(id_tk)::_::Leaf(num_tk)::varDefs2Nd::_) 
             ->symbolDic.Add(id_tk.Img,!varCnt)  
               memArr.[!varCnt] <- System.Int32.Parse(num_tk.Img) //memへの初期値登録    
               varCnt := !varCnt + 1 
               makeSymbolTB_Sub varDefs2Nd 
        
        //27:VarDefs2 = EPSILON 
        |Node(27,_,_)  
            -> () 
        |_ -> () 
 
    makeSymbolTB_Sub in_eb 
    (memArr,symbolDic) 
 
この関数を補助関数として使い、構文木からコード配列とメモリ配列と記号表を返す関数を次のように定義します。 
 
let makePLArr (in_eb:embodyST) = 
    let pccArr:CommandCode[] = Array.create 200 NULL 
    let ccaIndex = ref 0 
    let (memArr,symbolDic) = makeSymbolTB in_eb  
 
    let rec eVal1  (eb:embodyST)  = 
        match eb with 
        //0: Z = Program EOF 
        |Node(0,_,pro::_)      
            ->  eVal1 pro  
        //1:Program = DeclStmts Stmts 
        |Node(1,_,_::stmtsNd::_)  
            -> eVal1 stmtsNd 
        //2:Expression = Expression1 Term Expression2 
        //3:UnaryOp = PLUS 
        //4:UnaryOp = MINUS 
        //5:Expression1 = EPSILON 
        //6:Expression1 = UnaryOp 
        |Node(2,_,exp1Nd::termNd::exp2Nd::_)  
            -> eVal1 termNd   
               match exp1Nd with 
                   |Node(5,_,_) -> ()  
                   |Node(6,_,Node(3,_,_)::_)  -> () 
                   |Node(6,_,Node(4,_,_)::_)  -> pccArr.[!ccaIndex] <- NEG ; ccaIndex := !ccaIndex + 1 
                   |_ -> failwith "never occruable error"  
               eVal1 exp2Nd   
        //7:Expression2 = EPSILON 
        |Node(7,_,EPS_Leaf(_)::_)  
            -> ()  
        //8:AddOp = PLUS 
        //9:AddOp = MINUS 
        //10:Expression2 = AddOp Expression3 Term Expression2 
        //11:Expression3 = EPSILON 
        //12:Expression3 = UnaryOp 
        |Node(10,_,addOpNd::exp3Nd::termNd::exp2Nd::_)  
            ->eVal1 termNd  
              match exp3Nd with  
                   |Node(11,_,_) -> ()  
                   |Node(12,_,Node(3,_,_)::_)  -> () 
                   |Node(12,_,Node(4,_,_)::_)  -> pccArr.[!ccaIndex] <- NEG ; ccaIndex := !ccaIndex + 1 
                   |_ -> failwith "never occruable error"  
              match addOpNd with 
                |Node(8,_,_)  -> pccArr.[!ccaIndex] <- ADD ; ccaIndex := !ccaIndex + 1 
                |Node(9,_,_)  -> pccArr.[!ccaIndex] <- SUB ; ccaIndex := !ccaIndex + 1 
                |_ -> failwith "never occruable error"  
              eVal1 exp2Nd   
        //13:Term = Factor Term1 
        |Node(13,_,factorNd::term1Nd::_)  
            ->eVal1 factorNd 
              eVal1 term1Nd  
        //14:Term1 = EPSILON 
        |Node(14,_,_)  
            -> () 
        //15:MulOp = MUL 
        //16:MulOp = DIV 
        //17:Term1 = MulOp Factor Term1 
        |Node(17,_,mulOpNd::factorNd::term1Nd::_)  
            ->eVal1 factorNd 
              match mulOpNd with 
                |Node(15,_,_)  -> pccArr.[!ccaIndex] <- MUL ; ccaIndex := !ccaIndex + 1 
                |Node(16,_,_)  -> pccArr.[!ccaIndex] <- DIV ; ccaIndex := !ccaIndex + 1 
                |_ -> failwith "never occruable error"  
              eVal1 term1Nd 
        //18:Factor = NUM 
        |Node(18,_,Leaf(tk)::_) 
            -> let num = System.Int32.Parse(tk.Img) 
               pccArr.[!ccaIndex] <- LDI(num) ; ccaIndex := !ccaIndex + 1 
        //19:Factor = LPAR Expression RPAR 
        |Node(19,_,_::expNode::_::_)  
            -> eVal1 expNode 
        //20:Factor = ID 
        |Node(20,_,Leaf(tk)::_) 
            -> let adr =  symbolDic.[tk.Img] 
               pccArr.[!ccaIndex] <-  LOD(adr) ;ccaIndex := !ccaIndex + 1 
        //29:Stmts = PrintStmt SEMI Stmts 
        |Node(29,_,printStmtNd::_::stmtsNd::_) 
            ->eVal1 printStmtNd 
              eVal1 stmtsNd 
        //30:PrintStmt = EX VarRefs 
        |Node(30,_,_::varRefsNd::_) 
            ->eVal1 varRefsNd 
        //31:VarRefs = Expression VarRefs2 
        |Node(31,_,expNd::varRefs2Nd::_) 
            ->eVal1 expNd //これでスタックに評価値がのる 
              pccArr.[!ccaIndex] <- DISP ;ccaIndex := !ccaIndex + 1 
              eVal1 varRefs2Nd 
        //32:VarRefs2 = COMMA Expression VarRefs2 
        |Node(32,_,_::expNd::varRefs2Nd::_) 
            ->eVal1 expNd //これでスタックに評価値がのる 
              pccArr.[!ccaIndex] <- DISP ;ccaIndex := !ccaIndex + 1 
              eVal1 varRefs2Nd 
        //34:Stmts = AssignStmt SEMI Stmts 
        |Node(34,_,assStmtNd::_::stmtsNd::_) 
            ->eVal1 assStmtNd 
              eVal1 stmtsNd 
        //35:AssignStmt = ID EQ Expression  
        |Node(35,_,Leaf(tk)::_::expNd::_) 
            -> pccArr.[!ccaIndex] <- LDA(symbolDic.[tk.Img]);ccaIndex := !ccaIndex + 1//memの書き込み番地をスタックにのっける 
               eVal1 expNd //これでスタックに評価値がのる 
               pccArr.[!ccaIndex] <- ASS; ccaIndex := !ccaIndex + 1 
    
        //21:DeclStmts = DeclStmt SEMI DeclStmts2 
        //22:DeclStmts2  = EPSILON 
        //23:DeclStmts2  = DeclStmts 
        //24:DeclStmt = INT VarDefs 
        //25:VarDefs = ID EQ NUM VarDefs2 
        //26:VarDefs2 = COMMA ID EQ NUM VarDefs2 
        //27:VarDefs2 = EPSILON 
        //28:Stmts = EPSILON 
        //33:VarRefs2 = EPSILON 
        |_ -> ()  
 
    eVal1 in_eb 
    pccArr.[!ccaIndex] <- STOP  
    (pccArr,memArr,symbolDic) 
     
解釈実行部分はコードの終わりのあたりのoneStepExec ()関数をみてください。 
次回はこの言語のMSAM版コンパイラをやります。 
 
今回の全コードは以下の通りです。 
 open System    
open System.Text.RegularExpressions 
 
////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 
 
//文法定義のエラー 
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 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 LL1TokenizeAndParse (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 
 
    let gramsWithIndex = initStrLst 
                            |> List.map splitOneLineGram 
                            |> List.map (fun (index,lh,rhEles) -> (index,(lh,rhEles)))  
 
    let getNTN_DirectorMap  (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 getNTN_DirectorSet (inHh:string,inRhEles:list<string>) = 
            if isNullableTokensLstPA inRhEles then 
                (getFirstSetOfTokenLstPA inRhEles) + ntnFollowMap.[inHh] 
            else 
                (getFirstSetOfTokenLstPA inRhEles) 
 
        gramsWithIndex 
            |> List.map (fun (index,(lh,rhEles)) -> (index, getNTN_DirectorSet (lh,rhEles))) 
            |> Map.ofList              
 
    let directorMap = getNTN_DirectorMap initStrLst 
 
    let getOneToOneParsingRelation (inStrLst:list<string>) = 
        let relationBetweenIndexAndNTN_namdAndDirecSetList 
            = [ for (index,(lh,rhEles)) in gramsWithIndex do 
                    for direcEle in directorMap.[index] do 
                        yield (index,lh,direcEle) ] 
 
        let ParsingRelation 
            = relationBetweenIndexAndNTN_namdAndDirecSetList 
                |> List.fold (fun (stateMap:Map<string*string,Set<int>>)  (index,lh,direcEle)  ->       
                                        let tf = Map.tryFind (lh,direcEle) stateMap 
                                        match tf with 
                                        |Some(oldSet) -> Map.add (lh,direcEle) (oldSet + (Set.ofList [index])) stateMap 
                                        |None         -> Map.add (lh,direcEle) (Set.ofList [index]) stateMap 
                             ) 
                             Map.empty               
         
        let OneToOneParsingRelation 
            = ParsingRelation 
                |> Map.map (fun (ntnName,direcEle) intSet ->  
                                    if Set.count intSet > 1 then raise (MyGramExcp "衝突しているのでLL(1)解析できません") 
                                    else 
                                       match (List.ofSeq intSet) with 
                                       | [] -> failwith "neverOccurable Error" // 起こらない 
                                       | h::[] -> h 
                                       | _ ->  failwith "neverOccurable Error" // 起こらない 
                           )          
 
        OneToOneParsingRelation 
 
     
    let getIndexGRmap (inStrLst:list<string>) = 
        inStrLst 
            |> List.map splitOneLineGram  
            |> List.map (fun (index,_,gramLst) -> (index,gramLst)) 
            |> Map.ofList 
 
 
    let rec makeEmbodyST ((tntSet:Set<string>),(ntSet:Set<string>))  
                         (prMap:Map<(string * string),int>) (iGmap:Map<int,string list>) 
                         ((remainToken:list<Token>),(remainGRM:list<string>),(acc:list<embodyST>)) = 
        match remainToken,remainGRM with 
        |[],_ -> ([],[],acc) 
        //一つの構文要素終了時 
        |remt,[]    -> (remt,[],acc)  
        //εの場合 
        |hdt::tlt,hdg::tlg  when hdg = STR_EPS  
                    -> makeEmbodyST (tntSet,ntSet) prMap iGmap (remainToken,tlg,acc @ [EPS_Leaf(hdt)])  
        //終端記号 
        |hdt::tlt,hdg::tlg  when hdt.Kind = hdg 
                    -> makeEmbodyST (tntSet,ntSet) prMap iGmap  (tlt,tlg,acc @ [Leaf(hdt)]) 
        //非終端記号 
        |hdt::tlt,hdg::tlg   
                   -> let foundPRIndex = Map.tryFind (hdg,hdt.Kind) prMap 
                      match foundPRIndex with 
                      |Some(i) -> let shouldUseGram = iGmap.[i] 
                                  let (remT,remG,underNodes) = makeEmbodyST (tntSet,ntSet) prMap iGmap (remainToken,shouldUseGram,[]) 
                                  //上の行でremGは[]として返ってくる 
                                  makeEmbodyST (tntSet,ntSet) prMap iGmap (remT,tlg, acc @ [Node(i,hdg,underNodes)]) 
                               
                      |None    -> raise (MyGramExcp (sprintf "%sで文法エラー" (hdt.ToString()))) 
 
 
 
    member this.GetTokens (sourceLst:list<string>) =   
        tokenizer sourceLst   
 
    member this.GetEBASTtree (sourceLst:list<string>) =   
        let forTokenizedLst =  sourceLst @ ["EOF"] 
        let tokens = tokenizer forTokenizedLst 
        let relMap = getOneToOneParsingRelation initStrLst 
        let indexGRmap = getIndexGRmap initStrLst 
        let (_,_,madeTree) = makeEmbodyST (ntnSet,tnSet) relMap indexGRmap (tokens,["Z"],[]) 
        List.head madeTree 
 
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 
open System.Windows.Forms    
open System.Drawing   
 
let tnR = [ 
           ("INT","int"); 
           ("COMMA","\,"); 
           ("EQ","\="); 
           ("EX","\!"); 
           ("PLUS","\+"); 
           ("MINUS","\-"); 
           ("MUL","\*"); 
           ("DIV","\/"); 
           ("LPAR","\("); 
           ("RPAR","\)"); 
           ("NUM","\d+"); 
           ("SEMI","\;"); 
           ("ID","[a-z][a-z0-9]*") 
           ] 
 
let grammersStrLst = 
   ["1:Program = DeclStmts Stmts"; //ここが変わった 
    "2:Expression = Expression1 Term Expression2"; 
    "3:UnaryOp = PLUS"; 
    "4:UnaryOp = MINUS"; 
    "5:Expression1 = EPSILON"; 
    "6:Expression1 = UnaryOp"; 
    "7:Expression2 = EPSILON"; 
    "8:AddOp = PLUS"; 
    "9:AddOp = MINUS"; 
    "10:Expression2 = AddOp Expression3 Term Expression2"; 
    "11:Expression3 = EPSILON"; 
    "12:Expression3 = UnaryOp"; 
    "13:Term = Factor Term1"; 
    "14:Term1 = EPSILON"; 
    "15:MulOp = MUL"; 
    "16:MulOp = DIV"; 
    "17:Term1 = MulOp Factor Term1"; 
    "18:Factor = NUM"; 
    "19:Factor = LPAR Expression RPAR" 
    //ここ以降変化 
    "20:Factor = ID"; 
    "21:DeclStmts = DeclStmt SEMI DeclStmts2"; 
    "22:DeclStmts2  = EPSILON"; 
    "23:DeclStmts2  = DeclStmts"; 
    "24:DeclStmt = INT VarDefs"; 
    "25:VarDefs = ID EQ NUM VarDefs2"; 
    "26:VarDefs2 = COMMA ID EQ NUM VarDefs2"; 
    "27:VarDefs2 = EPSILON"; 
    "28:Stmts = EPSILON"; 
    "29:Stmts = PrintStmt SEMI Stmts"; 
    "30:PrintStmt = EX VarRefs"; 
    "31:VarRefs = Expression VarRefs2"; 
    "32:VarRefs2 = COMMA Expression VarRefs2"; 
    "33:VarRefs2 = EPSILON"; 
    "34:Stmts = AssignStmt SEMI Stmts"; 
    "35:AssignStmt = ID EQ Expression " 
 
      ] 
 
 
let tp = new LL1TokenizeAndParse (tnR,grammersStrLst) 
 
 
 
 
type CommandCode  = 
    |ADD        //s[p-1] = s[p-1] + s[p]; p <- p - 1   
    |SUB        //s[p-1] = s[p-1] - s[p]; p <- p - 1 
    |MUL        //s[p-1] = s[p-1] * s[p]; p <- p - 1 
    |DIV        //s[p-1] = s[p-1] / s[p]; p <- p - 1 
    |NEG        //s[p] = -s[p] 
    |LDI of int //s[p] <- int値; p <- p + 1 
    |STOP       //プログラムを正常終了 
    |LOD of int //int番地の内容をスタックにいれる s[++p] = 番地内容 
    |DISP       //s[p]を表示;p <- p - 1 
    |LDA of int //int番地そのものをスタックに入れる s[++p] = 番地  
    |ASS        //番地、さらにその上に値が載った状態で実行すると値を番地の示すところへ移す s[p-1]番地=s[p] ;p <- p - 2 
    |NULL 
 
    override  this.ToString() = 
        match this with 
        |ADD        -> "ADD"   
        |SUB        -> "SUB" 
        |MUL        -> "MUL" 
        |DIV        -> "DIV" 
        |NEG        -> "NEG" 
        |LDI(intNum)-> sprintf "LDI %d" intNum 
        |STOP       -> "STOP"  
        |LOD(intAdr)-> sprintf "LOD adr(%d)" intAdr 
        |DISP       -> "DISP" 
        |LDA(intAdr)-> sprintf "LDA adr(%d)" intAdr 
        |ASS        -> "ASS"     
        |NULL       -> "  " 
 
let makeSymbolTB (in_eb:embodyST)= 
    let memArr :int[]= Array.zeroCreate 100 
    let varCnt = ref 0 
    let symbolDic = new System.Collections.Generic.Dictionary<string,int>() 
  
    let rec makeSymbolTB_Sub (eb:embodyST) = 
        match eb with 
        //0: Z = Program EOF 
        |Node(0,_,proNd::_)      
            ->  for i in [0 .. ((Array.length memArr) - 1)] do memArr.[i] <- 0 
                varCnt :=  0 
                symbolDic.Clear()   
                makeSymbolTB_Sub  proNd  
        //1:Program = DeclStmts Stmts 
        |Node(1,_,decStmsNd::_) 
            -> makeSymbolTB_Sub  decStmsNd  
        //21:DeclStmts = DeclStmt SEMI DeclStmts2 
        |Node(21,_,declStmNd::_::declStm2Nd::_) 
            -> makeSymbolTB_Sub declStmNd  
               makeSymbolTB_Sub declStm2Nd  
        //22:DeclStmts2  = EPSILON 
        |Node(22,_,_) 
            -> () 
        //23:DeclStmts2  = DeclStmts 
        |Node(23,_,declStmtsNd::_) 
            -> makeSymbolTB_Sub declStmtsNd 
        //24:DeclStmt = INT VarDefs 
        |Node(24,_,_::varDefsNd::_) 
            -> makeSymbolTB_Sub varDefsNd 
        //25:VarDefs = ID EQ NUM VarDefs2 
        |Node(25,_,Leaf(id_tk)::_::Leaf(num_tk)::varDefs2Nd::_) 
            ->symbolDic.Add(id_tk.Img,!varCnt) //例えばx -> 1となる(1はアドレス=配列の添え字) 
                                              //2重登録はここでエラー  
              memArr.[!varCnt] <- System.Int32.Parse(num_tk.Img) //memへの初期値登録                                  
              varCnt :=  !varCnt + 1 
              makeSymbolTB_Sub varDefs2Nd 
        //26:VarDefs2 = COMMA ID EQ NUM VarDefs2 
        |Node(26,_,_::Leaf(id_tk)::_::Leaf(num_tk)::varDefs2Nd::_) 
             ->symbolDic.Add(id_tk.Img,!varCnt)  
               memArr.[!varCnt] <- System.Int32.Parse(num_tk.Img) //memへの初期値登録    
               varCnt := !varCnt + 1 
               makeSymbolTB_Sub varDefs2Nd 
        
        //27:VarDefs2 = EPSILON 
        |Node(27,_,_)  
            -> () 
        |_ -> () 
 
    makeSymbolTB_Sub in_eb 
    (memArr,symbolDic) 
 
 
let makePLArr (in_eb:embodyST) = 
    let pccArr:CommandCode[] = Array.create 200 NULL 
    let ccaIndex = ref 0 
    let (memArr,symbolDic) = makeSymbolTB in_eb  
 
    let rec eVal1  (eb:embodyST)  = 
        match eb with 
        //0: Z = Program EOF 
        |Node(0,_,pro::_)      
            ->  eVal1 pro  
        //1:Program = DeclStmts Stmts 
        |Node(1,_,_::stmtsNd::_)  
            -> eVal1 stmtsNd 
        //2:Expression = Expression1 Term Expression2 
        //3:UnaryOp = PLUS 
        //4:UnaryOp = MINUS 
        //5:Expression1 = EPSILON 
        //6:Expression1 = UnaryOp 
        |Node(2,_,exp1Nd::termNd::exp2Nd::_)  
            -> eVal1 termNd   
               match exp1Nd with 
                   |Node(5,_,_) -> ()  
                   |Node(6,_,Node(3,_,_)::_)  -> () 
                   |Node(6,_,Node(4,_,_)::_)  -> pccArr.[!ccaIndex] <- NEG ; ccaIndex := !ccaIndex + 1 
                   |_ -> failwith "never occruable error"  
               eVal1 exp2Nd   
        //7:Expression2 = EPSILON 
        |Node(7,_,EPS_Leaf(_)::_)  
            -> ()  
        //8:AddOp = PLUS 
        //9:AddOp = MINUS 
        //10:Expression2 = AddOp Expression3 Term Expression2 
        //11:Expression3 = EPSILON 
        //12:Expression3 = UnaryOp 
        |Node(10,_,addOpNd::exp3Nd::termNd::exp2Nd::_)  
            ->eVal1 termNd  
              match exp3Nd with  
                   |Node(11,_,_) -> ()  
                   |Node(12,_,Node(3,_,_)::_)  -> () 
                   |Node(12,_,Node(4,_,_)::_)  -> pccArr.[!ccaIndex] <- NEG ; ccaIndex := !ccaIndex + 1 
                   |_ -> failwith "never occruable error"  
              match addOpNd with 
                |Node(8,_,_)  -> pccArr.[!ccaIndex] <- ADD ; ccaIndex := !ccaIndex + 1 
                |Node(9,_,_)  -> pccArr.[!ccaIndex] <- SUB ; ccaIndex := !ccaIndex + 1 
                |_ -> failwith "never occruable error"  
              eVal1 exp2Nd   
        //13:Term = Factor Term1 
        |Node(13,_,factorNd::term1Nd::_)  
            ->eVal1 factorNd 
              eVal1 term1Nd  
        //14:Term1 = EPSILON 
        |Node(14,_,_)  
            -> () 
        //15:MulOp = MUL 
        //16:MulOp = DIV 
        //17:Term1 = MulOp Factor Term1 
        |Node(17,_,mulOpNd::factorNd::term1Nd::_)  
            ->eVal1 factorNd 
              match mulOpNd with 
                |Node(15,_,_)  -> pccArr.[!ccaIndex] <- MUL ; ccaIndex := !ccaIndex + 1 
                |Node(16,_,_)  -> pccArr.[!ccaIndex] <- DIV ; ccaIndex := !ccaIndex + 1 
                |_ -> failwith "never occruable error"  
              eVal1 term1Nd 
        //18:Factor = NUM 
        |Node(18,_,Leaf(tk)::_) 
            -> let num = System.Int32.Parse(tk.Img) 
               pccArr.[!ccaIndex] <- LDI(num) ; ccaIndex := !ccaIndex + 1 
        //19:Factor = LPAR Expression RPAR 
        |Node(19,_,_::expNode::_::_)  
            -> eVal1 expNode 
        //20:Factor = ID 
        |Node(20,_,Leaf(tk)::_) 
            -> let adr =  symbolDic.[tk.Img] 
               pccArr.[!ccaIndex] <-  LOD(adr) ;ccaIndex := !ccaIndex + 1 
        //29:Stmts = PrintStmt SEMI Stmts 
        |Node(29,_,printStmtNd::_::stmtsNd::_) 
            ->eVal1 printStmtNd 
              eVal1 stmtsNd 
        //30:PrintStmt = EX VarRefs 
        |Node(30,_,_::varRefsNd::_) 
            ->eVal1 varRefsNd 
        //31:VarRefs = Expression VarRefs2 
        |Node(31,_,expNd::varRefs2Nd::_) 
            ->eVal1 expNd //これでスタックに評価値がのる 
              pccArr.[!ccaIndex] <- DISP ;ccaIndex := !ccaIndex + 1 
              eVal1 varRefs2Nd 
        //32:VarRefs2 = COMMA Expression VarRefs2 
        |Node(32,_,_::expNd::varRefs2Nd::_) 
            ->eVal1 expNd //これでスタックに評価値がのる 
              pccArr.[!ccaIndex] <- DISP ;ccaIndex := !ccaIndex + 1 
              eVal1 varRefs2Nd 
        //34:Stmts = AssignStmt SEMI Stmts 
        |Node(34,_,assStmtNd::_::stmtsNd::_) 
            ->eVal1 assStmtNd 
              eVal1 stmtsNd 
        //35:AssignStmt = ID EQ Expression  
        |Node(35,_,Leaf(tk)::_::expNd::_) 
            -> pccArr.[!ccaIndex] <- LDA(symbolDic.[tk.Img]);ccaIndex := !ccaIndex + 1//memの書き込み番地をスタックにのっける 
               eVal1 expNd //これでスタックに評価値がのる 
               pccArr.[!ccaIndex] <- ASS; ccaIndex := !ccaIndex + 1 
    
        //21:DeclStmts = DeclStmt SEMI DeclStmts2 
        //22:DeclStmts2  = EPSILON 
        //23:DeclStmts2  = DeclStmts 
        //24:DeclStmt = INT VarDefs 
        //25:VarDefs = ID EQ NUM VarDefs2 
        //26:VarDefs2 = COMMA ID EQ NUM VarDefs2 
        //27:VarDefs2 = EPSILON 
        //28:Stmts = EPSILON 
        //33:VarRefs2 = EPSILON 
        |_ -> ()  
 
    eVal1 in_eb 
    pccArr.[!ccaIndex] <- STOP  
    (pccArr,memArr,symbolDic) 
 
let f2c x = x :> System.Windows.Forms.Control  
let makeTree_btn= new Button(Location = new Point(344, 6),Name = "makeTree_btn",Size = new Size(164, 23),TabIndex = 57,Text = "構文木化",UseVisualStyleBackColor = true) 
let ebTree_tl= new TextBox(Location = new Point(294, 35),Multiline = true,Name = "ebTree_tl",ScrollBars = ScrollBars.Both,Size = new Size(271, 484),TabIndex = 56,WordWrap = false) 
let label5= new Label(AutoSize = true,Location = new Point(19, 11),Name = "label5",Size = new Size(33, 12),TabIndex = 55,Text = "ソース") 
let source_tb= new TextBox(Location = new Point(21, 35),Multiline = true,Name = "source_tb",ScrollBars = ScrollBars.Both,Size = new Size(258, 484),TabIndex = 54) 
let label8= new Label(AutoSize = true,Location = new Point(759, 414),Name = "label8",Size = new Size(74, 12),TabIndex = 80,Text = "Symbol Table") 
let Symbol_tb= new TextBox(Location = new Point(756, 442),Multiline = true,Name = "Symbol_tb",ScrollBars = ScrollBars.Both,Size = new Size(167, 77),TabIndex = 79,WordWrap = false) 
let mem_lb= new ListBox(FormattingEnabled = true,ItemHeight = 12,Location = new Point(947, 351),Name = "mem_lb",Size = new Size(90, 280),TabIndex = 78) 
let label7= new Label(AutoSize = true,Location = new Point(945, 331),Name = "label7",Size = new Size(29, 12),TabIndex = 77,Text = "メモリ") 
let label4= new Label(AutoSize = true,Location = new Point(945, 35),Name = "label4",Size = new Size(82, 12),TabIndex = 76,Text = "オペランドスタック") 
let label3= new Label(AutoSize = true,Location = new Point(577, 36),Name = "label3",Size = new Size(74, 12),TabIndex = 75,Text = "プログラムリスト") 
let oStack_lb= new ListBox(FormattingEnabled = true,ItemHeight = 12,Location = new Point(947, 63),Name = "oStack_lb",Size = new Size(90, 220),TabIndex = 74) 
let label2= new Label(AutoSize = true,Location = new Point(784, 121),Name = "label2",Size = new Size(95, 12),TabIndex = 73,Text = "SP(スタックポインタ)") 
let pc_tb= new TextBox(Location = new Point(786, 84),Name = "pc_tb",Size = new Size(100, 19),TabIndex = 68,TextAlign = HorizontalAlignment.Center) 
let groupBox3= new GroupBox(Location = new Point(774, 302),Name = "groupBox3",Size = new Size(121, 100),TabIndex = 71,TabStop = false,Text = "一括実行") 
let wholeClear_btn= new Button(Location = new Point(13, 58),Name = "wholeClear_btn",Size = new Size(94, 23),TabIndex = 3,Text = "クリア",UseVisualStyleBackColor = true) 
let wholeExt_btn= new Button(Location = new Point(13, 20),Name = "wholeExt_btn",Size = new Size(94, 23),TabIndex = 2,Text = "一括実行",UseVisualStyleBackColor = true) 
let sp_tb= new TextBox(Location = new Point(786, 144),Name = "sp_tb",Size = new Size(100, 19),TabIndex = 72,TextAlign = HorizontalAlignment.Center) 
let label1= new Label(AutoSize = true,Location = new Point(784, 61),Name = "label1",Size = new Size(108, 12),TabIndex = 69,Text = "PC(プログラムカウンタ)") 
let programList_lb= new ListBox(FormattingEnabled = true,ItemHeight = 12,Location = new Point(579, 63),Name = "programList_lb",Size = new Size(142, 568),TabIndex = 67) 
let groupBox2= new GroupBox(Location = new Point(774, 183),Name = "groupBox2",Size = new Size(121, 100),TabIndex = 70,TabStop = false,Text = "ステップ実行") 
let oneStepClear_btn= new Button(Location = new Point(12, 62),Name = "oneStepClear_btn",Size = new Size(94, 23),TabIndex = 1,Text = "クリア",UseVisualStyleBackColor = true) 
let oneStepExe_btn= new Button(Location = new Point(12, 24),Name = "oneStepExe_btn",Size = new Size(94, 23),TabIndex = 0,Text = "ワンステップ実行",UseVisualStyleBackColor = true) 
let compile_btn= new Button(Location = new Point(758, 7),Name = "compile_btn",Size = new Size(164, 23),TabIndex = 66,Text = "コンパイル",UseVisualStyleBackColor = true) 
let label6= new Label(AutoSize = true,Location = new Point(19, 535),Name = "label6",Size = new Size(32, 12),TabIndex = 81,Text = "エラー") 
let error_tb= new TextBox(Location = new Point(21, 560),Multiline = true,Name = "error_tb",ScrollBars = ScrollBars.Both,Size = new Size(534, 71),TabIndex = 82) 
let label9= new Label(AutoSize = true,Location = new Point(759, 530),Name = "label9",Size = new Size(29, 12),TabIndex = 83,Text = "実行結果") 
let result_tb= new TextBox(Location = new Point(755, 554),Multiline = true,Name = "result_tb",ScrollBars = ScrollBars.Both,Size = new Size(167, 77),TabIndex = 84,WordWrap = false) 
let sourceSave_btn= new Button(Location = new Point(178, 6),Name = "sourceSave_btn",Size = new Size(101, 23),TabIndex = 86,Text = "ソースのSave",UseVisualStyleBackColor = true) 
let sourceLoad_btn= new Button(Location = new Point(71, 6),Name = "sourceLoad_btn",Size = new Size(101, 23),TabIndex = 85,Text = "ソースのLoad",UseVisualStyleBackColor = true) 
let mainForm= new Form(AutoScaleDimensions = new SizeF(6.0f, 12.0f),AutoScaleMode = AutoScaleMode.Font,ClientSize = new Size(1067, 648),Name = "mainForm",Text = "LL1IDPlusSampleVM") 
[ f2c oneStepClear_btn; f2c oneStepExe_btn] |> List.iter(fun cnt -> groupBox2.Controls.Add cnt) 
[ f2c wholeClear_btn; f2c wholeExt_btn] |> List.iter(fun cnt -> groupBox3.Controls.Add cnt) 
[ f2c sourceSave_btn; f2c sourceLoad_btn; f2c result_tb; f2c label9; f2c error_tb; f2c label6; f2c label8; f2c Symbol_tb; f2c mem_lb; f2c label7; f2c label4; f2c label3; f2c oStack_lb; f2c label2; f2c pc_tb; f2c groupBox3; f2c sp_tb; f2c label1; f2c programList_lb; f2c groupBox2; f2c compile_btn; f2c makeTree_btn; f2c ebTree_tl; f2c label5; f2c source_tb] |> List.iter(fun cnt -> mainForm.Controls.Add cnt) 
 
let GL_CurPC = ref (-1) 
let GL_CurSP = ref (-1) 
let mutable GL_PL:CommandCode[] = null 
let mutable GL_ST:Collections.Generic.Dictionary<string,int> = null 
 
type CntiState = 
    |Cnti 
    |Exit 
 
let showPC () = 
    pc_tb.Text <- (!GL_CurPC).ToString()    
    programList_lb.SelectedIndex <- !GL_CurPC 
 
let showSP () = 
    sp_tb.Text <- (!GL_CurSP).ToString() 
    oStack_lb.SelectedIndex <- !GL_CurSP  
 
let changeOSValue f intCurSP = 
    let u = System.Int32.Parse(oStack_lb.Items.[intCurSP-1].ToString()) 
    let v = System.Int32.Parse(oStack_lb.Items.[intCurSP].ToString()) 
    oStack_lb.Items.[intCurSP-1] <- f u v 
 
let getStkNum (refCurSP) (f:int->int) = //fを( (+) 0)とするとrefCurSPの指すスタック、((-) 1)で一つ下 
      System.Int32.Parse((oStack_lb.Items.[f (!refCurSP)]).ToString())   
     
let incPC () =  GL_CurPC := !GL_CurPC + 1 
 
let SPinc1 () = GL_CurSP := !GL_CurSP + 1 
let SPdec1 () = GL_CurSP := !GL_CurSP - 1 
let SPdec2 () = GL_CurSP := !GL_CurSP - 2 
 
 
let oneStepExec () = 
    if !GL_CurPC > -1 && GL_PL.[!GL_CurPC] = STOP then  
        showPC();Exit 
    else 
        if  !GL_CurPC = -1 then GL_CurPC := 0 
        showPC () 
        match GL_PL.[!GL_CurPC] with 
            |ADD  ->changeOSValue (+) !GL_CurSP; SPdec1 (); showSP(); incPC ();Cnti 
            |SUB  ->changeOSValue (-) !GL_CurSP; SPdec1 (); showSP() ;incPC ();Cnti 
            |MUL  ->changeOSValue (*) !GL_CurSP; SPdec1 (); showSP() ;incPC ();Cnti 
            |DIV  ->changeOSValue (/) !GL_CurSP; SPdec1 (); showSP() ;incPC ();Cnti   
            |NEG  ->oStack_lb.Items.[!GL_CurSP] <- (-1)*(System.Int32.Parse((oStack_lb.Items.[!GL_CurSP]).ToString()));Cnti 
            |LDI(intNum) -> SPinc1 (); showSP(); oStack_lb.Items.[!GL_CurSP] <- intNum;incPC ();Cnti 
            |STOP        -> Exit 
            |LOD(intAdr) ->  SPinc1 ();oStack_lb.Items.[!GL_CurSP] <- mem_lb.Items.[intAdr] ;showSP ();incPC ();Cnti 
            |LDA(intAdr) ->  SPinc1 ();oStack_lb.Items.[!GL_CurSP] <-intAdr;showSP ();incPC ();Cnti 
            |ASS         -> mem_lb.Items.[getStkNum GL_CurSP ((-) 1)] <-  (oStack_lb.Items.[!GL_CurSP]); 
                            SPdec2 ();showSP (); incPC ();Cnti  
            |DISP        -> result_tb.Text <- result_tb.Text  + ((oStack_lb.Items.[!GL_CurSP]).ToString()) + "\r\n"; 
                            SPdec1 (); showSP ();incPC ();Cnti 
            |NULL        -> failwith "プログラムカウンタが領域外を指しています。" 
 
 
let rec wholeExec comState =  
    if comState = Exit then 
        () 
    else 
        wholeExec (oneStepExec ()) 
 
 
let initVM() = 
    error_tb.Text <- "" 
    result_tb.Text <- "" 
    let sourceTextLst = source_tb.Text.Replace("\r\n", "\n").Split([|'\n'|]) |> List.ofArray 
    let ebTree = tp.GetEBASTtree sourceTextLst 
    GL_CurPC := -1 
    pc_tb.Text <- (!GL_CurPC).ToString() 
    GL_CurSP := -1 
    sp_tb.Text <- (!GL_CurSP).ToString() 
    oStack_lb.Items.Clear() 
    [1 .. 200] |> List.iter (fun _ -> oStack_lb.Items.Add(0) |> ignore) //stackの大きさは200 
    programList_lb.Items.Clear() 
    let (madePL,madeMM,madeST) = makePLArr ebTree 
    GL_PL<- madePL 
    GL_PL |> Array.iteri (fun i com -> programList_lb.Items.Add(sprintf "%3d %s" i (com.ToString()) ) |> ignore) 
    GL_ST <- madeST 
    Symbol_tb.Text <- sprintf "%A" GL_ST 
    mem_lb.Items.Clear() 
    madeMM |> Array.iter (fun ele ->  mem_lb.Items.Add(ele) |> ignore) 
 
 
makeTree_btn.Click.Add 
    (fun _ ->  
        error_tb.Text <- "" 
        result_tb.Text <- "" 
        try 
            let sourceTextLst = source_tb.Text.Replace("\r\n", "\n").Split([|'\n'|]) |> List.ofArray 
            let ebTree = tp.GetEBASTtree sourceTextLst 
            ebTree_tl.Text <- ebTree.dispStr 4 
        with 
          | ex -> error_tb.Text <- ex.Message  
    ) 
 
compile_btn.Click.Add 
    (fun _ -> 
        try 
            initVM() 
        with 
          | ex -> error_tb.Text <- ex.Message  
    ) 
 
oneStepExe_btn.Click.Add 
    (fun _ ->  
        try 
            oneStepExec () |> ignore 
        with 
        | ex -> error_tb.Text <- ex.Message  
    ) 
 
 
oneStepClear_btn.Click.Add 
    (fun _ ->  
        try 
            initVM() 
        with 
        | ex -> error_tb.Text <- ex.Message  
     ) 
 
wholeExt_btn.Click.Add 
    (fun _ -> 
        try 
          wholeExec Cnti 
        with 
        | ex -> error_tb.Text <- ex.Message  
     )            
 
wholeClear_btn.Click.Add 
    (fun _ ->  
        try 
            initVM() 
        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(mainForm) 
 
 
スポンサーサイト

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

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

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

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

この人とブロともになる

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