TinyAPL part 1: Introduction and Arrays

4 months ago 22

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

Read Entire Article