Logo Turtle Computation Expression

logo_turtle.fsx

namespace CExprs

module LogoTurtle  =

    type Distance_Unit = STEPS
    type Rotation_Unit = GRADATIONS
    type Rotation_Direction = | LEFT | RIGHT
    let STEP = STEPS
    let GRADATION = GRADATIONS

    type Color = | RED | GREEN | BLUE

    type Action =
        | Walk of int * Distance_Unit
        | Turn of int * Rotation_Unit * Rotation_Direction
        | LiftPenUp
        | PutPenDown
        | PickColor of Color

    type Turtle = Action seq

    type AS_word    = AS
    type TO_word    = TO
    type THE_word   = THE
    type PEN_word   = PEN
    type UP_word    = UP
    type DOWN_word  = DOWN
    type TIMES_word = TIMES
    type WHAT_word  = WHAT
    type DOES_word  = DOES



    type TurtleBuilder (name:string) =
        member x.Yield(()) = Seq.empty : Turtle

        [<CustomOperation("WALK", MaintainsVariableSpace = true)>]
        member x.Walk(source:Turtle, nb, unit:Distance_Unit) : Turtle=
            Seq.append source [Walk(nb, unit)]

        [<CustomOperation("==", MaintainsVariableSpace = true)>]
        member x.Op(source:Turtle, nb, unit:Distance_Unit) : Turtle=
            Seq.append source [Walk(nb, unit)]


        [<CustomOperation("TURN", MaintainsVariableSpace = true)>]
        member x.Turn(source:Turtle, nb, unit:Rotation_Unit, to_word:TO_word,
                      the_word:THE_word, direction:Rotation_Direction) : Turtle=
            Seq.append source [Turn(nb, unit, direction)]

        [<CustomOperation("LIFT", MaintainsVariableSpace = true)>]
        member x.LiftPenUp(source:Turtle, the_word:THE_word, pen_word:PEN_word,
                           up_word:UP_word) : Turtle =
            Seq.append source [LiftPenUp]

        [<CustomOperation("PUT", MaintainsVariableSpace = true)>]
        member x.PutPenDown(source:Turtle, the_word:THE_word, pen_word:PEN_word,
                            down_word:DOWN_word) : Turtle =
            Seq.append source [PutPenDown]

        [<CustomOperation("PICK", MaintainsVariableSpace = true)>]
        member x.PickColor(source:Turtle, the_word:THE_word, color:Color, pen_word:PEN_word) : Turtle =
            Seq.append source [PickColor color]

        [<CustomOperation("DO", MaintainsVariableSpace = true)>]
        member x.Do(source:Turtle, as_word:AS_word, turtle:Turtle) : Turtle =
            Seq.append source turtle

        [<CustomOperation("REPEAT", MaintainsVariableSpace = true)>]
        member x.Repeat(source:Turtle, nb:int, times_word:TIMES_word, what_word:WHAT_word,
                        turtle:Turtle, does_word:DOES_word) : Turtle =
            Seq.append source (List.replicate nb turtle |> Seq.collect id)


        static member (+) (t1:TurtleBuilder,t2:TurtleBuilder) : Turtle =
            Seq.append (t1.Yield()) (t2.Yield())

    let turtle name = new TurtleBuilder(name)

    let t1 = Seq.empty : Turtle
    let t2 = Seq.empty : Turtle

    let x n1 n2 = turtle n1  + turtle n2

    let example =
        turtle "smith"
         {
            ``==`` 4 STEPS
            LIFT THE PEN UP
            WALK 4 STEPS
            TURN 3 GRADATIONS TO THE RIGHT
            PICK THE GREEN PEN
            PUT THE PEN DOWN
            WALK 4 STEPS
        }