8 Anhang

Listing 1: Miss Grant’s Controller in F#

type condition = DoorClosed | DrawerOpened | LightOn
               | DoorOpened | PanelClosed
and actions = UnlockPanel | LockPanel | LockDoor | UnlockDoor
and codes = D1CL | D2OP | L1ON | D1OP | PNCL
          | PNUL | PNLK | D1LK | D1UL
and stateName = Idle | Active | WaitingForLight
              | WaitingForDrawer | UnlockedPanel
and state = {
    name: stateName;
    actions: actions list;
    transitions: (condition * stateName) list
}
and machine = {
    events : (condition * codes) list
    resetEvents: condition list
    commands : (actions * codes) list
    states : state list
}
 
let inline (=>) a b = (a, b)
let inline (:=) name (actions, transitions) =
    { name = name; actions = actions; transitions = transitions }
 
let machine = {
    events = [
                DoorClosed => D1CL
                DrawerOpened => D2OP
                LightOn => L1ON
                DoorOpened => D1OP
                PanelClosed => PNCL
    ];
    resetEvents = [ DoorOpened ];
    commands = [
                UnlockPanel => PNUL
                LockPanel => PNLK
                LockDoor => D1LK
                UnlockDoor => D1UL
    ];
     states = [
                Idle := [UnlockDoor; LockPanel]
                  => [DoorClosed => Active]
                Active := []
                  => [DrawerOpened => WaitingForLight;
                      LightOn => WaitingForDrawer]
                WaitingForLight := []
                  => [LightOn => UnlockedPanel]
                WaitingForDrawer := []
                  => [DrawerOpened => UnlockedPanel]
                UnlockedPanel := [UnlockPanel; LockDoor]
                  => [PanelClosed => Idle]
        ]
}

open System
open System.Text.RegularExpressions
open Microsoft.FSharp.Reflection
let run { events = events; resetEvents = resetEvents;
          commands = commands; states = states } =
    let assoc key (k, value) = if k = key then Some value else None
    let listAssoc key = List.pick(assoc key)
    let codeForEvent cond =
      events |> listAssoc cond
    let codeForAction action =
      commands |> listAssoc action
    let start = states.Head
    let splitOnCamelCase(word: string) = 
        String.concat "" [
            for i in 1..word.Length-1 do
                let a, b = word.[i-1], word.[i]
                yield string a
                if Char.IsLower a && Char.IsUpper b then yield " "
            yield string word.[word.Length-1]
        ]
    let print x = splitOnCamelCase(sprintf "%A" x)
    let printList select list =
      String.concat ", "
       (Seq.map (fun x -> print (select x)) list)
    let cases =
        let ctor = FSharpValue.PreComputeUnionConstructor
        FSharpType.GetUnionCases(typeof<condition>)
        |> Array.map(fun x -> (x.Name.ToUpper(),
                               ctor x [||]:?> condition))
    let readCondition() =
        let input = Console.ReadLine().Replace(" ", "").ToUpper()
        cases |> Array.tryPick(assoc input)
    let rec repl(state: state)(input: condition) =
        printfn "Received %s (%s)..."
            (print input) (print(codeForEvent input))
        match List.tryPick(assoc input) state.transitions with
        | Some next ->
            state.actions |> List.iter(fun x ->
                printfn "Doing %s (%s)..."
                    (print x) (print(codeForAction x)))
            states |> List.find(fun x -> x.name = next) |> startRepl
        | None ->
            if resetEvents |> List.exists((=)input) then
                startRepl start
            else
                startRepl state
    and startRepl state = 
        printfn "You're now in state %s." (print state.name)
        printfn "Transitions: %s" (printList fst state.transitions)
        let rec findSome() =
            printf "> "
            match readCondition() with
            | Some cond -> repl state cond
            | None ->  findSome()
        findSome()
    printfn "Reset transitions: %s" (printList id resetEvents)
    startRepl start

[<EntryPoint>]
let main _ = run machine

// Beispiel:
// Reset transitions: Door Opened
// You're now in state Idle.
// Transitions: Door Closed
// > Door Closed
// Received Door Closed (D1CL)...
// Doing Unlock Door (D1UL)...
// Doing Lock Panel (PNLK)...
// You're now in state Active.
// Transitions: Drawer Opened, Light On
// > Light On
// Received Light On (L1ON)...
// You're now in state Waiting For Drawer.
// Transitions: Drawer Opened
// > Drawer Opened
// Received Drawer Opened (D2OP)...
// You're now in state Unlocked Panel.
// Transitions: Panel Closed
// > Panel Closed
// Received Panel Closed (PNCL)...
// Doing Unlock Panel (PNUL)...
// Doing Lock Door (D1LK)...
// You're now in state Idle.
// Transitions: Door Closed
// > _

Listing 2: XML-Traversierung mit Active Patterns in F#

#r "System.Xml.Linq"
open System.Xml.Linq
 
let (|Node|_|)(name: string)(xObj: XObject) =
    match xObj with
    | :? XElement as element
        when element.Name.LocalName = name ->
    Some(element.Nodes())
    | _ -> None
     
let (|Text|_|)(xObj: XObject) =
    match xObj with
    | :? XElement -> None
    | _ -> Some(xObj.ToString())
 
let (|Attribute|_|)(name: string)(xObj: XObject) =
    match xObj with
    | :? XElement as element ->
        match element.Attribute(XName.Get(name)) with
        | null -> None
        | x -> Some(x.Value)
    | _ -> None
 
let rec traverseAll = Seq.iter traverseNode
and traverseNode = function
| Text text -> printfn "    %s" (text.Trim())
| Node "Matches" children -> traverseAll children
| Node "Match" children & Attribute "Winner" winner
  & Attribute "Loser" loser & Attribute"Score" score ->
    printfn "%s won against %s with score %s" winner loser score
    traverseAll children

let sampleXml = @"<Matches>
  <Match Winner='A' Loser='B' Score='1:0'>
    Description of the first match...
  </Match>
  <Match Winner='A' Loser='C' Score='1:0'>
    Description of the second match...
  </Match>
</Matches>"

traverseNode(XElement.Parse(sampleXml))

Listing 3: Generische Variante von Counting Sort in F#

> let inline SortInPlaceGeneric numbers =
    let maximum = Array.max numbers
    let occurences = Array.zeroCreate(int maximum + 1)
    for num in numbers do
        occurences.[int num] <- occurences.[int num] + 1
    let mutable insertionIndex = 0
    let mutable num = LanguagePrimitives.GenericZero
    while num <= maximum do
        for times = 1 to occurences.[int num] do
            numbers.[insertionIndex] <- num
            insertionIndex <- insertionIndex + 1
        num <- num + LanguagePrimitives.GenericOne
    numbers;;

val inline SortInPlaceGeneric : ^a [] ->  ^a []
  when  ^a : (static member get_Zero : ->  ^a)
   and  ^a : (static member op_Explicit :  ^a -> int) 
   and  ^a : comparison 
   and (^a or  ^b) : (static member ( + ) :  ^a *  ^b ->  ^a) 
   and  ^b : (static member get_One : ->  ^b)

// Beispielnutzung mit Ganzzahltypen int, int64, sbyte (signed byte), byte, int16 (suffix s für short), BigInteger
> SortInPlaceGeneric [| 1; 2; 3; 14; 120; 0; 2; 4 |];;
val it : int [] = [|0; 1; 2; 2; 3; 4; 14; 120|]
> SortInPlaceGeneric [| 1L; 2L; 3L; 14L; 120L; 0L; 2L; 4L |];;
val it : int64 [] = [|0L; 1L; 2L; 2L; 3L; 4L; 14L; 120L|]
> SortInPlaceGeneric [| 1y; 2y; 3y; 14y; 120y; 0y; 2y; 4y |];;
val it : sbyte [] = [|0y; 1y; 2y; 2y; 3y; 4y; 14y; 120y|]
> SortInPlaceGeneric [| 1uy; 2uy; 3uy; 14uy; 120uy; 0uy; 2uy; 4uy |];;
val it : byte [] = [|0uy; 1uy; 2uy; 2uy; 3uy; 4uy; 14uy; 120uy|]
> SortInPlaceGeneric [| 1s; 2s; 3s; 14s; 120s; 0s; 2s; 4s |];;
val it : int16 [] = [|0s; 1s; 2s; 2s; 3s; 4s; 14s; 120s|]
> SortInPlaceGeneric [| 1I; 2I; 3I; 14I; 120I; 0I; 2I; 4I |];;
val it : System.Numerics.BigInteger [] =
   [|0I; 1I; 2I; 2I; 3I; 4I; 14I; 120I|]

Listing 4: Prolog-ähnliche Quotation in F#

> open Microsoft.FSharp.Core.Operators.Unchecked
  let predicate<'a> = ignore<'a> // ignoriert den Parameter (f x = ())
  let value<'a> = defaultof<'a> // liefert null/false/0/0.0, je nach Typ
  // ^- Für das Typsystem, die Funktionen sollen nicht ausgeführt werden.
  let prolog x = x // Hier käme die Metaprogrammierung
                   // (Verarbeitung der Quotation x)

  let memb<'a> = predicate<'a * 'a list>
  let E<'a> = value<'a>
  let __<'a> = value<'a>
  let R<'a> = value<'a list>
  let (<--) a b = ();;
...
> prolog <@
          memb(E, E :: __)
          memb(E, __ :: R) <-- memb(E, R)
  @>;;
val it : Quotations.Expr<unit> =
    Sequential (Application (Call (None, memb, []),
                        NewTuple (Call (None, E, []),
                              NewUnionCase (Cons, Call (None, E, []),
                                Call (None, __, [])))),
      Call (None, op_LessMinusMinus,
      [Application (Call (None, memb, []),
        NewTuple (Call (None, E, []),
            NewUnionCase (Cons,
              Call (None, __, []),
              Call (None, R, [])))),
       Application (Call (None, memb, []),
        NewTuple (Call (None, E, []), Call (None, R, [])))]))