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.