As always, code from this post is available in a GitHub repository.
Tests
There's one big thing that's been missing from TinyAPL: some tests. From the beginning, the code has been full of bugs (remember when majorCells always returned an empty array?). I think it's time to change this.
I've written a test suite using hspec, currently the things tested are the array helper functions, all the primitives and the parser. The details of all the tests are of course very boring, here's some snippets to show vaguely how tests are set up.
-- PrimitivesSpec.hs
describe [G.logarithm] $ do
describe "ln" $ do
it "returns the natural logarithm of complex numbers" $ do
m P.logarithm (vector [Number 1, Number (exp 1), Number -1]) `shouldReturn` pure (vector [Number $ log 1, Number 1, Number $ 0 :+ pi])
it "fails with zero argument" $ do
e2m <$> m P.logarithm (scalar $ Number 0) `shouldReturn` Nothing
describe "log" $ do
it "returns the logarithm of complex numbers" $ do
d P.logarithm (scalar $ Number $ 2 :+ 1) (vector [Number 1, Number (0 :+ 3)]) `shouldReturn` pure (vector [Number 0, Number $ logBase (2 :+ 1) (0 :+ 3)])
it "returns 1 for 1, 1" $ do
d P.logarithm (scalar $ Number 1) (scalar $ Number 1) `shouldReturn` pure (scalar $ Number 1)
it "fails for left argument 1" $ do
e2m <$> d P.logarithm (scalar $ Number 1) (vector [Number 3, Number 0.5]) `shouldReturn` Nothing
-- ParserSpec.hs
it "parses numbers" $ do
tok "1" `shouldBe` pure [[TokenNumber 1 emptyPos]]
tok "¯2" `shouldBe` pure [[TokenNumber -2 emptyPos]]
tok "1.5" `shouldBe` pure [[TokenNumber 1.5 emptyPos]]
tok "¯3.25" `shouldBe` pure [[TokenNumber -3.25 emptyPos]]
tok "3⏨2" `shouldBe` pure [[TokenNumber 300 emptyPos]]
tok "2.4⏨¯3" `shouldBe` pure [[TokenNumber 0.0024 emptyPos]]
tok "3ᴊ2" `shouldBe` pure [[TokenNumber (3 :+ 2) emptyPos]]
tok "¯2ᴊ1.5⏨2" `shouldBe` pure [[TokenNumber (-2 :+ 150) emptyPos]]
The interpreter still isn't tested; I'll work on it in parallel to the next updates.
Bugs
Writing the tests made me find a few bugs in the primitives:
- Root had its arguments swapped
- Polar was wrong
- Set Phase had its right argument used wrongly; this was due to a previous version of the design for that primitive using that old definition.
Another bug was that vector notation didn't box its elements.
Docs
Another thing that TinyAPL has been missing is documentation.
I wrote a Deno server that hosts documentation for primitives, quad names, and general information as Markdown files (they're in /docs/pages). The actual code here doesn't really matter, I think, as this series focuses more on implementing TinyAPL itself. I also included documentation for many primitives that don't exist yet but are planned. Of course they may change before they're added so I put a notice specifying their planned status.
The latest version of the documentation is available here.
Inline Comments
I couldn't figure out line comments, but inline comments (delimited by ⟃ and ⟄) are quite easy:
whitespace :: Parser ()
whitespace = do
let comm :: Parser ()
comm = char (fst G.inlineComment) *> void (many $ noneOf [snd G.inlineComment]) <* char (snd G.inlineComment)
void $ many $ try comm <|> void (satisfy isSpace)
All instances of spaces (the builtin from Parsec) have been changed to use whitespace instead.
Complex Floor
Previously, TinyAPL's floor (and ceiling) for complex numbers was component-wise. The most accepted definition instead uses a different approach that snaps a number to one of three Gaussian integers depending on where it is in the complex unit square:
componentFloor :: RealFrac a => Complex a -> Complex a
componentFloor (r :+ i) = fromInteger (floor r) :+ fromInteger (floor i)
fracPart :: RealFrac a => a -> a
fracPart = snd . properFraction . (1 +) . snd . properFraction -- properFraction returns a negative number for negative inputs, 1| doesn't
complexFloor :: RealFloat a => Complex a -> Complex a
complexFloor (r :+ i) = let
b = componentFloor $ r :+ i
x = fracPart r
y = fracPart i
in
if x + y < 1 then b
else if x >= y then b + 1
else b + (0 :+ 1)
Definitions for complex ceiling and remainder follow:
complexCeiling :: RealFloat a => Complex a -> Complex a
complexCeiling = negate . complexFloor . negate
complexRemainder :: RealFloat a => Complex a -> Complex a -> Complex a
complexRemainder w z = z - w * complexFloor (if w == 0 then z else z / w)
The primitives have been changed to use the new functions. Round is unchanged and uses component floor.
LCM and GCD
Two other primitives that can now be implemented with complex floor are LCM and GCD, the extensions of And and Or to arbitrary numbers:
complexGCD :: RealFloat a => Complex a -> Complex a -> Complex a
complexGCD a w = if a `complexRemainder` w == 0 then a else (a `complexRemainder` w) `complexGCD` a
complexLCM :: RealFloat a => Complex a -> Complex a -> Complex a
complexLCM x y = if x == 0 && y == 0 then 0 else (x * y) / (x `complexGCD` y)
The primitives have been changed accordingly.
Each, Each Left and Each Right
Three easy primitves to add are the adverbs Each ¨, Each Left ᐵ and Each Right ᑈ. The last two are like Each but only mapping on one of the arguments.
each = Adverb
{ adverbRepr = [G.each]
, adverbOnArray = Just $ \arr -> pure $ Each $ Constant arr
, adverbOnFunction = Just $ \f -> pure $ Each f }
eachLeft = Adverb
{ adverbRepr = [G.eachLeft]
, adverbOnArray = Nothing
, adverbOnFunction = Just $ \f -> pure $ EachLeft f }
eachRight = Adverb
{ adverbRepr = [G.eachRight]
, adverbOnArray = Nothing
, adverbOnFunction = Just $ \f -> pure $ EachRight f }
| Each { eachFunction :: Function }
| EachLeft { eachLeftFunction :: Function }
| EachRight { eachRightFunction :: Function }
show (Each f) = "(" ++ show f ++ [')', G.each]
show (EachLeft f) = "(" ++ show f ++ [')', G.eachLeft]
show (EachRight f) = "(" ++ show f ++ [')', G.eachRight]
The code is similar to that of scalarMonad and scalarDyad, except that Each's don't traverse layers of nesting
callMonad (Each f) (Array sh cs) = Array sh <$> mapM (fmap box . callMonad f . fromScalar) cs
callMonad f@(EachLeft _) _ = throwError $ noMonad $ show f
callMonad f@(EachRight _) _ = throwError $ noMonad $ show f
callDyad (Each f) (Array ash acs) (Array bsh bcs)
| null ash && null bsh = scalar . box <$> callDyad f (fromScalar $ head acs) (fromScalar $ head bcs)
| null ash = Array bsh <$> mapM (fmap box . callDyad f (fromScalar $ head acs) . fromScalar) bcs
| null bsh = Array ash <$> mapM (fmap box . (\a -> callDyad f a (fromScalar $ head bcs)) . fromScalar) acs
| ash == bsh = Array ash <$> zipWithM (fmap box .: callDyad f) (fromScalar <$> acs) (fromScalar <$> bcs)
| otherwise = throwError $ LengthError "Incompatible shapes in arguments to Each"
callDyad (EachLeft f) (Array ash acs) b = Array ash <$> mapM (fmap box . (\a -> callDyad f a b) . fromScalar) acs
callDyad (EachRight f) a (Array bsh bcs) = Array bsh <$> mapM (fmap box . callDyad f a . fromScalar) bcs
Enlist
Enlist ∊ is a primitive function that returns all simple scalars in a nested array.
element = pureFunction (Just $ \x -> do
let go :: Array -> [ScalarValue]
go (Array [] [Box a]) = go a
go (Array [] sc) = sc
go (Array _ cs) = concatMap (go . fromScalar) cs
return $ vector $ go x
) Nothing [G.element]
show for arrays
Now that we have array notation, it's easy to implement proper show for arrays.
instance Show ScalarValue where
show (Number x) = showComplex x
show (Character x) = [x]
show (Box xs) = G.enclose : show xs
instance Show Array where
show (Array [] [s]) = show s
show (Array [_] xs)
| not (null xs) && all (\case (Character _) -> True; _ -> False) xs = xs >>= show
| otherwise = [fst G.vector] ++ intercalate [' ', G.separator, ' '] (show . fromScalar <$> xs) ++ [snd G.vector]
show arr = [fst G.highRank] ++ intercalate [' ', G.separator, ' '] (show <$> majorCells arr) ++ [snd G.highRank]
I chose to represent character vectors as unquoted strings and everything else using plain array notation. I also changed boxes to be represented with a prefix ⊂.