1 people like it.
Like the snippet!

Finger tree

 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:

type Node<'a> =
    | Node2 of 'a * 'a
    | Node3 of 'a * 'a * 'a

    static member OfList = function
        | [a; b] -> Node2(a, b)
        | [a; b; c] -> Node3(a, b, c)
        | _ -> failwith "Only lists of length 2 or 3 accepted!"

    member me.ToList () =
        match me with
        | Node2(a, b) -> [a; b]
        | Node3(a, b, c) -> [a; b; c]

type Digit<'a> =
    | One of 'a
    | Two of 'a * 'a
    | Three of 'a * 'a * 'a
    | Four of 'a * 'a * 'a * 'a

    static member OfList = function
        | [a] -> One(a)
        | [a; b] -> Two(a, b)
        | [a; b; c] -> Three(a, b, c)
        | [a; b; c; d] -> Four(a, b, c, d)
        | _ -> failwith "Only lists of length 1 to 4 accepted!"

    member me.ToList () =
        match me with
        | One a -> [a]
        | Two(a, b) -> [a; b]
        | Three(a, b, c) -> [a; b; c]
        | Four(a, b, c, d) -> [a; b; c; d]

    member me.Append x =
        match me with
        | One a -> Two(a, x)
        | Two(a, b) -> Three(a, b, x)
        | Three(a, b, c) -> Four(a, b, c, x)
        | _ -> failwith "Cannot prepend to Digit.Four!"

    member me.Prepend x =
        match me with
        | One a -> Two(x, a)
        | Two(a, b) -> Three(x, a, b)
        | Three(a, b, c) -> Four(x, a, b, c)
        | _ -> failwith "Cannot prepend to Digit.Four!"

[<NoComparison>]
[<NoEquality>]
type FingerTree<'a> =
    | Empty
    | Single of 'a
    | Deep of Digit<'a> * FingerTree<Node<'a>> * Digit<'a>

type Digit<'a> with
    member me.Promote () =
        match me with
        | One a -> Single a
        | Two(a, b) -> Deep(One a, Empty, One b)
        | Three(a, b, c) -> Deep(One a, Empty, Two(b, c))
        | Four(a, b, c, d) -> Deep(Two(a, b), Empty, Two(c, d))

type View<'a> = Nil | View of 'a * FingerTree<'a>

module Finger =
    let rec prepend<'a> (a:'a) : FingerTree<'a> -> FingerTree<'a> = function
        | Empty -> Single a
        | Single b -> Deep(One a, Empty, One b)
        | Deep(Four(b, c, d, e), deeper, suffix) ->
            Deep(Two(a, b), prepend (Node3(c, d, e)) deeper, suffix)
        | Deep(prefix, deeper, suffix) ->
            Deep(prefix.Prepend a, deeper, suffix)

    let rec viewl : FingerTree<'a> -> View<'a> = function
        | Empty -> Nil
        | Single x -> View(x, Empty)
        | Deep(One x, deeper(*:FingerTree<'a>/FingerTree<Node<'a>>*), suffix) ->
            let rest =
                match viewl deeper with
                | Nil ->
                    suffix.Promote()
                | View (node(*:Node<'a>*), rest) ->
                    let prefix = node.ToList() |> Digit<_>.OfList
                    Deep(prefix, rest, suffix)
            View(x, rest)
        | Deep(prefix, deeper, suffix) ->
            match prefix.ToList() with
            | x::xs ->
                View(x, Deep(Digit<_>.OfList xs, deeper, suffix))
            | _ -> failwith "Impossible!"

union case Node.Node2: 'a * 'a -> Node<'a>

union case Node.Node3: 'a * 'a * 'a -> Node<'a>

static member Node.OfList : (obj list -> Node<obj>)

Full name: Script.Node`1.OfList

val a : obj

val b : obj

val c : obj

val failwith : message:string -> 'T

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

val me : Node<'a>

member Node.ToList : unit -> 'a list

Full name: Script.Node`1.ToList

val a : 'a

val b : 'a

val c : 'a

type Digit<'a> =
  | One of 'a
  | Two of 'a * 'a
  | Three of 'a * 'a * 'a
  | Four of 'a * 'a * 'a * 'a
  member Append : x:'a -> Digit<'a>
  member Prepend : x:'a -> Digit<'a>
  member Promote : unit -> FingerTree<'a>
  member ToList : unit -> 'a list
  static member OfList : (obj list -> Digit<obj>)

Full name: Script.Digit<_>

union case Digit.One: 'a -> Digit<'a>

union case Digit.Two: 'a * 'a -> Digit<'a>

union case Digit.Three: 'a * 'a * 'a -> Digit<'a>

union case Digit.Four: 'a * 'a * 'a * 'a -> Digit<'a>

static member Digit.OfList : (obj list -> Digit<obj>)

Full name: Script.Digit`1.OfList

val d : obj

val me : Digit<'a>

member Digit.ToList : unit -> 'a list

Full name: Script.Digit`1.ToList

val d : 'a

member Digit.Append : x:'a -> Digit<'a>

Full name: Script.Digit`1.Append

val x : 'a

member Digit.Prepend : x:'a -> Digit<'a>

Full name: Script.Digit`1.Prepend

Multiple items
type NoComparisonAttribute =
inherit Attribute
new : unit -> NoComparisonAttribute

Full name: Microsoft.FSharp.Core.NoComparisonAttribute

--------------------
new : unit -> NoComparisonAttribute

Multiple items
type NoEqualityAttribute =
inherit Attribute
new : unit -> NoEqualityAttribute

Full name: Microsoft.FSharp.Core.NoEqualityAttribute

--------------------
new : unit -> NoEqualityAttribute

type FingerTree<'a> =
  | Empty
  | Single of 'a
  | Deep of Digit<'a> * FingerTree<Node<'a>> * Digit<'a>

Full name: Script.FingerTree<_>

union case FingerTree.Empty: FingerTree<'a>

union case FingerTree.Single: 'a -> FingerTree<'a>

union case FingerTree.Deep: Digit<'a> * FingerTree<Node<'a>> * Digit<'a> -> FingerTree<'a>

type Node<'a> =
  | Node2 of 'a * 'a
  | Node3 of 'a * 'a * 'a
  member ToList : unit -> 'a list
  static member OfList : (obj list -> Node<obj>)

Full name: Script.Node<_>

member Digit.Promote : unit -> FingerTree<'a>

Full name: Script.Digit`1.Promote

Multiple items
union case View.View: 'a * FingerTree<'a> -> View<'a>

--------------------
type View<'a> =
| Nil
| View of 'a * FingerTree<'a>

Full name: Script.View<_>

union case View.Nil: View<'a>

module Finger

from Script

val prepend : a:'a -> _arg1:FingerTree<'a> -> FingerTree<'a>

Full name: Script.Finger.prepend

val e : 'a

val deeper : FingerTree<Node<'a>>

val suffix : Digit<'a>

val prefix : Digit<'a>

member Digit.Prepend : x:'a -> Digit<'a>

val viewl : _arg1:FingerTree<obj> -> View<obj>

Full name: Script.Finger.viewl

val x : obj

val deeper : FingerTree<Node<obj>>

val suffix : Digit<obj>

val rest : FingerTree<obj>

member Digit.Promote : unit -> FingerTree<'a>

val node : obj

val prefix : Digit<obj>

member Digit.ToList : unit -> 'a list

val xs : obj list

Previous Version Raw view Test code New version

More information

Link:	http://fssnip.net/7QQ
Posted:	7 years ago
Author:
Tags: