1 people like it.

FizzBuzz in F# by Embedding a Domain-Specific Language

This is a translation to F# of the Haskell code in the article "FizzBuzz in Haskell by Embedding a Domain-Specific Language" by Maciej Piróg The original article is located here: http://themonadreader.files.wordpress.com/2014/04/issue23.pdf The idea is to help people familiar with F# but not with Haskell to follow the article.

FizzBuzz Exibit A (Page 8)

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 

// Exhibit A, in some cases, performs the `mod`3 and `mod`5 tests more than once
let ``fizzbuzz Exibit A`` n = 
    if n % 3 = 0 && n % 5 = 0 then
        "fizzbuzz"
    elif n % 3 = 0 then
        "fizz"
    elif n % 5 = 0 then
        "buzz"
    else
        string n

FizzBuzz Exibit B (Page 8)

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 

// Exhibit B disperses the buzzing code into more than one place in the program.
let ``fizzbuzz Exibit B`` n =
    if n % 3 = 0 then
        "fizz" + if n % 5 = 0 then
                    "buzz"
                 else
                    ""
    elif n % 5 = 0 then
            "buzz"
    else
        string n

FizzBuzz Exibit C (Page 9)

1: 
2: 
3: 
4: 
5: 
6: 

// Exibit C looks simple an elegant, but it has to check if the string is empty with the (<<|) operator.
let (<<|) a b = if a = "" then b else a
let ``fizzbuzz Exibit C`` n = 
    ((if n % 3 = 0 then "fizz" else "")
    + if n % 5 = 0 then "buzz" else "")
     <<| string n

Direct Definition (Page 11-12)

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 

// DSL implementation
type Cmd = Skip | Halt | Print of string
type Program = Cmd list

let rec interp (xs : Program) = 
    match xs with
        | Skip::t -> interp t
        | Halt::_ -> ""
        | Print s::t -> s + interp t
        | [] -> "" 

type Cont = Program -> Program

let fizz n : Cont = 
    match n with
        | _ when n % 3 = 0 -> fun x -> [Print "fizz"] @ x @ [Halt]
        | _ -> id

let buzz n  : Cont =  
    match n with
        | _ when n % 5 = 0 -> fun x -> [Print "buzz"] @ x @ [Halt]
        | _ -> id

let base' n : Cont = fun x -> x @ [Print (string n)]

let fb n = (base' n << fizz n << buzz n ) [Skip]

let fizzbuzz' n = fb n |> interp

Interpretation is a fold (Page 12)

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 

// First, we notice a known pattern here:
// interp is a fold. We can rewrite it as follows:
let step cmd t =
    match cmd with
        | Skip -> t
        | Halt -> ""
        | Print s -> s + t

let interp' xs = List.foldBack step xs ""

// Next version of Skip-Halt-Print commands (Page 13)
let ``const`` a _ = a

type Program' = string -> string

let skip : Program' = id
let halt  : Program' = ``const`` ""
let print : string -> Program' = (+)

// print "hello" << skip  << print "world" << halt

// (print "hello" << skip  << print "world" << halt) "" = "helloworld"

// We need to accordingly adjust the bodies of our contexts: (Page 14)
type Cont' = Program' -> Program'

let fizz' n : Cont' = 
    match n with
        | _ when n % 3 = 0 -> fun x -> print "fizz" << x << halt
        | _ -> id

let buzz' n : Cont' = 
    match n with
        | _ when n % 5 = 0 -> fun x -> print "buzz" << x << halt
        | _ -> id

let base'' n : Cont' = fun x -> x << print (string n) 

let fizzbuzz'' n = (base'' n << fizz' n << buzz' n) skip ""

Inlining (Page 14)

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 

let fizzbuzz''' n =
    let fizz = 
        match n with
            | _ when n % 3 = 0 -> fun x -> ``const`` ("fizz" + x "")
            | _ -> id
    let buzz = 
        match n with
            | _ when n % 5 = 0 -> fun x -> ``const`` ("buzz" + x "")
            | _ -> id
    (fizz << buzz) id (string n)

Final polishing (Page 14)

1: 
2: 
3: 
4: 
5: 
6: 

let fizzbuzz n = 
    let test d s x =
        match n with
            | _ when n % d = 0 -> fun _ -> s + x ""
            | _ -> x
    (test 3 "fizz" << test 5 "buzz") id <| string n
val ( fizzbuzz Exibit A ) : n:int -> string

Full name: Script.( fizzbuzz Exibit A )
val n : int
Multiple items
val string : value:'T -> string

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

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
val ( fizzbuzz Exibit B ) : n:int -> string

Full name: Script.( fizzbuzz Exibit B )
val a : string
val b : string
val ( fizzbuzz Exibit C ) : n:int -> string

Full name: Script.( fizzbuzz Exibit C )
type Cmd =
  | Skip
  | Halt
  | Print of string

Full name: Script.Cmd
union case Cmd.Skip: Cmd
union case Cmd.Halt: Cmd
union case Cmd.Print: string -> Cmd
type Program = Cmd list

Full name: Script.Program
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val interp : xs:Program -> string

Full name: Script.interp
val xs : Program
val t : Cmd list
val s : string
type Cont = Program -> Program

Full name: Script.Cont
val fizz : n:int -> Cont

Full name: Script.fizz
val x : Program
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val buzz : n:int -> Cont

Full name: Script.buzz
val base' : n:int -> x:Program -> Program

Full name: Script.base'
val fb : n:int -> Program

Full name: Script.fb
val fizzbuzz' : n:int -> string

Full name: Script.fizzbuzz'
val step : cmd:Cmd -> t:string -> string

Full name: Script.step
val cmd : Cmd
val t : string
val interp' : xs:Cmd list -> string

Full name: Script.interp'
val xs : Cmd list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val foldBack : folder:('T -> 'State -> 'State) -> list:'T list -> state:'State -> 'State

Full name: Microsoft.FSharp.Collections.List.foldBack
val a : 'a
type Program' = string -> string

Full name: Script.Program'
val skip : Program'

Full name: Script.skip
val halt : Program'

Full name: Script.halt
val print : (string -> Program')

Full name: Script.print
type Cont' = Program' -> Program'

Full name: Script.Cont'
val fizz' : n:int -> Cont'

Full name: Script.fizz'
val x : Program'
val buzz' : n:int -> Cont'

Full name: Script.buzz'
val base'' : n:int -> x:Program' -> Program'

Full name: Script.base''
val fizzbuzz'' : n:int -> string

Full name: Script.fizzbuzz''
val fizzbuzz''' : n:int -> string

Full name: Script.fizzbuzz'''
val fizz : ((string -> string) -> string -> string)
val x : (string -> string)
val buzz : ((string -> string) -> string -> string)
val fizzbuzz : n:int -> string

Full name: Script.fizzbuzz
val test : (int -> string -> (string -> string) -> string -> string)
val d : int
Raw view Test code New version

More information

Link:http://fssnip.net/mX
Posted:10 years ago
Author:Cesar Mendoza
Tags: kata , functional , functions , haskell

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.