open Lexer
let definitions = 
    lexerDefinitions {
        do! addNextlineDefinition "NEWLINE" @"(\n\r)|\n|\r"
        do! addIgnoreDefinition "WS"        @"\s"
        do! addDefinition "LET"             "let"
        do! addDefinition "ID"              "(?i)[a-z][a-z0-9]*"
        do! addDefinition "FLOAT"           @"[0-9]+\.[0-9]+"
        do! addDefinition "INT"             "[0-9]+"
        do! addDefinition "OPERATOR"      @"[+*=!/&|<>\^\-]+"   
    }

With those defined you can execute the lexer with:

open Lexer
let lex input = 
    try    
        let y = Lexer.tokenize definitions input
        printfn "%A" y
    with e -> printf "%s" e.Message
lex "let a = 5"

Which will result in:

seq [{name = "LET";
      text = "let";
      pos = 0;
      column = 0;
      line = 0;}; {name = "ID";
                   text = "a";
                   pos = 4;
                   column = 4;
                   line = 0;}; {name = "OPERATOR";
                                text = "=";
                                pos = 6;
                                column = 6;
                                line = 0;}; {name = "INT";
                                             text = "5";
                                             pos = 8;
                                             column = 8;
                                             line = 0;}]

The lexer’s code is structured in three parts.  The first part is a state monad using the F# computation expressions.  This enables the declarative approach (seen above) to setup your lexer rules.

module StateMonad
type State<'s,'a> = State of ('s -> ('a *'s))
let runState (State f) = f
type StateBuilder() = 
    member b.Return(x) = State (fun s -> (x,s))
    member b.Delay(f) = f() : State<'s,'a>
    member b.Zero() = State (fun s -> ((),s))
    member b.Bind(State p,rest) = State (fun s -> let v,s2 = p s in  (runState (rest v)) s2)
    member b.Get () = State (fun s -> (s,s))
    member b.Put s = State (fun _ -> ((),s))

The second part are the combinators that are used to define your lexer rules.  There are three main combinators:  AddDefinition which lets you define a name / regex pair, AddIgnoreDefinition which lets you define characters which the lexer should ignore and AddNextlineDefinition which lets you define what characters determine a new line.

type LexDefinitions = 
  {regexes : string list;
   names : string list;
   nextlines : bool list;
   ignores : bool list; }
   
let buildDefinition name pattern nextLine ignore =
    state {
        let! x = state.Get()
        do! state.Put { regexes = x.regexes @  [sprintf @"(?<%s>%s)" name pattern];
                        names = x.names @ [name]; 
                        nextlines  = x.nextlines @ [nextLine];
                        ignores = x.ignores @ [ignore]}
    }
    
let addDefinition name pattern = buildDefinition name pattern false false
let addIgnoreDefinition name pattern = buildDefinition name pattern false true
let addNextlineDefinition name pattern = buildDefinition name pattern true true    

And the final part is the code that performs the tokenizing.  It uses the Seq.unfold method to create the list of tokens.  Unfold is a function which takes a single item and generates a list of new items from it.  It is the opposite of Seq.fold which takes a list of items and turns it into a single item.  The tokenize function used Seq.unfold to generate each token while keeping track of the current line number, position in that line and position in the input string.

type Token = 
    { name : string;
      text: string; 
      pos :int;
      column: int;
      line: int }
   
let createLexDefs pb =  (runState pb) {regexes = []; names = []; nextlines = []; ignores = []} |> snd
 
let tokenize lexerBuilder (str:string) = 
    let patterns = createLexDefs lexerBuilder
    let combinedRegex =  Regex(List.fold (fun acc reg -> acc + "|" + reg) (List.head patterns.regexes) (List.tail patterns.regexes))
    let nextlineMap = List.zip patterns.names patterns.nextlines |> Map.ofList
    let ignoreMap = List.zip patterns.names patterns.ignores |> Map.ofList
    let tokenizeStep (pos,line,lineStart) = 
        if pos >= str.Length then
            None
        else
            let getMatchedGroupName (grps:GroupCollection) names = List.find (fun (name:string) -> grps.[name].Length > 0) names
            match combinedRegex.Match(str, pos) with
                | mt when mt.Success && pos = mt.Index  -> 
                    let groupName = getMatchedGroupName mt.Groups patterns.names
                    let column = mt.Index - lineStart
                    let nextPos = pos + mt.Length
                    let (nextLine, nextLineStart) = if nextlineMap.Item groupName then (line + 1, nextPos) else (line,lineStart)
                    let token = if ignoreMap.Item groupName 
                                then None 
                                else Some {
                                        name = groupName; 
                                        text = mt.Value; 
                                        pos = pos; 
                                        line = line; 
                                        column = column; }
                    Some(token, (nextPos, nextLine, nextLineStart))
                    
                | otherwise -> 
                    let textAroundError = str.Substring(pos, min (pos + 5) str.Length)
                    raise (ArgumentException (sprintf "Lexing error occured at line:%d and column:%d near the text:%s" line (pos - lineStart) textAroundError))
    Seq.unfold tokenizeStep (0, 0, 0) |> Seq.filter (fun x -> x.IsSome) |> Seq.map (fun x -> x.Value)

Lastly, here are the unit tests written using XUnit.Net:

module LexerFacts
open Xunit
open Lexer
open System.Linq
let simpleDefs = 
    state {
        do! addNextlineDefinition "NextLine"           "/"
        do! addIgnoreDefinition "IgnoredSymbol"        "=+"
        do! addDefinition "String"                     "[a-zA-Z]+"
        do! addDefinition "Number"                     "\d+"
        do! addDefinition "Name"                       "Matt"
    }
[<Fact>]
let Will_return_no_tokens_for_empty_string() =
  
    let tokens = Lexer.tokenize simpleDefs ""
    
    Assert.Equal(0, tokens.Count())
[<Fact>]
let Will_throw_exception_for_invalid_token() =
  
    let tokens = Lexer.tokenize simpleDefs "-"
    let ex = Assert.ThrowsDelegateWithReturn(fun () -> upcast tokens.Count()) |> Record.Exception
    Assert.NotNull(ex)
    Assert.True(ex :? System.ArgumentException)
[<Fact>]
let Will_ignore_symbols_defined_as_ignore_symbols() =
  
    let tokens = Lexer.tokenize simpleDefs "========="
    
    Assert.Equal(0, tokens.Count())
[<Fact>]
let Will_get_token_with_correct_position_and_type() =
  
    let tokens = Lexer.tokenize simpleDefs "1one=2=two"
    
    Assert.Equal("Number",tokens.ElementAt(2).name)
    Assert.Equal("2",tokens.ElementAt(2).text)
    Assert.Equal(5,tokens.ElementAt(2).pos)
    Assert.Equal(5,tokens.ElementAt(2).column)
    Assert.Equal(0,tokens.ElementAt(2).line)
[<Fact>]
let Will_tokenize_string_with_alernating_numbers_and_strings() =
  
    let tokens = Lexer.tokenize simpleDefs "1one2two"
    
    Assert.Equal("1",tokens.ElementAt(0).text)
    Assert.Equal("one",tokens.ElementAt(1).text)
    Assert.Equal("2",tokens.ElementAt(2).text)
    Assert.Equal("two",tokens.ElementAt(3).text)
[<Fact>]
let Will_increment_line_with_newline_symbol() =
  
    let tokens = Lexer.tokenize simpleDefs "1one/2two"
    
    Assert.Equal("Number",tokens.ElementAt(2).name)
    Assert.Equal("2",tokens.ElementAt(2).text)
    Assert.Equal(5,tokens.ElementAt(2).pos)
    Assert.Equal(0,tokens.ElementAt(2).column)
    Assert.Equal(1,tokens.ElementAt(2).line)
[<Fact>]
let Will_give_priority_to_lexer_definitions_defined_earlier() =
  
    let tokens = Lexer.tokenize simpleDefs "Matt"
    
    Assert.Equal("String",tokens.ElementAt(0).name)

I attached a zip (Lexer.zip) containing all the code mentioned above.

open Lexer
let definitions = 
    lexerDefinitions {
        do! addNextlineDefinition "NEWLINE" @"(\n\r)|\n|\r"
        do! addIgnoreDefinition "WS"        @"\s"
        do! addDefinition "LET"             "let"
        do! addDefinition "ID"              "(?i)[a-z][a-z0-9]*"
        do! addDefinition "FLOAT"           @"[0-9]+\.[0-9]+"
        do! addDefinition "INT"             "[0-9]+"
        do! addDefinition "OPERATOR"      @"[+*=!/&|<>\^\-]+"   
    }

With those defined you can execute the lexer with:

open Lexer
let lex input = 
    try    
        let y = Lexer.tokenize definitions input
        printfn "%A" y
    with e -> printf "%s" e.Message
lex "let a = 5"

Which will result in:

seq [{name = "LET";
      text = "let";
      pos = 0;
      column = 0;
      line = 0;}; {name = "ID";
                   text = "a";
                   pos = 4;
                   column = 4;
                   line = 0;}; {name = "OPERATOR";
                                text = "=";
                                pos = 6;
                                column = 6;
                                line = 0;}; {name = "INT";
                                             text = "5";
                                             pos = 8;
                                             column = 8;
                                             line = 0;}]

The lexer’s code is structured in three parts.  The first part is a state monad using the F# computation expressions.  This enables the declarative approach (seen above) to setup your lexer rules.

module StateMonad
type State<'s,'a> = State of ('s -> ('a *'s))
let runState (State f) = f
type StateBuilder() = 
    member b.Return(x) = State (fun s -> (x,s))
    member b.Delay(f) = f() : State<'s,'a>
    member b.Zero() = State (fun s -> ((),s))
    member b.Bind(State p,rest) = State (fun s -> let v,s2 = p s in  (runState (rest v)) s2)
    member b.Get () = State (fun s -> (s,s))
    member b.Put s = State (fun _ -> ((),s))

The second part are the combinators that are used to define your lexer rules.  There are three main combinators:  AddDefinition which lets you define a name / regex pair, AddIgnoreDefinition which lets you define characters which the lexer should ignore and AddNextlineDefinition which lets you define what characters determine a new line.

type LexDefinitions = 
  {regexes : string list;
   names : string list;
   nextlines : bool list;
   ignores : bool list; }
   
let buildDefinition name pattern nextLine ignore =
    state {
        let! x = state.Get()
        do! state.Put { regexes = x.regexes @  [sprintf @"(?<%s>%s)" name pattern];
                        names = x.names @ [name]; 
                        nextlines  = x.nextlines @ [nextLine];
                        ignores = x.ignores @ [ignore]}
    }
    
let addDefinition name pattern = buildDefinition name pattern false false
let addIgnoreDefinition name pattern = buildDefinition name pattern false true
let addNextlineDefinition name pattern = buildDefinition name pattern true true    

And the final part is the code that performs the tokenizing.  It uses the Seq.unfold method to create the list of tokens.  Unfold is a function which takes a single item and generates a list of new items from it.  It is the opposite of Seq.fold which takes a list of items and turns it into a single item.  The tokenize function used Seq.unfold to generate each token while keeping track of the current line number, position in that line and position in the input string.

type Token = 
    { name : string;
      text: string; 
      pos :int;
      column: int;
      line: int }
   
let createLexDefs pb =  (runState pb) {regexes = []; names = []; nextlines = []; ignores = []} |> snd
 
let tokenize lexerBuilder (str:string) = 
    let patterns = createLexDefs lexerBuilder
    let combinedRegex =  Regex(List.fold (fun acc reg -> acc + "|" + reg) (List.head patterns.regexes) (List.tail patterns.regexes))
    let nextlineMap = List.zip patterns.names patterns.nextlines |> Map.ofList
    let ignoreMap = List.zip patterns.names patterns.ignores |> Map.ofList
    let tokenizeStep (pos,line,lineStart) = 
        if pos >= str.Length then
            None
        else
            let getMatchedGroupName (grps:GroupCollection) names = List.find (fun (name:string) -> grps.[name].Length > 0) names
            match combinedRegex.Match(str, pos) with
                | mt when mt.Success && pos = mt.Index  -> 
                    let groupName = getMatchedGroupName mt.Groups patterns.names
                    let column = mt.Index - lineStart
                    let nextPos = pos + mt.Length
                    let (nextLine, nextLineStart) = if nextlineMap.Item groupName then (line + 1, nextPos) else (line,lineStart)
                    let token = if ignoreMap.Item groupName 
                                then None 
                                else Some {
                                        name = groupName; 
                                        text = mt.Value; 
                                        pos = pos; 
                                        line = line; 
                                        column = column; }
                    Some(token, (nextPos, nextLine, nextLineStart))
                    
                | otherwise -> 
                    let textAroundError = str.Substring(pos, min (pos + 5) str.Length)
                    raise (ArgumentException (sprintf "Lexing error occured at line:%d and column:%d near the text:%s" line (pos - lineStart) textAroundError))
    Seq.unfold tokenizeStep (0, 0, 0) |> Seq.filter (fun x -> x.IsSome) |> Seq.map (fun x -> x.Value)

Lastly, here are the unit tests written using XUnit.Net:

module LexerFacts
open Xunit
open Lexer
open System.Linq
let simpleDefs = 
    state {
        do! addNextlineDefinition "NextLine"           "/"
        do! addIgnoreDefinition "IgnoredSymbol"        "=+"
        do! addDefinition "String"                     "[a-zA-Z]+"
        do! addDefinition "Number"                     "\d+"
        do! addDefinition "Name"                       "Matt"
    }
[<Fact>]
let Will_return_no_tokens_for_empty_string() =
  
    let tokens = Lexer.tokenize simpleDefs ""
    
    Assert.Equal(0, tokens.Count())
[<Fact>]
let Will_throw_exception_for_invalid_token() =
  
    let tokens = Lexer.tokenize simpleDefs "-"
    let ex = Assert.ThrowsDelegateWithReturn(fun () -> upcast tokens.Count()) |> Record.Exception
    Assert.NotNull(ex)
    Assert.True(ex :? System.ArgumentException)
[<Fact>]
let Will_ignore_symbols_defined_as_ignore_symbols() =
  
    let tokens = Lexer.tokenize simpleDefs "========="
    
    Assert.Equal(0, tokens.Count())
[<Fact>]
let Will_get_token_with_correct_position_and_type() =
  
    let tokens = Lexer.tokenize simpleDefs "1one=2=two"
    
    Assert.Equal("Number",tokens.ElementAt(2).name)
    Assert.Equal("2",tokens.ElementAt(2).text)
    Assert.Equal(5,tokens.ElementAt(2).pos)
    Assert.Equal(5,tokens.ElementAt(2).column)
    Assert.Equal(0,tokens.ElementAt(2).line)
[<Fact>]
let Will_tokenize_string_with_alernating_numbers_and_strings() =
  
    let tokens = Lexer.tokenize simpleDefs "1one2two"
    
    Assert.Equal("1",tokens.ElementAt(0).text)
    Assert.Equal("one",tokens.ElementAt(1).text)
    Assert.Equal("2",tokens.ElementAt(2).text)
    Assert.Equal("two",tokens.ElementAt(3).text)
[<Fact>]
let Will_increment_line_with_newline_symbol() =
  
    let tokens = Lexer.tokenize simpleDefs "1one/2two"
    
    Assert.Equal("Number",tokens.ElementAt(2).name)
    Assert.Equal("2",tokens.ElementAt(2).text)
    Assert.Equal(5,tokens.ElementAt(2).pos)
    Assert.Equal(0,tokens.ElementAt(2).column)
    Assert.Equal(1,tokens.ElementAt(2).line)
[<Fact>]
let Will_give_priority_to_lexer_definitions_defined_earlier() =
  
    let tokens = Lexer.tokenize simpleDefs "Matt"
    
    Assert.Equal("String",tokens.ElementAt(0).name)

I attached a zip (Lexer.zip) containing all the code mentioned above.

open Lexer
let definitions = 
    lexerDefinitions {
        do! addNextlineDefinition "NEWLINE" @"(\n\r)|\n|\r"
        do! addIgnoreDefinition "WS"        @"\s"
        do! addDefinition "LET"             "let"
        do! addDefinition "ID"              "(?i)[a-z][a-z0-9]*"
        do! addDefinition "FLOAT"           @"[0-9]+\.[0-9]+"
        do! addDefinition "INT"             "[0-9]+"
        do! addDefinition "OPERATOR"      @"[+*=!/&|<>\^\-]+"   
    }

With those defined you can execute the lexer with:

open Lexer
let lex input = 
    try    
        let y = Lexer.tokenize definitions input
        printfn "%A" y
    with e -> printf "%s" e.Message
lex "let a = 5"

Which will result in:

seq [{name = "LET";
      text = "let";
      pos = 0;
      column = 0;
      line = 0;}; {name = "ID";
                   text = "a";
                   pos = 4;
                   column = 4;
                   line = 0;}; {name = "OPERATOR";
                                text = "=";
                                pos = 6;
                                column = 6;
                                line = 0;}; {name = "INT";
                                             text = "5";
                                             pos = 8;
                                             column = 8;
                                             line = 0;}]

The lexer’s code is structured in three parts.  The first part is a state monad using the F# computation expressions.  This enables the declarative approach (seen above) to setup your lexer rules.

module StateMonad
type State<'s,'a> = State of ('s -> ('a *'s))
let runState (State f) = f
type StateBuilder() = 
    member b.Return(x) = State (fun s -> (x,s))
    member b.Delay(f) = f() : State<'s,'a>
    member b.Zero() = State (fun s -> ((),s))
    member b.Bind(State p,rest) = State (fun s -> let v,s2 = p s in  (runState (rest v)) s2)
    member b.Get () = State (fun s -> (s,s))
    member b.Put s = State (fun _ -> ((),s))

The second part are the combinators that are used to define your lexer rules.  There are three main combinators:  AddDefinition which lets you define a name / regex pair, AddIgnoreDefinition which lets you define characters which the lexer should ignore and AddNextlineDefinition which lets you define what characters determine a new line.

type LexDefinitions = 
  {regexes : string list;
   names : string list;
   nextlines : bool list;
   ignores : bool list; }
   
let buildDefinition name pattern nextLine ignore =
    state {
        let! x = state.Get()
        do! state.Put { regexes = x.regexes @  [sprintf @"(?<%s>%s)" name pattern];
                        names = x.names @ [name]; 
                        nextlines  = x.nextlines @ [nextLine];
                        ignores = x.ignores @ [ignore]}
    }
    
let addDefinition name pattern = buildDefinition name pattern false false
let addIgnoreDefinition name pattern = buildDefinition name pattern false true
let addNextlineDefinition name pattern = buildDefinition name pattern true true    

And the final part is the code that performs the tokenizing.  It uses the Seq.unfold method to create the list of tokens.  Unfold is a function which takes a single item and generates a list of new items from it.  It is the opposite of Seq.fold which takes a list of items and turns it into a single item.  The tokenize function used Seq.unfold to generate each token while keeping track of the current line number, position in that line and position in the input string.

type Token = 
    { name : string;
      text: string; 
      pos :int;
      column: int;
      line: int }
   
let createLexDefs pb =  (runState pb) {regexes = []; names = []; nextlines = []; ignores = []} |> snd
 
let tokenize lexerBuilder (str:string) = 
    let patterns = createLexDefs lexerBuilder
    let combinedRegex =  Regex(List.fold (fun acc reg -> acc + "|" + reg) (List.head patterns.regexes) (List.tail patterns.regexes))
    let nextlineMap = List.zip patterns.names patterns.nextlines |> Map.ofList
    let ignoreMap = List.zip patterns.names patterns.ignores |> Map.ofList
    let tokenizeStep (pos,line,lineStart) = 
        if pos >= str.Length then
            None
        else
            let getMatchedGroupName (grps:GroupCollection) names = List.find (fun (name:string) -> grps.[name].Length > 0) names
            match combinedRegex.Match(str, pos) with
                | mt when mt.Success && pos = mt.Index  -> 
                    let groupName = getMatchedGroupName mt.Groups patterns.names
                    let column = mt.Index - lineStart
                    let nextPos = pos + mt.Length
                    let (nextLine, nextLineStart) = if nextlineMap.Item groupName then (line + 1, nextPos) else (line,lineStart)
                    let token = if ignoreMap.Item groupName 
                                then None 
                                else Some {
                                        name = groupName; 
                                        text = mt.Value; 
                                        pos = pos; 
                                        line = line; 
                                        column = column; }
                    Some(token, (nextPos, nextLine, nextLineStart))
                    
                | otherwise -> 
                    let textAroundError = str.Substring(pos, min (pos + 5) str.Length)
                    raise (ArgumentException (sprintf "Lexing error occured at line:%d and column:%d near the text:%s" line (pos - lineStart) textAroundError))
    Seq.unfold tokenizeStep (0, 0, 0) |> Seq.filter (fun x -> x.IsSome) |> Seq.map (fun x -> x.Value)

Lastly, here are the unit tests written using XUnit.Net:

module LexerFacts
open Xunit
open Lexer
open System.Linq
let simpleDefs = 
    state {
        do! addNextlineDefinition "NextLine"           "/"
        do! addIgnoreDefinition "IgnoredSymbol"        "=+"
        do! addDefinition "String"                     "[a-zA-Z]+"
        do! addDefinition "Number"                     "\d+"
        do! addDefinition "Name"                       "Matt"
    }
[<Fact>]
let Will_return_no_tokens_for_empty_string() =
  
    let tokens = Lexer.tokenize simpleDefs ""
    
    Assert.Equal(0, tokens.Count())
[<Fact>]
let Will_throw_exception_for_invalid_token() =
  
    let tokens = Lexer.tokenize simpleDefs "-"
    let ex = Assert.ThrowsDelegateWithReturn(fun () -> upcast tokens.Count()) |> Record.Exception
    Assert.NotNull(ex)
    Assert.True(ex :? System.ArgumentException)
[<Fact>]
let Will_ignore_symbols_defined_as_ignore_symbols() =
  
    let tokens = Lexer.tokenize simpleDefs "========="
    
    Assert.Equal(0, tokens.Count())
[<Fact>]
let Will_get_token_with_correct_position_and_type() =
  
    let tokens = Lexer.tokenize simpleDefs "1one=2=two"
    
    Assert.Equal("Number",tokens.ElementAt(2).name)
    Assert.Equal("2",tokens.ElementAt(2).text)
    Assert.Equal(5,tokens.ElementAt(2).pos)
    Assert.Equal(5,tokens.ElementAt(2).column)
    Assert.Equal(0,tokens.ElementAt(2).line)
[<Fact>]
let Will_tokenize_string_with_alernating_numbers_and_strings() =
  
    let tokens = Lexer.tokenize simpleDefs "1one2two"
    
    Assert.Equal("1",tokens.ElementAt(0).text)
    Assert.Equal("one",tokens.ElementAt(1).text)
    Assert.Equal("2",tokens.ElementAt(2).text)
    Assert.Equal("two",tokens.ElementAt(3).text)
[<Fact>]
let Will_increment_line_with_newline_symbol() =
  
    let tokens = Lexer.tokenize simpleDefs "1one/2two"
    
    Assert.Equal("Number",tokens.ElementAt(2).name)
    Assert.Equal("2",tokens.ElementAt(2).text)
    Assert.Equal(5,tokens.ElementAt(2).pos)
    Assert.Equal(0,tokens.ElementAt(2).column)
    Assert.Equal(1,tokens.ElementAt(2).line)
[<Fact>]
let Will_give_priority_to_lexer_definitions_defined_earlier() =
  
    let tokens = Lexer.tokenize simpleDefs "Matt"
    
    Assert.Equal("String",tokens.ElementAt(0).name)

I attached a zip (Lexer.zip) containing all the code mentioned above.

Enter input: someInput
someOutput
Enter input: otherInput
someoutPut
Enter input: quit
Thanks! Come again!

The code for this is in an imperative language is usually something like:

   1: while(true)

   2: {

   3:     Console.Write("\nEnter input:");

   4:     var line = Console.ReadLine();

   5:     if(line == "quit") break;

   6:     

   7:     doSomething(line);

   8: }

   9:  

  10: Console.WriteLine("Thanks! Come Again");

While reading some F# samples, I saw some code doing essentially the same thing which looked something like:

   1: Console.Write "\nEnter input:"

   2: let mutable input = Console.ReadLine()

   3: while input <> "quit"

   4:     do

   5:     

   6:     if input <> "quit" 

   7:     then

   8:         doSomething input

   9:         Console.Write "\nEnter input:" 

  10:         input <- Console.ReadLine()

Now this just feels dirty! In a functional language explicit loop constructs like a while loop feel wrong.  I different way of doing this which is more functional is to create an infinite list of actions.  Where each action represents one iteration of any of the above loops. Then you just execute each action until some condition is met (like seeing the input “quit”).

   1: let action = fun _ ->

   2:     Console.Write "\nEnter input: "

   3:     Console.ReadLine()

   4:  

   5: let readlines = Seq.init_infinite (fun _ -> action())

   6:     

   7: let run item = if item = "quit" 

   8:                 then Some(item) 

   9:                 else

  10:                     parse item 

  11:                     None

  12:  

  13: Seq.first run readlines |> ignore

  14: Console.WriteLine "Thanks! Come Again"

This code makes use of the Seq.init_infinite which create a infinite sequence and Seq.first which enumerates the sequence until the passed in function returns Some.

Enter input: someInput
someOutput
Enter input: otherInput
someoutPut
Enter input: quit
Thanks! Come again!

The code for this is in an imperative language is usually something like:

   1: while(true)

   2: {

   3:     Console.Write("\nEnter input:");

   4:     var line = Console.ReadLine();

   5:     if(line == "quit") break;

   6:     

   7:     doSomething(line);

   8: }

   9:  

  10: Console.WriteLine("Thanks! Come Again");

While reading some F# samples, I saw some code doing essentially the same thing which looked something like:

   1: Console.Write "\nEnter input:"

   2: let mutable input = Console.ReadLine()

   3: while input <> "quit"

   4:     do

   5:     

   6:     if input <> "quit" 

   7:     then

   8:         doSomething input

   9:         Console.Write "\nEnter input:" 

  10:         input <- Console.ReadLine()

Now this just feels dirty! In a functional language explicit loop constructs like a while loop feel wrong.  I different way of doing this which is more functional is to create an infinite list of actions.  Where each action represents one iteration of any of the above loops. Then you just execute each action until some condition is met (like seeing the input “quit”).

   1: let action = fun _ ->

   2:     Console.Write "\nEnter input: "

   3:     Console.ReadLine()

   4:  

   5: let readlines = Seq.init_infinite (fun _ -> action())

   6:     

   7: let run item = if item = "quit" 

   8:                 then Some(item) 

   9:                 else

  10:                     parse item 

  11:                     None

  12:  

  13: Seq.first run readlines |> ignore

  14: Console.WriteLine "Thanks! Come Again"

This code makes use of the Seq.init_infinite which create a infinite sequence and Seq.first which enumerates the sequence until the passed in function returns Some.

Enter input: someInput
someOutput
Enter input: otherInput
someoutPut
Enter input: quit
Thanks! Come again!

The code for this is in an imperative language is usually something like:

   1: while(true)

   2: {

   3:     Console.Write("\nEnter input:");

   4:     var line = Console.ReadLine();

   5:     if(line == "quit") break;

   6:     

   7:     doSomething(line);

   8: }

   9:  

  10: Console.WriteLine("Thanks! Come Again");

While reading some F# samples, I saw some code doing essentially the same thing which looked something like:

   1: Console.Write "\nEnter input:"

   2: let mutable input = Console.ReadLine()

   3: while input <> "quit"

   4:     do

   5:     

   6:     if input <> "quit" 

   7:     then

   8:         doSomething input

   9:         Console.Write "\nEnter input:" 

  10:         input <- Console.ReadLine()

Now this just feels dirty! In a functional language explicit loop constructs like a while loop feel wrong.  I different way of doing this which is more functional is to create an infinite list of actions.  Where each action represents one iteration of any of the above loops. Then you just execute each action until some condition is met (like seeing the input “quit”).

   1: let action = fun _ ->

   2:     Console.Write "\nEnter input: "

   3:     Console.ReadLine()

   4:  

   5: let readlines = Seq.init_infinite (fun _ -> action())

   6:     

   7: let run item = if item = "quit" 

   8:                 then Some(item) 

   9:                 else

  10:                     parse item 

  11:                     None

  12:  

  13: Seq.first run readlines |> ignore

  14: Console.WriteLine "Thanks! Come Again"

This code makes use of the Seq.init_infinite which create a infinite sequence and Seq.first which enumerates the sequence until the passed in function returns Some.

This concept exists in Haskell which you can see here. However, my attempts at replicating this in F# failed.  Unlike in Haskell, the computation expressions in F# don't share a common interface (or type class).  This prevents a computation from being able to generically take another computation as a parameter.  The reason is that an operation on the parameterized state transformer monad such as bind will result in a bind called on its encapsulated monad.  But since there is no interface for computations there is no bind method to call. 

I attempted to fix this by creating my own monad interface but this didn't work:

   1: type Monad =

   2:     abstract Bind : 'm * ('a -> 'm) -> 'm

   3:     abstract Delay : (unit ->'m) -> 'm

   4:     abstract Let : 'a * ('a -> 'm) -> 'm

   5:     abstract Return : 'a -> 'm

   6:     abstract Zero : unit -> 'm

   7:     abstract Combine : 'm -> 'm2 -> 'm3

   8:     abstract Run : (unit ->'m) -> 'm

After playing with that and failing I ended up with a less than ideal solution.  Given a Maybe monad like below:

   1: // Maybe Monad    

   2: type MaybeBuilder() =

   3:     member b.Return(x) = Some x

   4:     member b.Run(f) = f()

   5:     member b.Delay(f) = f

   6:     member b.Let(p,rest) = rest p

   7:     member b.Zero () = None

   8:     member b.Combine(m1,dm2) = match m1 with

   9:                                  | None -> dm2()

  10:                                  | x -> x

  11:  

  12:     member b.Bind(p,rest) = match p with 

  13:                             | None -> None

  14:                             | Some r -> rest r

I created a state transformer monad which take an argument of type m:MaybeBuilder

   1: type StateMBuilder(m:MaybeBuilder) = 

   2:     member b.Return(x) = fun s -> m.Return (x,s)

   3:     member b.Run(f) = fun inp -> (f inp)()

   4:     member b.Delay(f) = fun inp -> fun () -> f() inp

   5:     member b.Let(p,rest) = rest p

   6:     member b.Zero () = fun s -> m.Zero()

   7:     member b.Bind(p,rest) = fun s -> m.Bind(p s,fun (v,s2) -> rest v s2)

   8:     member b.Combine(p1,dp2) = fun s -> m.Combine(p1 s, dp2 s)

   9:  

  10:     // State specific functions

  11:     member b.Update f = fun s -> try m.Return (s, f s) with e -> m.Zero()

  12:     member b.Read () = b.Update id

  13:     member b.Set t = b.Update (fun _ -> t)

Now although this type is technically parameterized ;) it isn't really the idea since its not generic, it has to be a MaybeBuilder.  To use this with a different monad I would need to change m:MaybeBuild to m:SomeOtherMonad. 

I am still going to play with this but this is as far as I have gotten.

After all of that here is how you create a state transformer monad parameterized over the maybe monad:

   1: let maybe = MaybeBuilder()

   2: let state = StateMBuilder(maybe)

If anyone has an idea how I can make this work I would love to hear it.

I have have been playing around with F# and I decided to create a state monad.  This worked out really well since I was able to leverage the F# computation expressions.  I then decided to try to extend this and make it more general by creating a parameterized state transformer monad.  This is a state monad which encapsulates another monad.  What this allow you to do is turn any computation into a statefull one.

This concept exists in Haskell which you can see here. However, my attempts at replicating this in F# failed.  Unlike in Haskell, the computation expressions in F# don’t share a common interface (or type class).  This prevents a computation from being able to generically take another computation as a parameter.  The reason is that an operation on the parameterized state transformer monad such as bind will result in a bind called on its encapsulated monad.  But since there is no interface for computations there is no bind method to call. 

I attempted to fix this by creating my own monad interface but this didn’t work:

   1: type Monad =

   2:     abstract Bind : ‘m * (‘a -> ‘m) -> ‘m

   3:     abstract Delay : (unit ->‘m) -> ‘m

   4:     abstract Let : ‘a * (‘a -> ‘m) -> ‘m

   5:     abstract Return : ‘a -> ‘m

   6:     abstract Zero : unit -> ‘m

   7:     abstract Combine : ‘m -> ‘m2 -> ‘m3

   8:     abstract Run : (unit ->‘m) -> ‘m

After playing with that and failing I ended up with a less than ideal solution.  Given a Maybe monad like below:

   1: // Maybe Monad    

   2: type MaybeBuilder() =

   3:     member b.Return(x) = Some x

   4:     member b.Run(f) = f()

   5:     member b.Delay(f) = f

   6:     member b.Let(p,rest) = rest p

   7:     member b.Zero () = None

   8:     member b.Combine(m1,dm2) = match m1 with

   9:                                  | None -> dm2()

  10:                                  | x -> x

  11:  

  12:     member b.Bind(p,rest) = match p with 

  13:                             | None -> None

  14:                             | Some r -> rest r

I created a state transformer monad which take an argument of type m:MaybeBuilder

   1: type StateMBuilder(m:MaybeBuilder) = 

   2:     member b.Return(x) = fun s -> m.Return (x,s)

   3:     member b.Run(f) = fun inp -> (f inp)()

   4:     member b.Delay(f) = fun inp -> fun () -> f() inp

   5:     member b.Let(p,rest) = rest p

   6:     member b.Zero () = fun s -> m.Zero()

   7:     member b.Bind(p,rest) = fun s -> m.Bind(p s,fun (v,s2) -> rest v s2)

   8:     member b.Combine(p1,dp2) = fun s -> m.Combine(p1 s, dp2 s)

   9:  

  10:     // State specific functions

  11:     member b.Update f = fun s -> try m.Return (s, f s) with e -> m.Zero()

  12:     member b.Read () = b.Update id

  13:     member b.Set t = b.Update (fun _ -> t)

Now although this type is technically parameterized it isn’t really the idea since its not generic, it has to be a MaybeBuilder.  To use this with a different monad I would need to change m:MaybeBuild to m:SomeOtherMonad. 

I am still going to play with this but this is as far as I have gotten.

After all of that here is how you create a state transformer monad parameterized over the maybe monad:

   1: let maybe = MaybeBuilder()

   2: let state = StateMBuilder(maybe)

If anyone has an idea how I can make this work I would love to hear it.

I decided to do some Project Euler problems using F#. 

So here is my first one, Problem # 31.  Nothing in this solution really shows off anything special about F# but you have to start somewhere

   1: #light

   2:  

   3: let rec combos amt (denoms:int list) = 

   4:     if amt = 0 then 1

   5:     elif denoms.IsEmpty || amt < 0 then 0

   6:     else 

   7:         combos (amt – denoms.Head) denoms + 

   8:         combos amt denoms.Tail

   9:     

  10:     

  11: printf “\n\nThe Anwer is: %i \n” (combos 200 [200;100;50;20;10;5;2;1])

  12: