Share via

Going “Retro” and Loving It!

  • Article

Continuing my concatenative language kick, I’ve been having fun playing with Retro (https://www.retroforth.com) and couldn’t resist making an F#-based VM on which to run it. It is an elegant, minimal Forth with an important twist. What caught my eye is that it supports quotations and combinators much like Joy, Cat, Factor, ... I may have to add this to TransForth, and I may have to do a follow up post to “Programming is Pointless” showing off the beauty of quotations and combinators in a pure composition-based world.

Stop Thinking About the Stack

Quotations allow you to push anonymous functions to the stack and combinators are words taking functions as input. Here’s just one example (in Factor, taken from Aaron Schaefer’s blog) of how they change the flavor of your code. To find the average of a sequence of numbers we could:
 

{ 1 2 3 } dup sum swap length / .
  

Push a list of numbers, dup the list so that we can sum one copy, then swap and get the length of the other. Finally divide the sum by the length and display the result. This works fine, but with stack shuffling words like dup and swap, you have to keep the stack in mind. I would rather put that out of my mind and more directly express the intent:
 

{ 1 2 3 } [ sum ] [ length ] bi / .

The square brackets delimit quotations, treated as data. Here they contain single words but could just as easily contain longer sequences; something like anonymous functions. The bi word then consumes the list of numbers and the two quotations, applying each quotation to the list, leaving the sum and length to be consumed by / . This isn’t necessarily more concise, but it is certainly more direct without any stack juggling.

The Ngaro VM (in F#)

Retro runs on a tiny VM called Ngaro which has been ported to a growing list of languages and platforms – C, Python, Ruby, ANS Forth, C#, Common Lisp, Go, Java, Lua, Perl, Javascript, .... Missing from the list was F# (and as for .NET in general, the C# version was incomplete). I went ahead and made my own implementation (below) and submitted it back to the project. I like that for concision, the only implementation that beats this F# one is the one in Lisp – only slightly and it’s lacking file I/O features :-)

To use it, just grab the latest retroImage and drop it in the same directory. Like any respectable Forth, Retro is written in Retro of course and can compile itself. You can grab the source (core.rx) in the latest release, make tweaks and run the VM below “--with core.rx” to compile a new image. There are lots of interesting samples and libraries as well. Have fun!
 

open System

open System.IO

open System.Text

let MEM_SIZE = 1024 * 1024

let IMAGE_FILE = "retroImage"

let MAX_OPEN_FILES = 8

let PORTS = 12

letmutable ip = 0

letmutable ports = Array.create PORTS 0

letmutable inputs = Array.create PORTS ""

letmutable memory = Array.create MEM_SIZE 0

letmutable (files : FileStream[]) = Array.create MAX_OPEN_FILES null

letmutable isp = 0

letmutable offset = 0

letmutable shrink = false

letmutable halt = false

let data = ref []

let address = ref []

let pushVal d x = d := x :: !d

let popVal d () = match !d with h :: t -> d := t; h | _ -> failwith "Underflow"

let push = pushVal data

let pushr = pushVal address

let pop = popVal data

let popr = popVal address

let tos () = (!data).Head

let load() =

    use binReader = new BinaryReader(File.Open(IMAGE_FILE, FileMode.Open))

    for i in 0 .. int (binReader.BaseStream.Length / 4L) - 1 do

        memory.[i] <- binReader.ReadInt32()

let saveImage () =

    let j = if shrink then memory.[3] else MEM_SIZE

    use binWriter = new BinaryWriter(File.Open(IMAGE_FILE, FileMode.Create))

    Array.iter (fun (c : int) -> binWriter.Write(c)) memory.[0..j - 1]

let key () =

    if isp > 0 && offset = inputs.[isp].Length - 1 then// Next input source?

        isp <- isp - 1

        offset <- 0

    if isp > 0 then// Read from a file

        offset <- offset + 1

        int inputs.[isp].[offset]

    else// Read from Console

        let cki = Console.ReadKey(true)

        if cki.Key = ConsoleKey.Backspace then printf "\b "

        int cki.KeyChar

let devices () =

    let getString () =

        let s = pop ()

        let e = Array.FindIndex(memory, s, fun c -> c = 0)

        new String(Array.map char memory.[s .. e - 1])

    let openFile () =

        let handle = Array.findIndex ((=) null) files |> ((+) 1)

        let mode, name = pop (), getString ()

        try

            match mode with

            | 0 -> files.[handle] <- File.Open(name, FileMode.Open)

            | 1 -> files.[handle] <- File.Open(name, FileMode.OpenOrCreate)

       | 2 -> files.[handle] <- File.Open(name, FileMode.Append)

            | 3 ->let f = File.Open(name, FileMode.Open)

                   f.Seek(0L, SeekOrigin.End) |> ignore

                   files.[handle] <- f

            | _ -> failwith "Invalid mode"

            handle

        with _ -> 0

    let readFile h =

        let c = files.[h].ReadByte()

        if c = -1 then 0 else c

    let writeFile h = pop () |> byte |> files.[h].WriteByte; 1

    let closeFile h =

        let f = files.[h]

        if f <> nullthen

            f.Close()

f.Dispose()

            files.[h] <- null

        0

let getFilePos h = int files.[h].Position

    let setFilePos h = files.[h].Seek(pop () |> int64, SeekOrigin.Begin) |> int

    let getFileSize handle = files.[handle].Length |> int

    let deleteFile name = if File.Exists name then File.Delete name; -1 else 0

    if ports.[0] <> 1 then

        ports.[0] <- 1

        if ports.[1] = 1 then ports.[1] <- key () // Read from input source

        if ports.[2] = 1 then

            let x = pop ()

            if x < 0 then Console.Clear()

            else Console.Write(char x)

            ports.[2] <- 0

        if ports.[3] = 1 then ports.[3] <- 0 // Video update

        match ports.[4] with

        | 1 -> saveImage () ; ports.[4] <- 0 // Save Image

        | 2 ->// Add to Input Stack

            isp <- isp + 1

            inputs.[isp] <- System.IO.File.ReadAllText(getString ())

            ports.[4] <- 0

        | -1 -> ports.[4] <- openFile ()

       | -2 -> ports.[4] <- pop () |> readFile

        | -3 -> ports.[4] <- pop () |> writeFile

        | -4 -> ports.[4] <- pop () |> closeFile

| -5 -> ports.[4] <- pop () |> getFilePos

        | -6 -> ports.[4] <- pop () |> setFilePos

| -7 -> ports.[4] <- pop () |> getFileSize

        | -8 -> ports.[4] <- getString () |> deleteFile

        | _ -> ports.[4] <- 0

        ports.[5] <- match ports.[5] with// Capabilities

            | -1 -> MEM_SIZE

            | -5 -> (!data).Length // stack depth

            | -6 -> (!address).Length // address stack depth

            | -8 -> int (DateTime.UtcNow - new DateTime(1970,1,1)).TotalSeconds

            | -9 -> halt <- true; 0

            | -10 ->// Query for environment variable

                let var = getString ()

                let name = ref (pop ())

                Array.iter (fun element ->

                    memory.[name.Value] <- int element

                    name := name.Value + 1)

                    (var |> Environment.GetEnvironmentVariable

                         |> Encoding.ASCII.GetBytes)

                0

            | -11 -> Console.WindowWidth

            | -12 -> Console.WindowHeight

            | _ -> 0

letrec exec () =

    let dyadic fn = let x = pop () in fn (pop ()) x |> push

    let dyadic2 fn = let x, y = fn (pop ()) (pop ()) in push y; push x

    let incIp () = ip <- ip + 1

    let condJump fn =

        let x = pop ()

        if fn (pop ()) x then ip <- memory.[ip + 1] - 1 else incIp ()

    let jump () =

        ip <- memory.[ip] - 1

        if memory.[ip + 1] = 0 then incIp ()

        if memory.[ip + 1] = 0 then incIp ()

    let drop () = pop () |> ignore

    let loop () =

        pop () - 1 |> push

        if tos () > 0 then ip <- memory.[ip + 1] - 1

        else incIp (); drop ()

    if not halt then

        match memory.[ip] with

            | 0 -> () // NOP

            | 1 -> incIp (); memory.[ip] |> push // LIT

            | 2 -> tos () |> push // DUP

    | 3 -> drop () // DROP

            | 4 -> dyadic2 (fun x y -> y, x) // SWAP

            | 5 -> pop () |> pushr // PUSH

            | 6 -> popr () |> push // POP

            | 7 -> loop () // LOOP

            | 8 -> incIp (); jump () // JUMP

            | 9 -> ip <- popr () // RETURN

            | 10 -> condJump (>) // GT_JUMP

            | 11 -> condJump (<) // LT_JUMP

            | 12 -> condJump (<>) // NE_JUMP

            | 13 -> condJump (=) // EQ_JUMP

            | 14 -> memory.[pop ()] |> push // FETCH

            | 15 -> memory.[pop ()] <- pop () // STORE

            | 16 -> dyadic (+) // ADD

            | 17 -> dyadic (-) // SUB

            | 18 -> dyadic (*) // MUL

| 19 -> dyadic2 (fun x y -> y / x, y % x) // DIVMOD

| 20 -> dyadic (&&&) // AND

            | 21 -> dyadic (|||) // OR

            | 22 -> dyadic (^^^) // XOR

            | 23 -> dyadic (<<<) // SHL

            | 24 -> dyadic (>>>) // SHR

            | 25 ->if tos () = 0 then drop (); ip <- popr () // ZERO_EXIT

            | 26 -> pop () + 1 |> push // INC

            | 27 -> pop () - 1 |> push // DEC

            | 28 ->let x = pop () in ports.[x] |> push; ports.[x] <- 0 // IN

            | 29 -> ports.[pop ()] <- pop () // OUT

            | 30 -> devices () // WAIT

            | _ -> pushr ip; jump ()

        ip <- ip + 1

        exec ()

let args = Environment.GetCommandLineArgs()

Array.iteri

    (fun i arg ->

        match arg with

        | "--shrink"-> shrink <- true

        | "--about"-> printfn "Retro Language [VM: F#, .NET]"

        | "--with"->

            isp <- isp + 1

            inputs.[isp] <- File.ReadAllText(args.[i + 1])

        | _ -> ()

    ) args

load ()

exec ()

Comments

  • Anonymous
    August 16, 2011
    Huge thanks.