Bootstrapping

Let us create a cabal project:

$ cabal init --simple -p forth --cabal-version=3.4 \
           --language=GHC2021 --libandexe --tests \
           --test-dir=test forth

Now, let’s open a new file, src/StateMachine.hs, and make it a module with the following line:

module StateMachine where

Because we need a proper datatype to represent Forth’s execution model, I chose to implement it with a Linked List-based stack.

import Data.List qualified as List

newtype Stack = Stack {getStack :: [Integer]}
  deriving newtype (Show, Eq)

What the above lines mean is that we create a newtype, a wrapper around [Integer], with a constructor named Stack, and an accessor function called getStack. The deriving newtype line allows us to inherit the Show and Eq instances of the underlying type instead of the wrapper’s instances.

So what would an empty stack look like? Like this:

initStack :: Stack
initStack = Stack List.empty

We now need a function that will “process”, so to speak, the different operations we receive from our input:

process :: Stack -> Text -> Stack
process stack "+" = add
process stack "-" = sub
process stack a   = push item stack
  where
    item = parseInt a

The process function is a pure function that carries its state, the stack argument, with it. We pattern-match on defined keywords and operators of the language, and call the appropriate functions each time. The catch-all case at the bottom is there to grab numerical elements from our input and simply push them on the stack, which we will then return.

That being said, we also need a couple of helpers. The first one is parseInt . We have encountered it in the above where-clause.
The core of its definition relies on the decimal function from Data.Text.Read, as well as pack from Data.Text.

import Data.Text.Read (decimal)
import Data.Text (pack)

-- […]

parseInt :: Text -> Integer
parseInt a = either (error . pack) fst (decimal a)

However, this one-liner may be quite incomprehensible. Here is how we can rewrite this function:

parseInt a = 
  case decimal a of
    Right result -> fst result
    Left  errorMsg -> error $ pack errorMsg

decimal has the following type: Text -> Either String (Integer, Text), which means it can either return an error message in its Left parameter (String), or return a tuple of (Integer, Text) when parsing succeeds. The Text part of the tuple is used if and only if the number you intend to parse is followed with non-numerical characters. In practice, this translates to:

λ❯ decimal "32ee" :: Either String (Integer, Text)
Right (32,"ee")

Hence the use of fst on that result. We simply do not care about the second part, only about the integer.

Now, you may be wondering about the use of error . It doesn’t really return an integer, does it? Should it? Well, the thing about this function is that it will return whatever type you ask of it, because it will stop the execution of the program.
Terribly unsafe from a types perspective, morally digusting, but we are going to need it.

At that point, here’s what our file looks like:

module StateMachine where

import Data.Text (pack)
import Data.Text.Read (decimal)
import Data.List (List)
import qualified Data.List as List

newtype Stack = Stack {getStack :: [Integer]}
  deriving newtype (Show, Eq)

initStack :: Stack
initStack = Stack []

process :: Stack -> Text -> Stack
process stack "+" = add stack
process stack "-" = sub stack
process stack a  = push item stack
  where
    item = parseInt a

parseInt :: Text -> Integer
parseInt a = either (error . pack) fst (decimal a)
-- Equivalent to
-- parseInt = case parseInt a of
--           Right result   -> fst result
--           Left  errorMsg -> error $ pack errorMsg
-- 
-- either :: (a -> c) -> (b -> c) -> Either a b -> c
--            ^^^^^^      ^^^^^^     ^^^^^^^^^^
--              │            │            │  
--       this function   this function  The value
--       is called on    is called on   to be tested
--       the value in    the value in
--       the `Left`      the `Right`

Addition, subtraction

The next step is to implement the basics of stack manipulation.

The first function, push, is implemented as a cons operation:

push :: Integer -> Stack -> Stack
push item stack = item : stack

Its famous counterpart pop will not be implemented yet.

Then, let’s take care of addition:

add :: Stack -> Stack
add stack =
  if checkSize 2 stack
  then
    let (elems, newStack) = List.splitAt 2 (getStack stack)
        result = sum elems
     in push result (Stack newStack)
  else
    error "Stack underflow!"

Which brings us to our next helper: checkSize.

checkSize :: Int -> Stack -> Bool
checkSize requiredSize stack =
  (length (getStack stack)) >= requiredSize

Fundamentally, we need to be sure that the operation we make is safe at the stack level.

Now that we have all the cards, let’s combine them. First, with the help of List.splitAt , we grab a 2-tuple of lists. The first one supposedly contains the first two elements, and the second one has the rest of the stack in it.

With the help of checkSize , we then make sure to only proceed to the actual sum if and only if the first list, elems, has two elements. And finally, we push the result to the stack.

The subtraction function is similar in intent:

sub :: Stack -> Stack
sub stack =
  if checkSize 2 stack
  then
    let (elems, newStack) = List.splitAt 2 (getStack stack)
        result = sub' $ List.reverse elems
        sub' = List.foldl1 (-)
     in push result (Stack newStack)
  else
    error "Stack underflow!"

With the slight difference that we define our own subtraction function, and we reverse the list beforehand so we get a correct result.

foldl1 iterates over a container and applies the supplied function ((-)) over those elements while keeping an accumulator. By convention, the 1 suffix tells us that we do not need to supply a initial accumulator to the recursive function, assuming a non-empty container to start with.

So far, we implemented addition and subtraction. Their definion were a bit convoluted, unnessarily even, due to a lack of a better abstraction. But be patient.
In part 02, we will explore more traditional Forth operations, such as duplication, drop, and rotation, amongst others.