## Write a Forth in Haskell: Part 01

## Bootstrapping

First, let’s bootstrap a stack project. I am using my custom stack template, ultimaskell, which uses the alternative prelude Relude, by the fantastic people at Kowainik, as well as some convenient language extensions.

```
stack new farth https://glitchbra.in/ultimaskell.hsfiles
```

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 Vector-based stack.

```
import Data.Vector (Vector)
import qualified Data.Vector as V
newtype Stack = Stack {getStack :: Vector Integer}
deriving newtype (Show, Eq)
```

What the last lines means is that we create a new type, a wrapper around
`Vector Integer`

, with a constructor aptly named `Stack`

, and an accessor function
called `getStack`

.
The `deriving newtype`

line allows us to have a `Show`

and `Eq`

instance that
will use the underlying type (in our case, `Vector Integer`

) instead of the wrapper.

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

```
initStack :: Stack
initStack = Stack V.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 write 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 (
module StateMachine -- We export the whole module
)
import Data.Text (pack)
import Data.Text.Read (decimal)
import Data.Vector (Vector)
import qualified Data.Vector as V
newtype Stack = Stack {getStack :: Vector Integer}
deriving newtype (Show, Eq)
initStack :: Stack
initStack = Stack V.empty
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 = V.cons 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) = V.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. Size-indexed vectors do require a higher level of type-level programming than the one that is required to read this series, and we will have to make do with runtime checks.

Now that we have all the cards, let’s combine them.
First, with the help of
`V.splitAt`

, we grab a 2-tuple of vectors. 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 vector, `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) = V.splitAt 2 (getStack stack)
result = sub' $ V.reverse elems
sub' = 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 vector 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.

You need to import that function from `Data.Foldable`

:

```
import Data.Foldable (foldl1)
```

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.