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 Trees:
| 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.