API tools faq
paste
Advertisement
Guest User

ATTENTION

a guest
Jul 11th, 2016
84
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
F# 27.79 KB | None | 0 0
raw download clone embed print report
  1. module typeProviderTest.Provider
  2.  
  3. open FSharp.Core.CompilerServices
  4.  
  5. open Microsoft.FSharp.Quotations
  6. open ProviderImplementation.ProvidedTypes // open the providedtypes.fs file
  7. open System.Reflection // necessary if we want to use the f# assembly
  8.  
  9. open Microsoft.FSharp.Data
  10. open System
  11. open System.Net.Sockets
  12. open System.IO
  13. open System.Threading
  14.  
  15.  
  16. (*********************************************)
  17. (**********DOMAIN MODELLING TYPES*************)
  18. (*********************************************)
  19.  
  20. type ScribbleProtocole = FSharp.Data.JsonProvider<""" [ { "currentState":1 , "localRole":"Me", "partner":"You" , "label":"hello()" , "type":"send" , "nextState":2  } ] """>
  21.  
  22.  
  23. (***** Useless *******
  24. type ILocalType() = class end// Interface
  25.     //abstract GetMessage : unit -> byte []
  26. type RoleType = class end  // Super Class Qui ne sert a rien pour le moment
  27. **********************)
  28.  
  29. type Agent<'T> = MailboxProcessor<'T>
  30.  
  31.  
  32. type Message =
  33.     |SendMessage of byte [] * string
  34.     |ReceiveMessage of byte [] * AsyncReplyChannel<byte []> * string
  35.  
  36. (*********************************************)
  37. (*********************************************)
  38. (*********************************************)
  39.  
  40. type AgentSender(ipAddress,port) =
  41.    
  42.     let send (stream:NetworkStream) (actor:Agent<Message>) =
  43.         let rec loop () = async {
  44.             let! msg = actor.Receive()
  45.             match msg with
  46.                 |ReceiveMessage (message,channel,role) ->
  47.                     () // Montrer que ce cas est un erreur (Throw une erreur?)
  48.                     return! loop()      
  49.                 |SendMessage (message,role) -> // Faire plus de choses
  50.                     do! stream.AsyncWrite("hey"B)//  SE SERAIT COOL COMME SA message.GetMessage())
  51.                     return! loop()
  52.             }
  53.         in loop()
  54.  
  55.     let mutable agentSender = None
  56.  
  57.     // Ne sert a rien pour le moment et meme plus tard ne devrait servir a rien
  58.     member this.SendMessage(message) =
  59.         match (agentSender:Option<MailboxProcessor<Message>>) with
  60.             |None -> ()
  61.             |Some sending -> sending.Post(Message.SendMessage message)
  62.     member this.Start() =
  63.         let tcpClientSend = new TcpClient(ipAddress,port)
  64.         let stream = tcpClientSend.GetStream()    
  65.         let truc = Agent.Start(send stream)
  66.         agentSender <- Some truc
  67.  
  68.    
  69.  
  70. type AgentReceiver(ipAddress,port) =
  71.  
  72.     let mutable clientMap = Map.empty
  73.  
  74.     let readAllBytes (s : Stream) =
  75.         let ms = new MemoryStream()
  76.         s.CopyTo(ms)
  77.         ms.ToArray()
  78.  
  79.     let binding (tcpListenerReceive:TcpListener) (actor:Agent<Message>) =
  80.         let rec loop () = async {
  81.             let client = tcpListenerReceive.AcceptTcpClient()
  82.             let stream = client.GetStream()
  83.             // Lit le role de ce stream
  84.             let readRole = readAllBytes stream
  85.             clientMap <- clientMap.Add(readRole.ToString(),stream)
  86.             return! loop()
  87.             }
  88.         in loop()
  89.  
  90.     let receive (actor:Agent<Message>) =
  91.         let rec loop () = async {
  92.             let! msg = actor.Receive()
  93.             match msg with
  94.                 |SendMessage (message,role)->
  95.                     () // Montrer que ce cas est un erreur (Throw une erreur?) = pour faire du debuggage
  96.                     return! loop()      
  97.                 |ReceiveMessage (message,channel,role) -> // Faire plus de choses i.e verifier que c'est correct.
  98.                     let stream = clientMap.[role]
  99.                     let read = readAllBytes stream
  100.                     // A changer c'est juste pour s'en rappeller
  101.                     if ( read.Length > 0 ) then
  102.                         channel.Reply(message)
  103.                     return! loop()
  104.             }
  105.         in loop()
  106.  
  107.  
  108.     let mutable tcpListenerReceive = None
  109.     let mutable agentReceiver = None
  110.    
  111.     member this.Start()=
  112.         let truc = new TcpListener(Net.IPAddress.Parse(ipAddress),port)
  113.         tcpListenerReceive <- Some truc // A changer
  114.         match (tcpListenerReceive:Option<TcpListener>) with
  115.             |None -> ()
  116.             |Some receiving -> receiving.Start()
  117.                                Agent.Start(binding receiving) |> ignore
  118.                                let chose = Agent.Start(receive)
  119.                                agentReceiver <- Some chose
  120.    
  121.     // Pour close le listener a faire dans finish.
  122.     member this.Stop() =
  123.         for client in clientMap do
  124.             client.Value.Close()
  125.         match tcpListenerReceive with
  126.             |None -> ()
  127.             |Some receive -> receive.Stop()
  128.     // Ne sert a rien pour le moment et meme plus tard ne devrait servir a rien
  129.     member this.ReceiveMessage(message) =
  130.         match agentReceiver with
  131.             |Some receive -> receive.PostAndAsyncReply(fun _ -> Message.ReceiveMessage message)
  132.             |None -> async{
  133.                         let label,_,_ = message
  134.                         return label
  135.                      }        
  136.     // Sa sert a quoi?
  137.     member this.ReadMessage(message:string) =
  138.         message
  139.  
  140.  
  141.  
  142.  
  143. type AgentRouter(agentMap:Map<string,AgentSender>,agentReceiving:AgentReceiver) =
  144.     let agentMapping = agentMap
  145.     let agentReceiver = agentReceiving
  146.  
  147.     let sendAndReceive (agentRouter:Agent<Message>) =
  148.         let rec loop () = async{
  149.             let!  msg = agentRouter.Receive()
  150.             match msg with
  151.                 |SendMessage (message,role) ->
  152.                     let agentSender = agentMapping.[role]
  153.                     agentSender.SendMessage(message,role)
  154.                     return! loop()
  155.                 |ReceiveMessage (message,channel,role) -> // Faire quelque chose
  156.                     let! replyMessage = agentReceiver.ReceiveMessage(message,channel,role)
  157.                     channel.Reply(replyMessage)
  158.                     return! loop()
  159.             }
  160.         in loop()
  161.    
  162.     let agentRouter = Agent.Start(sendAndReceive)
  163.  
  164.     member this.Start() =
  165.         agentReceiver.Start()
  166.         for sender in agentMapping do
  167.             sender.Value.Start()
  168.                
  169.     member this.SendMessage(message) =
  170.         agentRouter.Post(Message.SendMessage message)
  171.    
  172.     member this.ReceiveMessage(message)=
  173.         let (msg,role) = message
  174.         async{
  175.             let! replyMessage = agentRouter.PostAndAsyncReply(fun channel -> Message.ReceiveMessage (msg,channel,role))
  176.             return replyMessage
  177.         }
  178.  
  179. // This defines the type provider. When this will be compiled as a DLL file, we can add this type, as a reference
  180. // to the type provider, in a project
  181. [<TypeProvider>]
  182. type ProviderTest(config : TypeProviderConfig) as this =
  183.     inherit TypeProviderForNamespaces ()
  184.     let ns = "typeProviderTest.Provided"
  185.     let asm = Assembly.LoadFrom(config.RuntimeAssembly)
  186.  
  187.     // DEFINING THE AGENTROUTER AGENTSENDERSSS AGENTRECEIVER
  188.  
  189.     // A MODIFIERERRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR = A ENGENDRER DANS LE TYPE PROVIDER
  190.  
  191.     // THE CODE FOR GENERATING TYPE PROViDER
  192.  
  193.     let findCurrentIndex current (fsmInstance:ScribbleProtocole.Root []) = // gerer les cas
  194.         let mutable inc = 0
  195.         let mutable index = -1
  196.         for event in fsmInstance do
  197.             match event.CurrentState with
  198.                 |n when n=current -> index <- inc
  199.                 | _ -> inc <- inc + 1
  200.         index
  201.  
  202.     let findNext index (fsmInstance:ScribbleProtocole.Root []) =
  203.         (fsmInstance.[index].NextState)
  204.  
  205.     let findNextIndex currentState (fsmInstance:ScribbleProtocole.Root []) =
  206.         let index = findCurrentIndex currentState fsmInstance in
  207.         let next = findNext index fsmInstance in
  208.         findCurrentIndex next fsmInstance
  209.  
  210.     let findSameNext nextState  (fsmInstance:ScribbleProtocole.Root [])  =
  211.         let mutable list = []
  212.         let mutable inc = 0
  213.         for event in fsmInstance do
  214.             if event.NextState = nextState then
  215.                 list <- inc::list
  216.             inc <- inc+1
  217.         list
  218.  
  219.     // Changer sa avec des OR et tout sa mais faire gaffe à pas faire de la merde
  220.     let rec alreadySeen (liste:string list) (s:string) =
  221.         match liste with
  222.             | [] -> false
  223.             | hd::tl -> if hd.Equals(s) then
  224.                             true
  225.                         else
  226.                             alreadySeen tl s
  227.  
  228.     let findSameCurrent currentState  (fsmInstance:ScribbleProtocole.Root [])  =
  229.         let mutable list = []
  230.         let mutable inc = 0
  231.         for event in fsmInstance do
  232.             if event.CurrentState = currentState then
  233.                 list <- inc::list
  234.             inc <- inc+1
  235.         list
  236.  
  237.     // Test this function by changing t with t+1 and see the mistakes happen  -> generate the useless ProvidedTypeDefinition and throw exception cause it
  238.     // is not added to the assembly.
  239.     let rec findProvidedType (providedList:ProvidedTypeDefinition list) stateValue =
  240.         match providedList with
  241.             |[] -> // Useless case, t is useless but we need this case due to pattern matching exhaustiveness.
  242.                    let t = ProvidedTypeDefinition("CodingMistake",None)
  243.                    t.AddXmlDoc("This State Was not found in the list of state types generated. This is probaly due to the way this list of state types is generated. This Should never Happen!!!! This Case should never happen, because we have generated the states correctly!!!!!")
  244.                    t
  245.             |[a] -> let t = ref 0
  246.                     if System.Int32.TryParse(a.Name.Replace("State",""),t) && (!t)=stateValue then
  247.                         a
  248.                     else
  249.                         findProvidedType [] stateValue    
  250.             |hd::tl -> let t = ref 0
  251.                        if System.Int32.TryParse(hd.Name.Replace("State",""),t) && (!t)=stateValue then
  252.                            hd
  253.                        else
  254.                            findProvidedType tl stateValue      
  255.  
  256.  
  257.     let makeRoleTypes (fsmInstance:ScribbleProtocole.Root []) =
  258.         let mutable liste = [fsmInstance.[0].LocalRole]
  259.         let mutable listeType = []
  260.         let t =  ProvidedTypeDefinition(fsmInstance.[0].LocalRole, baseType = Some typeof<obj> , IsErased = false)
  261.         let ctor = ProvidedConstructor([ProvidedParameter("Voir",typeof<int>)], InvokeCode = fun args -> <@@ "le Role est unique" :> obj @@>) // add argument later
  262.         t.AddMember(ctor)
  263.         //t.SetBaseTypeDelayed(fun() -> RoleType) // FAIRE UN TRUC LA POUR INTERFACER .SetBaseTypeDelayed(fun() -> ILocalType)
  264.         let myProp = ProvidedProperty("instance", t, IsStatic = true,
  265.                                                 GetterCode = (fun args -> Expr.NewObject(ctor,[]) ))
  266.         t.AddMember(myProp)
  267.         listeType <- t::listeType
  268.         let mutable mapping = Map.empty<_,ProvidedTypeDefinition>.Add(fsmInstance.[0].LocalRole,t)
  269.         for event in fsmInstance do
  270.             if not(alreadySeen liste event.Partner) then
  271.                 let t = ProvidedTypeDefinition(event.Partner,baseType = Some typeof<obj>)
  272.                 let ctor = ProvidedConstructor([], InvokeCode = fun args -> <@@ "le Role est unique" :> obj @@>) // add argument later
  273.                 t.AddMember(ctor)
  274.                 let myProp = ProvidedProperty("instance", t, IsStatic = true,
  275.                                                     GetterCode = (fun args -> Expr.NewObject(ctor,[]) ))
  276.                 t.AddMember(myProp)
  277.                 mapping <- mapping.Add(event.Partner,t)
  278.                 liste <- event.Partner::liste
  279.                 listeType <- t::listeType
  280.         (mapping,listeType)
  281.  
  282.     let makeChoiceType (nextType:ProvidedTypeDefinition) (event:ScribbleProtocole.Root) (choiceType:ProvidedTypeDefinition) =
  283.         let c = nextType.GetConstructors().[0]
  284.         let expression = Expr.NewObject(c, [])  
  285.         let name = event.Label.Replace("(","").Replace(")","")
  286.         let t = ProvidedTypeDefinition(name,None, IsErased = false)
  287.         let ctor = ProvidedConstructor([], InvokeCode = fun args -> <@@ "We'll see later" :> obj @@>) // add argument later
  288.         t.AddMember(ctor)
  289.         let myMethod = ProvidedMethod("next",[],nextType,InvokeCode = fun args -> expression)
  290.         let method2 =  ProvidedMethod("GetMessage",[],typeof<byte []>,InvokeCode = fun args -> <@@ name @@>)  
  291.         t.AddMember(myMethod)
  292.         t.AddMember(method2)
  293.         t.SetBaseTypeDelayed(fun() -> choiceType.DeclaringType.GetNestedType("LabelChoice"+ string event.CurrentState))
  294.         t
  295.  
  296.     // Refactorer un max
  297.     let makeLabelTypes (fsmInstance:ScribbleProtocole.Root []) (providedList: ProvidedTypeDefinition list) =
  298.         let mutable listeLabelSeen = []
  299.         let listeType = []
  300.         let mutable mapping = Map.empty<_,ProvidedTypeDefinition>
  301.         for event in fsmInstance do
  302.             if (event.Type.Contains("choice") && not(alreadySeen listeLabelSeen event.Label)) then
  303.                 let choiceType = ProvidedTypeDefinition("LabelChoice"+ string event.CurrentState, None, IsErased = false)
  304.                 //choiceType.SetBaseType(typeof<ILocalType>)
  305.                 let ctor = ProvidedConstructor([], InvokeCode = fun args -> <@@ "We'll see later" :> obj @@>) // add argument later
  306.                 choiceType.AddMember(ctor)
  307.                 let myMethod = ProvidedMethod("labelChoice" + string event.CurrentState ,[],typeof<unit>,InvokeCode = fun args -> <@@ () @@>) in
  308.                 choiceType.AddMember(myMethod)
  309.                 mapping <- mapping.Add("LabelChoice"+ string event.CurrentState,choiceType)
  310.                 choiceType::listeType |> ignore
  311.                 let listIndexChoice = findSameCurrent event.CurrentState fsmInstance
  312.                 let rec aux (liste:int list) =
  313.                     match liste with
  314.                         |[] -> ()
  315.                         |[aChoice] -> if not(alreadySeen listeLabelSeen fsmInstance.[aChoice].Label) then
  316.                                         let nextType = findProvidedType providedList fsmInstance.[aChoice].NextState
  317.                                         let state = fsmInstance.[aChoice]
  318.                                         let t = makeChoiceType nextType state choiceType
  319.                                         mapping <- mapping.Add(state.Label,t)
  320.                                         listeLabelSeen <- state.Label::listeLabelSeen
  321.                                         t::listeType |> ignore    
  322.                         |hd::tl -> if not(alreadySeen listeLabelSeen fsmInstance.[hd].Label) then
  323.                                         let nextType = findProvidedType providedList fsmInstance.[hd].NextState
  324.                                         let state = fsmInstance.[hd]
  325.                                         let t = makeChoiceType nextType state choiceType
  326.                                         mapping <- mapping.Add(state.Label,t)
  327.                                         listeLabelSeen <- state.Label::listeLabelSeen
  328.                                         t::listeType |> ignore
  329.                                         aux tl
  330.                 in aux listIndexChoice
  331.             else if not(alreadySeen listeLabelSeen event.Label) then
  332.                 let name = event.Label.Replace("(","").Replace(")","")
  333.                 let t = ProvidedTypeDefinition(name,None, IsErased = false)
  334.                 //t.SetBaseType(typeof<ILocalType>)
  335.                 let myMethod =  ProvidedMethod("GetMessage",[],typeof<byte []>,InvokeCode = fun args -> <@@ name @@>)
  336.                 let ctor = ProvidedConstructor([], InvokeCode = fun args -> <@@ "We'll see later" :> obj @@>) // add argument later
  337.                 t.AddMember(ctor)
  338.                 t.AddMember(myMethod)
  339.                 mapping <- mapping.Add(event.Label,t)
  340.                 listeLabelSeen <- event.Label::listeLabelSeen
  341.                 t::listeType |> ignore
  342.         (mapping,listeType)
  343.  
  344.     let makeStateType (n:int) (s:string) =
  345.         let t = ProvidedTypeDefinition(s + string n,Some typeof<obj>,IsErased=false)
  346.         let ctor = ProvidedConstructor([], InvokeCode = fun args -> <@@ "MakeStateType" :> obj @@>)
  347.         t.AddMember(ctor)
  348.         t
  349.  
  350.     let makeStateType (n:int) = makeStateType n "State"
  351.  
  352.  
  353.     let rec goingThrough (methodName:string) (providedList:ProvidedTypeDefinition list) (aType:ProvidedTypeDefinition) (indexList:int list) (mLabel:Map<string,ProvidedTypeDefinition>) (mRole:Map<string,ProvidedTypeDefinition>) (fsmInstance:ScribbleProtocole.Root []) (agentRouter:AgentRouter) =
  354.          match indexList with
  355.          |[] -> // Last state: no next state possible
  356.                 let myMethod = ProvidedMethod(methodName,[],typeof<unit>,InvokeCode = fun args -> <@@ printfn "finish" @@>) in
  357.                 aType.AddMember(myMethod)
  358.                 //printfn " There is a mistake, no index? should never happen, weird issue!!! "
  359.          |[b] -> let nextType = findProvidedType providedList fsmInstance.[b].NextState
  360.                  let labelType = mLabel.[fsmInstance.[b].Label]
  361.                  let exprLabel = Expr.NewObject(labelType.GetConstructors().[0], [])
  362.                  let c = nextType.GetConstructors().[0]
  363.                  let exprState = Expr.NewObject(c, [])
  364.                  let expression = exprState
  365.                  let myMethod = ProvidedMethod(methodName,[ProvidedParameter("Label",mLabel.[fsmInstance.[b].Label]);ProvidedParameter("Role",mRole.[fsmInstance.[b].Partner])],
  366.                                                                           nextType,InvokeCode = fun args -> expression) in
  367.                  aType.AddMember(myMethod)
  368.          |hd::tl -> let nextType = findProvidedType providedList fsmInstance.[hd].NextState
  369.                     let labelType = mLabel.[fsmInstance.[hd].Label]
  370.                     let exprLabel = Expr.NewObject(labelType.GetConstructors().[0], [])
  371.                     let c = nextType.GetConstructors().[0]
  372.                     let exprState = Expr.NewObject(c, [])
  373.                     let expression = exprState
  374.                     let myMethod = ProvidedMethod(methodName,[ProvidedParameter("Label",mLabel.[fsmInstance.[hd].Label]);ProvidedParameter("Role",mRole.[fsmInstance.[hd].Partner])],
  375.                                                                              nextType,InvokeCode = fun args -> expression) in
  376.                     aType.AddMember(myMethod)    
  377.                     goingThrough methodName providedList aType tl mLabel mRole fsmInstance agentRouter
  378.  
  379.  
  380.                     (*********************** VRAIIIIIIII VERSIONNNNNNNNNNNNNNNN ****************************************
  381.  
  382.                     let expression =
  383.                         match methodName with // ENVOYER LA PARTIE SERIALIZED DE LA EN FAITE
  384.                             |"send" -> <@@ let router = agentRouter.SendMessage(%%exprLabel,fsmInstance.[hd].Partner)     //agentMap.[fsmInstance.[hd].Partner]
  385.                                            %%exprState  @@>
  386.                             |"receive" -> <@@ agentRouter.ReceiveMessage(%%exprLabel,fsmInstance.[hd].Partner) |> ignore    //agentMap.[fsmInstance.[hd].Partner]
  387.                                               %%exprState  @@>
  388.                             |_ -> <@@ printfn "Not correct" @@>
  389.  
  390.  
  391.                     ***************************************************************************************************)
  392.  
  393.  
  394.     // REfactorer cela au max
  395.     let rec addProperty (providedListStatic:ProvidedTypeDefinition list) (providedList:ProvidedTypeDefinition list) (stateList: int list) (mLabel:Map<string,ProvidedTypeDefinition>) (mRole:Map<string,ProvidedTypeDefinition>) (fsmInstance:ScribbleProtocole.Root []) (agentRouter:AgentRouter)=
  396.         let currentState = stateList.Head
  397.         let indexOfState = findCurrentIndex currentState fsmInstance
  398.         let indexList = findSameCurrent currentState fsmInstance
  399.         let mutable methodName = "finish"
  400.         if indexOfState <> -1 then
  401.             methodName <- fsmInstance.[indexOfState].Type
  402.         match providedList with
  403.             |[] -> ()
  404.             |[aType] -> match methodName with
  405.                             |"send" -> goingThrough methodName providedListStatic aType indexList mLabel mRole fsmInstance agentRouter
  406.                             |"receive" -> goingThrough methodName providedListStatic aType indexList mLabel mRole fsmInstance agentRouter
  407.                             |"choice" -> let labelType = mLabel.["LabelChoice"+ string currentState]
  408.                                          let c = labelType.GetConstructors().[0]
  409.                                          let expression = Expr.NewObject(c,[])
  410.                                          let myMethod = ProvidedMethod("receive",[], labelType,InvokeCode = fun args -> expression )in
  411.                                          aType.AddMember(myMethod)
  412.                             |"finish" -> goingThrough methodName providedListStatic aType indexList mLabel mRole fsmInstance agentRouter
  413.                             | _ -> printfn "Not correct"
  414.                         let myProp = ProvidedProperty("MyProperty", typeof<string>, IsStatic = true,
  415.                                                         GetterCode = fun args -> <@@ "essaye Bateau" @@>)
  416.                         aType.AddMember(myProp)
  417.             |hd::tl ->  match methodName with
  418.                             |"send" -> goingThrough methodName providedListStatic hd indexList mLabel mRole fsmInstance agentRouter
  419.                             |"receive" -> goingThrough methodName providedListStatic hd indexList mLabel mRole fsmInstance agentRouter
  420.                             |"choice" -> let labelType = mLabel.["LabelChoice"+ string currentState]
  421.                                          let c = labelType.GetConstructors().[0]
  422.                                          let expression = Expr.NewObject(c,[])
  423.                                          let myMethod = ProvidedMethod("receive",[], labelType,InvokeCode = fun args -> expression )in
  424.                                          hd.AddMember(myMethod)
  425.                             |"finish" -> goingThrough methodName providedListStatic hd indexList mLabel mRole fsmInstance agentRouter
  426.                             | _ -> printfn "Not correct"
  427.                         let myProp = ProvidedProperty("MyProperty", typeof<string>, IsStatic = true,
  428.                                                        GetterCode = fun args -> <@@ "Test" @@>)
  429.                         hd.AddMember(myProp)
  430.                         addProperty providedListStatic tl (stateList.Tail) mLabel mRole fsmInstance agentRouter
  431.  
  432.     let contains (aSet:Set<'a>) x = Set.exists ((=) x) aSet
  433.  
  434.    let stateSet (fsmInstance:ScribbleProtocole.Root []) =
  435.        let firstState = fsmInstance.[0].CurrentState
  436.        let mutable setSeen = Set.empty
  437.        let mutable counter = 0
  438.        for event in fsmInstance do
  439.            if (not(contains setSeen event.CurrentState) || not(contains setSeen event.NextState)) then
  440.                setSeen <- setSeen.Add(event.CurrentState)
  441.                setSeen <- setSeen.Add(event.NextState)
  442.        (setSeen.Count,setSeen,firstState)
  443.  
  444. // LA PARTIE A GERER ENCOOOOOOOOORE
  445.  
  446.    let createType (name:string) (parameters:obj[]) =
  447.        
  448.        let basePort = 5000
  449.        
  450.        let modifySenders (mapping:Map<string,string*int>) =
  451.            let mutable agentMapSender = Map.empty
  452.            for event in mapping do
  453.                agentMapSender <- agentMapSender.Add(event.Key,new AgentSender(fst(event.Value),snd(event.Value)))
  454.            agentMapSender
  455.        
  456.        // USEFULL LATER NOT NOW
  457.        let modifySendersLocally port n =
  458.            let mutable agentMapSender = Map.empty
  459.            for i in 1..n do
  460.                agentMapSender <- agentMapSender.Add((port+i).ToString(),new AgentSender(("127.0.0.1",(port+i)))) // A CHANGER
  461.            agentMapSender  
  462.        
  463.        let modifyReceiver ipAddress port =
  464.            new AgentReceiver(ipAddress,port)
  465.        
  466.        let modifyReceiverLocally port =
  467.            modifyReceiver "127.0.0.1" port
  468. // LA PARTIE A GERER ENCOOOOOOOOORE FINNNNN
  469.  
  470.        let fsm = parameters.[0]  :?> string  (* this is used if we want to assure that the type of the parameter
  471.        we are grabbing is a string : DOWNCASTING . Which also means type verification at runtime and not compile time *)
  472.        let local = parameters.[1] :?> bool
  473.        let senders = parameters.[2] :?> Map<string,string*int>
  474.        let receiver = parameters.[3] :?> string*int
  475.  
  476.        let protocol = ScribbleProtocole.Parse(fsm)
  477.        let triple= stateSet protocol
  478.        let n,stateSet,firstState = triple
  479.        let listTypes = (Set.toList stateSet) |> List.map (fun x -> makeStateType x )
  480.        let firstStateType = findProvidedType listTypes firstState
  481.        let tupleLabel = makeLabelTypes protocol listTypes
  482.        let tupleRole = makeRoleTypes protocol
  483.        let list1 = snd(tupleLabel)
  484.        let list2 = snd(tupleRole)
  485.  
  486.        let numberOfRoles = list2.Length
  487.        let basePort = 5000
  488.  
  489.  
  490.        // TO CHANGE THIS IS NOT GOOD AT ALL BUT IT'S HERE FOR TESTING PURPOSES ONLY : I KNOW IT'S NOT GOOD :) = IF SENDERS IS EMPTY = LOCAL OTHERWISE WE TAKE WHAT' INSIDE THE MAP ( IT STILL CAN BE LOCAL BUT ALSO DISTRIBUTED )
  491.         let agentMapSender = if (local && senders.IsEmpty) then
  492.                                 modifySendersLocally basePort numberOfRoles
  493.                              elif (not(local) && not(senders.IsEmpty)) then
  494.                                 modifySenders senders
  495.                              else
  496.                                 modifySendersLocally basePort numberOfRoles                              
  497.  
  498.         let agentReceiver = if (local && senders.IsEmpty) then
  499.                                 modifyReceiverLocally basePort
  500.                             elif (not(local) && not(senders.IsEmpty)) then
  501.                                 modifyReceiver (fst(receiver)) (snd(receiver))
  502.                             else
  503.                                 modifyReceiverLocally basePort
  504.  
  505.         let agentRouter = new AgentRouter(agentMapSender,agentReceiver)
  506.         addProperty listTypes listTypes (Set.toList stateSet) (fst tupleLabel) (fst tupleRole) protocol agentRouter
  507.         let stuff = list2.ToString()
  508.         let ctor = ProvidedConstructor([], InvokeCode = fun args -> <@@ "hey " + string n + " nombre de receiver" + string numberOfRoles @@> )
  509.         let myMethod = ProvidedMethod("Start",[], firstStateType,InvokeCode = (fun args -> let c = firstStateType.GetConstructors().[0]
  510.                                                                                            //agentRouter.Start()
  511.                                                                                            Expr.NewObject(c, [])))  
  512.         let t = ProvidedTypeDefinition(asm,ns,name,Some typeof<obj>)
  513.         let memberList = listTypes |> List.append list2 |> List.append list1
  514.         t.AddMembers(memberList)
  515.         t.AddMember(myMethod)
  516.         t.AddMember(ctor)
  517.         t
  518.  
  519.  
  520.     // let assembly = ProvidedAssembly(Path.ChangeExtension(Path.GetTempFileName(), ".dll"))
  521.     // let c = assembly.AddTypes
  522.  
  523.     let providedType = ProvidedTypeDefinition(asm,ns,"RealProvider",Some typeof<obj>)
  524.     let parameters = [ProvidedStaticParameter("Protocol",typeof<string>);
  525.                       ProvidedStaticParameter("Local",typeof<bool>,parameterDefaultValue = true);
  526.                       ProvidedStaticParameter("Senders",typeof<Map<string,string*int>>,parameterDefaultValue = Map.empty<string,string*int> );
  527.                       ProvidedStaticParameter("Receiver",typeof<string*int>,parameterDefaultValue= ("127.0.0.1",5000) )]
  528.  
  529.     // ProvidedStaticParameter("SampleIsList", typeof<bool>, parameterDefaultValue = false) INSTEAD OF OPTIONSSSSSS
  530.  
  531.     do
  532.         providedType.DefineStaticParameters(parameters,createType)
  533.         this.AddNamespace(ns, [providedType] )
  534. [<assembly:TypeProviderAssembly>]
  535.     do()
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!