2 people like it.
Like the snippet!

Solving the expression problem

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81: 
82: 
83: 
84: 
85: 
86: 
87: 
88: 
89: 
90: 
91:

type 'e lam = ABS of string * 'e | APP of 'e * 'e | VAR of string

let lookup s = List.tryFind (fun (s', _) -> s = s')

let gensym = 
   let i = ref 0
   fun () -> 
        let result = sprintf "_%i" !i
        incr i
        result

let lamEval from ``to`` eval e = function
| ABS (s, b) -> 
    let s' = gensym ()
    ``to`` (ABS (s', eval ((s, ``to`` (VAR s'))::e) b))
| APP (f, x) -> 
    let f = eval e f
    let x = eval e x
    match from f with
    | Some (ABS (s, b)) -> 
        eval ((s, x)::e) b
    | _ ->
        ``to`` (APP (f, x))
| VAR s -> 
    match lookup s e with
    | Some (_, v) -> v
    | _ -> ``to`` (VAR s)

let lamToString toString = function
| ABS (s, b) -> sprintf @"(\%s.%s)" s (toString b)
| APP (f, x) -> sprintf "(%s %s)" (toString f) (toString x)
| VAR s      -> s

type 'e num = NUM of int | ADD of 'e * 'e | MUL of 'e * 'e

let numEval from ``to`` eval env = 
   let evalBop bop con (l, r) = 
      let l = eval env l
      let r = eval env r
      match (from l, from r) with
      | (Some (NUM l), Some (NUM r)) -> ``to`` (NUM (bop l r))
      | _                            -> ``to`` (con (l, r))
   function
   | NUM i -> ``to`` (NUM i)
   | ADD (x,y) -> evalBop (+) ADD (x,y)
   | MUL (x,y) -> evalBop (*) MUL (x,y)

let numToString toString = function
| NUM i -> string i
| ADD (l, r) -> sprintf "(%s + %s)" (toString l) (toString r)
| MUL (l, r) -> sprintf "(%s * %s)" (toString l) (toString r)

type 'e cons = CONS of 'e * 'e | FST of 'e | SND of 'e

let consToString toString = function
| CONS (l, r) -> sprintf "(%s, %s)" (toString l) (toString r)
| FST e       -> sprintf "(#1 %s)" (toString e)
| SND e       -> sprintf "(#2 %s)" (toString e)

let consEval from ``to`` eval e = 
   let prj f c t = 
      let t = eval e t
      match from t with
      | Some (CONS(x,y)) -> f(x,y)
      | _             -> ``to`` (c t)
   function
   | CONS (f, s) -> ``to`` (CONS (eval e f, eval e s))
   | FST t       -> prj fst FST t
   | SND t       -> prj snd SND t


type t = L of t lam | N of t num | C of t cons

let rec toString = function
| L l -> lamToString  toString l
| N n -> numToString  toString n
| C c -> consToString toString c

let rec eval e = function
| L l -> lamEval  (function | L l -> Some l | _ -> None) L eval e l
| N n -> numEval  (function | N n -> Some n | _ -> None) N eval e n
| C c -> consEval (function | C c -> Some c | _ -> None) C eval e c

let e = L (APP (L (ABS ("x",
                        N (ADD (C (FST (L (VAR "x"))),
                                N (NUM 1))))),
                C (CONS (N (NUM 2), N (NUM 3)))))

let (N (NUM 3)) = eval [] e
let "((\\x.((#1 x) + 1)) (2, 3))" = toString e
let (L (VAR "y")) = eval [] (L (APP (L (ABS ("x", L (VAR "x"))), L (VAR "y"))))

union case lam.ABS: string * 'e -> 'e lam

Multiple items
val string : value:'T -> string

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

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

Full name: Microsoft.FSharp.Core.string

union case lam.APP: 'e * 'e -> 'e lam

union case lam.VAR: string -> 'e lam

val lookup : s:'a -> (('a * 'b) list -> ('a * 'b) option) (requires equality)

Full name: Script.lookup

val s : 'a (requires equality)

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 tryFind : predicate:('T -> bool) -> list:'T list -> 'T option

Full name: Microsoft.FSharp.Collections.List.tryFind

val s' : 'a (requires equality)

val gensym : (unit -> string)

Full name: Script.gensym

val i : int ref

Multiple items
val ref : value:'T -> 'T ref

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

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>

val result : string

val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf

val incr : cell:int ref -> unit

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

val lamEval : from:('a -> 'b lam option) -> to:('a lam -> 'a) -> eval:((string * 'a) list -> 'b -> 'a) -> e:(string * 'a) list -> _arg1:'b lam -> 'a

Full name: Script.lamEval

val from : ('a -> 'b lam option)

val eval : ((string * 'a) list -> 'b -> 'a)

val e : (string * 'a) list

val s : string

val b : 'b

val s' : string

val f : 'b

val x : 'b

val f : 'a

val x : 'a

union case Option.Some: Value: 'T -> Option<'T>

val v : 'a

val lamToString : toString:('a -> string) -> _arg1:'a lam -> string

Full name: Script.lamToString

val toString : ('a -> string)

val b : 'a

type 'e num =
  | NUM of int
  | ADD of 'e * 'e
  | MUL of 'e * 'e

Full name: Script.num<_>

union case num.NUM: int -> 'e num

Multiple items
val int : value:'T -> int (requires member op_Explicit)

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

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

union case num.ADD: 'e * 'e -> 'e num

union case num.MUL: 'e * 'e -> 'e num

val numEval : from:('a -> 'b num option) -> to:('a num -> 'c) -> eval:('d -> 'e -> 'a) -> env:'d -> ('e num -> 'c)

Full name: Script.numEval

val from : ('a -> 'b num option)

val eval : ('d -> 'e -> 'a)

val env : 'd

val evalBop : ((int -> int -> int) -> ('a * 'a -> 'a num) -> 'e * 'e -> 'c)

val bop : (int -> int -> int)

val con : ('a * 'a -> 'a num)

val l : 'e

val r : 'e

val l : 'a

val r : 'a

val l : int

val r : int

val i : int

val x : 'e

val y : 'e

val numToString : toString:('a -> string) -> _arg1:'a num -> string

Full name: Script.numToString

type 'e cons =
  | CONS of 'e * 'e
  | FST of 'e
  | SND of 'e

Full name: Script.cons<_>

union case cons.CONS: 'e * 'e -> 'e cons

union case cons.FST: 'e -> 'e cons

union case cons.SND: 'e -> 'e cons

val consToString : toString:('a -> string) -> _arg1:'a cons -> string

Full name: Script.consToString

val e : 'a

val consEval : from:('a -> 'b cons option) -> to:('a cons -> 'b) -> eval:('c -> 'd -> 'a) -> e:'c -> ('d cons -> 'b)

Full name: Script.consEval

val from : ('a -> 'b cons option)

val eval : ('c -> 'd -> 'a)

val e : 'c

val prj : (('b * 'b -> 'b) -> ('a -> 'a cons) -> 'd -> 'b)

val f : ('b * 'b -> 'b)

val c : ('a -> 'a cons)

val t : 'd

val t : 'a

val y : 'b

val f : 'd

val s : 'd

val fst : tuple:('T1 * 'T2) -> 'T1

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

val snd : tuple:('T1 * 'T2) -> 'T2

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

type t =
  | L of t lam
  | N of t num
  | C of t cons

Full name: Script.t

union case t.L: t lam -> t

type 'e lam =
  | ABS of string * 'e
  | APP of 'e * 'e
  | VAR of string

Full name: Script.lam<_>

union case t.N: t num -> t

union case t.C: t cons -> t

val toString : _arg1:t -> string

Full name: Script.toString

val l : t lam

val n : t num

val c : t cons

val eval : e:(string * t) list -> _arg1:t -> t

Full name: Script.eval

val e : (string * t) list

union case Option.None: Option<'T>

val e : t

Full name: Script.e

Raw view Test code New version

More information

Link:	http://fssnip.net/gn
Posted:	11 years ago
Author:
Tags: