Factor in Haskell - Introduction and simple functions

Nearly 3 years ago, I was in a team that was practicing collective technological scanning.

Every month or so, someone came with a topic, and the whole team discussed it or practiced it.

Note: I think every team should do it; it strengthens team bonds and improves creativity.My CTO at the time came with the factor programming language, which is a concatenative, stack-based programming language.

• Stack-based: every primitive is designed around a stack, which grows and shrinks depending on the operation
• Concatenative: all expressions are functions; chaining them is composition (e.g., 42 f g h is equivalent to h(g(f(42)))).I do not truly enjoy them as, in my opinion, it is pushing temporal coupling to its maximum: the stack should be really well structured to have a working program.

As we did for Prolog, we will implement a subset in Haskell.

Note: I have used this and this to learn factor

Unlike factor, I want to have a statically typed stack. Given that Haskell lists are homogeneous, we have to define an indexed stack defined as follows:

data Stack (as :: [Type]) :: Type where
  EmptyStack :: Stack '[]
  (:*) :: n -> Stack ns -> Stack (n ': ns)

infixr 4 :*

Since we will use tests, we have to define Eq and Show instances, starting with Eq, as follows:

instance Eq (Stack '[]) where
  EmptyStack == EmptyStack = True

instance (Eq x, Eq (Stack xs)) => Eq (Stack (x ': xs)) where
  (x :* xs) == (y :* ys) = x == y && xs == ys

This is the great thing with indexed types: we can define distinct instances, which allows us to define instance-by-constructor, making mistakes difficult to do.

The next one is Show, it takes a bit more work, as we want to represent the stack as it is done in factor, from right to left, as follows:

instance Show (Stack '[]) where
  showsPrec _ EmptyStack = id

instance (Show x, Show (Stack xs)) => Show (Stack (x ': xs)) where
  showsPrec d (x :* xs) = showsPrec d xs . showString " " . showsPrec (d + 1) x

-- >>> show (True :* 2 :* 1 :* EmptyStack)
-- 1 2 True

Then, we can add the following helpers to keep the factor's order, as follows:

(%) :: (a -> b) -> (b -> c) -> a -> c
(%) = flip (.)

infixr 9 %

(.%) :: (Stack '[] -> Stack xs) -> (Stack xs -> Stack ys) -> Stack ys
(.%) f g = g $ f EmptyStack

infixr 9 .%

push_ :: a -> Stack xs -> Stack (a ': xs)
push_ = (:*)

-- it "push" $
--   (push_ 1 .% push_ 2 % push_ True) `shouldBe` (True :* 2 :* 1 :* EmptyStack)

The next step is to come up with functions manipulating the stack; the most trivial is drop, removing the top of the stack, defined as follows:

drop_ :: Stack (x ': xs) -> Stack xs
drop_ (_ :* xs) = xs

-- it "drop" $
--   (push_ 1 .% push_ 2 % drop_) `shouldBe` (1 :* EmptyStack)

To generalize over this, we may want to have functions of arbitrary inputs/outputs applied to the stack, for example, minus ((-)) taking two values and adding one, as follows:

app_ :: (a -> b -> c) -> Stack (a ': b ': xs) -> Stack (c ': xs)
app_ f (x :* y :* xs) = f x y :* xs

-- it "app" $
--   (push_ 1 .% push_ 2 % app_ (-)) `shouldBe` (1 :* EmptyStack)

It is a combinatory trap; we should create as many combinations as functions input/output sizes, as follows:

app11_ :: (a -> b) -> Stack (a ': xs) -> Stack (b ': xs)
app11_ f (x :* xs) = f x :* xs

app12_ :: (a -> (b, c)) -> Stack (a ': xs) -> Stack (b ': c ': xs)
app12_ f (x :* xs) = let (b, c) = f x in b :* c :* xs

app21_ :: (a -> b -> c) -> Stack (a ': b ': xs) -> Stack (c ': xs)
app21_ f (x :* y :* xs) = f x y :* xs

app22_ :: (a -> b -> (c, d)) -> Stack (a ': b ': xs) -> Stack (c ': d ': xs)
app22_ f (x :* y :* xs) = let (c, d) = f x y in c :* d :* xs

We can leverage those in other functions, such as dup, which duplicate the top value, as follows:

dup_ :: Stack (x ': xs) -> Stack (x ': x ': xs)
dup_ = app12_ $ \x -> (x, x)

-- it "dup" $
--   (push_ 1 .% dup_) `shouldBe` (1 :* 1 :* EmptyStack)

Or swap, which swaps the first and second values from the top, as follows:

swap_ :: Stack (x ': y ': xs) -> Stack (y ': x ': xs)
swap_ = app22_ $ \x y -> (y, x)

-- it "swap" $
--   (push_ 1 .% push_ 2 % swap_) `shouldBe` (1 :* 2 :* EmptyStack)

Next week, we will study more advanced functions and structures, such as quotations.