Back to Index Page

TinyAPL part 6: Tests, Docs, Each

#tinyapl#apl#haskell

Madeline Vergani

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 .