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
-- sadly we need this.
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:
-- 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'
dyadNN2N' = dyadNN2N . (pure .:)
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 :)