Monadic LOGO Large Step Interpreter

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