In this post, I add array notation to TinyAPL, as well as reductions, scans, and a few other primitives.

As usual, code from this post is available in a GitHub repository

## Array Notation

The most signifcant change for this post is the introduction of APL Array Notation, which introduces syntax for vectors using `⟨⋄⟩`

and higher-rank arrays (built from major cells) using `[⋄]`

.

First, functions to convert between arrays and scalars:

```
fromScalar :: ScalarValue -> Array
fromScalar (Box arr) = arr
fromScalar sc = scalar sc
toScalar :: Array -> ScalarValue
toScalar (Array [] [x]) = x
toScalar arr = box arr
```

Next, tokens for vectors and high-rank arrays:

```
data Token
-- ...
| TokenVector [[Token]] SourcePos
| TokenHighRank [[Token]] SourcePos
tokenPos (TokenVector _ pos) = pos
tokenPos (TokenHighRank _ pos) = pos
```

Tokenization for array notation:

```
array = between spaces spaces (try number <|> try charVec <|> try str <|> try arrayAssign <|> try (withPos $ TokenArrayName <$> arrayName) <|> try vectorNotation <|> try highRankNotation <|> primArray) where
vectorNotation :: Parser Token
vectorNotation = withPos $ between (char $ fst G.vector) (char $ snd G.vector) (TokenVector <$> sepBy bits separator)
highRankNotation :: Parser Token
highRankNotation = withPos $ between (char $ fst G.highRank) (char $ snd G.highRank) (TokenHighRank <$> sepBy bits separator)
```

Binding, with two new `Tree`

s:

```
| VectorBranch { vectorEntries :: [Tree] }
| HighRankBranch { highRankEntries :: [Tree] }
(VectorBranch es) -> (indent ++ "⟨⟩") : concatMap (go (i + 1)) es
(HighRankBranch es) -> (indent ++ "[]") : concatMap (go (i + 1)) es
treeCategory (VectorBranch _) = CatArray
treeCategory (HighRankBranch _) = CatArray
tokenToTree (TokenVector es pos) = array VectorBranch es pos
tokenToTree (TokenHighRank es pos) = array HighRankBranch es pos
array :: ([Tree] -> Tree) -> [[Token]] -> SourcePos -> Result Tree
array t es _ = t <$> mapM (\x -> categorizeAndBind x >>=
requireOfCategory CatArray (\c -> makeSyntaxError (tokenPos $ head x) source $ "Invalid array entry of type " ++ show c ++ ", array required")) es
```

Interpreting array notation:

```
eval (VectorBranch es) = do
entries <- mapM (eval >=> unwrapArray (DomainError "Array notation entries must be arrays")) es
return $ VArray $ vector $ toScalar <$> entries
eval (HighRankBranch es) = do
entries <- mapM (eval >=> unwrapArray (DomainError "Array notation entries must be arrays")) es
return $ VArray $ fromMajorCells entries
```

Lastly, array notation is documented in the REPL:

```
putStrLn $ "* array notation: " ++ [fst G.vector, G.separator, snd G.vector] ++ " vector, " ++ [fst G.highRank, G.separator, snd G.highRank] ++ " higher rank array (combine major cells)"
```

## Reduce and Scan

Reduce and Scan use these glyphs, suggested by Adám on the APL Orchard:

`⤈`

for (first-axis) reduce-down (left-to-right function application)`⤉`

for (first-axis) reduce-up (right-to-left function application, like standard Reduce in APL)`⇟`

for (first-axis) scan-down on prefixes (left-to-right function application)`⇞`

for (first-axis) scan-up on suffixes (right-to-left function application)

```
reduceDown = Adverb
{ adverbRepr = [G.reduceDown]
, adverbOnArray = Nothing
, adverbOnFunction = Just $ \f -> pure $ ReduceDown f }
reduceUp = Adverb
{ adverbRepr = [G.reduceUp]
, adverbOnArray = Nothing
, adverbOnFunction = Just $ \f -> pure $ ReduceUp f }
scanDown = Adverb
{ adverbRepr = [G.scanDown]
, adverbOnArray = Nothing
, adverbOnFunction = Just $ \f -> pure $ ScanDown f }
scanUp = Adverb
{ adverbRepr = [G.scanUp]
, adverbOnArray = Nothing
, adverbOnFunction = Just $ \f -> pure $ ScanUp f }
```

And the actual implementations of the operators, as usual implemented as cases to `callMonad`

and `callDyad`

:

```
data Function
| ReduceDown { reduceDownFunction :: Function }
| ReduceUp { reduceUpFunction :: Function }
| ScanDown { scanDownFunction :: Function }
| ScanUp { scanUpFunction :: Function }
```

```
show (ReduceDown f) = "(" ++ show f ++ [')', G.reduceDown]
show (ReduceUp f) = "(" ++ show f ++ [')', G.reduceUp]
show (ScanDown f) = "(" ++ show f ++ [')', G.scanDown]
show (ScanUp f) = "(" ++ show f ++ [')', G.scanUp]
```

Reduce down is a `foldl1`

:

```
callMonad (ReduceDown f) xs = do
let go :: [Array] -> St Array
go [] = throwError $ DomainError "Reduce empty axis"
go [x] = return x
go (a : b : xs) = do
x <- callDyad f a b
go $ x : xs
go $ majorCells xs
```

And reduce up is a `foldr1`

:

```
callMonad (ReduceUp f) xs = do
let go :: [Array] -> St Array
go [] = throwError $ DomainError "Reduce empty axis"
go [x] = return x
go (x : xs) = do
y <- go xs
callDyad f x y
go $ majorCells xs
```

Scans are applications of the corresponding Reduce on prefixes and suffixes:

```
callMonad (ScanDown f) xs = do
if isScalar xs then return xs
else fromMajorCells <$> mapM (callMonad (ReduceDown f) . fromMajorCells) (prefixes $ majorCells xs)
callMonad (ScanUp f) xs = do
if isScalar xs then return xs
else fromMajorCells <$> mapM (callMonad (ReduceUp f) . fromMajorCells) (suffixes $ majorCells xs)
```

These use the prefixes and suffixes functions from `Util`

:

```
prefixes :: [a] -> [[a]]
prefixes [] = []
prefixes (x:xs) = [x] : ((x :) <$> prefixes xs)
suffixes :: [a] -> [[a]]
suffixes = map reverse . prefixes . reverse
```

```
callDyad (ReduceDown _) _ _ = throwError $ NYIError "Windowed reduce not implemented yet"
callDyad (ReduceUp _) _ _ = throwError $ NYIError "Windowed reduce not implemented yet"
callDyad (ScanDown _) _ _ = throwError $ DomainError "Dyadic scan"
callDyad (ScanUp _) _ _ = throwError $ DomainError "Dyadic scan"
```

## Rotate

Rotate is very similar to Take and Drop:

```
-- as argument to reverse = pureFunction
Just $ \r arr -> let
rotate c
| c < 0 = List.reverse . rotate (negate c) . List.reverse
| c == 0 = id
| otherwise = \case
[] -> []
(x : xs) -> rotate (c - 1) (xs ++ [x])
go [] xs = xs
go (d:ds) xs = fromMajorCells $ rotate d $ go ds <$> majorCells xs
mustBeIntegral = DomainError "Rotate left argument must be integral"
in do
rs <- asVector (RankError "Rotate left argument must be a vector") r >>= mapM (asNumber mustBeIntegral >=> asInt mustBeIntegral)
pure $ go rs arr
```

## Replicate

Simple function which checks that the lengths match and then calls `genericReplicate`

on each major cell.

```
replicate = pureFunction Nothing (Just $ \r arr -> do
let error = DomainError "Replicate left argument must be a natural vector"
rs <- asVector error r >>= mapM (asNumber error >=> asNat error)
let cells = majorCells arr
if length rs /= length cells then err $ LengthError "Replicate: different lengths in left and right argument"
else return $ fromMajorCells $ concat $ zipWith genericReplicate rs cells) [G.replicate]
```

## Number Functions

First, Magnitude and Remainder:

```
abs = pureFunction (Just $ monadN2N' Prelude.abs) (Just $ dyadNN2N $ \x y ->
if x == 0 then err $ DomainError "Remainder by zero"
else return $ y - (fromInteger (Prelude.floor $ realPart $ y / x) :+ fromInteger (Prelude.floor $ imagPart $ y / x)) * x) [G.abs]
```

Remainder is implemented with complex floating point floored modulo.

I added three functions that work with complex number: Phase `∡`

, Real Part `ℜ`

and Imaginary Part `ℑ`

. Dyadically I decided to give the meaning of "set phase"/"set real part"/"set imaginary part".

Dyadic Phase takes the magnitude from the left argument and the phase from the right argument:

```
phase = pureFunction (Just $ monadN2N' $ \x -> Data.Complex.phase x :+ 0) (Just $ dyadNN2N' $ \x y -> Prelude.abs x * exp (0 :+ Data.Complex.phase y)) [G.phase]
```

Dyadic Real Part takes the imaginary part from the left argument and the real part from the right argument:

```
real = pureFunction (Just $ monadN2N' $ \x -> realPart x :+ 0) (Just $ dyadNN2N' $ \x y -> realPart y :+ imagPart x) [G.real]
```

Dyadic Imaginary Part takes the real part from the left argument and the imaginary part from the right argument:

```
imag = pureFunction (Just $ monadN2N' $ \x -> imagPart x :+ 0) (Just $ dyadNN2N' $ \x y -> realPart x :+ imagPart y) [G.imag]
```

## Set Functions

The last functions added in this post are set functions: Unique `∪`

, Union `∪`

, Intersection `∩`

, Difference `~`

, Symmetric Difference `§`

and Nub Sieve `≠`

.

Nub sieve marks whether the index of an element is the same as the first index of that element:

```
-- as argument to notEqual = pureFunction
Just $ \x -> do
let cells = majorCells x
return $ vector $ (\(c, idx) -> boolToScalar $ fromJust (c `elemIndex` cells) == idx) <$> zip cells [0..]
```

The other set functions are straightforwardly implemented following their spec.

```
union = pureFunction (Just $ return . fromMajorCells . List.nub . majorCells) (Just $ \x y ->
return $ fromMajorCells $ majorCells x ++ filter (not . (`elem` majorCells x)) (majorCells y)) [G.union]
intersection = pureFunction Nothing (Just $ \x y -> return $ fromMajorCells $ filter (`elem` majorCells y) $ majorCells x) [G.intersection]
difference = pureFunction (Just $ monadN2N' (1 -)) (Just $ \x y -> return $ fromMajorCells $ filter (not . (`elem` majorCells y)) $ majorCells x) [G.difference]
symdiff = pureFunction Nothing (Just $ \x y ->
return $ fromMajorCells $ filter (not . (`elem` majorCells y)) (majorCells x) ++ filter (not . (`elem` majorCells x)) (majorCells y)) [G.symdiff]
```

## Planning

I've included a list of supported and planned features in the README on the GitHub repository for TinyAPL.