Reflection in J

The abstract syntax tree for a verb is stored as a noun in atomic form. Thus J programs can build and manipulate abstract syntax trees, then execute them.

In abstract syntax trees, verbs are inductively represented as follows. A built-in verb is represented by a boxed string consisting of its name. For example, denoting boxes with square brackets, addition is represented as:

["+"]

Adverbs and conjunctions are arrays of two boxes. The first box contains the name of the adverb or conjunction, and the second box contains the arguments. For example:

[["/"], [["+"]]]
[["@"], [["-"], ["+:"]]]

A hook is tagged with the number 2:

[[2], [["%"], ["-"]]]

A fork is tagged with the number 3:

[[3], [["*:"], ["*"], ["*:"]]]

Thus the famous fork for computing the mean is:

[[3], [[["/"], [["+"]]], ["%"], ["#"]]]

J literals are tagged with the number 0. For example, the number 42 is represented with the J array:

[[0], [42]]

A verb v applied to one or two nouns m, n can be represented as:

[v, [m]]
[v, [m, n]]

Lastly, bonded conjunctions and trains of adverbs are tagged with the number 4:

[[4], [["+"], ["&"]]]
[[4], [[[4], [["/"], ["\"]]], ["/"]]]

The tie conjunction converts given verbs to their boxed representation. Thus the tie conjunction is special in that it returns a noun, unlike other J conjunctions.

The J interpreter builds an abstract syntax tree from each input except that it automatically performs a sort of constant folding: on each monad and dyad (rules 0, 1, and 2), instead of building an abstract syntax tree, we immediately execute the verbs on the nouns and return the resulting noun.

This makes the recursion verb $: behave non-intuitively:

   (    1 & +)^:(1&<) 0
0
   (    1 & +)^:(1&<) 5
5
   (($:0) & +)^:(1&<) 5
|stack error

Recall $: refers to the longest verb containing it. We might think $:0 should evaluate to 0, but because of constant folding, the interpreter tries to call $: before it knows what it represents.

Jason born

We’re ready to write our toy J interpreter. We name it Jason, because that sounds like "J’s son".

Here’s the REPL:

import Jumble
import Shaped
import Control.Monad
import Data.Char
import Data.Function
import Data.List
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import Data.Vector ((!))
import qualified Data.Vector as V
import System.IO
import Text.ParserCombinators.Parsec

type Noun = Shaped Jumble
data JMonad = JMonad Int (Noun -> Noun)
data JDyad  = JDyad Int Int (Noun -> Noun -> Noun)
type Dict = M.Map String Jumble

jLine :: Parser [String]
jLine = (map unwords . groupBy ((. isJNum) . (&&) . isJNum)) -- Join numbers.
  <$> (spaces >> many jToken)  -- Eat leading spaces.

isJNum s@(c:_) = (isDigit c || c == '_') && last s `notElem` ".:"

jToken =
    ( (string "NB." >>= (<$> many anyChar) . (++)) -- NB.
  <|> do
    char '\''
    s <- concat <$> many (many1 (noneOf "'") <|> try (string "''"))
    char '\'' <?> "closing quote"
    return $ concat ["'", s, "'"]
  <|> ((++) <$> (many1 (char '_' <|> alphaNum) <|> count 1 anyChar)
  <*> many (oneOf ".:")) -- e.g. "ab_12" or "#" followed by e.g. "..:.:.::.".
    ) >>= (spaces >>) . return -- Eat trailing spaces.

main = repl M.empty

repl dict = do
  putStr "   "
  hFlush stdout
  done <- isEOF
  unless done $ do
    s <- getLine
    let (out, dict') = eval dict s
    unless (isNothing out) $ putStrLn $ fromJust out
    repl dict'

eval :: Dict -> String -> (Maybe String, Dict)
eval dict s = case parse jLine "" s of
  Left err -> (Just $ "| " ++ show err, dict)
  Right ws -> let
    xs = "" : reverse ("":filter (not . isPrefixOf "NB.") ws)
    (mj, dict') = ast dict xs []
    in (dump <$> mj, dict')

dump j = let Shaped _ xs = jOpen j in case jGetI $ xs!0 of
  Just 0  -> show $ jOpen $ xs!1
  Nothing -> show j

Parsing and execution follows Chapter 39 of J for C Programmers; an alternative is to make our interpreter behave more conventionally and separate parsing from execution by removing the run calls from ast, and only calling run once the entire expression has been parsed.

Storing the abstract syntax tree in native J data structures has some drawbacks. Every time we wish to determine if a given box contains a noun, verb, adverb, or conjunction, we must go through a bunch of tests. Perhaps the offical J interpreter caches what part of speech a box belongs to, and this is why gerunds built from strings differ to those built from expressions.

The tie conjunction is handled specially because unlike other conjunctions, it returns a noun.

ast :: Bool -> Dict -> [String] -> [Jumble] -> (Maybe Jumble, Dict)
ast echo dict xs st
  | length st < 4 = shift
  -- 0 Monad
  | ecl, isV j1, isN j2 =
    reduce (j0:run dict (jBox $ fromList [j1, jBox $ singleton j2]):j3:rest)
  -- 1 Monad
  | eclavn, isV j1, isV j2, isN j3 =
    reduce (j0:j1:run dict (jBox $ fromList [j2, jBox $ singleton j3]):rest)
  -- 2 Dyad
  | eclavn, isN j1, isV j2, isN j3 =
    reduce (j0:run dict (jBox $ fromList [j2, jBox $ fromList [j1, j3]]):rest)
  -- 3 Adverb
  | eclavn, isV j1, isA j2 =
    reduce (j0:jBox (fromList [j2, jBox $ singleton j1]):j3:rest)
  -- 4 Conjunction
  | eclavn, isV j1 || isN j1, isC j2, isV j3 || isN j3 =
    reduce (j0:jBox (fromList [j2, jBox $ fromList [j1, j3]]):rest)
  -- 5 Fork
  | eclavn, isV j1, isV j2, isV j3 =
    reduce (j0:jBox (fromList [jBox $ singleton $ intToJumble 3, jBox $ fromList [j1, j2, j3]]):rest)
  -- 6 Hook
  | ecl, isV j1, isV j2 =
    reduce (j0:jBox (fromList [jBox $ singleton $ intToJumble 2, jBox $ fromList [j1, j2]]):j3:rest)
  -- 7 Is
  | Just name <- jGets j0, match j1 ["=.", "=:"], isCAVN j2 =
    ast False (M.insert name j2 dict) xs (j2:j3:rest)
  -- 8 Paren
  | match j0 ["("], isCAVN j1, match j2 [")"] = reduce (j1:j3:rest)
  | otherwise = shift
  where
    (j0:j1:j2:j3:rest) = st
    ecl = match j0 ["", "=.", "=:", "("]
    eclavn = ecl || isA j0 || isV j0 || isN j0
    f = sym dict
    isA j | Just x <- f j = isA x
          | Just s <- jGets j = s `M.member` adverbDict
          | Shaped [2] xs <- jOpen j, Just i <- jGetI $ xs!0 = i == 4
          | otherwise = False
    isV j | Just x <- f j = isV x
          | Just s <- jGets j = s `M.member` verbDict
          | Shaped [2] xs <- jOpen j, Just i <- jGetI $ xs!0 = i == 2 || i == 3
          | Shaped [2] xs <- jOpen j = isA (xs!0) || (isC (xs!0) && Just "`" /= jGets (xs!0))
          | otherwise = False
    isN j | Just x <- f j = isN x
          | Shaped [2] xs <- jOpen j, Just i <- jGetI $ xs!0 = i == 0
          | Shaped [2] xs <- jOpen j = isV (xs!0) || Just "`" == jGets (xs!0)
          | otherwise = False
    isC j | Just x <- f j = isC x
          | Just s <- jGets j = s `M.member` conjunctionDict
          | otherwise = False
    isCAVN j = isC j || isA j || isV j || isN j
    match j ss | Just s <- jGets j = s `elem` ss
               | otherwise = False

    encNoun x = jBox $ fromList [jBox $ singleton $ intToJumble 0, jBox x]
    shift | (h:t) <- xs     = ast echo dict t $ atomize h:st
          | otherwise       = (out, dict)
    out   | not echo        = Nothing
          | [_, _]    <- st = Nothing
          | [_, x, _] <- st = Just x
          | otherwise       = Just $ jPuts $ "|syntax error: " ++ show st
    reduce = ast True dict xs

atomize s
  | null s = jPuts ""
  | length ws > 1 = maybe (jPuts "|syntax error") (tag 0 . fromList) $ mapM readJumble ws
  | Just j <- readJumble s = tag 0 $ singleton j
  | otherwise = jPuts s
  where ws = words s

sym dict j | Just s <- jGets j, isName s = M.lookup s dict
           | otherwise = Nothing

run :: Dict -> Jumble -> Jumble
run dict j
  | Just x <- sym dict j = x
  | null rs = j
  | Just i <- jGetI $ xs!0 = case i of
    0 -> j
  | Just "`" <- jGets $ xs!0 = jTie dict (args!0) (args!1)
  | Just v <- verbOf dict' $ xs!0 =
    case V.length args of
    1 -> let y = nounOf $ run dict' (args!0) in tag 0 $ verb1 v y
    2 -> let
      x = nounOf $ run dict' (args!0)
      y = nounOf $ run dict' (args!1)
      in tag 0 $ verb2 v x y
  where
    Shaped rs xs = jOpen j
    Just word = jGets $ xs!0
    Shaped _ args = jOpen $ xs!1
    dict' = M.insertWith (flip const) "$:" (xs!0) dict

verbOf dict j
  | Just s <- jGets j, s == "$:" = Just $ recur dict $ dict M.! "$:"
  | Just s <- jGets j, Just v <- M.lookup s verbDict = Just v
  | Just s <- jGets $ xs!0, Just a <- M.lookup s adverbDict = let Just v = verbOf dict $ args!0 in Just $ a v
  | Just s <- jGets $ xs!0, s /= "`", Just c <- M.lookup s conjunctionDict = Just $ if s == "@." then runAgenda dict (args!0) (args!1) else runConjunction dict c (args!0) (args!1)
  | Just i <- jGetI $ xs!0, i == 2 = let
    [Just u, Just v] = verbOf dict <$> V.toList args
    in Just $ jHook u v
  | Just i <- jGetI $ xs!0, i == 3 = let
    [Just u, Just v, Just w] = verbOf dict <$> V.toList args
    in Just $ jFork u v w
  | otherwise = Nothing
  where
    Shaped rs xs = jOpen j
    Shaped _ args = jOpen $ xs!1

recur dict j = let v = fromJust $ verbOf dict j
  in (JMonad maxBound $ verb1 v, JDyad maxBound maxBound $ verb2 v)

runConjunction dict (nn, nv, vn, vv) j0 j1
  | [Nothing, Nothing] <- verbOf dict <$> [j0, j1] = nn m n
  | [Nothing,  Just v] <- verbOf dict <$> [j0, j1] = nv m v
  | [Just u , Nothing] <- verbOf dict <$> [j0, j1] = vn u n
  | [Just u ,  Just v] <- verbOf dict <$> [j0, j1] = vv u v
  where
    m = nounOf $ run dict j0
    n = nounOf $ run dict j1

tag :: Integral a => a  -> Noun -> Jumble
tag i m = jBox $ fromList [jBox $ singleton $ intToJumble i, jBox m]

nounOf j = let Shaped _ xs = jOpen j in jOpen $ xs!1

isName = all isAlpha

Verbs are stored as pairs of J monads and dyads. We use maxBound to represent infinite rank.

jZero = intToJumble 0
verb1 (JMonad mu u, _)   = go1 jZero mu u
verb2 (_, JDyad lu ru u) = go2 jZero lu ru u

-- Shortcut for J monads of rank 0 that output atoms.
atomic1 f = JMonad 0  $ \(Shaped [] xs)
  -> singleton $ f (xs!0)

-- Shortcut for J dyads of rank 0 0 that output atoms.
atomic2 f = JDyad 0 0 $ \(Shaped [] xs) (Shaped [] ys)
  -> singleton $ f (xs!0) (ys!0)

verbDict = M.fromList
  [ ("+:", (atomic1 $ join jAdd, undefined))
  , ("*:", (atomic1 $ join jMul, undefined))
  , ("-:", (atomic1 $ flip jDiv (intToJumble 2), undefined))
  , ("+", (undefined, atomic2 jAdd))
  , ("-", (atomic1 $ jSub $ intToJumble 0, atomic2 jSub))
  , ("*", (atomic1 $ intToJumble . signum . jumbleToInt, atomic2 jMul))
  , ("%", (atomic1 $ jDiv (intToJumble 1), atomic2 jDiv))
  , ("^", (atomic1 jExp, atomic2 jPow))
  , ("^.", (atomic1 jLog, undefined))
  , ("%:", (atomic1 jSqrt, undefined))
  , ("<", (JMonad maxBound $ \x -> singleton $ jBox x, atomic2 jLT))
  , ("<.", (atomic1 jFloor, atomic2 jMin))
  , (">", (JMonad 0 $ \(Shaped [] x) -> jOpen (x!0), atomic2 jGT))
  , ("<:", (atomic1 $ jAdd (intToJumble (-1)), atomic2 jLE))
  , (">:", (atomic1 $ jAdd (intToJumble 1), atomic2 jGE))
  , ("=", (undefined, atomic2 jEQ))
  , ("[", (JMonad maxBound id, JDyad maxBound maxBound const))
  , ("]", (JMonad maxBound id, JDyad maxBound maxBound $ flip const))
  , ("$:", (JMonad maxBound $ const $ singleton $ jPuts "|stack error", JDyad maxBound maxBound $ \_ _ -> singleton $ jPuts "|stack error"))
  , ("|", (atomic1 jMag, atomic2 jRes))
  , ("#:", (JMonad maxBound undefined, JDyad 1 0 jAntibase))
  , ("I.", (JMonad 1 jIndices, JDyad maxBound maxBound undefined))
  , ("/:", (undefined, JDyad maxBound maxBound jSortUp))
  , ("{.", (JMonad maxBound jHead, undefined))
  , ("1:", (JMonad maxBound $ const $ singleton $ intToJumble 1,
            JDyad maxBound maxBound $ \_ _ -> singleton $ intToJumble 1))
  ...

Our toy interpreter only handles a fraction of J, but it has enough to run Simple Examples, as well as the the Unforgettable Numbers essay (though less efficiently).

Reflections on J

Some J features are inspiring. First and foremost is its friendliness towards tacit programming. In proper doses, tacit programming improves clarity by omitting irrelevant details.

Avoiding parentheses appears to have been a design goal. Several language features, such as hooks, forks, and capped forks, allow many functions to be without any parentheses, though J may have gone too far in this regard.

The derivative operator is thought-provoking. If we build a function from certain other functions, surely the computer should be able to figure out its derivative for us. J achieves this. This might possibly translate to other languages, but in Haskell, probably the best we can do is design a data structure to hold differentiable functions and implement the derivative ourselves.

As for the other language features:

Shape-polymorphic arrays: While suitable for certain problems, this data structure feels too heavyweight to serve as the foundation of a language.

Rank polymorphism: Automatically extending verbs to any rank is clever and fun to implement. Furthermore, the notation for setting a verb to a particular rank is terse yet informative.

However, in this case, a little bit of notation goes a long way, as the number of characters saved fails to justify the costs:

  • Deep nesting is rare. Beyond a certain point, programmers break up a hierarchy and abstract away lower levels or risk being overwhelmed by complexity. For example, in Haskell, we only need a few <$> and pure calls at a time.

  • Implicit pure calls seem to imply the interpreter must often examine types at runtime. For example, it may need to check if a verb has been given an integer or an array; if an integer it must either call a special case or build an array then call the general version of the function.

  • Notation such as pure and <$> is powerful. It allows the same code to iterate over, say, trees instead of arrays. It allows us to safely combine pure and impure code. And much more.

Terminology: Terms like "noun", "verb", and so on are cute, but make it harder to connect with the large body of existing type theory.

Notation: Redesigning mathematical notation so computers and humans alike can understand it is an admirable goal, but the most practical approach would be to adapt existing mathematical notation (which Iverson refers to as MN). Breaking too many conventions alienates users, dooming the effort from the start.

Additionally, some of the notation oddities of J appear to be solely consequences of a simplistic parser, rather than a desire to improve on MN.

Haskell has shown that a practical programming language can resemble MN. For example, consider a variant of the function that features in the Collatz conjecture:

f(1)             = 1
f(n) | even n    = n `div` 2
     | otherwise = 3*n + 1

This only differs from human notation in minor ways:

Compare with an equivalent in J:

collatz=: -:`(>:@(3&*))`1: @. (1&= + 2&|)

Special cases: In our adventure, we’ve encountered many traps for the unwary. There are many more:

  • The result of folds (the "/" adverb) executed on empty arrays.

  • The verbs that support the obverse.

  • The verbs that support the derivative.

  • The meaning of the !. fit/customize conjunction.

  • The errors caught when defining verbs with ":" versus when they are run.

  • The $: verb depends on where it appears, while all other verbs always have the same meaning

Redundancy: Minimizing code size appears to be a goal of J, judging by the many one- or two-character operators, all of which are overloaded. Yet we find different characters with the same meaning.:

  • @ and & are the same when used on prefix operators.

  • ` and , are the same for nouns.

  • ❏ are the same when used as prefix operators.

This works against brevity as obviously we could pack more meaning into fewer characters by ensuring each operator has distinct meanings.

On the topic of brevity: information density varies across natural languages, and research suggests speakers adjust their talking speed so that the data transmission rate is the same in all languages, except when information density is so low that it is infeasible to speak quickly enough to compensate. Beyond some point, brevity appears to be a fruitless goal: we might read and write less, but we’ll take longer to do so.

Types: J’s type system undermines its alleged intimate connection with mathematics. Rigour is a hallmark of modern mathematics. Theorems must state the type of each object, so it’s clear if it applies only to positive integers, or regular primes, or twice-differentiable functions. In contrast, J verbs try to run on any given input.

Any sufficiently advanced type system is indistinguishable from mathematics, a fact known as the Curry-Howard correspondence. Sadly, the type system of J is trivially distinguishable.

J’s sophisticated type promotion may be convenient at times, but may also be dangerous at other times.

Also, with type checking, ceteris paribus, compile-time (static) beats run-time (dynamic). Would you rather a user be surprised by your mistake, or have the computer prevent you from making it in the first place?


Ben Lynn blynn@cs.stanford.edu 💡