In this series of articles, I will be documenting my process in implementing an APL in Haskell. I've been learning APL for the past year and since the first day I've been wondering how difficult it might be to write an interpreter for a simplified dialect, named TinyAPL.

In a somewhat bold choice, I decided to delay parsing until a few articles and weeks into the future. I want to start by implementing the part I'm most interested in, that is, a representation of APL arrays, functions and operators in the Haskell typesystem.

module TinyAPL where

Prerequisites

Sadly, this series can't be an introduction to Haskell, or it would become way too long. I therefore assume some level of familiarity with the language. If you need help understanding a particular topic, or you think it might be clearer, let me know! (More information at the end of the article.)

Following along

All the code in this series is written for GHC 9.6.2. ghcup should help you set that up, although I'm sure not much modification will be needed to make my code compile on later versions.

A GitHub repository is also available with all the code from this article.

Representing Arrays

TinyAPL only supports characters and (complex) numbers as scalar types, plus of course boxes.

import Data.Complex

data ScalarValue
  = Number (Complex Double)
  | Character Char
  | Box Array

I'll store arrays as a pair of shape and elements, in ravel order.

import Numeric.Natural


data Array = Array {
  arrayShape :: [Natural],
  arrayContents :: [ScalarValue]
}

Because we cannot easily require that the invariant holds, I'll implement some helper functions to construct arrays. All functions assume that the invariant holds, and won't check.

import Data.List

scalar :: ScalarValue -> Array
scalar x = Array [] [x]

vector :: [ScalarValue] -> Array
vector xs = Array [genericLength xs] xs

arrayOf :: [Natural] -> [ScalarValue] -> Maybe Array
arrayOf sh cs
  | product sh == genericLength cs = Just $ Array sh cs
  | otherwise = Nothing

arrayReshaped :: [Natural] -> [ScalarValue] -> Array
arrayReshaped sh cs = Array sh $ genericTake (product sh) $ cycle cs

Comparing Arrays

Scalars and arrays have a total ordering (ie, lawful Ord instances). While characters and boxes compare trivially, numbers are a bit harder.

Dyalog uses the formula (|X-Y) ≤ ⎕ct×X⌈⍥|Y for deciding whether X and Y compare equal, where ⎕ct is a configurable system variable with default value 1e¯14. TinyAPL will use a fixed comparison tolerance of 1e¯14.

comparisonTolerance = 1e-14


realEqual a b = abs (a - b) <= comparisonTolerance * (abs a `max` abs b)
complexEqual a b = magnitude (a - b) <= comparisonTolerance * (magnitude a `max` magnitude b)

isReal (_ :+ b) = 0 `realEqual` b 

Now that we can compare two numbers, we can implement Eq and Ord for scalars.

instance Eq ScalarValue where
  (Character a) == (Character b) = a == b
  (Box as) == (Box bs) = as == bs
  (Number a) == (Number b)
    | isReal a && isReal b = realPart a `realEqual` realPart b
    | otherwise = a `complexEqual` b
  _ == _ = False


instance Ord ScalarValue where
  (Number (ar :+ ai)) `compare` (Number (br :+ bi))
    | ar `realEqual` br && ai `realEqual` bi = EQ
    | ar `realEqual` br = ai `compare` bi
    | otherwise = ar `compare` br
  (Number _)    `compare` _             = LT
  (Character _) `compare` (Number _)    = GT
  (Character a) `compare` (Character b) = a `compare` b
  (Character _) `compare` _             = LT
  (Box as)      `compare` (Box bs)      = as `compare` bs
  (Box _)       `compare` _             = GT

And then arrays:

instance Eq Array where
  
  (Array ash as) == (Array bsh bs) = (ash, as) == (bsh, bs)

instance Ord Array where
  
  (Array ash as) `compare` (Array bsh bs) = (ash `compare` bsh) <> (as `compare` bs)

Printing Arrays

For Show instances, I'll make an auxiliary module TinyAPL.Glyphs that contains definitions for character glyphs (HLS doesn't seem to play well with Unicode characters in files).

module TinyAPL.Glyphs where
import Data.Char (chr)

negative = chr 0xaf
ravel = ','
rho = chr 0x2374
imaginary = chr 0x1d457

Implementing Dyalog-like array formatting isn't trivial, so for now we will just represent arrays as their shape and ravel.

Once again, numbers have a non-trivial Show instance, because we want to print reals without their empty complex value.

import qualified TinyAPL.Glyphs as G

isInt :: Double -> Bool
isInt = realEqual <*> (fromInteger . floor)

showReal x = let
  isNegative = x < 0
  pos = if isInt x then show $ floor $ abs x else show $ abs x
  in if isNegative then G.negative : pos else pos

showComplex (a :+ b)
  | b `realEqual` 0 = showReal a
  | otherwise = showReal a ++ (G.imaginary : showReal b)

Equipped with these helpers, we can now implement the Show instances we need.

instance Show ScalarValue where
  show (Number x) = showComplex x
  show (Character x) = [x]
  show (Box xs) = "[box " ++ show xs ++ "]"


instance Show Array where
  show (Array sh cs) =
    "{ array with " ++ [G.rho] ++ " = " ++ unwords (map show sh) ++
    " and " ++ [G.ravel] ++ " = " ++ show cs ++ " }"

Errors

As we start implementing the first functions, we will need some way to signal errors. Sticking to Haskell-style purity, instead of using something like error to throw exceptions, we'll write a type for errors and then use the Either monad.

import GHC.Stack (HasCallStack)

data Error
  = DomainError String
  | LengthError String
  | RankError String
  | NYIError String
  deriving (Show)

type Result = Either Error


unerror :: HasCallStack => Result a -> a
unerror (Right x) = x
unerror (Left e) = error $ show e

And some helper functions:

err :: Error -> Result a
err = Left

asNumber :: Error -> ScalarValue -> Result (Complex Double)
asNumber _ (Number x) = pure x
asNumber e _ = err e

asReal :: Error -> Complex Double -> Result Double
asReal e x
  | isReal x = pure $ realPart x
  | otherwise = err e

asInt' :: Integral num => Error -> Double -> Result num
asInt' e x
  | isInt x = pure $ fromInteger $ floor x
  | otherwise = err e

asInt :: Integral num => Error -> Complex Double -> Result num
asInt e = asInt' e <=< asReal e

asNat' :: Integral num => Error -> num -> Result Natural
asNat' e x
  | x >= 0 = pure $ toEnum $ fromEnum x
  | otherwise = err e

asNat :: Error -> Complex Double -> Result Natural
asNat e = asNat' e <=< asInt e

isScalar :: Array -> Bool
isScalar (Array [] _) = True
isScalar _ = False

asScalar :: Error -> Array -> Result ScalarValue
asScalar _ (Array _ [x]) = pure x
asScalar e _ = err e

Scalar functions

A scalar function is one that operates on each element of one or two arrays.

Scalar monads are easy to implement, we just need to map the function on each item of the array, remembering to fail if the mapping function fails, which is exactly what mapM does.

scalarMonad ::
  (ScalarValue -> Result ScalarValue)
      -> Array -> Result Array
scalarMonad f (Array sh cs) = Array sh <$> mapM f' cs where
  f' (Box xs) = Box <$> scalarMonad f xs
  f' x = f x

Dyads are somewhat more complicated because of how different shapes interact. TinyAPL only supports scalar + scalar, scalar + array, array + scalar, and array + array where the shapes of the two arrays are equivalent.

import Control.Monad

scalarDyad ::
  (ScalarValue -> ScalarValue -> Result ScalarValue)
      -> Array ->       Array -> Result Array
scalarDyad f a@(Array ash as) b@(Array bsh bs)
  | isScalar a && isScalar b = let ([a'], [b']) = (as, bs) in scalar <$> f' a' b'
  | isScalar a = let [a'] = as in Array bsh <$> mapM (a' `f'`) bs
  | isScalar b = let [b'] = bs in Array (arrayShape a) <$> mapM (`f'` b') (arrayContents a)
  | arrayShape a == arrayShape b =
    Array (arrayShape a) <$> zipWithM f' (arrayContents a) (arrayContents b)
  | otherwise = err $ DomainError "Mismatched left and right argument shapes"
  where
    f' (Box as) (Box bs) = Box <$> scalarDyad f as bs
    f' (Box as) b = Box <$> scalarDyad f as (scalar b)
    f' a (Box bs) = Box <$> scalarDyad f (scalar a) bs
    f' a b = f a b

Array instances

To end this off, let's define some class instances on Arrays that make use of scalarMonad/scalarDyad (and, sadly, unerror).

As usual, first a few helpers:

(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:) f g a b = f $ g a b

monadN2N f = scalarMonad f' where
  f' x = do
    x' <- flip asNumber x $ DomainError ""
    Number <$> f x'

monadN2N' = monadN2N . (pure .)

dyadNN2N f = scalarDyad f' where
  f' a b = do
    a' <- flip asNumber a $ DomainError ""
    b' <- flip asNumber b $ DomainError ""
    Number <$> f a' b'

dyadNN2N' = dyadNN2N . (pure .:)

We can now implement Num and friends for Arrays.

instance Num Array where
  (+) = unerror .: dyadNN2N' (+)
  (-) = unerror .: dyadNN2N' (-)
  (*) = unerror .: dyadNN2N' (*)
  abs = unerror . monadN2N' abs
  signum = unerror . monadN2N' signum
  fromInteger = scalar . Number . fromInteger

instance Fractional Array where
  recip = unerror . monadN2N (\case
    0 -> err $ DomainError "Divide by zero"
    x -> pure $ recip x)
  (/) = unerror .: dyadNN2N (\cases
    0 0 -> pure 1
    _ 0 -> err $ DomainError "Divide by zero"
    x y -> pure $ x / y)
  fromRational = scalar . Number . fromRational

instance Floating Array where
  pi = scalar $ Number pi
  exp = unerror . monadN2N' exp
  log = unerror . monadN2N (\case
    0 -> err $ DomainError "Logarithm of zero"
    x -> pure $ log x)
  sin = unerror . monadN2N' sin
  cos = unerror . monadN2N' cos
  tan = unerror . monadN2N' tan
  asin = unerror . monadN2N' asin
  acos = unerror . monadN2N' acos
  atan = unerror . monadN2N' atan
  sinh = unerror . monadN2N' sinh
  cosh = unerror . monadN2N' cosh
  tanh = unerror . monadN2N' tanh
  asinh = unerror . monadN2N' asinh
  acosh = unerror . monadN2N' acosh
  atanh = unerror . monadN2N' atanh

Conclusion

I think this is more than enough work for today.

If you have any suggestions, questions, or just want to chat, reach out to me! I spend most of my time taggable on the APL Orchard, so tag @RubenVerg there. If the conversation becomes too off-topic, I'll find another way for us to keep talking :)