37 people like it.
Like the snippet!

Scheme interpreter in F#

A small Scheme interpreter using Higher Order Abstract Syntax (HOAS) encoding for terms. The essence of the technique is to use F# (meta-level) functions to encode Scheme (object-level) functions and other binding constructs, thus avoiding the need for representing variables, bindings, explicit substitution and dealing with shadowing.

 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:

type Prim =
    | Add
    | Sub
    | Mul
    | Div
    | Eq
    | Not

type Value =
    | Bool of bool
    | Int of int
    | Lambda of (list<Expr> -> Expr)

and Expr =
    | Apply of Expr * list<Expr>
    | Call of Prim * list<Expr>
    | Const of Value
    | If of Expr * Expr * Expr
    | Let of Expr * (Expr -> Expr)
    | LetRec of (Lazy<Expr> -> Expr * Expr)

let Op prim =
    match prim with
    | Add ->
        fun [Int x; Int y] -> Int (x + y)
    | Sub ->
        fun [Int x; Int y] -> Int (x - y)
    | Mul ->
        fun [Int x; Int y] -> Int (x * y)
    | Div ->
        fun [Int x; Int y] -> Int (x / y)
    | Eq  ->
        function
        | [Int x; Int y] -> Bool (x = y)
        | [Bool x; Bool y] -> Bool (x = y)
    | Not -> fun [Bool x] ->
        Bool (not x)

let (|Binary|_|) (expr: Expr) =
    match expr with
    | Call (p, [x; y]) -> Some (p, x, y)
    | _                -> None

let rec Eval (expr: Expr) : Value =
    match expr with
    | Apply (f, xs) ->
        match Eval f with
        | Lambda f ->
            Eval (f xs)
    | Call (p, xs) ->
        Op p (List.map Eval xs)
    | Const x ->
        x
    | If (x, y, z) ->
        match Eval x with
        | Bool true  -> Eval y
        | Bool false -> Eval z
    | Let (x, f) ->
        Eval (f (Const (Eval x)))
    | LetRec f ->
        let rec x = lazy fst pair
        and body  = snd pair
        and pair  = f x
        Eval body

let rec Fac x =
    if x = 0 then 1 else x * Fac (x - 1)

let Fac10 =
    let i x = Const (Int x)
    let ( =? ) a b = Call (Eq, [a; b])
    let ( *? ) a b = Call (Mul, [a; b])
    let ( -? ) a b = Call (Sub, [a; b])
    let ( ^^ ) f x = Apply (f, [x])
    LetRec <| fun fac ->
        let fac =
            fun [x] ->
                let (Lazy fac) = fac
                If (x =? i 0, i 1, x *? (fac ^^ (x -? i 1)))
            |> Lambda
            |> Const
        (fac, fac ^^ i 10)

Fac 10
|> printfn "%A"

Eval Fac10
|> printfn "%A"

union case Prim.Add: Prim

union case Prim.Sub: Prim

union case Prim.Mul: Prim

union case Prim.Div: Prim

union case Prim.Eq: Prim

union case Prim.Not: Prim

type Value =
  | Bool of bool
  | Int of int
  | Lambda of (Expr list -> Expr)

Full name: Script.Value

union case Value.Bool: bool -> Value

type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool

union case Value.Int: int -> Value

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 Value.Lambda: (Expr list -> Expr) -> Value

type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>

union case Expr.Apply: Expr * Expr list -> Expr

union case Expr.Call: Prim * Expr list -> Expr

type Prim =
  | Add
  | Sub
  | Mul
  | Div
  | Eq
  | Not

Full name: Script.Prim

union case Expr.Const: Value -> Expr

union case Expr.If: Expr * Expr * Expr -> Expr

union case Expr.Let: Expr * (Expr -> Expr) -> Expr

union case Expr.LetRec: (Lazy<Expr> -> Expr * Expr) -> Expr

Multiple items
active recognizer Lazy: Lazy<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.( |Lazy| )

--------------------
type Lazy<'T> = System.Lazy<'T>

Full name: Microsoft.FSharp.Control.Lazy<_>

val Op : prim:Prim -> (Value list -> Value)

Full name: Script.Op

val prim : Prim

val x : int

val y : int

val x : bool

val y : bool

val not : value:bool -> bool

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

val expr : Expr

val p : Prim

val x : Expr

val y : Expr

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

union case Option.None: Option<'T>

val Eval : expr:Expr -> Value

Full name: Script.Eval

val f : Expr

val xs : Expr list

val f : (Expr list -> Expr)

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 map : mapping:('T -> 'U) -> list:'T list -> 'U list

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

val x : Value

val z : Expr

val f : (Expr -> Expr)

val f : (Lazy<Expr> -> Expr * Expr)

val x : Lazy<Expr>

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

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

val body : Expr

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

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

val pair : Expr * Expr

val Fac : x:int -> int

Full name: Script.Fac

val Fac10 : Expr

Full name: Script.Fac10

val i : (int -> Expr)

val a : Expr

val b : Expr

val fac : Lazy<Expr>

val fac : Expr

val printfn : format:Printf.TextWriterFormat<'T> -> 'T

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

Next Version Raw view Test code New version

More information

Link:	http://fssnip.net/2T
Posted:	13 years ago
Author:	Anton Tayanovskyy
Tags:	hoas , scheme , learning f#