open System

//F# State Monad

type State<'state, 'a> = State of ('state ->'a * 'state)

type StateMonad() =

member b.Bind(m, f) = State (fun s -> let r = match m with

| State f -> f s

match r with

| (v,s) -> match f v with

| State f -> f s)

member b.Return(x) = State (fun s -> x, s)

let state = StateMonad()

let GetState = State (fun s -> s, s)

let SetState s = State (fun s' -> (), s)

let Execute m s = match m with

| State f -> let (x,s') = f s

s'

let rec ForEach f xs =

state {

match xs with

| x :: xs' -> do! f x

return! ForEach f xs'

| [] -> return ()

}

let sin = Math.Sin

let cos = Math.Cos

let atan = Math.Atan

let float_of_int x = (float x)

let int_of_float x = (int x)

type logo = | Home

| Forward of int

| Turn of int

| For of int * logo list

let pi = 4.0 * atan 1.0

let dsin t = sin(pi * (float_of_int t) / 180.0)

and dcos t = cos(pi * (float_of_int t) / 180.0)

let AddToState x = state { let! xs = GetState

do! SetState (x::xs) }

let GoHome = state { do! AddToState (0,0,0) }

let GoForward n = state { let! (x,y,d)::xs = GetState

do! AddToState (x + (int_of_float ((float n) * dsin d)), y + (int_of_float ((float n) * dcos d)), d) }

let GoTurn n = state { let! (x,y,d)::xs = GetState

do! AddToState (x,y,d+n) }

let rec interpret e = state {

do! match e with

| Home -> GoHome

| Forward n -> GoForward n

| Turn(n) -> GoTurn n

| For(i, es) -> if i > 0 then

state {

do! interpret_prog es

do! interpret (For(i - 1, es))

}

else

state { return () } }

and interpret_prog xs = ForEach interpret xs

let sample = [Home; For(20, [Turn 18; For(36, [Forward 10; Turn 10])])]

let Run = Execute(interpret_prog sample) [(0,0,0)] |> List.to_array

## Tuesday, 28 April 2009

### Monadic LOGO Large Step Interpreter

## Tuesday, 21 April 2009

### LOGO Translator

open System;

let sin = Math.Sin

let cos = Math.Cos

let atan = Math.Atan

let float_of_int x = (float x)

let int_of_float x = (int x)

type logo = | Home

| Forward of int

| Turn of int

| For of int * logo list

let pi = 4.0 * atan 1.0

let dsin t = sin(pi * (float_of_int t) / 180.0)

and dcos t = cos(pi * (float_of_int t) / 180.0)

let forward (x,y,d) steps = (x + (int_of_float ((float steps) * dsin d)),

y + (int_of_float ((float steps) * dcos d)), d)

let compose f g = fun x -> f(g(x))

let rec translate h x = match x with

| Home -> fun pos -> pos

| Forward(n) -> fun pos ->

let pos' = forward pos n

h pos'

| Turn(n) -> fun (x,y,d) -> (x,y,d + n)

| For(i, xs) -> let f = translate_prog h xs in

if i > 1 then

compose f (translate h (For(i - 1, xs)))

else

f

and translate_prog h xs = List.fold_left (fun f x -> compose (translate h x) f) (fun pos -> pos) xs

let current = (0, 0, 0)

let sample = [Home; For(20, [Turn 18; For(36, [Forward 10; Turn 10])])]

let f = translate_prog (fun x -> (printf "%A" x) ; x) sample

let result = f current

## Sunday, 19 April 2009

### LOGO Large Step Interpreter

open System;

let sin = Math.Sin

let cos = Math.Cos

let atan = Math.Atan

let float_of_int x = (float x)

let int_of_float x = (int x)

type logo = | Home

| Forward of int

| Turn of int

| For of int * logo list

let pi = 4.0 * atan 1.0

let dsin t = sin(pi * (float_of_int t) / 180.0)

and dcos t = cos(pi * (float_of_int t) / 180.0)

let rec interpret f (x,y,d) e =

let interpret' (x,y,d) e = match e with

| Home -> (0,0,0)

| Forward(n) -> (x + (int_of_float ((float n) * dsin d)), y + (int_of_float ((float n) * dcos d)), d)

| Turn(n) -> (x, y, d + n)

| For(i, xs) -> if i > 0 then

interpret f (interpret_prog f (x,y,d) xs) (For(i - 1, xs))

else

(x,y,d)

f (x,y,d)

interpret' (x,y,d) e

and interpret_prog f pos xs = match xs with

| x::xs' -> interpret_prog f (interpret f pos x) xs'

| [] -> pos

let current = (0, 0, 0)

let sample = [Home; For(20, [Turn 18; For(36, [Forward 10; Turn 10])])]

let result = interpret_prog (printf "%A") current sample

Subscribe to:
Posts (Atom)