Back to Index Page

# TinyAPL part 1: Introduction & Arrays

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

-- Invariant: length (arrayContents arr) == product (arrayShape arr)
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 -- We need two functions, because abs on a Complex Double returns another Complex Double which isn't comparable. 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 -- A number is real if its imaginary part compares equal to zero.  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 {- Order: * numbers, in lexicographical order (real then imaginary) * characters, in codepoint order * boxes, ordered by their contents -} 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 -- Two arrays are equal iff both their shapes and their ravels are equal. (Array ash as) == (Array bsh bs) = (ash, as) == (bsh, bs) instance Ord Array where -- Arrays are ordered by shape and then contents (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 ++ "]"

-- We'll implement proper array formatting later.
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

(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:

-- Equivalent of APL's Atop called as a dyad.
-- The name (.:) for this function is standard in Haskell.
(.:) :: (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'



We can now implement Num and friends for Arrays.

{-# LANGUAGE LambdaCase #-}

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 :)