11 people like it.

A little esoteric os

Petrovich is more than just a programming language, it is a complete computer operating system and program development environment named after Ivan Petrovich Pavlov. Design Principles: * Provide an operating system and computer language that can learn and improve its performance in a natural manner. * Adapt to user feedback in an intelligent manner.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81: 
82: 
83: 
84: 
85: 
86: 
87: 
88: 
89: 
90: 
91: 
92: 
93: 
94: 
95: 
96: 
open System

(* Petrovich provides two methods of influencing its behaviour: rewards and punishments. 
Whenever Petrovich does something the user doesn't approve of, the user can punish it. 
Conversely, whenever Petrovich does something useful, the user can reward it. 
Petrovich then adapts its behaviour to avoid punishment and enjoy more rewards. *)
type Action = 
    | DoSmth                    //Causes Petrovich to do something. 
    | DoSmthWithFile of string  //Causes Petrovich to do something using the named file. 
    | Punish                    //Punishes Petrovich. 
    | Reward                    //Rewards Petrovich. 
    | Exit                      

let print a = a >> printfn "%A"

(Do Something Actions Realization)
let doSmthActions = [
    beep
    print get100Numbers
    print getDate 
    print getTimeZoneInfo 
    print sortArray
    sleep
]

(Do Something With File Actions Realization)
//Attention! Don't try this at home, especially with some important files! =)
let doSmthWithFileActions = [
    getCreationTime
    print getPath
    writeGuid
    delete
    read
]

type DecisionList<'a>(list: 'a list) =
    (private fields)
    member i.Choose() = (...)
    member i.Reward() = (...)
    member i.Punish() = (...)                 

type OS() =
    let doSmth = new DecisionList<_>(doSmthActions)
    let doSmthWithFile = new DecisionList<_>(doSmthWithFileActions)

    let printLine = printfn "Petrovich> %s"
    (* MailboxProcessor with 2 states: 
        - 'command' to make it do something
        - 'response' to formulate a reflex *)
    let core =
        MailboxProcessor.Start(fun inbox ->
            let rec command() =
                async { let! msg = inbox.Receive()
                    match msg with
                    | DoSmth -> 
                        printLine "do something"
                        doSmth.Choose()()
                        return! response doSmth.Punish doSmth.Reward
                    | DoSmthWithFile fileName ->
                        printLine <| "do something with " + fileName
                        doSmthWithFile.Choose() fileName
                        return! response doSmthWithFile.Punish doSmthWithFile.Reward
                    | Exit ->
                        printLine "exit" 
                        return ()
                    | _ -> return! command()
                }
            and response (*on punish*)p (*on reward*)r =
                async { let! msg = inbox.Receive()
                    match msg with
                    | Punish ->
                        printLine "punish"; p()
                        return! command()
                    | Reward ->
                        printLine "reward"; r()
                        return! command()
                    | Exit ->
                        printLine "exit" 
                        return ()
                    | _ -> return! response p r
                }
            command())

    member i.DoSomething() = core.Post DoSmth
    member i.DoSomethingWithFile fName = core.Post << DoSmthWithFile <| fName
    member i.Reward() = core.Post Reward
    member i.Punish() = core.Post Punish
    member i.Exit() = core.Post Exit

//time to test:
let petrovich = new OS()
petrovich.DoSomething()
petrovich.DoSomethingWithFile "test.txt"
petrovich.Reward()
petrovich.Punish()
petrovich.Exit()
namespace System
Multiple items
type Action =
  | DoSmth
  | DoSmthWithFile of string
  | Punish
  | Reward
  | Exit

Full name: Script.Action

--------------------
type Action<'T> =
  delegate of 'T -> unit

Full name: System.Action<_>

--------------------
type Action<'T1,'T2> =
  delegate of 'T1 * 'T2 -> unit

Full name: System.Action<_,_>

--------------------
type Action<'T1,'T2,'T3> =
  delegate of 'T1 * 'T2 * 'T3 -> unit

Full name: System.Action<_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 -> unit

Full name: System.Action<_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 -> unit

Full name: System.Action<_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 -> unit

Full name: System.Action<_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 -> unit

Full name: System.Action<_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11,'T12> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 * 'T12 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11,'T12,'T13> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 * 'T12 * 'T13 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11,'T12,'T13,'T14> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 * 'T12 * 'T13 * 'T14 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11,'T12,'T13,'T14,'T15> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 * 'T12 * 'T13 * 'T14 * 'T15 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11,'T12,'T13,'T14,'T15,'T16> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 * 'T12 * 'T13 * 'T14 * 'T15 * 'T16 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_>
union case Action.DoSmth: Action
union case Action.DoSmthWithFile: string -> Action
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
union case Action.Punish: Action
union case Action.Reward: Action
union case Action.Exit: Action
val print : a:('a -> 'b) -> ('a -> unit)

Full name: Script.print
val a : ('a -> 'b)
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
let beep() = Console.Beep()
let get100Numbers() = [1..100]
let getDate() = DateTime.Now
let getTimeZoneInfo() = TimeZoneInfo.Local
let sleep() = printfn "sleeping..."; Threading.Thread.Sleep 10000
let sortArray() =
    let r = new Random()
    let array = Array.init 10 r.Next
    printfn "sorting: %A" array
    Array.sort array
val doSmthActions : (unit -> unit) list

Full name: Script.doSmthActions
val beep : unit -> unit

Full name: Script.beep
val get100Numbers : unit -> int list

Full name: Script.get100Numbers
val getDate : unit -> DateTime

Full name: Script.getDate
val getTimeZoneInfo : unit -> TimeZoneInfo

Full name: Script.getTimeZoneInfo
val sortArray : unit -> int []

Full name: Script.sortArray
val sleep : unit -> unit

Full name: Script.sleep
let doIfExists action fName =
    if IO.File.Exists fName then action fName
    else
        IO.File.WriteAllText(fName, "new file")
        printfn "file was created"

let getCreationTime = doIfExists <| print IO.File.GetCreationTime
let getPath = IO.Path.GetFullPath
let read = doIfExists <| print IO.File.ReadAllText

let delete = doIfExists (fun fName ->
    IO.File.Delete fName
    printfn "file was deleted")

let writeGuid = doIfExists (fun fName ->
    IO.File.WriteAllText(fName, Guid.NewGuid().ToString())
    printfn "guid was saved")
val doSmthWithFileActions : (string -> unit) list

Full name: Script.doSmthWithFileActions
val getCreationTime : (string -> unit)

Full name: Script.getCreationTime
val getPath : arg00:string -> string

Full name: Script.getPath
val writeGuid : (string -> unit)

Full name: Script.writeGuid
val delete : (string -> unit)

Full name: Script.delete
val read : (string -> unit)

Full name: Script.read
Multiple items
type DecisionList<'a> =
  new : list:'a list -> DecisionList<'a>
  member Choose : unit -> 'a
  member Punish : unit -> unit
  member Reward : unit -> unit

Full name: Script.DecisionList<_>

--------------------
new : list:'a list -> DecisionList<'a>
Multiple items
val list : 'a list

--------------------
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
let variants = list.Length / 3
    let decisions = new Collections.Generic.List<'a>(list)
    let random = new Random()
    let mutable last: Option<int> = None
val i : DecisionList<'a>
member DecisionList.Choose : unit -> 'a

Full name: Script.DecisionList`1.Choose
let index = random.Next(0, variants)
        last <- Some index
        decisions.[index]
member DecisionList.Reward : unit -> unit

Full name: Script.DecisionList`1.Reward
match last with
        | None -> ()
        | Some index ->
            let decision = decisions.[index]
            decisions.RemoveAt index
            decisions.Insert (random.Next variants, decision)
            last <- None
member DecisionList.Punish : unit -> unit

Full name: Script.DecisionList`1.Punish
match last with
        | None -> ()
        | Some index ->
            let decision = decisions.[index]
            decisions.RemoveAt index
            let newIndex = index + random.Next(variants, decisions.Count)
            if newIndex < decisions.Count then
                decisions.Insert (newIndex, decision)
            else
                decisions.Add decision
            last <- None
Multiple items
type OS =
  new : unit -> OS
  member DoSomething : unit -> unit
  member DoSomethingWithFile : fName:string -> unit
  member Exit : unit -> unit
  member Punish : unit -> unit
  member Reward : unit -> unit

Full name: Script.OS

--------------------
new : unit -> OS
val doSmth : DecisionList<(unit -> unit)>
val doSmthWithFile : DecisionList<(string -> unit)>
val printLine : (string -> unit)
val core : MailboxProcessor<Action>
Multiple items
type MailboxProcessor<'Msg> =
  interface IDisposable
  new : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:CancellationToken -> MailboxProcessor<'Msg>
  member Post : message:'Msg -> unit
  member PostAndAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply>
  member PostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply
  member PostAndTryAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply option>
  member Receive : ?timeout:int -> Async<'Msg>
  member Scan : scanner:('Msg -> Async<'T> option) * ?timeout:int -> Async<'T>
  member Start : unit -> unit
  member TryPostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply option
  ...

Full name: Microsoft.FSharp.Control.MailboxProcessor<_>

--------------------
new : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:Threading.CancellationToken -> MailboxProcessor<'Msg>
static member MailboxProcessor.Start : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:Threading.CancellationToken -> MailboxProcessor<'Msg>
val inbox : MailboxProcessor<Action>
val command : (unit -> Async<unit>)
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val msg : Action
member MailboxProcessor.Receive : ?timeout:int -> Async<'Msg>
member DecisionList.Choose : unit -> 'a
val response : ((unit -> unit) -> (unit -> unit) -> Async<unit>)
member DecisionList.Punish : unit -> unit
member DecisionList.Reward : unit -> unit
val fileName : string
val p : (unit -> unit)
val r : (unit -> unit)
val i : OS
member OS.DoSomething : unit -> unit

Full name: Script.OS.DoSomething
member MailboxProcessor.Post : message:'Msg -> unit
member OS.DoSomethingWithFile : fName:string -> unit

Full name: Script.OS.DoSomethingWithFile
val fName : string
member OS.Reward : unit -> unit

Full name: Script.OS.Reward
member OS.Punish : unit -> unit

Full name: Script.OS.Punish
member OS.Exit : unit -> unit

Full name: Script.OS.Exit
val petrovich : OS

Full name: Script.petrovich
member OS.DoSomething : unit -> unit
member OS.DoSomethingWithFile : fName:string -> unit
member OS.Reward : unit -> unit
member OS.Punish : unit -> unit
member OS.Exit : unit -> unit
Raw view Test code New version

More information

Link:http://fssnip.net/2j
Posted:13 years ago
Author:Natallie Baikevich
Tags: mailbox processor