воскресенье, 7 ноября 2010 г.

(null : string).GetEnumerator() ?

Little quiz, guess what will be the result of the code below:

((string)null).GetEnumerator(); //C#

Obvious, isn’t it? And what about this?

(null : string).GetEnumerator() //F#

Expecting NullReferenceException? Well, time for little dissapointment, because this code will be compiled and executed without any errors. How can this happen, we expicitly invoke method with null instance and haven’t received any complains? Does it mean that this  will be null inside the instance method? Prepare to be astonished – yes.

[<AllowNullLiteral>]
type MyClass() =
member this.IsThisNull() = (box this) = null

let b : MyClass = null
printfn "%b" (b.IsThisNull())
(*
true
*)

To find out the reason, let’s decompile result assembly and have a look to its internals:

// C# representation
public static void main@()
{
fp@1 = new PrintfFormat<FSharpFunc<bool, Unit>, TextWriter, Unit, Unit, bool>("%b");
PrintfModule.PrintFormatLineToTextWriter<FSharpFunc<bool, Unit>>(Console.Out, Program.fp@1).Invoke(null.IsThisNull());
}

Haven’’t got new clues, maybe IL representation will be more descriptive:

.method public static void main@() cil managed
{
.entrypoint
.maxstack 4
L_0000: nop
L_0001: nop
L_0002: ldstr "%b"
L_0007: newobj instance void [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<bool, class [FSharp.Core]Microsoft.FSharp.Core.Unit>, class [mscorlib]System.IO.TextWriter, class [FSharp.Core]Microsoft.FSharp.Core.Unit, class [FSharp.Core]Microsoft.FSharp.Core.Unit, bool>::.ctor(string)
L_000c: stsfld class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<bool, class [FSharp.Core]Microsoft.FSharp.Core.Unit>, class [mscorlib]System.IO.TextWriter, class [FSharp.Core]Microsoft.FSharp.Core.Unit, class [FSharp.Core]Microsoft.FSharp.Core.Unit> <StartupCode$ConsoleApplication4>.$Program::fp@1
L_0011: call class [mscorlib]System.IO.TextWriter [mscorlib]System.Console::get_Out()
L_0016: call class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<bool, class [FSharp.Core]Microsoft.FSharp.Core.Unit>, class [mscorlib]System.IO.TextWriter, class [FSharp.Core]Microsoft.FSharp.Core.Unit, class [FSharp.Core]Microsoft.FSharp.Core.Unit> Program::get_fp@1()
L_001b: call !!0 [FSharp.Core]Microsoft.FSharp.Core.PrintfModule::PrintFormatLineToTextWriter<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<bool, class [FSharp.Core]Microsoft.FSharp.Core.Unit>>(class [mscorlib]System.IO.TextWriter, class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<!!0, class [mscorlib]System.IO.TextWriter, class [FSharp.Core]Microsoft.FSharp.Core.Unit, class [FSharp.Core]Microsoft.FSharp.Core.Unit>)
L_0020: ldnull
L_0021: call instance bool Program/MyClass::IsThisNull()
L_0026: callvirt instance !1 [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<bool, class [FSharp.Core]Microsoft.FSharp.Core.Unit>::Invoke(!0)
L_002b: pop
L_002c: ret
}

Aha, IsThisNull() is invoked with call instruction that doesn’t perform null checks for this argument. C# in many cases uses callvirt instead of call to get cheap null check. For more details please refer to the post by Eric Gunnerson (Why does C# always use callvirt). or to Eric Lippert’s comment here: Summing up: Case (1) invoke virtual method: generate callvirt. Case (2) invoke instance method on nullable receiver: generate callvirt to get cheap null check -- yes, this is typesafe. Case (3) invoke instance method on known non-nullable receiver: generate call to avoid null check. Your first example falls into category (2), your second example falls into category (3). (The compiler knows that new never returns null and therefore need not check again.).

You may think: nulls are rare in F#, we need to explicitly mark nullable types so maybe this error wouldn’t appear in my code. However F# is part of .NET platform so interoperability with other languages is mandatory feature. Lets imagine we have created (or used existing) C# library that returns some object to F# code. Factory method reports about internal errors via returning null.

    public static class Factory
{
public static SomeObject Create()
{
return null;
}
}

public class SomeObject
{
public void Do(int a)
{
Console.WriteLine(a);
}

public SomeAnotherObject Create()
{
return new SomeAnotherObject(this);
}
}

public class SomeAnotherObject
{
private readonly SomeObject o;

public SomeAnotherObject(SomeObject o)
{
this.o = o;
}

public void Start()
{
o.Do(10);
}
}
// F# part
let x = Factory.Create()
let y = x.Create()
y.Start()

Compile and run our sample – it fails with NullReferenceException inside Start. Ok, in our synthetic example it is obvious – o field is null. It is initialized in constructor – find every usage of constructor. The only found case passes this as the argument and we expect this cannot be null. So what else can be the reason? Creating instance via reflection…we can spend hours searching for the real answer. Real life code can be more complex, so such corner cases look like timebomb – you can never predict when it will explode.

четверг, 7 октября 2010 г.

Solving Zebra puzzle + few announcements and ads

For today I have 2 news and 1 announcement:

  1. Bad (news): My F# related activities on Blogger are frozen. Here I'll publish only general .NET/C# programming stuff, so do not remove me from your RSS feeds :).
  2. Good (news): I didn’t give up F# blogging, moreover I’ll try to increase quality of posts. Please meet my new blog on IntelliFactory website together with the first post: Solving Zebra Puzzle. Subscribe to feeds and stay tuned!
  3. Neutral (announcement): The company I work for is looking for senior .NET developers to work on site at Goldman Sachs and Bank of America Merrill Lynch in New York City (downtown location). The job involves developing trading and risk management applications and integrating them with bank systems. Only .NET experience is required, the company will provide training in financial software. If anyone is interested in this position visit http://compatibl.com, contact me or send email to jobs@compatibl.com.

вторник, 5 октября 2010 г.

Introducing UStatic: check Unity injection statically

A few months ago I’ve made post about wrapper over Unity container that allows to verify object structure during compilation. At that time this wrapper supports only one type of injection – through properties (setter injection). Today it evolve into more evil and aggressive creature that besides property injection can initialize objects through calling specified constructors (constructor injection) and invoking methods.

Basically idea remains the same: we use lambdas for collecting user-defined configuration and describe dependencies as expression trees (amazing stuff, BTW! it can be applied to solve dozens of problems, from describing queries to being source for automatic generation of WPF ViewModels). With properties everything is pretty trivial:

using System;
using Microsoft.Practices.Unity;
using UStatic;

namespace UStaticTest
{
class Program
{
static void Main()
{
var container = new UnityContainer();

container.RegisterType<AnotherTestObject>(
c => c
.SetName("Test1")
.SetValueProperty(_ => _.Name, "The one you need")
);

container.RegisterType<AnotherTestObject>(
c => c
.SetValueProperty(_ => _.Name, "How did you get it??")
);

container.RegisterType<TestObject>(
c => c
.SetResolvedProperty(_ => _.A, "Test1")
.SetValueProperty(_ => _.B, "String value")
);

var testObject = container.Resolve<TestObject>();
Console.WriteLine(testObject.A.Name); // The one you need
Console.WriteLine(testObject.B); // String value
}
}

class TestObject
{
public AnotherTestObject A { get; set; }
public string B { get; set; }
}

public class AnotherTestObject
{
public string Name { get; set; }
}
}

We register AnotherTestObject twice: first time with name and  second – anonymous. For both registrations we specify value being set into property Name. After that we register TestObject with resolved property A. Our extension translates expression trees into various subtypes of InjectionMember but preserving type related information. This is funny but not new, we have already seen it in the previous post. What is really interesting is how can we use expression trees to describe constructor and method call. If we want to pass constant values everything is straightforward – just make another method in the interface, name it SetInitMethod and analyze expression in the similar way with SetResolvedProperty. But was if we want method arguments to be resolved from container during instance initialization? This is usual and widely used scenario. We need some auxiliary types to denote holes in our source expression so later this holes can be filled using values from container.

    /// <summary>
/// This type is used to make typed placeholders in expression trees that will be filled with actual values during resolution.
/// </summary>
public static class Param
{
internal static readonly MethodInfo ResolvedMethod = new Func<ResolvedParameterPlaceholder<int>>(Resolved<int>).Method.GetGenericMethodDefinition();
internal static readonly MethodInfo ResolvedWithNameMethod = new Func<string, ResolvedParameterPlaceholder<int>>(Resolved<int>).Method.GetGenericMethodDefinition();

public sealed class ResolvedParameterPlaceholder<T>
{
private ResolvedParameterPlaceholder() { }

public static implicit operator T(ResolvedParameterPlaceholder<T> p)
{
throw NoDynamicInvokation();
}
}

/// <summary>
/// Denotes placeholder for resolved value with specified type.
/// </summary>
/// <typeparam name="T">Type of target object</typeparam>
/// <returns>Resolution placeholder</returns>
public static ResolvedParameterPlaceholder<T> Resolved<T>()
{
throw NoDynamicInvokation();
}

/// <summary>
/// Denotes placeholder for resolved value with specified type and name.
/// </summary>
/// <typeparam name="T">Type of target object</typeparam>
/// <param name="name">Name of target object</param>
/// <returns>Resolution placeholder</returns>
public static ResolvedParameterPlaceholder<T> Resolved<T>(string name)
{
throw NoDynamicInvokation();
}

private static Exception NoDynamicInvokation()
{
return new InvalidOperationException("This operation is intended to be used in expression trees only");
}
}

ResolvedParameterPlaceholder type will act as placeholder (that’s why he has such weird name). It shouldn’t ever be created, we intended to use it only as marker in expression trees. Implicit conversion operator allows to use this type instead of any other actual types. Our analyzer will process usages of Param.Resolved separately and use ResolvedParameter instead of value. Nice and simple idea and it should also work for constructors. To select constructor we will use new expression + direct values and Param.Resolved.

using System;
using Microsoft.Practices.Unity;
using UStatic;

namespace UStaticTest
{
class Program
{
static void Main()
{
var container = new UnityContainer();

container.RegisterType<AnotherTestObject>(
c => c
.SetValueProperty(_ => _.Name, "AnotherTestObject")
);
container.RegisterType<YetAnotherTestObject>(
c => c
.SetValueProperty(_ => _.Name, "YetAnotherTestObject")
);

container.RegisterType<TestObject>(
c => c
.SetConstructor(() => new TestObject(Param.Resolved<YetAnotherTestObject>()))
.SetInitMethod(_ => _.Initialize(Param.Resolved<AnotherTestObject>()))
);

container.Resolve<TestObject>(); // Initialize: testObject.Name = AnotherTestObject, B = YetAnotherTestObject
}
}

class TestObject
{
public TestObject(YetAnotherTestObject obj)
{
B = obj;
}

public TestObject(YetAnotherTestObject obj, string text)
{
throw new InvalidOperationException("What's happen??");
}

public YetAnotherTestObject B { get; set; }

public void Initialize(AnotherTestObject testObject)
{
Console.WriteLine("Initialize: testObject.Name = {0}, B = {1}", testObject.Name, B.Name);
}
}

public class AnotherTestObject
{
public string Name { get; set; }
}

public class YetAnotherTestObject
{
public string Name { get; set; }
}
}

Complete source code of this project(I’ve named it UStatic) is avaiable here. As always any suggestions, constructive critisicm (and especially huge money donations :) ) are welcomed and appreciated.

вторник, 14 сентября 2010 г.

Slides And Samples

Presentation and code samples from my recent talk on FSUG meeting.

понедельник, 30 августа 2010 г.

F#: Building compiler from sources.

I think every curious person couldn’t resist from peeking when he met folder named Source inside F# installation directory. And what can be funnier that browsing through the source code of real-world compiler? Of course, compiling them sources and observing all internal compiler activities, so to say “in action’.

You need F# 2.0 and F#PowerPack to be installed. Additionaly we’ll build a few necessary utilities from PowerPack sources (in fact we can build entire PowerPack from scratch, but to save time we’ll take prepared binaries).

Initial ingredients:

So, let’s start:

  1. Create new folder (denoted below as $ROOT)
  2. Copy F# sources into $ROOT\source
  3. Copy PowerPack sources into $ROOT\powerpack
  4. Create auxiliary directory $ROOT\lkg\FSharp-2.0.50726.900\bin\. Copy files listed below to newly created folder
    • From PowerPack installation folder
      • FSharp.PowerPack.targets
      • FSharp.PowerPack.Build.Tasks.dll
      • Fslex.exe
      • Fsyacc.exe
    • From F# installation folder
      • Fsc.exe
      • FSharp.Core.dll
      • FSharp.Core.optdata
      • FSharpCore.sigdata
  5. Briefly about remaining steps: build FsSrGen utility from PowerPack, build proto compiler and finally build result compiler with proto (obtained on step 2). To automate the build process you can use script given below (copy it to $ROOT folder)
    set MSB35="c:\WINDOWS\Microsoft.NET\Framework\v3.5\MSBuild.exe"

    SET ROOT=%cd%

    @rem Delete previous build results
    rmdir %ROOT%\powerpack\head\Debug /S /Q

    @rem Build FsResGen
    cd %ROOT%\powerpack\head\workyard\FsSrGen\FsSrGen
    %MSB35% FsSrGen.fsproj

    @rem Build FsResGen task
    cd %ROOT%\powerpack\head\workyard\FsSrGen\FSharp.SRGen.Build.Tasks
    %MSB35% FSharp.SRGen.Build.Tasks.fsproj

    @rem Copy build results
    copy %ROOT%\powerpack\head\Debug\bin\*.* %ROOT%\lkg\FSharp-2.0.50726.900\bin\ /Y

    rem proto
    cd %ROOT%\source
    %MSB35% /p:TargetFrameworkVersion=v3.5 fsharp-proto-build.proj
    %MSB35% /p:TargetFrameworkVersion=v3.5 fsharp-compiler-build.proj

    cd %ROOT%\source\Debug\bin\

Overall compilation time will be something about 20 min.

Testing the result

For the test we’'ll take well-known sample with async downloading of web pages, but this time it will be examined from the inside.

open System.IO
open System.Net

let downloadPage (uri : string) = async {
let request = WebRequest.Create(uri)
let! response = request.AsyncGetResponse()
use stream = response.GetResponseStream()
use reader = new StreamReader(stream)
return reader.ReadLine()
}

let content = Async.RunSynchronously <| downloadPage "http://microsoft.com"
printfn "%d" content.Length

 

Create new C# ConsoleApplication project in VS, open Project Properties –> Debug page and select Start external program.

1. set path

External program here: out freshly built fsc.

Save settings, press F10 and behold… you are debugging the compiler

debugging the compiler  parsing in progress

After compiler finish its job modify Project Properties and replace external program file from  fsc.exe to the name of new executable file.

main

Start debugging and set breakpoint inside downloadPage function.

debug 3

Press F11 several times and you step into source code of FSharp.Core

debug 4

Having your own tamed version of the compiler is pretty convinient, you can not only browse static source code but also inspect behavior dynamically. Imagination is the only limitation, enjoy :).

суббота, 14 августа 2010 г.

INotifyPropertyChanged strikes back

This short post was inspired by this question on StackOverflow. Questioner asks for some language-specific features that can simplify tracking of changes in objects. This task can be perfectly solved by language that supports compile-time metaprogramming, unfortunately F# doesn’t have such features… maybe only in some distant future. Let’s demonstrate the solution using language that already has such capabilities – Nemerle.

Macros in Nemerle are programs that are executed in compile-time, consumes and produces AST.

Macro code

using Nemerle;
using Nemerle.Assertions;
using Nemerle.Collections;
using Nemerle.Compiler;
using Nemerle.Compiler.Parsetree;
using Nemerle.Compiler.Typedtree;
using Nemerle.Text;
using Nemerle.Utility;

using System;
using SCG = System.Collections.Generic;
using System.Linq;
using System.ComponentModel;

namespace ComponentModelHelpers
{
[MacroUsage(MacroPhase.BeforeInheritance, MacroTargets.Class, Inherited = false, AllowMultiple = false)]
public macro ImplementsNotifyPropertyChanged(tb : TypeBuilder)
{
NPCHelper.ImplementInterface(tb);
}

[MacroUsage(MacroPhase.WithTypedMembers, MacroTargets.Class, Inherited = false, AllowMultiple = false)]
public macro ImplementsNotifyPropertyChanged(tb : TypeBuilder)
{
NPCHelper.FixProperties(tb)
}

[MacroUsage(MacroPhase.BeforeInheritance, MacroTargets.Property, Inherited = false, AllowMultiple = false)]
public macro IgnoreProperty(tb : TypeBuilder, property : ParsedProperty)
{
NPCHelper.RegisterIgnored(tb, property)
}

module NPCHelper
{
private ignoredProperties : SCG.HashSet[TypeBuilder * string] = SCG.HashSet();

public RegisterIgnored(tb : TypeBuilder, property : ClassMember.Property) : void
{
ignore(ignoredProperties.Add(tb, property.Name));
}

public FixProperties(tb : TypeBuilder) : void
{
def properties = tb
.GetProperties()
.Filter(p => !ignoredProperties.Contains(tb, p.Name));

foreach(p is PropertyBuilder in properties)
{
def setter = (p.GetSetter() :> MethodBuilder);
when (setter != null)
{
setter.Body = <[
$(setter.Body);
RaisePropertyChanged($(p.Name : string));
]>;
}
}
}

public ImplementInterface(tb : TypeBuilder) : void
{
def handlerFieldName = Macros.NewSymbol("PropertyChanged");
def fieldDecl = <[ decl:
private mutable $(handlerFieldName.Id : usesite) : PropertyChangedEventHandler;
]>;

def modifyEvent(modifier)
{
<[
mutable tmp;
mutable h = $(handlerFieldName.Id : usesite);
do
{
tmp = h;
def newHandler = $(modifier)(tmp, value) :> PropertyChangedEventHandler;
h = System.Threading.Interlocked.CompareExchange(ref $(handlerFieldName.Id : usesite), newHandler, tmp);
} while(h != tmp);
]>
}
def eventDecl = <[decl:
public event PropertyChanged : PropertyChangedEventHandler
{
add { $(modifyEvent(<[ Delegate.Combine ]>)); }
remove { $(modifyEvent(<[ Delegate.Remove ]>)); }
}
]>;

def raisePropertyChangedMethodDecl = <[ decl:
protected RaisePropertyChanged(propertyName: string) : void
{
def h = $(handlerFieldName.Id : usesite);
when (h != null)
h(this, PropertyChangedEventArgs(propertyName));
}
]>;

tb.Define(fieldDecl);
tb.Define(eventDecl);
tb.Define(raisePropertyChangedMethodDecl);
tb.AddImplementedInterface(<[INotifyPropertyChanged]>);
}
}
}

Notes:

  • ImplementsNotifyPropertyChanged macro adds implementation of INotifiedPropertyChanged and patches properties so RaisePropertyChanged will be called in every setter
  • IgnoreProperty registers ignored property.
  • <[ ]> – denotes a quotation. Basically quotation produces PExpr (expression), so we need to mark explicitly if quotation contains declaration with decl: prefix
  • $(…) – splice in quotation
  • Macros in Nemerle are hygienic, so x variable introduced in macros won’t clash with the variable of the same name. If we need to suppress hygiene – this is done with :usesite directive.

Client code

using Nemerle.Collections;
using Nemerle.Text;
using Nemerle.Utility;

using System;
using System.Collections.Generic;
using System.Console;
using System.Linq;
using System.ComponentModel;

using ComponentModelHelpers;

module Program
{
Main() : void
{
def c = MegaComponent();
Test(c);
c.X = 100;
c.Y = "123";
}

Test(npc : INotifyPropertyChanged) : void
{
npc.PropertyChanged += (_, e) => WriteLine($"$(e.PropertyName) changed")
}
}

[ImplementsNotifyPropertyChanged]
class MegaComponent
{
private mutable y : string;

public X : int {get;set;};

[IgnoreProperty]
public Y : string
{
get { y }
set
{
y = value;
RaisePropertyChanged("Y");
}
}
}

/*
X changed
Y changed
*/

Notes:

  • Macro is made accessible in source code by opening containing namespace: ComponentModelHelpers
  • RaisePropertyChanged method is generated by macro so source code can use it

Decompiled class

internal class MegaComponent : INotifyPropertyChanged
{
// Fields
private PropertyChangedEventHandler _N_PropertyChanged_2784;
[CompilerGenerated, DebuggerBrowsable(DebuggerBrowsableState.Never)]
private int _N_X_3169;
private string y;

// Events
public event PropertyChangedEventHandler PropertyChanged
{
add
{
PropertyChangedEventHandler a = null;
PropertyChangedEventHandler handler2 = this._N_PropertyChanged_2784;
do
{
a = handler2;
PropertyChangedEventHandler handler3 = (PropertyChangedEventHandler) Delegate.Combine(a, value);
handler2 = Interlocked.CompareExchange<PropertyChangedEventHandler>(ref this._N_PropertyChanged_2784, handler3, a);
}
while (handler2 != a);
}
remove
{
PropertyChangedEventHandler source = null;
PropertyChangedEventHandler handler2 = this._N_PropertyChanged_2784;
do
{
source = handler2;
PropertyChangedEventHandler handler3 = (PropertyChangedEventHandler) Delegate.Remove(source, value);
handler2 = Interlocked.CompareExchange<PropertyChangedEventHandler>(ref this._N_PropertyChanged_2784, handler3, source);
}
while (handler2 != source);
}
}

// Methods
protected void RaisePropertyChanged(string propertyName)
{
PropertyChangedEventHandler handler = this._N_PropertyChanged_2784;
if (handler != null)
{
handler(this, new PropertyChangedEventArgs(propertyName));
}
}

// Properties
public int X
{
[CompilerGenerated]
get
{
return this._N_X_3169;
}
[CompilerGenerated]
set
{
this._N_X_3169 = value;
this.RaisePropertyChanged("X");
}
}

public string Y
{
get
{
return this.y;
}
set
{
this.y = value;
this.RaisePropertyChanged("Y");
}
}
}

понедельник, 9 августа 2010 г.

WebSharper, part 2: WebExcel

Well, after the long pause, I came back to blogging and today out test pet once again will be WebSharper. However now we’ll make pure client-side application so it can reveal all (or mostly all) positive sides of WS.

Today’s demo project will be modestly codenamed WebExcel – simple spreadsheet with support of formulae.

All major components of our system and relations between them are shown on the diagram below:

diagram

  • EvalResult – in fact it is discriminated union that represents current runtime cell value: it can be either Ok of obj – value, or Error of string – failure with description.
  • Presenter – This component handles all user input, invokes some functions from Model part and updates UI – MVP presenter.
  • CellDataStorage – simple container for cell values.
  • CellFormulaStorage – facade for formulae related functionality. Stores mapping from cell reference to parsed formula.
  • Parser – converts text representation for formula to parsed expression – instance of Expr type.
  • Expr – represents parsed formulae. Contains the following case constructors:
    • Value – literal value
    • Ref – reference to another cell
    • Operation – function that accepts list of Expr and produces EvalResult. Operation function accepts context argument that is used during expression evaluation to resolve Ref into value.
  • TopoSort – helps to build formula evaluation order according to dependencies between them.

Common workflow of handling UI events is roughly following:

workflow

Now, enough pictures, lets turn to the code.

EvalResult type

[<JavaScriptType>]
type EvalResult = Ok of obj | Error of string

Ast module

module Ast =
open System.Collections.Generic

[<JavaScriptType>]
type Context = string -> EvalResult option

[<JavaScriptType>]
type Expr =
| Value of obj
| Ref of string
| Operation of (Context -> list<Expr> -> EvalResult) * list<Expr>

[<JavaScript>]
let eval (ctx : Context) = function
| Value o -> Ok o
| Ref name ->
match ctx name with
| Some r -> r
| None -> Error("Name " + name + " not found")
| Operation (f, args) -> f ctx args

[<JavaScript>]
let bind ctx f e =
match eval ctx e with
| Ok v -> f v
| e -> e

[<JavaScript>]
let bindList ctx f args =
let rec impl l acc =
match l with
| [] -> f (List.rev acc)
| x::xs -> x |> bind ctx (fun o -> impl xs (o::acc))
impl args []

[<JavaScript>]
let getReferences e =
let rec impl (acc : Set<_>) = function
| Value _ -> acc
| Ref v -> acc.Add v
| Operation(_, l) -> (acc, l) ||> Seq.fold impl
impl Set.empty e

Ast contains definition of Expr type and some auxiliary functions:

  • eval – name is self descriptive – evaluates expression in a given context
  • bind – helper for chaining subsequent evaluations, returns on first occurance of Error
  • bindList – similar to bind but works for the list of expressions
  • getReferences – traverses given Expr and collects references to other cells

Operations module

module Operations = 

open Ast

[<JavaScript>]
let adapt f ctx args =
try
match args with
| [e1; e2] ->
e1 |> bind ctx (fun v1 ->
e2 |> bind ctx (fun v2 ->
Ok(f (unbox<double> v1) (unbox<double> v2))
)
)
| _ -> Error("Incorrect number of arguments")
with
e -> e.Message |> Error

[<JavaScript>]
let add = adapt (+)

[<JavaScript>]
let sub = adapt (-)

[<JavaScript>]
let mul = adapt (*)

[<JavaScript>]
let div = adapt (/)

[<JavaScript>]
let gt = adapt (>)

[<JavaScript>]
let ge = adapt (>=)

[<JavaScript>]
let lt = adapt (<)

[<JavaScript>]
let le = adapt (<=)

[<JavaScript>]
let eq = adapt (=)

[<JavaScript>]
let neq = adapt (<>)

[<JavaScript>]
let iif ctx args =
try
match args with
| [c; ifTrue; ifFalse] ->
c |> bind ctx (fun cond ->
if (unbox<bool> cond) then eval ctx ifTrue
else eval ctx ifFalse
)
| _ -> Error "Invalid number of arguments"
with
e -> Error e.Message

[<JavaScript>]
let average ctx args =
try
args |> bindList ctx (fun objs ->
objs
|> List.map unbox<double>
|> List.average
|> (box >> Ok)
)
with
e -> Error e.Message

[<JavaScript>]
let operations =
[
"IF", iif
"AVERAGE", average
] |> Map.ofSeq

Operations module stores all functions that will be accessible from formulae: common infix operators and external ones. Our definitions of Expr.Operation as function that accepts not values but thunks gives us capability to define functions like IF: evaluate first argument and after that evaluate second or third.

Parser module

module Parser = 

open Ast

[<JavaScript>]
let some v (rest : string) = Some(v, rest)

[<JavaScript>]
let capture pattern text =
let regex = JRegExp("^(" + pattern + ")(.*)")
if regex.Test(text)
then regex.Exec(text) |> Option.bind (fun v -> some v.[1] v.[2])
else None

[<JavaScript>]
let matchValue pattern = (capture @"\s*") >> (Option.bind (snd >> capture pattern))
[<JavaScript>]
let matchSymbol pattern = (matchValue pattern) >> (Option.bind (snd >> Some))

[<JavaScript>]
let (|NUMBER|_|) = matchValue @"-?\d+\.?\d*"
[<JavaScript>]
let (|IDENTIFIER|_|) = matchValue @"[A-Za-z]\w*"
[<JavaScript>]
let (|LPAREN|_|) = matchSymbol @"\("
[<JavaScript>]
let (|RPAREN|_|) = matchSymbol @"\)"
[<JavaScript>]
let (|PLUS|_|) = matchSymbol @"\+"
[<JavaScript>]
let (|MINUS|_|) = matchSymbol @"-"

[<JavaScript>]
let (|GT|_|) = matchSymbol @">"
[<JavaScript>]
let (|GE|_|) = matchSymbol @">="
[<JavaScript>]
let (|LT|_|) = matchSymbol @"<"
[<JavaScript>]
let (|LE|_|) = matchSymbol @"<="
[<JavaScript>]
let (|EQ|_|) = matchSymbol @"="
[<JavaScript>]
let (|NEQ|_|) = matchSymbol @"<>"

[<JavaScript>]
let (|MUL|_|) = matchSymbol @"\*"
[<JavaScript>]
let (|DIV|_|) = matchSymbol @"/"
[<JavaScript>]
let (|COMMA|_|) = matchSymbol @","

[<JavaScript>]
let operation op args rest = some (Operation(op, args)) rest

// error handling in case of unknown operation is omitted
let rec [<JavaScript>] (|Factor|_|) = function
| IDENTIFIER(id, r) ->
match r with
| LPAREN (ArgList (args, RPAREN r)) -> operation (Operations.operations.[id]) args r
| _ -> some(Ref id) r
| NUMBER (v, r) -> some (Value (System.Double.Parse v)) r
| LPAREN(Logical (e, RPAREN r)) -> some e r
| _ -> None

and [<JavaScript>] (|ArgList|_|) = function
| Logical(e, r) ->
match r with
| COMMA (ArgList(t, r1)) -> some (e::t) r1
| _ -> some [e] r
| rest -> some [] rest

and [<JavaScript>] (|Term|_|) = function
| Factor(e, r) ->
match r with
| MUL (Term(r, rest)) -> operation Operations.mul [e; r] rest
| DIV (Term(r, rest)) -> operation Operations.div [e; r] rest
| _ -> some e r
| _ -> None

and [<JavaScript>] (|Expr|_|) = function
| Term(e, r) ->
match r with
| PLUS (Expr(r, rest)) -> operation Operations.add [e; r] rest
| MINUS (Expr(r, rest)) -> operation Operations.sub [e; r] rest
| _ -> some e r
| _ -> None

and [<JavaScript>] (|Logical|_|) = function
| Expr(l, r) ->
match r with
| GE (Logical(r, rest)) -> operation Operations.ge [l; r] rest
| GT (Logical(r, rest)) -> operation Operations.gt [l; r] rest
| LE (Logical(r, rest)) -> operation Operations.le [l; r] rest
| LT (Logical(r, rest)) -> operation Operations.lt [l; r] rest
| EQ (Logical(r, rest)) -> operation Operations.eq [l; r] rest
| NEQ (Logical(r, rest)) -> operation Operations.neq [l; r] rest
| _ -> some l r
| _ -> None

and [<JavaScript>] (|Formula|_|) (s : string) =
if s.StartsWith("=") then
match s.Substring(1) with
| Logical(l, t) when System.String.IsNullOrEmpty(t) -> Some l
| _ -> None
else None

Concept of implementing parser using active patterns I've shamelessly stolen from excellent article by Adam Granicz.

Model module

module Model = 

open System
open System.Collections.Generic

[<JavaScript>]
let private toString o = o.ToString()

[<JavaScript>]
let private concat lines =
let delimiter = ", "
if Seq.isEmpty lines
then ""
else lines |> Seq.reduce(fun a b -> a + delimiter + b)

[<JavaScript>]
let rows = [1..20] |> List.map toString
[<JavaScript>]
let private rowsSet = Set.ofSeq rows

[<JavaScript>]
let cols = [int 'A'..int 'H'] |> List.map (char >> toString)
[<JavaScript>]
let colSet = Set.ofSeq cols


[<JavaScript>]
let private isReference (s : string) =
if System.String.IsNullOrEmpty s || s.Length < 2 then false
else
let col = toString s.[0]
let row = s.Substring(1)
rowsSet.Contains row && colSet.Contains col

[<JavaScriptType>]
type ICellDataStorage =
abstract member GetValue : string -> EvalResult option
abstract member SetValue : cell : string * value : EvalResult -> unit

[<JavaScriptType>]
type CellDataStorage [<JavaScript>] () =
let results = new System.Collections.Generic.Dictionary<string, EvalResult>()

[<JavaScript>]
let setValue cell value = results.[cell] <- value

[<JavaScript>]
member this.SetValue(cell, value) =
if System.String.IsNullOrEmpty value
then
this.DeleteValue(cell)
true
else
let (v, ok) = try Ok (box (float value)), true with _ -> Error "Not a number", false
setValue cell v
ok

[<JavaScript>]
member this.DeleteValue(cell) =
if results.ContainsKey cell then
results.Remove cell |> ignore

[<JavaScript>]
member this.GetValue(cell) =
if results.ContainsKey cell
then results.[cell] |> Some
else None

interface ICellDataStorage with
[<JavaScript>]
member this.GetValue(cell) = this.GetValue(cell)
[<JavaScript>]
member this.SetValue(cell, value) = setValue cell value

[<JavaScriptType>]
type TopoSort [<JavaScript>] () =
let map = new System.Collections.Generic.Dictionary<string, Set<_>>()

[<JavaScript>]
member this.Insert(cell, parents) =
for p in parents do
let s = if map.ContainsKey(p) then map.[p] else Set.empty
map.[p] <- s.Add cell
try
this.GetDependents(cell) |> ignore
with
_ ->
this.Delete(cell, parents)
reraise()

[<JavaScript>]
member this.Delete(cell, parents) =
for p in parents do
let s = map.[p]
map.[p] <- s.Remove cell

[<JavaScript>]
member this.GetDependents(s) =
let visited = ref Set.empty
let rec impl ((order, cycles) as state) s =
if Set.contains s cycles then failwith ("Cycle detected:" + (concat cycles))
if Set.contains s !visited
then state
else
visited := Set.add s !visited
if map.ContainsKey s
then
let children = map.[s]
((order, Set.add s cycles), children)
||> Seq.fold impl
|> (fun (l, cycle) -> List.Cons(s, l), Set.remove s cycles)
else
s::order, cycles

impl ([], Set.empty) s |> fst

[<JavaScriptType>]
type CellFormulaStorage [<JavaScript>](dataStorage : ICellDataStorage) =
let map = new System.Collections.Generic.Dictionary<string, Ast.Expr>()
let toposort = new TopoSort()

[<JavaScript>]
let getValue cell =
match dataStorage.GetValue cell with
| None -> Some(Ok 0.0)
| x -> x

[<JavaScript>]
member this.HasFormula(cell) = map.ContainsKey cell

[<JavaScript>]
member this.DeleteFormula(cell) =
if map.ContainsKey cell then
let oldExpr = map.[cell]
let parents = Ast.getReferences oldExpr
toposort.Delete(cell, parents)
map.Remove(cell) |> ignore


[<JavaScript>]
member this.SetFormula(cell, text) =
match text with
| Parser.Formula(f) ->
let invalidReferences =
Ast.getReferences f
|> Seq.filter (not << isReference)
|> Seq.toList
if List.isEmpty invalidReferences
then
let parents = Ast.getReferences f

try
toposort.Insert(cell, parents)
map.[cell] <- f

this.Evaluate(cell)
with
e -> dataStorage.SetValue(cell, Error(e.ToString()))
[cell]
else
dataStorage.SetValue(cell, Error ("Formula contains invalid references: " + (concat invalidReferences)))
[cell]
| _ ->
dataStorage.SetValue(cell, Error ("Invalid formula text:" + text))
[cell]


[<JavaScript>]
member this.Evaluate(cell) =
let dependencies = toposort.GetDependents(cell)
for d in dependencies do
if map.ContainsKey(d) then
let e = map.[d]
let res = Ast.eval getValue e
dataStorage.SetValue (d, res)
dependencies

ICellDataStorage interface is used only during formula evaluation: for the simplicity we make assumption that values obtained as evaluation results are correct and do not require validation.

UI module

open IntelliFactory.WebSharper.Html

[<Require(typeof<Styles.Table>)>]
module UI =

open System
open System.Collections.Generic

[<JavaScriptType>]
type Presenter [<JavaScript>] () =

let dataStorage = new Model.CellDataStorage()
let formulaStorage = new Model.CellFormulaStorage(dataStorage)

let userInput = new Dictionary<_, _>()

let map = new Dictionary<_, _>()

[<JavaScript>]
let onFocus (cell : Element) =
cell.AddClass("editing")
cell.Value <- if userInput.ContainsKey cell.Id then userInput.[cell.Id] else ""

[<JavaScript>]
let onBlur (cell : Element) =
cell.RemoveClass("editing")
userInput.[cell.Id] <- cell.Value
formulaStorage.DeleteFormula(cell.Id)

cell.RemoveClass("error")
cell.RemoveClass("formula")
try
let dependencies =
if cell.Value.StartsWith("=")
then
formulaStorage.SetFormula(cell.Id, cell.Value)
else
let ok = dataStorage.SetValue(cell.Id, cell.Value)
if ok
then formulaStorage.Evaluate(cell.Id)
else [cell.Id]

for dep in dependencies do
let el : Element = map.[dep]
match dataStorage.GetValue(el.Id) with
| Some (Ok v) ->
el.RemoveAttribute("title")
if formulaStorage.HasFormula el.Id then
el.AddClass("formula")
el.SetAttribute("title", userInput.[el.Id])
el.Value <- v.ToString()
| Some (Error msg) ->
el.SetAttribute("title", msg)
el.AddClass("error")
el.Value <- "#ERROR"
| None ->
el.RemoveAttribute("title")
el.Value <- ""
with
e ->
Window.Alert(e.ToString())

[<JavaScript>]
member this.CreateCell(name) =
let cell =
Input [Id name]
|>! OnFocus(fun e _ -> onFocus e)
|>! OnBlur(fun e _ -> onBlur e)
map.Add(name, cell)
cell

[<JavaScript>]
let main =

let presenter = new Presenter()

Table [] -< [
yield TR [
yield TD [Class "specialCell firstColumn"];
for col in Model.cols do yield TD [Class "specialCell"] -< [Text col]]
for row in Model.rows do
yield TR [
yield TD [Class "specialCell firstColumn"] -< [ Text row ];
for col in Model.cols do yield TD [presenter.CreateCell (col + row)]
]
]

[<JavaScriptType>]
type ExcelControl() =
inherit Web.Control()

[<JavaScript>]
override this.Body = UI.main

Presenter stores all values (even incorrect) so user can resume editing from the same point in case of incorrect input.

Final result with some CSS tweaks.

Let’s make some tests…

Create formula with incorrect reference

1_incorrect input

and behold… error notification.

2_tooltip

Fix formula: =A1 * 10 + 2

3_formulatooltip

Implicitly absence of value = 0

Create 3 linked formulae: A1 <- =A2 * 2, A2 <- =A1 + 10, A3 <- =B1 * 3

4_formulachain

Change value in A2 and observe chain reevaluation

5_reevaluation

Create formula cycle: A2 <- C1

6_cycle

Use IF and AVERAGE formulae: A2 <- AVERAGE(A1, B1, C1), A3 <- IF (A2 > B2, 10, -10)

7_if

Project source code can be downloaded here.

среда, 21 июля 2010 г.

Tricky late binding operators

F# Dynamic and DynamicAssignment operators are not as simple as they appear ex facte. Most popular sample of their usage is something like this:

let (?) o n : 'T =  
let prop = o.GetType().GetProperty(n)
downcast prop.GetValue(o, null)

let (?<-) o n v =
let prop = o.GetType().GetProperty(n)
prop.SetValue(o, box v, null)

let sb = new System.Text.StringBuilder()
sb?Length <- 20
let l : int = sb?Length // 20

Everything is clear...but what if the exact property name is unknown in the invocation point.

let (?) o n : 'T =  
let prop = o.GetType().GetProperty(n)
downcast prop.GetValue(o, null)

let (?<-) o n v =
let prop = o.GetType().GetProperty(n)
prop.SetValue(o, box v, null)

let setAndGetProperty s name value =
s?name <- value
printfn "%A" s?name

let sb = new System.Text.StringBuilder()
setAndGetProperty sb "Length" 20
(*
System.NullReferenceException: Object reference not set to an instance of an object.
at FSI_0013.op_DynamicAssignment[a,b](a o, String n, b v) in C:\Users\vladm\AppData\Local\Temp\~vs8CA8.fsx:line 15
at FSI_0013.setAndGetProperty[a,b,c](a s, b name, c value) in C:\Users\vladm\AppData\Local\Temp\~vs8CA8.fsx:line 18
at <StartupCode$FSI_0013>.$FSI_0013.main@() in C:\Users\vladm\AppData\Local\Temp\~vs8CA8.fsx:line 22
Stopped due to error
*)

Quite unexpected huh?!. Compiler translates expr ? identifier into (?) expr "identifier" and in case of indirect references n in ? will be equal to "name" not to "Length". To prove it let's add some tracing:

let (?) o n : 'T =  
printfn "Requested property name for get'%s'" n
let prop = o.GetType().GetProperty(n)
downcast prop.GetValue(o, null)

let (?<-) o n v =
printfn "Requested property name for set '%s'" n
let prop = o.GetType().GetProperty(n)
prop.SetValue(o, box v, null)

let setAndGetProperty s name value =
s?name <- value
printfn "%A" s?name

let sb = new System.Text.StringBuilder()
setAndGetProperty sb "Length" 20
(*
Requested property name for set 'name'
System.NullReferenceException: Object reference not set to an instance of an object.
at FSI_0015.op_DynamicAssignment[a,b](a o, String n, b v) in C:\Users\vladm\AppData\Local\Temp\~vs8CA8.fsx:line 17
at FSI_0015.setAndGetProperty[a,b,c](a s, b name, c value) in C:\Users\vladm\AppData\Local\Temp\~vs8CA8.fsx:line 20
at <StartupCode$FSI_0015>.$FSI_0015.main@() in C:\Users\vladm\AppData\Local\Temp\~vs8CA8.fsx:line 24
Stopped due to error
*)

Fix is very simple: change ?id to ?(id). It will change translation rules to : expr?identifier -> (?) expr identifier.

let (?) o n : 'T =  
printfn "Requested property name for get'%s'" n
let prop = o.GetType().GetProperty(n)
downcast prop.GetValue(o, null)

let (?<-) o n v =
printfn "Requested property name for set '%s'" n
let prop = o.GetType().GetProperty(n)
prop.SetValue(o, box v, null)

let setAndGetProperty s name value =
s?(name) <- value
printfn "%A" s?(name)

let sb = new System.Text.StringBuilder()
setAndGetProperty sb "Length" 20
(*
Requested property name for set 'Length'
Requested property name for get'Length'
20
*)

четверг, 17 июня 2010 г.

Playing with WebSharper

I’ve decided to make post about WebSharper long time ago…and finally time has come :).

The idea behind the WebSharper is not new, compilers that translate some source language to JavaScript already exists (for example GWT). Main distinguished feature of WS is using F# as a source language: built-in metaprogramming capabilities, type inference, succinct and expressive syntax, seamless integration with .NET platform makes it a very good choice both server (F# itself)and client side (translated JavaScript). Besides JavaScript translation WS provides statically-typed wrappers for existing JavaScript libraries (like JQuery), HTML combinators for defining content of pages, formlets and many other interesting things.

As a sample we’ll make simple StickyNotes application. Web design is not my primary and favorite skill, so I'll omit cross-browser compatibility and bind all styles to Firefox. For a start server-side part will be trivial: storing all notes data in application state. Later (in forthcoming posts) it will be extended with specific user notes, registration routine (with formlets), persisting data in database etc…

Server part

module State = 

type Note =
{ X : int
Y : int
Content : string }

let private key = "StickyNotesState"
let private doSave (notes : Note list) =
HttpContext.Current.Application.Set(key, notes)
notes

let private doLoad () =
match HttpContext.Current.Application.Get(key) with
| :? list<Note> as v -> v
| _ -> doSave []

let private lockObj = obj()

let save notes = lock lockObj (fun () -> doSave notes)
let load () = lock lockObj doLoad

Type Note stores basic note information (coordinates and content).Remaining part of the module just store/load functionality with HttpApplicationState on backend. This code has no WS specific features, just pure F#.

Client/Server communucations

module Rpc = 
[<Rpc>]
let loadNotes () =
State.load ()

[<Rpc>]
let saveNotes notes =
State.save notes

Client will make server calls througn invoking methods annotated with Rpc attribute.

Client side.

[<Require(typeof<Styles.StickyNotes>)>]
module Notes =

// client-side storage for notes
[<JavaScript>]
let notes = System.Collections.Generic.Dictionary<_, _>()

// configuration data for JQuery.animate function
type AnimateConfiguration = { opacity : float }

[<JavaScript>]
let main () =

// moves specified element to the top in z-order
let maxZ = ref 0
let bringToTop (e : Element) =
incr maxZ
e.Css("z-index", string (!maxZ))


let body = Div []

// create 'Note' visual component and append it to body
// if state is defined then it contains previousy stored state
let noteId = ref 0
let createNote (state : option<Note>) =
let currentId = !noteId
incr noteId

let edit = Div [ Class "edit"; Html5.Attr.ContentEditable "true"]
let close = Div [Class "closebutton"]
let rec note =
Div [Class "note"] -< [
Div [Class "header"] |>! OnMouseDown (fun _ _ -> bringToTop note)
close
edit
]

close |> OnClick(fun _ _ ->
note.JQuery.Animate({opacity=0.3}, 300.0, "linear", (fun () ->
notes.Remove(currentId) |> ignore
note.Remove()
)) |> ignore
)

// make element draggable
JQueryUI.Draggable.New(note, JQueryUI.DraggableConfiguration(Handle = ".header")) |> ignore
notes.Add(currentId, (note, edit))

match state with
| Some(n) ->
edit.Append n.Content
note.Css("left", string n.X + "px")
note.Css("top", string n.Y + "px")

| _ ->
()

body.Append(note)

// saves current snapshot of notes in server storage
let saveNotes (el : Element) (_ : JQueryEvent) =
el.SetAttribute("disabled", "true")
el.Text <- "Saving..."

notes
|> Seq.map(fun kv ->
let n,e = kv.Value
let pos = n.JQuery.Position()
{ X = pos.Left; Y = pos.Top; Content = e.Html }
)
|> Seq.toList
|> Rpc.saveNotes

el.Text <- "Save"
el.RemoveAttribute("disabled")


// restore previous state
let notes = Rpc.loadNotes()
for n in notes do
createNote (Some n)

Table [
TR [
TD [ Width "30"] -< [Button [Text "Create"] |>! OnClick(fun _ _ -> createNote None) ]
TD [ Button [Text "Save" ] |>! OnClick saveNotes ]
]
TR [TD [ColSpan "2" ] -< [body] ]
]


[<JavaScriptType>]
type Body() =
inherit Web.Control()
[<JavaScript>]
override this.Body = Notes.main ()

Notes:

  1. Javascript attribute marks items that should be compiled into JavaScript
  2. AnimateConfiguration type is static wrapper for calling .animate function. WebSharper JavaScript translator converts F# record types into JavaScript objects with matching fields. We need to pass fixed number of parameters so solution with record will be shorted than common approach from section 7.
  3. Element.Css function sets style property to given object via calling .css()
  4. Page structure is defined with handy HTML combinators(Div, Table etc…)
  5. -< combinator appends one sequence to another. It is basically used to create element both with attributes and child elements.
  6. |>! combinator allows attaching event handlers to elements in a composable way. Its definition is simple:
    let (|>!) x f = f x; x 
  7. JQueryUI.Draggable is a typed wrapper to  JQuery draggable plugin. It accepts parameters in form of DraggableConfiguration object: type with fields having DefaultValueAttibute attached. This is common convention for passing objects with optional fields to JavaScript code.
  8. When F# to JavaScript translator meets type annotated with JavaScriptTypeAttribute, it generates not only data fields but also class representation.

Also you’ve noticed Require attribute atop of Notes module. This attribute is utilized by WebSharper resource control system that tracks all necessary dependencies(css or js files) and orders them properly – all these activities are based on declarative information provided by developer. First of al you need to define a resource, in our sample it will be external css file.

module Styles = 
type StickyNotes() =
interface IResource with
member this.Render(r, w) =
let u = r.GetWebResourceUrl(typeof<StickyNotes>, "StickyNotes.css")
Resource.RenderCss u w

Resource is type that has default constructor and implements interface IResource.

After than annotate all types that depends on this resource with Require attribute (you can also apply RequireAssembly to assembly). WebSharper will build directed graph and use for resource management. ScriptManager control that should be embedded in the head section emits all necessary page resources preserving correct order.

Entire VS2010 solution with this sample can be found here, it already contains WebSharper JQueryUI extension but you also need WebSharper to be installed, so you can build and run the application.

Demonstration:

1. I’ve opened Firefox and created two notes

initial

2. One note is closed (it’s a pity, but I wasn’t able to capture fancy semi-transparent note when it dissapears)

first_deleted

3. I saved the state and opened the same page in Chrome (on the right).

same_page_in_chrome

Stay tuned!

вторник, 8 июня 2010 г.

F# Performance of events (update)

There is another solution to the challenge we’ve met last time. In my previous post I’ve skipped it because it is F# specific and result cannot be used directly in other languages. However after discussion with ControlFlow I think this solution is also worth mentioning.

As you remember the problem was inability to call Invoke method of the delegate. Using statically resolved type parameters and member constraints we can make compiler do all the job for ensuring that type has method Invoke with particular signature and calling it properly.

type MCEvent< ^D, ^A when ^D :> Delegate and ^D : delegate< ^A, unit> and ^D : (member Invoke : obj * ^A -> unit) and ^D : null>() = 
[<DefaultValue>]
val mutable multicast : ^D

member inline this.Trigger(sender : obj, arg : ^A) =
match this.multicast with
| null -> ()
| d -> (^D : (member Invoke : obj * ^A -> unit)(this.multicast, sender, arg))

member inline this.Publish =
{ new IDelegateEvent< ^D> with
member x.AddHandler(d) =
this.multicast <- System.Delegate.Combine(this.multicast, d) :?> ^D
member x.RemoveHandler(d) =
this.multicast <- System.Delegate.Remove(this.multicast, d) :?> ^D }

//test helper
type MCEventClass(num) =
let event = new MCEvent<EventHandler<EventArgs>, _>()

[<CLIEvent>]
member this.Event = event.Publish

member this.Run () =
for i in 1 .. num do
event.Trigger(this, new System.EventArgs())


Test class is appeared to be almost the same as ones we’ve used in previous post. However if you open compiled assembly with Reflector you’ll see the difference

// FsFastEventClass
public void Run()
{
int i = 1;
int num = this.num;
if (num >= i)
{
do
{
this.@event.Trigger(this, EventArgs.Empty);
i++;
}
while (i != (num + 1));
}
}

// MCEventClass
public void Run()
{
int i = 1;
int num = this.num;
if (num >= i)
{
do
{
MCEvent<EventHandler<EventArgs>, EventArgs> event2 = this.@event;
object sender = this;
EventArgs e = new EventArgs();
if (event2.multicast != null)
{
event2.multicast(sender, e);
}
i++;
}
while (i != (num + 1));
}
}

As you see compiler have inlined code of Trigger method inside Run  and accessed field multicast directly. That’s why we replaced let binding with val.

namespace Benchmark
{
class Program
{
const int Iters = 1000000;

static void Run(string caption, Action action)
{
Console.WriteLine("{0} started", caption);
var sw = Stopwatch.StartNew();
action();
sw.Stop();
Console.WriteLine("{0}:{1}", caption, sw.Elapsed);
}


static void Main(string[] args)
{
Run("F# events", RunFSEventTest);
Run("Fast events", RunFastEventTest);

// initial pass to trigger generation of invoker (so generation time is not included in tests)
RunEventV2Test(1);
Run("Precomputed events", () => RunEventV2Test(Iters));
Run("MemberConstrainedEvents", RunMemberConstrainedEventTest);
}

private static void RunFSEventTest()
{
var fs = new Events.FsEventClass(Iters);
int fsCalled = 0;
fs.Event += (s, a) => fsCalled++;
fs.Run();
}

private static void RunFastEventTest()
{
var fs = new Events.FsFastEventClass(Iters);
int fsCalled = 0;
fs.Event += (s, a) => fsCalled++;
fs.Run();
}

private static void RunEventV2Test(int n)
{
var fs = new Events.GenFastEventClass(n);
int fsCalled = 0;
fs.Event += (s, a) => fsCalled++;
fs.Run();
}
private static void RunMemberConstrainedEventTest()
{
var fs = new Events.MCEventClass(Iters);
int fsCalled = 0;
fs.Event += (s, a) => fsCalled++;
fs.Run();
}

/*
F# events started
F# events:00:00:8.8833742
Fast events started
Fast events:00:00:00.0300628
Precomputed events started
Precomputed events:00:00:00.876707
MemberConstrainedEvents started
MemberConstrainedEvents:00:00:00.0251707
*/
}
}

суббота, 5 июня 2010 г.

F# Performance of events

Events in F# are first class citizens, and this is in fact feature with vast amount of applications. We can compose events using combinators, pass events to functions, return them as a results… IDelegateEvent wrap delegates and under the hood use Delegate.DynamicInvoke for invoking methods bound to delegate, causing significant performance degradation. Rick Minerich has made good description of this problem and also suggested solution that has brilliant performance characteristics but binds event to particular delegate type.

So, is is possible to have both possibility to use arbitraty delegates and good performance characteristics? Linq expression trees come to the rescue. We cannot access Invoke method of delegate directly but we can create typed helper that will do this instead of us.

// helper type that will perform invocation
type Invoker<'D, 'A> = delegate of 'D * obj * 'A -> unit

// :)
type EventV2<'D, 'A when 'D :> Delegate and 'D : delegate<'A, unit> and 'D : null>() =
static let invoker =
let d = Expression.Parameter(typeof<'D>, "dlg")
let sender = Expression.Parameter(typeof<obj>, "sender")
let arg = Expression.Parameter(typeof<'A>, "arg")
let lambda = Expression.Lambda<Invoker<'D, 'A>>(Expression.Invoke(d, sender, arg), d, sender, arg)
lambda.Compile()

let mutable multicast : 'D = null

member x.Trigger(sender:obj,args: 'A) =
match multicast with
| null -> ()
| d -> invoker.Invoke(d, sender, args) // DelegateEvent used: d.DynamicInvoke(args) |> ignore

member x.Publish =
{ new IDelegateEvent<'D> with
member x.AddHandler(d) =
multicast <- System.Delegate.Combine(multicast, d) :?> 'D
member x.RemoveHandler(d) =
multicast <- System.Delegate.Remove(multicast, d) :?> 'D }

// helper to be used in test
type GenFastEventClass(num) =
let event = new EventV2<EventHandler<EventArgs>, _>()

[<CLIEvent>]
member this.Event = event.Publish

member this.Run () =
for i in 1 .. num do
event.Trigger(this, new System.EventArgs())

Performance measurements (I took code for other tests from Rick’s post):

class Program
{
const int Iters = 1000000;

static void Run(string caption, Action action)
{
Console.WriteLine("{0} started", caption);
var sw = Stopwatch.StartNew();
action();
sw.Stop();
Console.WriteLine("{0}:{1}", caption, sw.Elapsed);
}


static void Main(string[] args)
{
Run("F# events", RunFSEventTest);
Run("Fast events", RunFastEventTest);

// initial pass to trigger generation of invoker (so generation time is not included in tests)
RunEventV2Test(1);
Run("Precomputed events", () => RunEventV2Test(Iters));
}

private static void RunFSEventTest()
{
var fs = new Events.FsEventClass(Iters);
int fsCalled = 0;
fs.Event += (s, a) => fsCalled++;
fs.Run();
}

private static void RunFastEventTest()
{
var fs = new Events.FsFastEventClass(Iters);
int fsCalled = 0;
fs.Event += (s, a) => fsCalled++;
fs.Run();
}

private static void RunEventV2Test(int n)
{
var fs = new Events.GenFastEventClass(n);
int fsCalled = 0;
fs.Event += (s, a) => fsCalled++;
fs.Run();
}

/*
F# events started
F# events:00:00:08.4989916
Fast events started
Fast events:00:00:00.0316716
Precomputed events started
Precomputed events:00:00:00.0821696
*/
}

As you see the results of events with pregenerated indirect caller is very close to fast events, but we preserve ability to use arbitraty delegate. Cool, isn't it?

суббота, 29 мая 2010 г.

F# Parsing simple language

During my professional career I often met the task of code generation based on some source data. Last time it was analogue of BCL compiler for ExpressionTrees and then C# compiler have done mostly all the required job with parsing expressions. It is time to invert our responsibilities and feel ourselves in the shoes of compiler. As a test animal we’ll take MiniML-like language (without binary/unary operators and with slightly modified syntax).

Parsing

Out first goal is transformation of plain character stream into the structured representation. First of all we’ll declare components of abstract syntax tree (AST)

namespace MiniML

type Ast =
| Let of string * Ast * Ast
| Letrec of string * Ast * Ast
| Var of string
| Integer of int
| Lambda of string * Ast
| Apply of Ast * Ast
| IfThenElse of Ast * Ast * Ast

With tools like fslexx/fsyacc creation of parser becomes a easy task, however today we’ll use another techique named parser combinators and define parser using F# itself. More details about this approach can be found in the documents below:

Disclaimer:Version of parser given in sample is pretty straightforward and ineffective for the sake of clearness

First of all we need to declare basic elements and combinators to create more complex parsers.

namespace MiniML

module BaseParsing =
open System

// result of parsing - either value+remaining part of char stream or evidence of failure
type ParseResult<'T> = Success of 'T * list<char> | Failed
// parser itself - function from list of chars to parsing result
type Parser<'T> = Parser of (list<char> -> ParseResult<'T>)

let apply (Parser p) s = p s
let run p l = apply p (Seq.toList l)

// wraps given value into parser keeping char stream untouched
let one v = Parser( fun cs -> Success(v, cs) )
let failed () = Parser (fun _ -> Failed)

// binds subsequent parsers
let bind p f = Parser (fun cs ->
match apply p cs with
| Success(r, cs2) -> apply (f r) cs2
| Failed -> Failed
)
// (OR combinator) applies first parser, if it fails - applies second
let (<|>) p1 p2 = Parser(fun cs ->
match apply p1 cs with
| Failed -> apply p2 cs
| ok -> ok
)
// (AND combinator) applies first parser to source stream, then applies second to remaining part of stream
let (<&>) p1 p2 = Parser(fun cs ->
match apply p1 cs with
| Success(_, cs2) -> apply p2 cs2
| Failed -> Failed
)
// applies given predicate to first symbol in the stream, on success transforms the symbol with p function
let choose f p = Parser(fun cs ->
match cs with
| c::cs2 when f c -> Success(p c, cs2)
| _ -> Failed
)
// selects digit and returns it as a result
let digit = choose Char.IsDigit id
// selects digit and returns unit
let digitU = choose Char.IsDigit ignore
// selects letter and returns it as a result
let letter = choose Char.IsLetter id
// selects digit and returns unit
let letterU = choose Char.IsLetter ignore
// selects letter or digit and returns it as a result
let letterOrDigit = choose Char.IsLetterOrDigit id
// selects digit and returns unit
let letterOrDigitU = choose Char.IsLetterOrDigit ignore
// selects given char and returns it as a result
let char c = choose ((=) c) id
// selects given char and returns unit
let charU c = choose ((=) c) ignore
// selects whitespace
let ws = choose Char.IsWhiteSpace ignore

// To enable computation expresion syntax
type ParserBuilder() =
member this.Return(v) = one v
member this.Bind(p, f) = bind p f
member this.ReturnFrom(p) = p
member this.Zero() = failed ()
let parser = ParserBuilder()

// applies given parser zero or more times. results are composed with v0 using f (in fold like manner)
let rec zeroOrMany p f v0 = parser {
return! oneOrMany p f v0 <|> one v0
}
// applies given parser one or more times. results are composed with v0 using f (in fold like manner)
and oneOrMany p f v0 = parser {
let! v1 = p
return! zeroOrMany p f (f v0 v1)
}

// repetition of given parser 0 or more times (similar to * in regexes)
let zeroOrManyU p = zeroOrMany p (fun _ _ -> ()) ()
// repetition of given parser 1 or more times (similar to + in regexes)
let oneOrManyU p = oneOrMany p (fun _ _ -> ()) ()
// transforms parser result with f function
let map p f = parser {
let! v = p
return f v
}

Now we can declare language grammar itself

namespace MiniML

module MiniMLParser =

open System
open BaseParsing

// Helpers

// checks if parsed text matches given string
let text (s : string) = Parser(fun cs ->
let rec loop l p =
if p >= s.Length then Success((), l)
else
match l with
| h::tl when h = s.[p] -> loop tl (p + 1)
| _ -> Failed
loop cs 0
)
// defines parser that consumes 0+ whitespaces + specified parser
let ws0Plus p = zeroOrManyU ws <&> p
// defines parser that consumes 1+ whitespaces + specified parser
let ws1Plus = oneOrManyU ws
// matches 0+ whitespaces + specifies string
let ws0Text s = ws0Plus (text s)
let ws1Text s = ws1Plus <&> (text s)
// matches 0+ whitespaces + specified char
let ws0Char c = ws0Plus (charU c)

// list of language keywords
let keywords = set ["let"; "letrec"; "in"; "if"; "then"; "else"]

// zero or more whitespaces + optional '-' + one or more digit
let integer = parser {
let! sign = ws0Plus ((char '-' <&> one -1) <|> (one 1))
let! value = 0 |> oneOrMany digit (fun acc v -> acc * 10 + (int v - int '0'))
return sign * value
}

// zero or more whitespaces + letter + zero or more letters or digits
// result should not be keyword
let identifier = parser {
let! f = ws0Plus letter
let sb = (new Text.StringBuilder()).Append(f)
let! r = sb |> zeroOrMany letterOrDigit (fun acc v -> acc.Append(v))
let text = r.ToString()
if not <| keywords.Contains(text)
then return text
}

let rec expr =
let parseIdentifier = map identifier Var
let parseNumber = map integer Integer

let parseLet, parseLetrec =
let p keyword f = parser {
do! ws0Text keyword <&> ws
let! id = identifier
do! ws0Char '='
let! value = expr
do! ws1Text "in"<&> ws
let! body = expr
return f(id, value, body)
}
p "let" Let, p "letrec" Letrec

let parseLambda = parser {
do! ws0Char '\\'
let! id = identifier
do! ws0Text "->"
let! body = expr
return Lambda(id, body)
}

let parseBracketed = parser {
do! ws0Char '('
let! e = expr
do! ws0Char ')'
return e
}

let parseApply = parser {
let! f = parseIdentifier <|> parseBracketed
return! f |> oneOrMany (parseIdentifier <|> parseNumber <|> parseBracketed) (fun acc e -> Apply(acc, e))
}

let parseIfThenElse = parser {
let body = parseIdentifier <|> parseBracketed <|> parseNumber

do! ws0Text "if" <&> ws
let! cond = parseIdentifier <|> parseBracketed
do! ws1Text "then" <&> ws
let! ifTrue = body
do! ws1Text "else" <&> ws
let! ifFalse = body
return IfThenElse(cond, ifTrue, ifFalse)

}

parseLet <|> parseLetrec <|> parseLambda <|> parseIfThenElse <|> parseApply <|> parseBracketed <|> parseIdentifier <|> parseNumber

let parse s = run expr s

To visualize parsing results we’ll use auxiliary function toString

open MiniML

let rec astToString = function
| Let(name, v, body) ->
sprintf "let %s =
%s in
%s" name (astToString v) (astToString body)
| Letrec(name, v, body) ->
sprintf "letrec %s =
%s in
%s" name (astToString v) (astToString body)
| Apply(arg, r) -> sprintf("(%s %s)") (astToString arg) (astToString r)
| IfThenElse(cond, ifTrue, ifFalse) ->
sprintf "if %s
then %s
else %s" (astToString cond) (astToString ifTrue) (astToString ifFalse)
| Integer(v) -> string v
| Lambda(name, body) -> sprintf "\%s -> %s" name (astToString body)
| Var(name) -> name

let parse s =
match MiniMLParser.parse s with
| BaseParsing.Success(r, []) -> printfn "%s" (astToString r)
| BaseParsing.Success(r, rest) ->
printfn "Warning: remaining chars found %A" rest
printfn "%s" (astToString r)
| BaseParsing.Failed -> printfn "Parsing failed for %s" s

let sources =
[
@"letrec length = \l -> if (null l) then 0 else (add 1 (length (tail l))) in length"
@"letrec fact = \x -> if (eq x 1) then 1 else (mul x (fact (add x -1))) in fact"
@"let f = \x -> \y -> (cons (x y) y) in f"
]

for src in sources do
parse src
(*
letrec length =
\l -> if (null l)
then 0
else ((add 1) (length (tail l))) in
length
letrec fact =
\x -> if ((eq x) 1)
then 1
else ((mul x) (fact ((add x) -1))) in
fact
let f =
\x -> \y -> ((cons (x y)) y) in
f
*)

All right, parsing step is completed but now we are facing another problem: our AST doesn’t contain any information about expression types (except the primitive numeric values). Luckily we know the answer.

Type inference

Wikipedia defines type inference as

Type inference, or implicit typing, refers to the ability to deduce automatically the type of a value in a programming language

In our compiler we’ll implement Hindley Milner type inference algorithm that is used by F# itself (as well as Haskell, Ocaml etc). Also nice and simple explanation can be found in ScalaByExample or here.

namespace MiniML

exception TypeInferenceException of Ast * string

module Types =
open System

type TypeVarName = string

// basic entity in the algorithm
type Type =
| TypeVar of TypeVarName
| Function of Type * Type
| TypeConstructor of string * Type list
override this.ToString() =
match this with
| TypeVar(name) -> name
| Function(arg, res) -> sprintf "(%O -> %O)" arg res
| TypeConstructor(name, args) ->
if List.isEmpty args
then name
else sprintf "%s[%s]" name (String.Join(", ", args |> Seq.map string))

exception UnificationException of Type * Type

// creates fresh type variables
type TypeVarGenerator() =
let n = ref 0
member this.New() =
incr n
TypeVar(sprintf "T%d" !n)

// represents mapping between types
[<AbstractClass>]
type Substitution private() =
static let empty = {new Substitution() with override this.Lookup(tv) = TypeVar(tv) }
static member Empty = empty

abstract Lookup : TypeVarName -> Type
member this.Run(t) =
match t with
| TypeVar tv ->
let substituted = this.Lookup(tv)
if t = substituted then substituted
else this.Run(substituted)
| Function(a, r) ->
Function(this.Run(a), this.Run(r))
| TypeConstructor(name, tyArgs) ->
TypeConstructor(name, tyArgs |> List.map this.Run)

member this.Extend(v : TypeVarName, t : Type) =
{ new Substitution() with override __.Lookup(tv) = if v = tv then t else this.Lookup(tv) }

// type + free type variables in type
// Instance returns new type where all free variables are replaces with fresh type vars
type TypeScheme(tyVars : Set<_>, t, gen : TypeVarGenerator) =
let subst = (Substitution.Empty, tyVars) ||> Seq.fold(fun s tt -> s.Extend(tt, gen.New() ))
let instance = subst.Run(t)
member this.Instance = instance
member this.TypeVariables = tyVars
member this.Type = t

// maps names to type schemes
// contains auxiliary functions that extracts type vars from different entities
module Env =
type Environment = Map<string, TypeScheme>

let rec typeVarsOfType = function
| TypeVar(tv) -> Set.singleton tv
| Function(a, r) -> typeVarsOfType(a) + typeVarsOfType(r)
| TypeConstructor(_, tyArgs) -> (Set.empty, tyArgs) ||> List.fold (fun acc ty -> acc + typeVarsOfType ty)

let typeVarsOfScheme(s : TypeScheme) =
(typeVarsOfType s.Type) - s.TypeVariables

let typeVarsOfEnv(e : Environment) =
let schemes = e |> Map.toSeq |> Seq.map snd
(Set.empty, schemes) ||> Seq.fold (fun acc s -> acc + (typeVarsOfScheme s))

let typeToScheme (env : Environment, t : Type, gen) =
TypeScheme((typeVarsOfType t) - (typeVarsOfEnv env), t, gen)

type Inferencer() =
let nameGenerator = TypeVarGenerator()

// calculates substitution that can convert two specified types into equivalent one
let rec unify(a : Type, b : Type, s : Substitution) =
match(s.Run(a), s.Run(b)) with
| TypeVar(ta), TypeVar(tb) when ta = tb ->
s
| TypeVar(ta), _ when not <| Env.typeVarsOfType(b).Contains(ta) ->
s.Extend(ta, b)
| _, TypeVar(_) ->
unify(b, a, s)
| Function(a1, b1), Function(a2, b2) ->
unify(a1, a2, unify(b1, b2, s))
| TypeConstructor(name1, args1), TypeConstructor(name2, args2) when name1 = name2 ->
(s, args1, args2) |||> List.fold2 (fun subst t1 t2 -> unify(t1, t2, subst))
| x,y -> UnificationException(x,y) |> raise

// predefines types and expressions
let newTypeVar = nameGenerator.New()
let newTypeScheme t = Env.typeToScheme(Map.empty, t, nameGenerator)

let boolean = TypeConstructor("bool", [])
let integer = TypeConstructor("int", [])
let list(t) = TypeConstructor("list", [t])

let builtins =
[
"true", newTypeScheme(boolean)
"false", newTypeScheme(boolean)
"nil", newTypeScheme(list(newTypeVar))
"cons", newTypeScheme(Function(newTypeVar, Function(list(newTypeVar), list(newTypeVar))))
"null", newTypeScheme(Function(list(newTypeVar), boolean))
"eq", newTypeScheme(Function(newTypeVar, Function(newTypeVar, boolean)))
"add", newTypeScheme(Function(integer, Function(integer, integer)))
"mul", newTypeScheme(Function(integer, Function(integer, integer)))
"sub", newTypeScheme(Function(integer, Function(integer, integer)))
"tail", newTypeScheme(Function(list(newTypeVar), list(newTypeVar)))
"head", newTypeScheme(Function(list(newTypeVar), newTypeVar))
] |> Map.ofList

// compute general substitution (based on s) for the pair of ast and baseType
let rec analyze (e : Env.Environment, ast, baseType : Type, s : Substitution) =
try
match ast with
| Integer(v) ->
unify(integer, baseType, s)
| Var(name) ->
if not (e.ContainsKey name)
then failwithf "Name %s no found" name

let schema = e.[name]
unify(schema.Instance, baseType, s)
| Lambda(arg, body) ->
let a = nameGenerator.New()
let b = nameGenerator.New()

let s1 = unify(baseType, Function(a, b), s)
let newEnv = e.Add(arg, TypeScheme(Set.empty, a, nameGenerator))
analyze(newEnv, body, b, s1)
| Apply(f, arg) ->
let a = nameGenerator.New()
let s1 = analyze(e, f, Function(a, baseType), s)
analyze(e, arg, a, s1)
| Let(name, inV, body) ->
let a = nameGenerator.New()
let s1 = analyze(e, inV, a, s)
analyze(e.Add(name, Env.typeToScheme(e, s1.Run(a), nameGenerator)),body, baseType, s1)
| Letrec(name, inV, body) ->
let t = nameGenerator.New()
let newEnv = e.Add(name, TypeScheme(Set.empty, t, nameGenerator))
let s1 = analyze(newEnv, inV, t, s)
analyze(e.Add(name, Env.typeToScheme(e, s1.Run(t), nameGenerator)), body, baseType, s1)

| IfThenElse(cond, ifTrue, ifFalse) ->
let s1 = analyze(e, cond, boolean, s)
let s2 = analyze(e, ifTrue, baseType, s1)
analyze(e, ifFalse, baseType, s2)
with
UnificationException(t1, t2) -> TypeInferenceException(ast, sprintf "Cannot unify %O and %O" t1 t2) |> raise

// renames type variables into good-looking ones
let alpha (t) =
let l = ref 'A'
let map = Collections.Generic.Dictionary<_, _>()
let rec run = function
| TypeVar(name) ->
if not <| map.ContainsKey(name) then
let newName = string (!l)
l := Convert.ToChar(int !l + 1)
map.Add(name, newName)
TypeVar(map.[name])
| Function(arg, res) -> Function(run arg, run res)
| TypeConstructor(name, typeArgs) -> TypeConstructor(name, List.map run typeArgs)
run t

member this.TypeOf(ast) =
let a = nameGenerator.New()
analyze(builtins, ast, a, Substitution.Empty).Run(a) |> alpha

Some samples

open MiniML

let sources =
[
@"if (1) then true else false", "incorrect condition type"
@"if true then 1 else false", "different types for conditional branches"
@"letrec fold =
\f -> \s -> \l -> if (null l) then s else (fold f (f s (head l)) (tail l)) in
fold", "generic fold"
@"letrec fold =
\f -> \s -> \l -> if (null l) then s else (fold f (f s (head l)) (tail l)) in
fold add", "partial application"
@"letrec length = \l -> if (null l) then 0 else (add 1 (length (tail l))) in length", "recursive definition1"
@"letrec fact = \x -> if (eq x 1) then 1 else (mul x (fact (add x -1))) in fact", "factorial"
@"let f = \x -> \y -> (cons (x y) y) in f", ""
]

let rec astToString = function
| Let(name, v, body) ->
sprintf "let %s =
%s in
%s" name (astToString v) (astToString body)
| Letrec(name, v, body) ->
sprintf "letrec %s =
%s in
%s" name (astToString v) (astToString body)
| Apply(arg, r) -> sprintf("(%s %s)") (astToString arg) (astToString r)
| IfThenElse(cond, ifTrue, ifFalse) ->
sprintf "if %s
then %s
else %s" (astToString cond) (astToString ifTrue) (astToString ifFalse)
| Integer(v) -> string v
| Lambda(name, body) -> sprintf "\%s -> %s" name (astToString body)
| Var(name) -> name

let parse (s, comment) =
printfn "===%s" comment
let inferencer = Types.Inferencer()
match MiniMLParser.parse s with
| BaseParsing.Success(r, []) ->
printfn "%s" (astToString r)
let text = try inferencer.TypeOf(r).ToString() with TypeInferenceException(ast, text) -> sprintf "%s: %s" (astToString ast) text
printfn "Type: %s" text
| _ -> printfn "Parsing failed for %s" s

for src in sources do
parse src
(*
===incorrect condition type
if 1
then true
else false
Type: 1: Cannot unify int and bool
===different types for conditional branches
if true
then 1
else false
Type: false: Cannot unify bool and int
===generic fold
letrec fold =
\f -> \s -> \l -> if (null l)
then s
else (((fold f) ((f s) (head l))) (tail l)) in
fold
Type: ((A -> (B -> A)) -> (A -> (list[B] -> A)))
===partial application
letrec fold =
\f -> \s -> \l -> if (null l)
then s
else (((fold f) ((f s) (head l))) (tail l)) in
(fold add)
Type: (int -> (list[int] -> int))
===recursive definition1
letrec length =
\l -> if (null l)
then 0
else ((add 1) (length (tail l))) in
length
Type: (list[A] -> int)
===factorial
letrec fact =
\x -> if ((eq x) 1)
then 1
else ((mul x) (fact ((add x) -1))) in
fact
Type: (int -> int)
===
let f =
\x -> \y -> ((cons (x y)) y) in
f
Type: ((list[A] -> A) -> (list[A] -> list[A]))
*)

Notes:

  1. Substutution is principal of the algorithm. It is function that maps type variables in given type to other types. Base substitution is Empty that is simple identity mapping. Inferencer.unify method creates general substitution that
    • Extend source substitution
    • Can convert two specified type into equivalent one
  2. TypeScheme describes structure of the type. It contains type itself and all type variables that is free in type (not captured from environment)
  3. Type inference mechanism relies on known information about built-in basic types (defined by builtins map)
  4. After type inference process is completed we perform alpha conversion for type variables to replace temporary names with nice looking ones
 
GeekySpeaky: Submit Your Site!