Home
Insert
Update snippet 'Traits, Mixins and Aspect-Oriented Programming in F#'
Title
Description
A compositional type system built using generics and monads in F#. It is only a very limited, _toy_ project exploring traits, mixins and aspect-oriented programming.
Source code
////////////////////////////////////////////////////////////////// // A compositional type system using generics and monads in F#. // ////////////////////////////////////////////////////////////////// // A very limited, _toy_ project exploring traits, mixins // // and aspect oriented programming // // by Zach Bray (http://www.zbray.com). // ////////////////////////////////////////////////////////////////// (*[omit:(Class monad omitted.)]*) module TypeSystem = type Class0() = do () type Class1<'m1>(m1) = member c.Member1:'m1 = m1 static member ( / ) (c:Class1<_>, m:'m) = c.Member1 m type Class2<'m1,'m2>(m1, m2) = member c.Member1:'m1 = m1 member c.Member2:'m2 = m2 static member ( / ) (c:Class2<_,_>, m:'m) = c.Member1 m static member ( / ) (c:Class2<_,_>, m:'m) = c.Member2 m type Class3<'m1,'m2,'m3>(m1, m2, m3) = member c.Member1:'m1 = m1 member c.Member2:'m2 = m2 member c.Member3:'m3 = m3 static member ( / ) (c:Class3<_,_,_>, m:'m) = c.Member1 m static member ( / ) (c:Class3<_,_,_>, m:'m) = c.Member2 m static member ( / ) (c:Class3<_,_,_>, m:'m) = c.Member3 m type Class4<'m1,'m2,'m3,'m4>(m1, m2, m3, m4) = member c.Member1:'m1 = m1 member c.Member2:'m2 = m2 member c.Member3:'m3 = m3 member c.Member4:'m4 = m4 static member ( / ) (c:Class4<_,_,_,_>, m:'m) = c.Member1 m static member ( / ) (c:Class4<_,_,_,_>, m:'m) = c.Member2 m static member ( / ) (c:Class4<_,_,_,_>, m:'m) = c.Member3 m static member ( / ) (c:Class4<_,_,_,_>, m:'m) = c.Member4 m type Class5<'m1,'m2,'m3,'m4,'m5>(m1, m2, m3, m4, m5) = member c.Member1:'m1 = m1 member c.Member2:'m2 = m2 member c.Member3:'m3 = m3 member c.Member4:'m4 = m4 member c.Member5:'m5 = m5 static member ( / ) (c:Class5<_,_,_,_,_>, m:'m) = c.Member1 m static member ( / ) (c:Class5<_,_,_,_,_>, m:'m) = c.Member2 m static member ( / ) (c:Class5<_,_,_,_,_>, m:'m) = c.Member3 m static member ( / ) (c:Class5<_,_,_,_,_>, m:'m) = c.Member4 m static member ( / ) (c:Class5<_,_,_,_,_>, m:'m) = c.Member5 m type Class5 with static member ( - ) (x:Class5< ('m -> 'a) , _, _, _, _>, m:'m) = Class4(x.Member2, x.Member3, x.Member4, x.Member5) static member ( - ) (x:Class5<_, ('m -> 'a), _, _, _>, m:'m) = Class4(x.Member1, x.Member3, x.Member4, x.Member5) static member ( - ) (x:Class5<_, _, ('m -> 'a), _, _>, m:'m) = Class4(x.Member1, x.Member2, x.Member4, x.Member5) static member ( - ) (x:Class5<_, _, _, ('m -> 'a), _>, m:'m) = Class4(x.Member1, x.Member2, x.Member3, x.Member5) static member ( - ) (x:Class5<_, _, _, _, ('m -> 'a)>, m:'m) = Class4(x.Member1, x.Member2, x.Member3, x.Member4) type Class4 with static member ( + ) (x:Class4<_,_,_,_>, y:Class1<_>) = Class5(x.Member1, x.Member2, x.Member3, x.Member4, y.Member1) static member ( - ) (x:Class4< ('m -> 'a) , _, _, _>, m:'m) = Class3(x.Member2, x.Member3, x.Member4) static member ( - ) (x:Class4<_, ('m -> 'a), _, _>, m:'m) = Class3(x.Member1, x.Member3, x.Member4) static member ( - ) (x:Class4<_, _, ('m -> 'a), _>, m:'m) = Class3(x.Member1, x.Member2, x.Member4) static member ( - ) (x:Class4<_, _, _, ('m -> 'a)>, m:'m) = Class3(x.Member1, x.Member2, x.Member3) type Class3 with static member ( + ) (x:Class3<_,_,_>, y:Class1<_>) = Class4(x.Member1, x.Member2, x.Member3, y.Member1) static member ( + ) (x:Class3<_,_,_>, y:Class2<_,_>) = Class5(x.Member1, x.Member2, x.Member3, y.Member1, y.Member2) static member ( - ) (x:Class3< ('m -> 'a) , _, _>, m:'m) = Class2(x.Member2, x.Member3) static member ( - ) (x:Class3<_, ('m -> 'a), _>, m:'m) = Class2(x.Member1, x.Member3) static member ( - ) (x:Class3<_, _, ('m -> 'a)>, m:'m) = Class2(x.Member1, x.Member2) type Class2 with static member ( + ) (x:Class2<_,_>, y:Class1<_>) = Class3(x.Member1, x.Member2, y.Member1) static member ( + ) (x:Class2<_,_>, y:Class2<_,_>) = Class4(x.Member1, x.Member2, y.Member1, y.Member2) static member ( + ) (y:Class2<_,_>, x:Class3<_,_,_>) = Class5(x.Member1, x.Member2, x.Member3, y.Member1, y.Member2) static member ( - ) (x:Class2< ('m -> 'a) , _>, m:'m) = Class1(x.Member2) static member ( - ) (x:Class2<_, ('m -> 'a) >, m:'m) = Class1(x.Member1) type Class1 with static member ( + ) (x:Class1<_>, y:Class1<_>) = Class2(x.Member1, y.Member1) static member ( + ) (y:Class1<_>, x:Class2<_,_>) = Class3(x.Member1, x.Member2, y.Member1) static member ( + ) (y:Class1<_>, x:Class3<_,_,_>) = Class4(x.Member1, x.Member2, x.Member3, y.Member1) static member ( + ) (y:Class1<_>, x:Class4<_,_,_,_>) = Class5(x.Member1, x.Member2, x.Member3, x.Member4, y.Member1) static member ( - ) (x:Class1< ('m -> 'a) >, m:'m) = Class0() type Class0 with static member ( + ) (x:Class0, y:Class1<_>) = y static member ( + ) (x:Class0, y:Class2<_,_>) = y static member ( + ) (x:Class0, y:Class3<_,_,_>) = y static member ( + ) (x:Class0, y:Class4<_,_,_,_>) = y static member ( + ) (x:Class0, y:Class5<_,_,_,_,_>) = y type ClassBuilder() = member inline b.Yield f = Class1(f) member inline b.YieldFrom x = x member inline b.Combine(x, y) = x + y member inline b.Delay f = f() let Class = ClassBuilder() (*[/omit]*) open System open TypeSystem ////////////////////////////////////////////////////////////////// // BASICS // ////////////////////////////////////////////////////////////////// // Member symbols are defined as single cases. type FirstName = |FirstName type LastName = |LastName type Name = |Name // Class constructors are created using the Class monad. // In this example only 5 members are supported. let person firstName lastName = Class { // Each member function is yielded yield function FirstName -> firstName yield function LastName -> lastName yield function Name -> firstName + " " + lastName } // Members symbols can have arguments (and these arguments can be generic). type 'a AddManager = |AddManager of 'a type Managers = |Managers // Class constructors can be generic let worker<'a>() = Class { // Mutable state can be kept inside reference cells. let managers = ref List.empty<'a> yield function Managers -> !managers // A member that takes a parameter yield function AddManager newManager -> managers := newManager :: !managers } // Class constructors can be composed let employee<'a> firstName secondName = Class { // We can yield the members of one class... yield! person firstName secondName // ... then another yield! worker<'a>() } // We construct instances by passing the parameters into // the constuctor let testConstruction = let rupert = employee<unit> "Rupert" "Maddog" let becca = employee "Becca" "Brooked" let dave = employee "Dave" "Kameroon" // We access members by using the (/) operator becca / AddManager(rupert) dave / AddManager(becca) for manager in dave / Managers do printfn "%s" (manager / Name) ////////////////////////////////////////////////////////////////// // MIXINS & ADAPTORS // ////////////////////////////////////////////////////////////////// // Class constructors can also be composed using // the (+) operator which allows us to use mixins a la Scala // http://www.scala-lang.org/node/117 // Iterator members type HasNext = |HasNext type Next = |Next // Rich iterator members type 'a ForEach = |ForEach of ('a -> unit) // A rich iterator provides a foreach wrapper // around the HasNext and Next members let inline richIterator x = Class { yield function ForEach f -> while x / HasNext do f (x / Next) } // Here we construct a basic string iterator let stringIterator (str:string) = Class { let i = ref 0 yield function HasNext -> !i < str.Length yield function Next -> let c = str.[!i] incr i c } // Here we construct a mixin of the string iterator // and the rich iterator let richStringIterator str = let iter = stringIterator str // We combine the rich iterator interface with // the existing interface here using the (+) operator richIterator iter + iter // We can also choose to use the rich iterator constructor // as an adaptor rather than a mixin by omitting the // composition with the original iter let onlyRichStringIterator str = richIterator (stringIterator str) // We can use either the ForEach member or the HasNext and // Next members of a richStringIterator to print a string let testRSI = // Using rich interface let iter = richStringIterator "Ordered generic parameters suck!" iter / ForEach (printf "%c") printfn "" // Using basic interface let iter2 = richStringIterator "Arbitrary metrics suck!" while iter2 / HasNext do printf "%c" (iter2 / Next) printfn "" // If we use the adapter method we can only use the rich interface let testORSI = // Using rich interface still works! let iter = onlyRichStringIterator "Type safety rules!" iter / ForEach (printf "%c") printfn "" // Using basic interface will _not_ compile! (* let iter2 = onlyRichStringIterator "Type safety rules!" while iter2 / HasNext do printf "%c" (iter2 / Next) printfn "" *) ////////////////////////////////////////////////////////////////// // ASPECT-ORIENTED // ////////////////////////////////////////////////////////////////// // In addition to adding new members using the (+) operator we // can also hide members using the (-) operator. // This means we can do some simple aspect oriented programming // http://en.wikipedia.org/wiki/Aspect-oriented_programming // Here we create the interface to a bank account... type Balance = |Balance type Deposit = |Deposit of decimal type Withdraw = |Withdraw of decimal // ... and its constructor let account name = Class { let balance = ref 0m yield function Name -> name yield function Balance -> !balance yield function Deposit x -> balance := !balance + x yield function Withdraw x -> balance := !balance - x } // Here we create a helper that will run some code before a given // member is accessed. let inline beforeAccess f (property:'a) x = Class { yield fun (_:'a) -> f() x / property } + (x - property) // Here we create a function that logs before a property is accessed let inline logAccess property x = x |> beforeAccess (fun () -> printfn "%A Accessed!" property) property // Here we create a new constructor for an account that logs balance // requests. let loggingAccount name = account name |> logAccess Balance let testLoggingAccount = let acc = loggingAccount "Zach's current account" let illicitFunds = 1000000m acc / Deposit illicitFunds printfn "Zach's account balance is: %f" (acc / Balance) // prints: // > Balance Accessed! // > Zach's account balance is: 1000000.000000 // We can re-use the same block of code to log when a persons name is accessed. // Here we create a new constructor for a person that logs when their name // is accessed let loggingPerson fName sName = person fName sName |> logAccess Name let testLoggingPerson = let zach = loggingPerson "Zach" "Bray" printf "My name is: %s" (zach / Name) // prints: // > Name Accessed! // > My name is: Zach Bray Console.ReadLine() |> ignore<string>
Tags
monad
mixin
generic
types
aspect-oriented
monad
mixin
generic
types
aspect-oriented
Author
Link
Reference NuGet packages
If your snippet has external dependencies, enter the names of NuGet packages to reference, separated by a comma (
#r
directives are not required).
Update
