Things

lol

8 files changed, 179 insertions, 150 deletions

diff --git a/bruijn.cabal b/bruijn.cabal
index d2d7449..85f648a 100644
--- a/bruijn.cabal
+++ b/bruijn.cabal
@@ -6,7 +6,7 @@ cabal-version: 1.12
 
 name:           bruijn
 version:        0.1.0.0
-description:    Please see the README on GitHub at <https://github.com/githubuser/bruijn#readme>
+description:    Please see the README on GitHub at <https://github.com/marvinborner/bruijn>
 homepage:       https://github.com/githubuser/bruijn#readme
 bug-reports:    https://github.com/githubuser/bruijn/issues
 author:         Marvin Borner
@@ -44,6 +44,7 @@ library
       src
   default-extensions:
       LambdaCase
+  ghc-options: -Wall -Wextra -Werror -Wincomplete-uni-patterns -Wincomplete-record-updates -Widentities -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
     , binary
@@ -65,7 +66,7 @@ executable bruijn
       app
   default-extensions:
       LambdaCase
-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
     , binary
diff --git a/package.yaml b/package.yaml
index 120d0e4..7ce52be 100644
--- a/package.yaml
+++ b/package.yaml
@@ -20,7 +20,7 @@ data-files:
 # To avoid duplicated efforts in documentation and dealing with the
 # complications of embedding Haddock markup inside cabal files, it is
 # common to point users to the README.md file.
-description:         Please see the README on GitHub at <https://github.com/githubuser/bruijn#readme>
+description:         Please see the README on GitHub at <https://github.com/marvinborner/bruijn>
 
 default-extensions:
   - LambdaCase
@@ -39,13 +39,20 @@ dependencies:
 
 library:
   source-dirs: src
+  ghc-options:
+  - -Wall
+  - -Wextra
+  - -Werror
+  - -Wincomplete-uni-patterns
+  - -Wincomplete-record-updates
+  - -Widentities
+  - -Wredundant-constraints
 
 executables:
   bruijn:
     main:                Main.hs
     source-dirs:         app
     ghc-options:
-    - -Wall
     - -threaded
     - -rtsopts
     - -with-rtsopts=-N
diff --git a/src/Binary.hs b/src/Binary.hs
index 2a1c891..359dea8 100644
--- a/src/Binary.hs
+++ b/src/Binary.hs
@@ -5,25 +5,23 @@ module Binary
   , fromBitString
   ) where
 
-import           Control.Applicative
 import           Data.Binary                    ( decode
                                                 , encode
                                                 )
 import qualified Data.BitString                as Bit
 import qualified Data.ByteString.Lazy          as Byte
-import           Data.Char
 import           Data.Int                       ( Int8 )
 import           Helper
 
 toBinary :: Expression -> String
 toBinary (Bruijn      x        ) = (replicate (x + 1) '1') ++ "0"
-toBinary (Abstraction exp      ) = "00" ++ toBinary exp
+toBinary (Abstraction e        ) = "00" ++ toBinary e
 toBinary (Application exp1 exp2) = "01" ++ (toBinary exp1) ++ (toBinary exp2)
+toBinary _                       = "" -- shouldn't happen
 
 fromBinary' :: String -> (Expression, String)
 fromBinary' = \case
-  '0' : '0' : rst ->
-    let (exp, rst) = fromBinary' rst in (Abstraction exp, rst)
+  '0' : '0' : rst -> let (e, es) = fromBinary' rst in (Abstraction e, es)
   '0' : '1' : rst ->
     let (exp1, rst1) = fromBinary' rst
         (exp2, rst2) = fromBinary' rst1
@@ -51,6 +49,7 @@ toBitString str = Bit.concat
     (\case
       '0' -> False
       '1' -> True
+      _   -> error "invalid bit"
     )
     str
   ]
@@ -66,4 +65,4 @@ fromBitString bits =
     $ Bit.toList
     $ Bit.take (Bit.length bits - pad bits)
     $ Bit.drop 8 bits
-  where pad bits = decode $ Bit.realizeBitStringLazy $ Bit.take 8 bits
+  where pad = decode . Bit.realizeBitStringLazy . Bit.take 8
diff --git a/src/Eval.hs b/src/Eval.hs
index 03d5bd5..0eb6c9e 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -8,20 +8,15 @@ import           Control.Monad.State
 import qualified Control.Monad.State.Strict    as StrictState
 import qualified Data.BitString                as Bit
 import qualified Data.ByteString               as Byte
-import           Data.Either
 import           Data.List
-import           Debug.Trace
 import           Helper
 import           Parser
 import           Paths_bruijn
 import           Reducer
 import           System.Console.Haskeline
-import           System.Console.Haskeline.Completion
 import           System.Directory
 import           System.Environment
-import           System.Exit
 import           System.FilePath.Posix          ( takeBaseName )
-import           System.IO
 import           Text.Megaparsec         hiding ( State
                                                 , try
                                                 )
@@ -35,7 +30,7 @@ type M = StrictState.StateT EnvState IO
 split :: (Eq a) => [a] -> [a] -> [[a]]
 split _  [] = []
 split [] x  = map (: []) x
-split a@(d : ds) b@(c : cs)
+split a@(_ : _) b@(c : _)
   | Just suffix <- a `stripPrefix` b = [] : split a suffix
   | otherwise = if null rest then [[c]] else (c : head rest) : tail rest
   where rest = split a $ tail b
@@ -43,25 +38,25 @@ split a@(d : ds) b@(c : cs)
 -- TODO: Force naming convention for namespaces/files
 loadFile :: String -> IO EnvState
 loadFile path = do
-  file <- try $ readFile path :: IO (Either IOError String)
-  case file of
+  f <- try $ readFile path :: IO (Either IOError String)
+  case f of
     Left exception ->
       print (exception :: IOError) >> pure (EnvState $ Environment [])
-    Right file -> eval (filter (not . null) $ split "\n\n" file)
+    Right f' -> eval (filter (not . null) $ split "\n\n" f')
                        (EnvState $ Environment [])
                        False
 
 evalVar :: String -> Environment -> Program (Failable Expression)
 evalVar var (Environment sub) = state $ \env@(Environment e) ->
-  let find name env = case lookup name env of
+  let lookup' name env' = case lookup name env' of
         Nothing -> Left $ UndeclaredFunction var
         Just x  -> Right x
-  in  case find var (map fst sub) of
+  in  case lookup' var (map fst sub) of -- search in sub env
         s@(Right _) -> (s, env)
-        _           -> (find var (map fst e), env) -- search in global env
+        _           -> (lookup' var (map fst e), env) -- search in global env
 
 evalAbs :: Expression -> Environment -> Program (Failable Expression)
-evalAbs exp sub = evalExp exp sub >>= pure . fmap Abstraction
+evalAbs e sub = evalExp e sub >>= pure . fmap Abstraction
 
 evalApp :: Expression -> Expression -> Environment -> Program (Failable Expression)
 evalApp f g sub =
@@ -74,33 +69,33 @@ evalApp f g sub =
 evalExp :: Expression -> Environment -> Program (Failable Expression)
 evalExp idx@(Bruijn      _  ) = const $ pure $ Right idx
 evalExp (    Variable    var) = evalVar var
-evalExp (    Abstraction exp) = evalAbs exp
+evalExp (    Abstraction e) = evalAbs e
 evalExp (    Application f g) = evalApp f g
 
 evalDefine
   :: String -> Expression -> Environment -> Program (Failable Expression)
-evalDefine name exp sub =
-  evalExp exp sub
+evalDefine name e sub =
+  evalExp e sub
     >>= (\case
-          Left e -> pure $ Left e
+          Left e' -> pure $ Left e'
           Right f ->
             modify (\(Environment s) -> Environment $ ((name, f), Environment []) : s)
               >> pure (Right f)
         )
 
 evalTest :: Expression -> Expression -> Environment -> Program (Failable Instruction)
-evalTest exp1 exp2 sub =
-  evalExp exp1 sub
+evalTest e1 e2 sub =
+  evalExp e1 sub
     >>= (\case
-          Left  exp1 -> pure $ Left exp1
-          Right exp1 -> fmap (Test exp1) <$> evalExp exp2 sub
+          Left  err -> pure $ Left err
+          Right e1' -> fmap (Test e1') <$> evalExp e2 sub
         )
 
 evalSubEnv :: [Instruction] -> EnvState -> Bool -> IO EnvState
-evalSubEnv [] state _ = return state
-evalSubEnv (instr : is) state@(EnvState env) isRepl =
-  handleInterrupt (putStrLn "<aborted>" >> return state)
-    $ evalInstruction instr state (evalSubEnv is) isRepl
+evalSubEnv [] s _ = return s
+evalSubEnv (instr : is) s isRepl =
+  handleInterrupt (putStrLn "<aborted>" >> return s)
+    $ evalInstruction instr s (evalSubEnv is) isRepl
 
 evalInstruction
   :: Instruction
@@ -108,15 +103,15 @@ evalInstruction
   -> (EnvState -> Bool -> IO EnvState)
   -> Bool
   -> IO EnvState
-evalInstruction instr state@(EnvState env) rec isRepl = case instr of
-  Define name exp sub -> do
-    EnvState subEnv <- evalSubEnv sub state isRepl
+evalInstruction instr s@(EnvState env) rec isRepl = case instr of
+  Define name e sub inp -> do
+    EnvState subEnv <- evalSubEnv sub s isRepl
     let
-      (res, env') = evalDefine name exp subEnv `runState` env
+      (res, env') = evalDefine name e subEnv `runState` env
      in  case res of
-          Left  err -> print err >> rec (EnvState env') isRepl
+          Left  err -> print (ContextualError err inp) >> pure s -- don't continue
           Right _   -> if isRepl
-            then (putStrLn $ name <> " = " <> show exp)
+            then (putStrLn $ name <> " = " <> show e)
               >> return (EnvState env')
             else rec (EnvState env') isRepl
   -- TODO: Import loop detection
@@ -128,88 +123,82 @@ evalInstruction instr state@(EnvState env) rec isRepl = case instr of
     let prefix | null namespace   = takeBaseName path ++ "."
                | namespace == "." = ""
                | otherwise        = namespace ++ "."
-    env' <- pure $ Environment $ map (\((n, e), s) -> ((prefix ++ n, e), s))
+    env'' <- pure $ Environment $ map (\((n, e), o) -> ((prefix ++ n, e), o))
                                      ((\(Environment e) -> e) env') -- TODO: Improve
-    rec (EnvState $ env <> env') False -- import => isRepl = False
-  Evaluate exp ->
-    let (res, env') = evalExp exp (Environment []) `runState` env
+    rec (EnvState $ env <> env'') False -- import => isRepl = False
+  Evaluate e ->
+    let (res, _) = evalExp e (Environment []) `runState` env
     in  putStrLn
             (case res of
               Left err -> show err
-              Right exp ->
+              Right e' ->
                 "<> "
-                  <> (show exp)
+                  <> (show e')
                   <> "\n*> "
                   <> (show reduced)
                   <> (if likeTernary reduced
                        then "\t(" <> (show $ ternaryToDecimal reduced) <> ")"
                        else ""
                      )
-                where reduced = reduce exp
+                where reduced = reduce e'
             )
-          >> rec state isRepl
-  Test exp1 exp2 ->
-    let (res, _) = evalTest exp1 exp2 (Environment []) `runState` env
+          >> rec s isRepl
+  Test e1 e2 ->
+    let (res, _) = evalTest e1 e2 (Environment []) `runState` env
     in  case res of
-          Left err -> print err >> pure state
-          Right (Test exp1' exp2') ->
+          Left err -> print err >> pure s
+          Right (Test e1' e2') ->
             when
-                (reduce exp1' /= reduce exp2')
-                (  putStrLn
-                $  "ERROR: test failed: "
-                <> (show exp1)
-                <> " != "
-                <> (show exp2)
-                )
-              >> rec state isRepl
-  _ -> rec state isRepl
+                (lhs /= rhs)
+                (print $ FailedTest e1 e2 lhs rhs)
+              >> rec s isRepl
+            where
+              lhs = reduce e1'
+              rhs = reduce e2'
+          _ -> rec s isRepl
+  _ -> rec s isRepl
 
 eval :: [String] -> EnvState -> Bool -> IO EnvState
-eval []   state _ = return state
-eval [""] state _ = return state
-eval (block : bs) state@(EnvState env) isRepl =
-  handleInterrupt (putStrLn "<aborted>" >> return state)
+eval []   s _ = return s
+eval [""] s _ = return s
+eval (block : bs) s isRepl =
+  handleInterrupt (putStrLn "<aborted>" >> return s)
     $ case parse blockParser "" block of
-        Left  err   -> putStrLn (errorBundlePretty err) >> eval bs state isRepl
-        Right instr -> evalInstruction instr state (eval bs) isRepl
+        Left  err   -> print (SyntaxError $ errorBundlePretty err) >> eval bs s isRepl
+        Right instr -> evalInstruction instr s (eval bs) isRepl
   where blockParser = if isRepl then parseReplLine else parseBlock 0
 
-evalFunc :: String -> Environment -> Maybe Expression
-evalFunc func (Environment env) = do
-  exp <- lookup func (map fst env)
-  pure $ reduce exp
-
 evalMainFunc :: Environment -> Expression -> Maybe Expression
 evalMainFunc (Environment env) arg = do
-  exp <- lookup "main" (map fst env)
-  pure $ reduce $ Application exp arg
+  e <- lookup "main" (map fst env)
+  pure $ reduce $ Application e arg
 
 evalFile :: String -> (a -> IO ()) -> (Expression -> a) -> IO ()
-evalFile path write conv = do
+evalFile path wr conv = do
   EnvState env <- loadFile path
   arg          <- encodeStdin
   case evalMainFunc env arg of
-    Nothing  -> putStrLn "ERROR: main function not found"
-    Just exp -> write $ conv exp
+    Nothing  -> print $ ContextualError (UndeclaredFunction "main") path
+    Just e -> wr $ conv e
 
 exec :: String -> (String -> IO (Either IOError a)) -> (a -> String) -> IO ()
-exec path read conv = do
-  file <- read path
-  case file of
+exec path rd conv = do
+  f <- rd path
+  case f of
     Left  exception -> print (exception :: IOError)
-    Right file      -> print $ reduce $ fromBinary $ conv file
+    Right f'      -> print $ reduce $ fromBinary $ conv f'
 
 repl :: EnvState -> InputT M ()
-repl state =
+repl s =
   (handleInterrupt (return $ Just "") $ withInterrupt $ getInputLine
       "\ESC[36mλ\ESC[0m "
     )
-    >>= (\case
+    >>= (\case -- TODO: Add non-parser error support for REPL
           Nothing   -> return ()
           Just line -> do
-            state <- (liftIO $ eval [line] state True)
-            lift (StrictState.put state)
-            repl state
+            s' <- (liftIO $ eval [line] s True)
+            lift (StrictState.put s')
+            repl s'
         )
 
 lookupCompletion :: String -> M [Completion]
diff --git a/src/Helper.hs b/src/Helper.hs
index e1b3819..6c1509d 100644
--- a/src/Helper.hs
+++ b/src/Helper.hs
@@ -5,22 +5,46 @@ import qualified Data.BitString                as Bit
 import qualified Data.ByteString               as Byte
 import           Data.List
 
-data Error = UndeclaredFunction String | DuplicateFunction String | InvalidIndex Int | FatalError String
+printContext :: String -> String
+printContext str = p $ lines str
+ where
+  p [l] = "in \"" <> l <> "\"\n"
+  p (l : ls) =
+    (p [l])
+      <> "near\n"
+      <> (intercalate "\n" $ map ("  | " ++) $ take 3 $ ls)
+      <> "\n"
+  p _ = ""
+
+errPrefix :: String
+errPrefix = "\ESC[41mERROR\ESC[0m "
+data Error = SyntaxError String | UndeclaredFunction String | InvalidIndex Int | FailedTest Expression Expression Expression Expression | ContextualError Error String
 instance Show Error where
-  show (UndeclaredFunction err) = "ERROR: undeclared function " <> show err
-  show (DuplicateFunction  err) = "ERROR: duplicate function " <> show err
-  show (InvalidIndex       err) = "ERROR: invalid index " <> show err
-  show (FatalError         err) = show err
+  show (ContextualError err ctx) = show err <> "\n" <> (printContext ctx)
+  show (SyntaxError err        ) = errPrefix <> "invalid syntax\nnear " <> err
+  show (UndeclaredFunction func) =
+    errPrefix <> "undeclared function " <> show func
+  show (InvalidIndex err) = errPrefix <> "invalid index " <> show err
+  show (FailedTest exp1 exp2 red1 red2) =
+    errPrefix
+      <> "test failed: "
+      <> show exp1
+      <> " = "
+      <> show exp2
+      <> "\n      reduced to "
+      <> show red1
+      <> " = "
+      <> show red2
 type Failable = Either Error
 
 data Expression = Bruijn Int | Variable String | Abstraction Expression | Application Expression Expression
   deriving (Ord, Eq)
-data Instruction = Define String Expression [Instruction] | Evaluate Expression | Comment | Import String String | Test Expression Expression
+data Instruction = Define String Expression [Instruction] String | Evaluate Expression | Comment | Import String String | Test Expression Expression
   deriving (Show)
 instance Show Expression where
-  show (Bruijn      x  ) = "\ESC[31m" <> show x <> "\ESC[0m"
-  show (Variable    var) = "\ESC[35m" <> var <> "\ESC[0m"
-  show (Abstraction exp) = "\ESC[36m[\ESC[0m" <> show exp <> "\ESC[36m]\ESC[0m"
+  show (Bruijn      x  ) = "\ESC[91m" <> show x <> "\ESC[0m"
+  show (Variable    var) = "\ESC[95m" <> var <> "\ESC[0m"
+  show (Abstraction e  ) = "\ESC[36m[\ESC[0m" <> show e <> "\ESC[36m]\ESC[0m"
   show (Application exp1 exp2) =
     "\ESC[33m(\ESC[0m" <> show exp1 <> " " <> show exp2 <> "\ESC[33m)\ESC[0m"
 
@@ -40,8 +64,8 @@ instance Show Environment where
 
 listify :: [Expression] -> Expression
 listify [] = Abstraction (Abstraction (Bruijn 0))
-listify (fst : rst) =
-  Abstraction (Application (Application (Bruijn 0) fst) (listify rst))
+listify (e : es) =
+  Abstraction (Application (Application (Bruijn 0) e) (listify es))
 
 encodeByte :: Bit.BitString -> Expression
 encodeByte bits = listify (map encodeBit (Bit.toList bits))
@@ -71,17 +95,19 @@ decimalToTernary n =
   Abstraction $ Abstraction $ Abstraction $ Abstraction $ gen n
  where
   gen 0 = Bruijn 3
-  gen n = Application (Bruijn $ fromIntegral $ mod n 3) (gen $ div (n + 1) 3)
+  gen n' =
+    Application (Bruijn $ fromIntegral $ mod n' 3) (gen $ div (n' + 1) 3)
 
 ternaryToDecimal :: Expression -> Integer
-ternaryToDecimal exp = sum $ zipWith (*) (resolve exp) (iterate (* 3) 1)
+ternaryToDecimal e = sum $ zipWith (*) (resolve e) (iterate (* 3) 1)
  where
   multiplier (Bruijn 0) = 0
   multiplier (Bruijn 1) = 1
   multiplier (Bruijn 2) = (-1)
+  multiplier _          = 0 -- ??
   resolve' (Application x@(Bruijn _) (Bruijn 3)) = [multiplier x]
-  resolve' (Application fst@(Bruijn _) rst@(Application _ _)) =
-    (multiplier fst) : (resolve' rst)
+  resolve' (Application x@(Bruijn _) xs@(Application _ _)) =
+    (multiplier x) : (resolve' xs)
   resolve' _ = [0]
   resolve (Abstraction (Abstraction (Abstraction (Abstraction n)))) =
     resolve' n
diff --git a/src/Parser.hs b/src/Parser.hs
index 54a5a62..accda90 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -6,7 +6,6 @@ module Parser
 import           Control.Monad                  ( ap
                                                 , void
                                                 )
-import           Data.Functor.Identity
 import           Data.Void
 import           Helper
 import           Text.Megaparsec         hiding ( parseTest )
@@ -17,8 +16,8 @@ type Parser = Parsec Void String
 
 -- exactly one space
 -- TODO: replace many scs with sc
-sc :: Parser ()
-sc = void $ char ' '
+-- sc :: Parser ()
+-- sc = void $ char ' '
 
 -- zero or more spaces
 scs :: Parser ()
@@ -63,10 +62,10 @@ importPath = some $ oneOf "./_+-" <|> letterChar <|> digitChar
 
 parseAbstraction :: Parser Expression
 parseAbstraction = do
-  symbol "[" <?> "opening abstraction"
-  exp <- parseExpression
-  symbol "]" <?> "closing abstraction"
-  pure $ Abstraction exp
+  _ <- symbol "[" <?> "opening abstraction"
+  e <- parseExpression
+  _ <- symbol "]" <?> "closing abstraction"
+  pure $ Abstraction e
 
 parseApplication :: Parser Expression
 parseApplication = do
@@ -109,41 +108,43 @@ parseSingleton =
 parseExpression :: Parser Expression
 parseExpression = do
   scs
-  expr <- parseApplication <|> parseSingleton
+  e <- parseApplication <|> parseSingleton
   scs
-  pure expr <?> "expression"
+  pure e <?> "expression"
 
 parseEvaluate :: Parser Instruction
 parseEvaluate = Evaluate <$> parseExpression
 
 parseDefine :: Int -> Parser Instruction
 parseDefine lvl = do
+  inp <- getInput
   var <- defIdentifier
   scs
-  exp  <- parseExpression
+  e    <- parseExpression
   -- TODO: Fix >1 sub-defs
   subs <-
     (try $ newline *> (many (parseBlock (lvl + 1)))) <|> (try eof >> return [])
-  pure $ Define var exp subs
+  pure $ Define var e subs inp
 
 parseReplDefine :: Parser Instruction
 parseReplDefine = do
+  inp <- getInput
   var <- defIdentifier
   scs
-  symbol "="
+  _ <- symbol "="
   scs
-  exp <- parseExpression
-  pure $ Define var exp []
+  e <- parseExpression
+  pure $ Define var e [] inp
 
 parseComment :: Parser ()
 parseComment = do
-  string "# " <?> "comment"
-  some $ noneOf "\r\n"
+  _ <- string "# " <?> "comment"
+  _ <- some $ noneOf "\r\n"
   return ()
 
 parseImport :: Parser Instruction
 parseImport = do
-  string ":import " <?> "import"
+  _ <- string ":import " <?> "import"
   scs
   path <- importPath
   scs
@@ -153,25 +154,25 @@ parseImport = do
 
 parsePrint :: Parser Instruction
 parsePrint = do
-  string ":print " <?> "print"
+  _ <- string ":print " <?> "print"
   scs
-  exp <- parseExpression
+  e <- parseExpression
   scs
-  pure $ Evaluate exp
+  pure $ Evaluate e
 
 parseTest :: Parser Instruction
 parseTest = do
-  string ":test " <?> "test"
-  exp1 <- parseExpression
+  _  <- string ":test " <?> "test"
+  e1 <- parseExpression
   scs
-  symbol "="
+  _ <- symbol "="
   scs
-  exp2 <- parseExpression
-  pure $ Test exp1 exp2
+  e2 <- parseExpression
+  pure $ Test e1 e2
 
 parseCommentBlock :: Parser Instruction
 parseCommentBlock = do
-  sepEndBy1 parseComment newline
+  _ <- sepEndBy1 parseComment newline
   eof
   return Comment
 
diff --git a/src/Reducer.hs b/src/Reducer.hs
index 2de307d..a0edc25 100644
--- a/src/Reducer.hs
+++ b/src/Reducer.hs
@@ -10,33 +10,36 @@ import           Helper
 --   (Abstraction f@_ (Bruijn 0)) = f
 
 (<+>) :: Expression -> Int -> Expression
-(<+>) (Bruijn x             ) n = if x > n then Bruijn (pred x) else Bruijn x
-(<+>) (Application exp1 exp2) n = Application (exp1 <+> n) (exp2 <+> n)
-(<+>) (Abstraction exp      ) n = Abstraction $ exp <+> (succ n)
+(<+>) (Bruijn x         ) n = if x > n then Bruijn (pred x) else Bruijn x
+(<+>) (Application e1 e2) n = Application (e1 <+> n) (e2 <+> n)
+(<+>) (Abstraction e    ) n = Abstraction $ e <+> (succ n)
+(<+>) _                   _ = error "invalid"
 
 (<->) :: Expression -> Int -> Expression
-(<->) (Bruijn x             ) n = if x > n then Bruijn (succ x) else Bruijn x
-(<->) (Application exp1 exp2) n = Application (exp1 <-> n) (exp2 <-> n)
-(<->) (Abstraction exp      ) n = Abstraction $ exp <-> (succ n)
+(<->) (Bruijn x         ) n = if x > n then Bruijn (succ x) else Bruijn x
+(<->) (Application e1 e2) n = Application (e1 <-> n) (e2 <-> n)
+(<->) (Abstraction e    ) n = Abstraction $ e <-> (succ n)
+(<->) _                   _ = error "invalid"
 
 bind :: Expression -> Expression -> Int -> Expression
-bind exp (Bruijn x) n = if x == n then exp else Bruijn x
-bind exp (Application exp1 exp2) n =
-  Application (bind exp exp1 n) (bind exp exp2 n)
-bind exp (Abstraction exp') n = Abstraction (bind (exp <-> (-1)) exp' (succ n))
+bind e (Bruijn x         ) n = if x == n then e else Bruijn x
+bind e (Application e1 e2) n = Application (bind e e1 n) (bind e e2 n)
+bind e (Abstraction exp' ) n = Abstraction (bind (e <-> (-1)) exp' (succ n))
+bind _ _                   _ = error "invalid"
 
 step :: Expression -> Expression
-step (Bruijn exp                        ) = Bruijn exp
-step (Application (Abstraction exp) app ) = (bind (app <-> (-1)) exp 0) <+> 0
-step (Application exp1              exp2) = Application (step exp1) (step exp2)
-step (Abstraction exp                   ) = Abstraction (step exp)
+step (Bruijn e) = Bruijn e
+step (Application (Abstraction e) app) = (bind (app <-> (-1)) e 0) <+> 0
+step (Application e1 e2) = Application (step e1) (step e2)
+step (Abstraction e) = Abstraction (step e)
+step _ = error "invalid"
 
 reduceable :: Expression -> Bool
-reduceable (Bruijn   _                      ) = False
-reduceable (Variable _                      ) = True
-reduceable (Application (Abstraction _) _   ) = True
-reduceable (Application exp1 exp2) = reduceable exp1 || reduceable exp2
-reduceable (Abstraction exp                 ) = reduceable exp
+reduceable (Bruijn   _                    ) = False
+reduceable (Variable _                    ) = True
+reduceable (Application (Abstraction _) _ ) = True
+reduceable (Application e1              e2) = reduceable e1 || reduceable e2
+reduceable (Abstraction e                 ) = reduceable e
 
 -- alpha conversion is not needed with de bruijn indexing
 reduce :: Expression -> Expression
diff --git a/std/Number.bruijn b/std/Number.bruijn
index efd6d2d..fa97989 100644
--- a/std/Number.bruijn
+++ b/std/Number.bruijn
@@ -125,6 +125,7 @@ inc [snd (0 inc-z inc-neg inc-pos inc-zero)]
 	inc-neg [0 [[pair (up-neg 1) (up-zero 1)]]]
 	inc-zero [0 [[pair (up-zero 1) (up-pos 1)]]]
 	inc-pos [0 [[pair (up-pos 1) (up-neg 0)]]]
+
 sinc [strip (inc 0)]
 
 :test eq? (inc -42) -41 = T
@@ -139,6 +140,7 @@ dec [snd (0 dec-z dec-neg dec-pos dec-zero)]
 	dec-neg [0 [[pair (up-neg 1) (up-pos 0)]]]
 	dec-zero [0 [[pair (up-zero 1) (up-neg 1)]]]
 	dec-pos [0 [[pair (up-pos 1) (up-zero 1)]]]
+
 sdec [strip (dec 0)]
 
 :test dec -42 = -43
@@ -160,7 +162,8 @@ add [[add-abs 1 (abstractify 0)]]
 	add-a-zero [[[1 (add-b-zero 1) add-b-neg add-b-pos add-b-zero]]]
 	add-z [[0 (dec (normalize 1)) (inc (normalize 1)) (normalize 1)]]
 	add-abs [add-c (0 add-z add-a-neg add-a-pos add-a-zero)]
-# sadd [[strip (add 1 0)]]
+
+sadd [[strip (add 1 0)]]
 
 :test eq? (add -42 -1) -43 = T
 :test eq? (add -5 +6) +1 = T
@@ -171,6 +174,7 @@ add [[add-abs 1 (abstractify 0)]]
 
 # subs two balanced ternary numbers (can introduce leading 0s)
 sub [[add 1 (negate 0)]]
+
 ssub [[strip (sub 1 0)]]
 
 :test eq? (sub -42 -1) -41 = T
@@ -185,11 +189,10 @@ mul [[1 +0 mul-neg mul-pos mul-zero]]
 	mul-neg [sub (up-zero 0) 1]
 	mul-pos [add (up-zero 0) 1]
 	mul-zero [up-zero 0]
+
 smul [[strip (mul 1 0)]]
 
 :test eq? (mul +42 +0) +0 = T
 :test eq? (mul -1 +42) -42 = T
 :test eq? (mul +3 +11) +33 = T
 :test eq? (mul +42 -4) -168 = T
-
-main [inc +1]