cicuits in fsharp

circuit.fsx

type Action = unit->unit

type Wire = (bool ref) * (Action list ref)

let getSignal ((s,_):Wire) : bool = s.Value
let setSignal ((s,fs):Wire) (signal:bool) = 
    if s.Value <> signal 
    then s.Value <- signal
         List.iter (fun f->f()) fs.Value 

let addAction ((s,fs):Wire) (f:unit -> unit) = 
    fs.Value <- f :: fs.Value
    f()
open System.Collections.Generic
type Segments = SortedList<int,Action list>
type Agenda = int ref * Segments
let newAgenda() = (ref 0, new SortedList<int,Action list>())
let currentTime ((time,_):Agenda) = time.Value
let setCurrentTime ((time,_):Agenda) newTime = time.Value <- newTime
let getSegments ((_,s):Agenda) = s
let addToAgenda ((_,segments):Agenda) time f = 
    if segments.TryAdd(time, [f]) |> not
    then segments.[time] <- f :: segments.[time]

let getFirstSegment a = 
    let ss = getSegments a 
    if ss.Count = 0 then None
    else Some(ss.Keys.[0],ss.Values.[0])

let removeFirstSegment a = 
    let ss = getSegments a 
    if ss.Count = 0 then ()
    else ss.RemoveAt(0)

let afterDelay (a:Agenda) (delay:int) (f) = 
    addToAgenda a (currentTime a + delay) f

let rec propagate (a:Agenda) =
    match getFirstSegment a with
    | None -> ()
    | Some(time, actions) -> 
        printfn "Propagating current time %d" time
        setCurrentTime a time
        Seq.iter (fun f -> f()) actions
        removeFirstSegment a
        propagate a
         
    
let inverterDelay = 2

let inverter agenda (input:Wire) (output:Wire) = 
    let invert () =
        let newVal = not <| getSignal input
        afterDelay agenda inverterDelay (fun () -> setSignal output newVal)
    addAction input invert

let andDelay = 3

let andGate agenda (input:Wire) (input2:Wire) (output:Wire) = 
    let andAction () =
        let newVal = getSignal input && getSignal input2
        afterDelay agenda andDelay (fun () -> setSignal output newVal)
    addAction input andAction
    addAction input2 andAction

let orDelay = 5

let orGate agenda (input:Wire) (input2:Wire) (output:Wire) = 
    let orAction () =
        let newVal = getSignal input || getSignal input2
        afterDelay agenda orDelay (fun () -> setSignal output newVal)
    addAction input orAction
    addAction input2 orAction

let makeWire () : Wire = (ref false, ref [])

let halfAdder agenda a b s c =
    let d = makeWire()
    let e = makeWire()
    orGate agenda a b d
    andGate agenda a b c
    inverter agenda c e
    andGate agenda d e s

let probe agenda name wire =
    addAction wire (fun () ->
                printfn "%s %d new value = %A" name (currentTime agenda) (getSignal wire))

let agenda = newAgenda()
let input1 = makeWire()
let input2 = makeWire()
let sum = makeWire()
let carry = makeWire()

probe agenda "sum" sum
probe agenda "carry" carry

halfAdder agenda input1 input2 sum carry

setSignal input1 true
propagate agenda

setSignal input2 true
propagate agenda