Use different command types for each arity (#1063)

* refactor: Use different command types for each arity

* feat: Improved evaluation error messages in arity checks

src/Commands.hs

@@ -51,41 +51,55 @@ falseXObj = XObj (Bol False) Nothing Nothing
 boolToXObj :: Bool -> XObj
 boolToXObj b = if b then trueXObj else falseXObj
 
--- | Use this function to register commands in the environment.
-addCommand :: SymPath -> Int -> CommandCallback -> String -> String -> (String, Binder)
-addCommand name arity callback doc example = addCommandConfigurable name (Just arity) callback doc example
-
-addCommandConfigurable :: SymPath -> Maybe Int -> CommandCallback -> String -> String -> (String, Binder)
-addCommandConfigurable path maybeArity callback doc example =
-  let cmd =
-        XObj
-          ( Lst
-              [ XObj (Command (CommandFunction f)) (Just dummyInfo) Nothing,
-                XObj (Sym path Symbol) Nothing Nothing,
-                unfoldArgs
-              ]
-          )
-          (Just dummyInfo)
-          (Just DynamicTy)
-      SymPath _ name = path
-      meta = Meta.set "doc" (XObj (Str docString) Nothing Nothing) emptyMeta
-   in (name, Binder meta cmd)
+addCmd :: SymPath -> CommandFunctionType -> String -> String -> (String, Binder)
+addCmd path callback doc example =
+  (name, Binder meta cmd)
   where
-    f = case maybeArity of
-      Just arity -> withArity arity
-      Nothing -> callback
-    docString = doc ++ "\n\n" ++ exampleUsage
+    SymPath _ name = path
     exampleUsage = "Example Usage:\n```\n" ++ example ++ "\n```\n"
-    withArity arity ctx args =
-      if length args == arity
-        then callback ctx args
-        else pure (evalError ctx ("Invalid args to '" ++ show path ++ "' command: " ++ joinWithComma (map pretty args) ++ "\n\n" ++ exampleUsage) Nothing)
-    unfoldArgs =
-      case maybeArity of
-        Just arity ->
-          let tosym x = (XObj (Sym (SymPath [] x) Symbol) Nothing Nothing)
-           in XObj (Arr (map (tosym . intToArgName) [1 .. arity])) Nothing Nothing
-        Nothing -> XObj (Arr [(XObj (Sym (SymPath [] "") Symbol) Nothing Nothing)]) Nothing Nothing
+    docString = doc ++ "\n\n" ++ exampleUsage
+    meta = Meta.set "doc" (XObj (Str docString) Nothing Nothing) emptyMeta
+    cmd =
+      XObj
+        ( Lst
+            [ XObj (Command callback) (Just dummyInfo) Nothing,
+              XObj (Sym path Symbol) Nothing Nothing,
+              XObj
+                ( Arr args
+                )
+                Nothing
+                Nothing
+            ]
+        )
+        (Just dummyInfo)
+        (Just DynamicTy)
+    args = (\x -> XObj (Arr [XObj (Sym (SymPath [] x) Symbol) Nothing Nothing]) Nothing Nothing) <$> argnames
+    argnames = case callback of
+      NullaryCommandFunction _ -> []
+      UnaryCommandFunction _ -> ["x"]
+      BinaryCommandFunction _ -> ["x", "y"]
+      TernaryCommandFunction _ -> ["x", "y", "z"]
+      VariadicCommandFunction _ -> []
+
+-- | Use this function to register nullary commands in the environment.
+addNullaryCommand :: SymPath -> NullaryCommandCallback -> String -> String -> (String, Binder)
+addNullaryCommand p = addCmd p . NullaryCommandFunction
+
+-- | Use this function to register unary commands in the environment.
+addUnaryCommand :: SymPath -> UnaryCommandCallback -> String -> String -> (String, Binder)
+addUnaryCommand p = addCmd p . UnaryCommandFunction
+
+-- | Use this function to register binary commands in the environment.
+addBinaryCommand :: SymPath -> BinaryCommandCallback -> String -> String -> (String, Binder)
+addBinaryCommand p = addCmd p . BinaryCommandFunction
+
+-- | Use this function to register ternary commands in the environment.
+addTernaryCommand :: SymPath -> TernaryCommandCallback -> String -> String -> (String, Binder)
+addTernaryCommand p = addCmd p . TernaryCommandFunction
+
+-- | Use this function to register n-ary commands in the environment.
+addVariadicCommand :: SymPath -> VariadicCommandCallback -> String -> String -> (String, Binder)
+addVariadicCommand p = addCmd p . VariadicCommandFunction
 
 presentErrorWithLabel :: MonadIO m => String -> String -> a -> m a
 presentErrorWithLabel label msg ret =
@@ -100,8 +114,8 @@ presentError msg ret =
     pure ret
 
 -- | Command for changing various project settings.
-commandProjectConfig :: CommandCallback
-commandProjectConfig ctx [xobj@(XObj (Str key) _ _), value] = do
+commandProjectConfig :: BinaryCommandCallback
+commandProjectConfig ctx xobj@(XObj (Str key) _ _) value = do
   let proj = contextProj ctx
       newProj = case key of
         "cflag" -> do
@@ -182,13 +196,12 @@ commandProjectConfig ctx [xobj@(XObj (Str key) _ _), value] = do
   case newProj of
     Left errorMessage -> presentErrorWithLabel "CONFIG ERROR" errorMessage (ctx, dynamicNil)
     Right ok -> pure (ctx {contextProj = ok}, dynamicNil)
-commandProjectConfig ctx [faultyKey, _] =
+commandProjectConfig ctx faultyKey _ =
   presentError ("First argument to 'Project.config' must be a string: " ++ pretty faultyKey) (ctx, dynamicNil)
-commandProjectConfig _ _ = error "commandprojectconfig"
 
 -- | Command for changing various project settings.
-commandProjectGetConfig :: CommandCallback
-commandProjectGetConfig ctx [xobj@(XObj (Str key) _ _)] =
+commandProjectGetConfig :: UnaryCommandCallback
+commandProjectGetConfig ctx xobj@(XObj (Str key) _ _) =
   let proj = contextProj ctx
       xstr s = XObj s (Just dummyInfo) (Just StringTy)
       getVal _ = case key of
@@ -218,20 +231,19 @@ commandProjectGetConfig ctx [xobj@(XObj (Str key) _ _)] =
    in pure $ case getVal ctx of
         Right val -> (ctx, Right $ xstr val)
         Left k -> (evalError ctx (labelStr "CONFIG ERROR" ("Project.get-config can't understand the key '" ++ k)) (xobjInfo xobj))
-commandProjectGetConfig ctx [faultyKey] =
+commandProjectGetConfig ctx faultyKey =
   presentError ("First argument to 'Project.config' must be a string: " ++ pretty faultyKey) (ctx, dynamicNil)
-commandProjectGetConfig _ _ = error "commandprojectgetconfig"
 
 -- | Command for exiting the REPL/compiler
-commandQuit :: CommandCallback
-commandQuit ctx _ =
+commandQuit :: NullaryCommandCallback
+commandQuit ctx =
   do
     _ <- liftIO exitSuccess
     pure (ctx, dynamicNil)
 
 -- | Command for printing the generated C output (in out/main.c)
-commandCat :: CommandCallback
-commandCat ctx _ = do
+commandCat :: NullaryCommandCallback
+commandCat ctx = do
   let outDir = projectOutDir (contextProj ctx)
       outMain = outDir </> "main.c"
   liftIO $ do
@@ -239,8 +251,8 @@ commandCat ctx _ = do
     pure (ctx, dynamicNil)
 
 -- | Command for running the executable generated by the 'build' command.
-commandRunExe :: CommandCallback
-commandRunExe ctx _ = do
+commandRunExe :: NullaryCommandCallback
+commandRunExe ctx = do
   let proj = contextProj ctx
       outDir = projectOutDir proj
       quoted x = "\"" ++ x ++ "\""
@@ -257,8 +269,8 @@ commandRunExe ctx _ = do
       pure (ctx, dynamicNil)
 
 -- | Command for building the project, producing an executable binary or a shared library.
-commandBuild :: Bool -> Context -> [XObj] -> IO (Context, Either EvalError XObj)
-commandBuild shutUp ctx _ = do
+commandBuild :: Bool -> NullaryCommandCallback
+commandBuild shutUp ctx = do
   let env = contextGlobalEnv ctx
       typeEnv = contextTypeEnv ctx
       proj = contextProj ctx
@@ -330,8 +342,8 @@ setProjectCanExecute value ctx =
    in ctx {contextProj = proj'}
 
 -- | Command for printing all the bindings in the current environment.
-commandListBindings :: CommandCallback
-commandListBindings ctx _ =
+commandListBindings :: NullaryCommandCallback
+commandListBindings ctx =
   liftIO $ do
     putStrLn "Types:\n"
     putStrLn (prettyEnvironment (getTypeEnv (contextTypeEnv ctx)))
@@ -341,24 +353,24 @@ commandListBindings ctx _ =
     pure (ctx, dynamicNil)
 
 -- | Command for printing information about the current project.
-commandProject :: CommandCallback
-commandProject ctx _ = do
+commandProject :: NullaryCommandCallback
+commandProject ctx = do
   liftIO (print (contextProj ctx))
   pure (ctx, dynamicNil)
 
 -- | Command for getting the name of the operating system you're on.
-commandHostOS :: CommandCallback
-commandHostOS ctx _ =
+commandHostOS :: NullaryCommandCallback
+commandHostOS ctx =
   pure (ctx, (Right (XObj (Str os) (Just dummyInfo) (Just StringTy))))
 
 -- | Command for getting the native architecture.
-commandHostArch :: CommandCallback
-commandHostArch ctx _ =
+commandHostArch :: NullaryCommandCallback
+commandHostArch ctx =
   pure (ctx, (Right (XObj (Str arch) (Just dummyInfo) (Just StringTy))))
 
 -- | Command for adding a header file include to the project.
-commandAddInclude :: (String -> Includer) -> CommandCallback
-commandAddInclude includerConstructor ctx [x] =
+commandAddInclude :: (String -> Includer) -> UnaryCommandCallback
+commandAddInclude includerConstructor ctx x =
   case x of
     XObj (Str file) _ _ -> do
       let proj = contextProj ctx
@@ -372,130 +384,115 @@ commandAddInclude includerConstructor ctx [x] =
       pure (ctx {contextProj = proj'}, dynamicNil)
     _ ->
       pure (evalError ctx ("Argument to 'include' must be a string, but was `" ++ pretty x ++ "`") (xobjInfo x))
-commandAddInclude _ _ _ = error "commandaddinclude"
 
-commandAddSystemInclude :: CommandCallback
+commandAddSystemInclude :: UnaryCommandCallback
 commandAddSystemInclude = commandAddInclude SystemInclude
 
-commandAddRelativeInclude :: CommandCallback
-commandAddRelativeInclude ctx [x] =
+commandAddRelativeInclude :: UnaryCommandCallback
+commandAddRelativeInclude ctx x =
   case x of
     XObj (Str file) i@(Just info) t ->
       let compiledFile = infoFile info
        in commandAddInclude
             RelativeInclude
             ctx
-            [ XObj (Str $ takeDirectory compiledFile </> file) i t
-            ]
+            (XObj (Str $ takeDirectory compiledFile </> file) i t)
     _ ->
       pure (evalError ctx ("Argument to 'include' must be a string, but was `" ++ pretty x ++ "`") (xobjInfo x))
-commandAddRelativeInclude _ _ = error "commandaddrelativeinclude"
 
-commandIsList :: CommandCallback
-commandIsList ctx [x] =
+commandIsList :: UnaryCommandCallback
+commandIsList ctx x =
   pure $ case x of
     XObj (Lst _) _ _ -> (ctx, Right trueXObj)
     _ -> (ctx, Right falseXObj)
-commandIsList _ _ = error "commandislist"
 
-commandIsArray :: CommandCallback
-commandIsArray ctx [x] =
+commandIsArray :: UnaryCommandCallback
+commandIsArray ctx x =
   pure $ case x of
     XObj (Arr _) _ _ -> (ctx, Right trueXObj)
     _ -> (ctx, Right falseXObj)
-commandIsArray _ _ = error "commandisarray"
 
-commandIsSymbol :: CommandCallback
-commandIsSymbol ctx [x] =
+commandIsSymbol :: UnaryCommandCallback
+commandIsSymbol ctx x =
   pure $ case x of
     XObj (Sym _ _) _ _ -> (ctx, Right trueXObj)
     _ -> (ctx, Right falseXObj)
-commandIsSymbol _ _ = error "commandissymbol"
 
-commandArray :: CommandCallback
+commandArray :: VariadicCommandCallback
 commandArray ctx args =
   pure (ctx, Right (XObj (Arr args) (Just dummyInfo) Nothing))
 
-commandList :: CommandCallback
+commandList :: VariadicCommandCallback
 commandList ctx args =
   pure (ctx, Right (XObj (Lst args) (Just dummyInfo) Nothing))
 
-commandLength :: CommandCallback
-commandLength ctx [x] =
+commandLength :: UnaryCommandCallback
+commandLength ctx x =
   pure $ case x of
     XObj (Lst lst) _ _ ->
       (ctx, (Right (XObj (Num IntTy (Integral (length lst))) Nothing Nothing)))
     XObj (Arr arr) _ _ ->
       (ctx, (Right (XObj (Num IntTy (Integral (length arr))) Nothing Nothing)))
     _ -> evalError ctx ("Applying 'length' to non-list: " ++ pretty x) (xobjInfo x)
-commandLength _ _ = error "commandlength"
 
-commandCar :: CommandCallback
-commandCar ctx [x] =
+commandCar :: UnaryCommandCallback
+commandCar ctx x =
   pure $ case x of
     XObj (Lst (car : _)) _ _ -> (ctx, Right car)
     XObj (Arr (car : _)) _ _ -> (ctx, Right car)
     _ -> evalError ctx ("Applying 'car' to non-list: " ++ pretty x) (xobjInfo x)
-commandCar _ _ = error "commandcar"
 
-commandCdr :: CommandCallback
-commandCdr ctx [x] =
+commandCdr :: UnaryCommandCallback
+commandCdr ctx x =
   pure $ case x of
     XObj (Lst (_ : cdr)) i _ -> (ctx, Right (XObj (Lst cdr) i Nothing))
     XObj (Arr (_ : cdr)) i _ -> (ctx, Right (XObj (Arr cdr) i Nothing))
     _ -> evalError ctx "Applying 'cdr' to non-list or empty list" (xobjInfo x)
-commandCdr _ _ = error "commandcdr"
 
-commandLast :: CommandCallback
-commandLast ctx [x] =
+commandLast :: UnaryCommandCallback
+commandLast ctx x =
   pure $ case x of
     XObj (Lst lst@(_ : _)) _ _ -> (ctx, Right (last lst))
     XObj (Arr arr@(_ : _)) _ _ -> (ctx, Right (last arr))
     _ -> evalError ctx "Applying 'last' to non-list or empty list." (xobjInfo x)
-commandLast _ _ = error "commandlast"
 
-commandAllButLast :: CommandCallback
-commandAllButLast ctx [x] =
+commandAllButLast :: UnaryCommandCallback
+commandAllButLast ctx x =
   pure $ case x of
     XObj (Lst lst) i _ -> (ctx, Right (XObj (Lst (init lst)) i Nothing))
     XObj (Arr arr) i _ -> (ctx, Right (XObj (Arr (init arr)) i Nothing))
     _ -> evalError ctx "Applying 'all-but-last' to non-list or empty list." (xobjInfo x)
-commandAllButLast _ _ = error "commandallbutlast"
 
-commandCons :: CommandCallback
-commandCons ctx [x, xs] =
+commandCons :: BinaryCommandCallback
+commandCons ctx x xs =
   pure $ case xs of
     XObj (Lst lst) _ _ ->
       (ctx, Right (XObj (Lst (x : lst)) (xobjInfo x) (xobjTy x))) -- TODO: probably not correct to just copy 'i' and 't'?
     XObj (Arr arr) _ _ -> (ctx, Right (XObj (Arr (x : arr)) (xobjInfo x) (xobjTy x)))
     _ -> evalError ctx "Applying 'cons' to non-list or empty list." (xobjInfo xs)
-commandCons _ _ = error "commandcons"
 
-commandConsLast :: CommandCallback
-commandConsLast ctx [x, xs] =
+commandConsLast :: BinaryCommandCallback
+commandConsLast ctx x xs =
   pure $ case xs of
     XObj (Lst lst) i t ->
       (ctx, Right (XObj (Lst (lst ++ [x])) i t)) -- TODO: should they get their own i:s and t:s
     _ -> evalError ctx "Applying 'cons-last' to non-list or empty list." (xobjInfo xs)
-commandConsLast _ _ = error "commandconslast"
 
-commandAppend :: CommandCallback
-commandAppend ctx [xs, ys] =
+commandAppend :: BinaryCommandCallback
+commandAppend ctx xs ys =
   pure $ case (xs, ys) of
     (XObj (Lst lst1) i t, XObj (Lst lst2) _ _) ->
       (ctx, Right (XObj (Lst (lst1 ++ lst2)) i t)) -- TODO: should they get their own i:s and t:s
     (XObj (Arr arr1) i t, XObj (Arr arr2) _ _) -> (ctx, Right (XObj (Arr (arr1 ++ arr2)) i t))
     _ -> evalError ctx "Applying 'append' to non-array/list or empty list." (xobjInfo xs)
-commandAppend _ _ = error "commandappend"
 
-commandMacroError :: CommandCallback
-commandMacroError ctx [msg] =
+commandMacroError :: UnaryCommandCallback
+commandMacroError ctx msg =
   pure $ case msg of
     XObj (Str smsg) _ _ -> evalError ctx smsg (xobjInfo msg)
     x -> evalError ctx (pretty x) (xobjInfo msg)
-commandMacroError _ _ = error "commandmacroerror"
 
-commandMacroLog :: CommandCallback
+commandMacroLog :: VariadicCommandCallback
 commandMacroLog ctx msgs = do
   liftIO (mapM_ (putStr . logify) msgs)
   liftIO (putStr "\n")
@@ -506,8 +503,8 @@ commandMacroLog ctx msgs = do
         XObj (Str msg) _ _ -> msg
         x -> pretty x
 
-commandEq :: CommandCallback
-commandEq ctx [a, b] =
+commandEq :: BinaryCommandCallback
+commandEq ctx a b =
   pure $ case cmp (a, b) of
     Left (a', b') -> evalError ctx ("Can't compare " ++ pretty a' ++ " with " ++ pretty b') (xobjInfo a')
     Right b' -> (ctx, Right (boolToXObj b'))
@@ -549,153 +546,138 @@ commandEq ctx [a, b] =
     cmp' _ invalid@(Left _) = invalid
     cmp' _ (Right False) = Right False
     cmp' elt (Right True) = cmp elt
-commandEq _ _ = error "commandeq"
 
-commandComp :: (Number -> Number -> Bool) -> String -> CommandCallback
-commandComp op _ ctx [XObj (Num aTy aNum) _ _, XObj (Num bTy bNum) _ _] | aTy == bTy = pure $ (ctx, Right (boolToXObj (op aNum bNum)))
-commandComp _ opname ctx [a, b] = pure $ evalError ctx ("Can't compare (" ++ opname ++ ") " ++ pretty a ++ " with " ++ pretty b) (xobjInfo a)
-commandComp _ _ _ _ = error "commandcomp"
+commandComp :: (Number -> Number -> Bool) -> String -> BinaryCommandCallback
+commandComp op _ ctx (XObj (Num aTy aNum) _ _) (XObj (Num bTy bNum) _ _) | aTy == bTy = pure $ (ctx, Right (boolToXObj (op aNum bNum)))
+commandComp _ opname ctx a b = pure $ evalError ctx ("Can't compare (" ++ opname ++ ") " ++ pretty a ++ " with " ++ pretty b) (xobjInfo a)
 
-commandLt :: CommandCallback
+commandLt :: BinaryCommandCallback
 commandLt = commandComp (<) "<"
 
-commandGt :: CommandCallback
+commandGt :: BinaryCommandCallback
 commandGt = commandComp (>) ">"
 
-commandCharAt :: CommandCallback
-commandCharAt ctx [a, b] =
+commandCharAt :: BinaryCommandCallback
+commandCharAt ctx a b =
   pure $ case (a, b) of
     (XObj (Str s) _ _, XObj (Num IntTy (Integral i)) _ _) ->
       if length s > i
         then (ctx, Right (XObj (Chr (s !! i)) (Just dummyInfo) (Just IntTy)))
         else evalError ctx ("Can't call char-at with " ++ pretty a ++ " and " ++ show i ++ ", index too large") (xobjInfo a)
     _ -> evalError ctx ("Can't call char-at with " ++ pretty a ++ " and " ++ pretty b) (xobjInfo a)
-commandCharAt _ _ = error "commandcharat"
 
-commandIndexOf :: CommandCallback
-commandIndexOf ctx [a, b] =
+commandIndexOf :: BinaryCommandCallback
+commandIndexOf ctx a b =
   pure $ case (a, b) of
     (XObj (Str s) _ _, XObj (Chr c) _ _) ->
       (ctx, Right (XObj (Num IntTy (Integral (getIdx c s))) (Just dummyInfo) (Just IntTy)))
     _ -> evalError ctx ("Can't call index-of with " ++ pretty a ++ " and " ++ pretty b) (xobjInfo a)
   where
     getIdx c s = fromMaybe (-1) $ elemIndex c s
-commandIndexOf _ _ = error "commandindexof"
 
-commandSubstring :: CommandCallback
-commandSubstring ctx [a, b, c] =
+commandSubstring :: TernaryCommandCallback
+commandSubstring ctx a b c =
   pure $ case (a, b, c) of
     (XObj (Str s) _ _, XObj (Num IntTy (Integral f)) _ _, XObj (Num IntTy (Integral t)) _ _) ->
       (ctx, Right (XObj (Str (take t (drop f s))) (Just dummyInfo) (Just StringTy)))
     _ -> evalError ctx ("Can't call substring with " ++ pretty a ++ ", " ++ pretty b ++ " and " ++ pretty c) (xobjInfo a)
-commandSubstring _ _ = error "commandsubstring"
 
-commandStringLength :: CommandCallback
-commandStringLength ctx [a] =
+commandStringLength :: UnaryCommandCallback
+commandStringLength ctx a =
   pure $ case a of
     XObj (Str s) _ _ ->
       (ctx, Right (XObj (Num IntTy (Integral (length s))) (Just dummyInfo) (Just IntTy)))
     _ -> evalError ctx ("Can't call length with " ++ pretty a) (xobjInfo a)
-commandStringLength _ _ = error "commandstringlength"
 
-commandStringConcat :: CommandCallback
-commandStringConcat ctx [a] =
+commandStringConcat :: UnaryCommandCallback
+commandStringConcat ctx a =
   pure $ case a of
     XObj (Arr strings) _ _ ->
       case mapM unwrapStringXObj strings of
         Left err -> evalError ctx err (xobjInfo a)
         Right result -> (ctx, Right (XObj (Str (join result)) (Just dummyInfo) (Just StringTy)))
     _ -> evalError ctx ("Can't call concat with " ++ pretty a) (xobjInfo a)
-commandStringConcat _ _ = error "commandconcat"
 
-commandStringSplitOn :: CommandCallback
-commandStringSplitOn ctx [XObj (Str sep) _ _, XObj (Str s) _ _] =
+commandStringSplitOn :: BinaryCommandCallback
+commandStringSplitOn ctx (XObj (Str sep) _ _) (XObj (Str s) _ _) =
   pure $ (ctx, Right (XObj (Arr (xstr <$> splitOn sep s)) (Just dummyInfo) Nothing))
   where
     xstr o = XObj (Str o) (Just dummyInfo) (Just StringTy)
-commandStringSplitOn ctx [sep, s] =
+commandStringSplitOn ctx sep s =
   pure $ evalError ctx ("Can't call split-on with " ++ pretty sep ++ ", " ++ pretty s) (xobjInfo sep)
-commandStringSplitOn _ _ = error "commandstringspliton"
 
-commandSymConcat :: CommandCallback
-commandSymConcat ctx [a] =
+commandSymConcat :: UnaryCommandCallback
+commandSymConcat ctx a =
   pure $ case a of
     XObj (Arr syms) _ _ ->
       case mapM unwrapSymPathXObj syms of
         Left err -> evalError ctx err (xobjInfo a)
         Right result -> (ctx, Right (XObj (Sym (SymPath [] (join (map show result))) (LookupGlobal CarpLand AVariable)) (Just dummyInfo) Nothing))
     _ -> evalError ctx ("Can't call concat with " ++ pretty a) (xobjInfo a)
-commandSymConcat _ _ = error "commandsymconcat"
 
-commandSymPrefix :: CommandCallback
-commandSymPrefix ctx [XObj (Sym (SymPath [] prefix) _) _ _, XObj (Sym (SymPath [] suffix) _) i t] =
+commandSymPrefix :: BinaryCommandCallback
+commandSymPrefix ctx (XObj (Sym (SymPath [] prefix) _) _ _) (XObj (Sym (SymPath [] suffix) _) i t) =
   pure $ (ctx, Right (XObj (Sym (SymPath [prefix] suffix) (LookupGlobal CarpLand AVariable)) i t))
-commandSymPrefix ctx [x, XObj (Sym (SymPath [] _) _) _ _] =
+commandSymPrefix ctx x (XObj (Sym (SymPath [] _) _) _ _) =
   pure $ evalError ctx ("Can’t call `prefix` with " ++ pretty x) (xobjInfo x)
-commandSymPrefix ctx [_, x] =
+commandSymPrefix ctx _ x =
   pure $ evalError ctx ("Can’t call `prefix` with " ++ pretty x) (xobjInfo x)
-commandSymPrefix _ _ = error "commandsymprefix"
 
-commandSymFrom :: CommandCallback
-commandSymFrom ctx [x@(XObj (Sym _ _) _ _)] = pure (ctx, Right x)
-commandSymFrom ctx [XObj (Str s) i t] = pure (ctx, Right $ XObj (sFrom_ s) i t)
-commandSymFrom ctx [XObj (Pattern s) i t] = pure (ctx, Right $ XObj (sFrom_ s) i t)
-commandSymFrom ctx [XObj (Chr c) i t] = pure (ctx, Right $ XObj (sFrom_ (show c)) i t)
-commandSymFrom ctx [XObj (Num _ v) i t] = pure (ctx, Right $ XObj (sFrom_ (show v)) i t)
-commandSymFrom ctx [XObj (Bol b) i t] = pure (ctx, Right $ XObj (sFrom_ (show b)) i t)
-commandSymFrom ctx [x] =
+commandSymFrom :: UnaryCommandCallback
+commandSymFrom ctx x@(XObj (Sym _ _) _ _) = pure (ctx, Right x)
+commandSymFrom ctx (XObj (Str s) i t) = pure (ctx, Right $ XObj (sFrom_ s) i t)
+commandSymFrom ctx (XObj (Pattern s) i t) = pure (ctx, Right $ XObj (sFrom_ s) i t)
+commandSymFrom ctx (XObj (Chr c) i t) = pure (ctx, Right $ XObj (sFrom_ (show c)) i t)
+commandSymFrom ctx (XObj (Num _ v) i t) = pure (ctx, Right $ XObj (sFrom_ (show v)) i t)
+commandSymFrom ctx (XObj (Bol b) i t) = pure (ctx, Right $ XObj (sFrom_ (show b)) i t)
+commandSymFrom ctx x =
   pure $ evalError ctx ("Can’t call `from` with " ++ pretty x) (xobjInfo x)
-commandSymFrom _ _ = error "commandsymfrom"
 
-commandSymStr :: CommandCallback
-commandSymStr ctx [XObj (Sym s _) i _] =
+commandSymStr :: UnaryCommandCallback
+commandSymStr ctx (XObj (Sym s _) i _) =
   pure (ctx, Right $ XObj (Str (show s)) i (Just StringTy))
-commandSymStr ctx [x] =
+commandSymStr ctx x =
   pure $ evalError ctx ("Can’t call `str` with " ++ pretty x) (xobjInfo x)
-commandSymStr _ _ = error "commandsymstr"
 
 sFrom_ :: String -> Obj
 sFrom_ s = Sym (SymPath [] s) (LookupGlobal CarpLand AVariable)
 
-commandPathDirectory :: CommandCallback
-commandPathDirectory ctx [a] =
+commandPathDirectory :: UnaryCommandCallback
+commandPathDirectory ctx a =
   pure $ case a of
     XObj (Str s) _ _ ->
       (ctx, Right (XObj (Str (takeDirectory s)) (Just dummyInfo) (Just StringTy)))
     _ -> evalError ctx ("Can't call `directory` with " ++ pretty a) (xobjInfo a)
-commandPathDirectory _ _ = error "commandpathdirectory"
 
-commandPathAbsolute :: CommandCallback
-commandPathAbsolute ctx [a] =
+commandPathAbsolute :: UnaryCommandCallback
+commandPathAbsolute ctx a =
   case a of
     XObj (Str s) _ _ -> do
       abs <- makeAbsolute s
       pure $ (ctx, Right (XObj (Str abs) (Just dummyInfo) (Just StringTy)))
     _ -> pure $ evalError ctx ("Can't call `absolute` with " ++ pretty a) (xobjInfo a)
-commandPathAbsolute _ _ = error "commandpathabsolute"
 
-commandArith :: (Number -> Number -> Number) -> String -> CommandCallback
-commandArith op _ ctx [XObj (Num aTy aNum) _ _, XObj (Num bTy bNum) _ _]
+commandArith :: (Number -> Number -> Number) -> String -> BinaryCommandCallback
+commandArith op _ ctx (XObj (Num aTy aNum) _ _) (XObj (Num bTy bNum) _ _)
   | aTy == bTy =
     pure $ (ctx, Right (XObj (Num aTy (op aNum bNum)) (Just dummyInfo) (Just aTy)))
-commandArith _ opname ctx [a, b] = pure $ evalError ctx ("Can't call " ++ opname ++ " with " ++ pretty a ++ " and " ++ pretty b) (xobjInfo a)
-commandArith _ _ _ _ = error "commandarith"
+commandArith _ opname ctx a b = pure $ evalError ctx ("Can't call " ++ opname ++ " with " ++ pretty a ++ " and " ++ pretty b) (xobjInfo a)
 
-commandPlus :: CommandCallback
+commandPlus :: BinaryCommandCallback
 commandPlus = commandArith (+) "+"
 
-commandMinus :: CommandCallback
+commandMinus :: BinaryCommandCallback
 commandMinus = commandArith (-) "-"
 
-commandDiv :: CommandCallback
-commandDiv ctx p@[XObj (Num _ (Integral _)) _ _, XObj (Num _ (Integral _)) _ _] = commandArith div "/" ctx p
-commandDiv ctx p@[XObj (Num _ (Floating _)) _ _, XObj (Num _ (Floating _)) _ _] = commandArith (/) "/" ctx p
-commandDiv ctx p = commandArith (error "div") "/" ctx p
+commandDiv :: BinaryCommandCallback
+commandDiv ctx p@(XObj (Num _ (Integral _)) _ _) q@(XObj (Num _ (Integral _)) _ _) = commandArith div "/" ctx p q
+commandDiv ctx p@(XObj (Num _ (Floating _)) _ _) q@(XObj (Num _ (Floating _)) _ _) = commandArith (/) "/" ctx p q
+commandDiv ctx p q = commandArith (error "div") "/" ctx p q
 
-commandMul :: CommandCallback
+commandMul :: BinaryCommandCallback
 commandMul = commandArith (*) "*"
 
-commandStr :: CommandCallback
+commandStr :: VariadicCommandCallback
 commandStr ctx xs =
   pure (ctx, Right (XObj (Str (join (map f xs))) (Just dummyInfo) (Just StringTy)))
   where
@@ -707,15 +689,14 @@ commandStr ctx xs =
     escape ('\\' : y) = "\\\\" ++ escape y
     escape (x : y) = x : escape y
 
-commandNot :: CommandCallback
-commandNot ctx [x] =
+commandNot :: UnaryCommandCallback
+commandNot ctx x =
   pure $ case x of
     XObj (Bol ab) _ _ -> (ctx, Right (boolToXObj (not ab)))
-    _ -> evalError ctx ("Can't perform logical operation (not) on " ++ pretty x) (xobjInfo x)
-commandNot _ _ = error "commandnot"
+    _ -> evalError ctx ("can't perform logical operation (not) on " ++ pretty x) (xobjInfo x)
 
-commandReadFile :: CommandCallback
-commandReadFile ctx [filename] =
+commandReadFile :: UnaryCommandCallback
+commandReadFile ctx filename =
   case filename of
     XObj (Str fname) _ _ -> do
       exceptional <- liftIO ((try $ slurp fname) :: (IO (Either IOException String)))
@@ -723,10 +704,9 @@ commandReadFile ctx [filename] =
         Right contents -> (ctx, Right (XObj (Str contents) (Just dummyInfo) (Just StringTy)))
         Left _ -> (evalError ctx ("The argument to `read-file` `" ++ fname ++ "` does not exist") (xobjInfo filename))
     _ -> pure (evalError ctx ("The argument to `read-file` must be a string, I got `" ++ pretty filename ++ "`") (xobjInfo filename))
-commandReadFile _ _ = error "commandreadfile"
 
-commandWriteFile :: CommandCallback
-commandWriteFile ctx [filename, contents] =
+commandWriteFile :: BinaryCommandCallback
+commandWriteFile ctx filename contents =
   case filename of
     XObj (Str fname) _ _ ->
       case contents of
@@ -737,16 +717,14 @@ commandWriteFile ctx [filename, contents] =
             Left _ -> evalError ctx ("Cannot write to argument to `" ++ fname ++ "`, an argument to `write-file`") (xobjInfo filename)
         _ -> pure (evalError ctx ("The second argument to `write-file` must be a string, I got `" ++ pretty contents ++ "`") (xobjInfo contents))
     _ -> pure (evalError ctx ("The first argument to `write-file` must be a string, I got `" ++ pretty filename ++ "`") (xobjInfo filename))
-commandWriteFile _ _ = error "commandwritefile"
 
-commandHostBitWidth :: CommandCallback
-commandHostBitWidth ctx [] =
+commandHostBitWidth :: NullaryCommandCallback
+commandHostBitWidth ctx =
   let bitSize = Integral (finiteBitSize (undefined :: Int))
    in pure (ctx, Right (XObj (Num IntTy bitSize) (Just dummyInfo) (Just IntTy)))
-commandHostBitWidth _ _ = error "commandhostbitwidth"
 
-commandSaveDocsInternal :: CommandCallback
-commandSaveDocsInternal ctx [modulePath] = do
+commandSaveDocsInternal :: UnaryCommandCallback
+commandSaveDocsInternal ctx modulePath = do
   let globalEnv = contextGlobalEnv ctx
   case modulePath of
     XObj (Lst xobjs) _ _ ->
@@ -768,23 +746,22 @@ commandSaveDocsInternal ctx [modulePath] = do
           Left ("I can’t generate documentation for `" ++ pretty x ++ "` because it isn’t a module")
         Nothing ->
           Left ("I can’t find the module `" ++ show path ++ "`")
-commandSaveDocsInternal _ _ = error "commandsavedocsinternal"
 
 saveDocs :: Context -> [(SymPath, Binder)] -> IO (Context, Either a XObj)
 saveDocs ctx pathsAndEnvBinders = do
   liftIO (saveDocsForEnvs (contextProj ctx) pathsAndEnvBinders)
   pure (ctx, dynamicNil)
 
-commandSexpression :: CommandCallback
+commandSexpression :: VariadicCommandCallback
 commandSexpression ctx [xobj, (XObj (Bol b) _ _)] =
-  commandSexpressionInternal ctx [xobj] b
+  commandSexpressionInternal ctx xobj b
 commandSexpression ctx [xobj] =
-  commandSexpressionInternal ctx [xobj] False
+  commandSexpressionInternal ctx xobj False
 commandSexpression ctx xobj =
   pure $ evalError ctx ("s-expr expects a symbol argument and an optional bool, but got: " ++ unwords (map pretty xobj)) (Just dummyInfo)
 
-commandSexpressionInternal :: Context -> [XObj] -> Bool -> IO (Context, Either EvalError XObj)
-commandSexpressionInternal ctx [xobj] bol =
+commandSexpressionInternal :: Context -> XObj -> Bool -> IO (Context, Either EvalError XObj)
+commandSexpressionInternal ctx xobj bol =
   let tyEnv = getTypeEnv $ contextTypeEnv ctx
    in case xobj of
         (XObj (Lst [inter@(XObj (Interface ty _) _ _), path]) i t) ->
@@ -824,7 +801,6 @@ commandSexpressionInternal ctx [xobj] bol =
                 combine _ _ = error "combine"
         _ ->
           pure $ evalError ctx ("can't get an s-expression for: " ++ pretty xobj ++ " is it a bound symbol or literal s-expression?") (Just dummyInfo)
-commandSexpressionInternal _ _ _ = error "commandsexpressioninternal"
 
 toSymbols :: XObj -> XObj
 toSymbols (XObj (Mod e) i t) =

src/Emit.hs

@@ -114,61 +114,62 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
       Globals -> 4
       All -> 0
     visit :: Int -> XObj -> State EmitterState String
-    visit indent xobj = let dontVisit = error (show (DontVisitObj xobj)) in
-      case xobjObj xobj of
-        Lst _ -> visitList indent xobj
-        Arr _ -> visitArray indent xobj
-        StaticArr _ -> visitStaticArray indent xobj
-        Num IntTy num -> pure (show num)
-        Num LongTy num -> pure (show num ++ "l")
-        Num ByteTy num -> pure (show num)
-        Num FloatTy num -> pure (show num ++ "f")
-        Num DoubleTy num -> pure (show num)
-        Num _ _ -> error "Can't emit invalid number type."
-        Bol b -> pure (if b then "true" else "false")
-        Str _ -> visitString indent xobj
-        Pattern _ -> visitString indent xobj
-        Chr c -> pure $ case c of
-          '\t' -> "'\\t'"
-          '\n' -> "'\\n'"
-          '\\' -> "'\\\\'"
-          x -> show (ord x) ++ "/*" ++ show x ++ "*/" -- ['U', '\'', x, '\'']
-        Closure elt _ -> visit indent elt
-        Sym _ _ -> visitSymbol indent xobj
-        Mod _ -> error (show (CannotEmitModKeyword xobj))
-        External _ -> error (show (CannotEmitExternal xobj))
-        (Defn _) -> dontVisit
-        Def -> dontVisit
-        Let -> dontVisit
-        If -> dontVisit
-        Break -> dontVisit
-        While -> dontVisit
-        Do -> dontVisit
-        (Deftype _) -> dontVisit
-        (DefSumtype _) -> dontVisit
-        ExternalType _ -> dontVisit
-        (Command _) -> dontVisit
-        (Primitive _) -> dontVisit
-        (Deftemplate _) -> dontVisit
-        (Instantiate _) -> dontVisit
-        (Defalias _) -> dontVisit
-        (MultiSym _ _) -> dontVisit
-        (InterfaceSym _) -> dontVisit
-        Address -> dontVisit
-        SetBang -> dontVisit
-        Macro -> dontVisit
-        Dynamic -> dontVisit
-        DefDynamic -> dontVisit
-        The -> dontVisit
-        Ref -> dontVisit
-        Deref -> dontVisit
-        (Interface _ _) -> dontVisit
-        (Dict _) -> dontVisit
-        (Fn _ _) -> dontVisit
-        LetDef -> dontVisit
-        (Match _) -> dontVisit
-        With -> dontVisit
-        MetaStub -> dontVisit
+    visit indent xobj =
+      let dontVisit = error (show (DontVisitObj xobj))
+       in case xobjObj xobj of
+            Lst _ -> visitList indent xobj
+            Arr _ -> visitArray indent xobj
+            StaticArr _ -> visitStaticArray indent xobj
+            Num IntTy num -> pure (show num)
+            Num LongTy num -> pure (show num ++ "l")
+            Num ByteTy num -> pure (show num)
+            Num FloatTy num -> pure (show num ++ "f")
+            Num DoubleTy num -> pure (show num)
+            Num _ _ -> error "Can't emit invalid number type."
+            Bol b -> pure (if b then "true" else "false")
+            Str _ -> visitString indent xobj
+            Pattern _ -> visitString indent xobj
+            Chr c -> pure $ case c of
+              '\t' -> "'\\t'"
+              '\n' -> "'\\n'"
+              '\\' -> "'\\\\'"
+              x -> show (ord x) ++ "/*" ++ show x ++ "*/" -- ['U', '\'', x, '\'']
+            Closure elt _ -> visit indent elt
+            Sym _ _ -> visitSymbol indent xobj
+            Mod _ -> error (show (CannotEmitModKeyword xobj))
+            External _ -> error (show (CannotEmitExternal xobj))
+            (Defn _) -> dontVisit
+            Def -> dontVisit
+            Let -> dontVisit
+            If -> dontVisit
+            Break -> dontVisit
+            While -> dontVisit
+            Do -> dontVisit
+            (Deftype _) -> dontVisit
+            (DefSumtype _) -> dontVisit
+            ExternalType _ -> dontVisit
+            (Command _) -> dontVisit
+            (Primitive _) -> dontVisit
+            (Deftemplate _) -> dontVisit
+            (Instantiate _) -> dontVisit
+            (Defalias _) -> dontVisit
+            (MultiSym _ _) -> dontVisit
+            (InterfaceSym _) -> dontVisit
+            Address -> dontVisit
+            SetBang -> dontVisit
+            Macro -> dontVisit
+            Dynamic -> dontVisit
+            DefDynamic -> dontVisit
+            The -> dontVisit
+            Ref -> dontVisit
+            Deref -> dontVisit
+            (Interface _ _) -> dontVisit
+            (Dict _) -> dontVisit
+            (Fn _ _) -> dontVisit
+            LetDef -> dontVisit
+            (Match _) -> dontVisit
+            With -> dontVisit
+            MetaStub -> dontVisit
     visitStr' indent str i =
       -- This will allocate a new string every time the code runs:
       -- do let var = freshVar i

src/Eval.hs

@@ -285,7 +285,7 @@ eval ctx xobj@(XObj o info ty) preference =
               then (ctx, Right (XObj (Closure (XObj (Lst l) info ty) (CCtx ctx)) info ty))
               else evalError ctx ("`fn` requires all arguments to be unqualified symbols, but it got `" ++ pretty args ++ "`") (xobjInfo args)
         XObj (Closure (XObj (Lst [XObj (Fn _ _) _ _, XObj (Arr params) _ _, body]) _ _) (CCtx c)) _ _ : args ->
-          case checkArity params args of
+          case checkArity "<closure>" params args of
             Left err -> pure (evalError ctx err (xobjInfo xobj))
             Right () ->
               do
@@ -295,8 +295,8 @@ eval ctx xobj@(XObj o info ty) preference =
                     (_, res) <- apply c body params okArgs
                     pure (newCtx, res)
                   Left err -> pure (newCtx, Left err)
-        XObj (Lst [XObj Dynamic _ _, _, XObj (Arr params) _ _, body]) i _ : args ->
-          case checkArity params args of
+        XObj (Lst [XObj Dynamic _ _, sym, XObj (Arr params) _ _, body]) i _ : args ->
+          case checkArity (getName sym) params args of
             Left err ->
               pure (evalError ctx err i)
             Right () ->
@@ -305,8 +305,8 @@ eval ctx xobj@(XObj o info ty) preference =
                 case evaledArgs of
                   Right okArgs -> apply newCtx body params okArgs
                   Left err -> pure (newCtx, Left err)
-        XObj (Lst [XObj Macro _ _, _, XObj (Arr params) _ _, body]) i _ : args ->
-          case checkArity params args of
+        XObj (Lst [XObj Macro _ _, sym, XObj (Arr params) _ _, body]) i _ : args ->
+          case checkArity (getName sym) params args of
             Left err -> pure (evalError ctx err i)
             Right () -> do
               -- Replace info so that the macro which is called gets the source location info of the expansion site.
@@ -315,13 +315,43 @@ eval ctx xobj@(XObj o info ty) preference =
               case res of
                 Right xobj' -> macroExpand ctx' xobj'
                 Left _ -> pure (ctx, res)
-        XObj (Lst [XObj (Command callback) _ _, _, _]) _ _ : args ->
+        [XObj (Lst [XObj (Command (NullaryCommandFunction nullary)) _ _, _, _]) _ _] ->
+          do
+            (_, evaledArgs) <- foldlM successiveEval (ctx, Right []) []
+            case evaledArgs of
+              Right [] -> nullary ctx
+              Right _ -> error "eval nullary"
+              Left err -> pure (ctx, Left err)
+        [XObj (Lst [XObj (Command (UnaryCommandFunction unary)) _ _, _, _]) _ _, x] ->
+          do
+            (_, evaledArgs) <- foldlM successiveEval (ctx, Right []) [x]
+            case evaledArgs of
+              Right [x'] -> unary ctx x'
+              Right _ -> error "eval unary"
+              Left err -> pure (ctx, Left err)
+        [XObj (Lst [XObj (Command (BinaryCommandFunction binary)) _ _, _, _]) _ _, x, y] ->
+          do
+            (_, evaledArgs) <- foldlM successiveEval (ctx, Right []) [x, y]
+            case evaledArgs of
+              Right [x', y'] -> binary ctx x' y'
+              Right _ -> error "eval binary"
+              Left err -> pure (ctx, Left err)
+        [XObj (Lst [XObj (Command (TernaryCommandFunction ternary)) _ _, _, _]) _ _, x, y, z] ->
+          do
+            (_, evaledArgs) <- foldlM successiveEval (ctx, Right []) [x, y, z]
+            case evaledArgs of
+              Right [x', y', z'] -> ternary ctx x' y' z'
+              Right _ -> error "eval ternary"
+              Left err -> pure (ctx, Left err)
+        XObj (Lst [XObj (Command (VariadicCommandFunction variadic)) _ _, _, _]) _ _ : args ->
           do
             (_, evaledArgs) <- foldlM successiveEval (ctx, Right []) args
             case evaledArgs of
-              Right okArgs -> getCommand callback ctx okArgs
+              Right xs -> variadic ctx xs
               Left err -> pure (ctx, Left err)
-        x@(XObj (Lst [XObj (Primitive prim) _ _, _, _]) _ _) : args -> (getPrimitive prim) x ctx args
+        XObj (Lst [XObj (Command _) _ _, sym, XObj (Arr params) _ _]) i _ : args ->
+          badArity (getName sym) params args i
+        x@(XObj (Lst [XObj (Primitive prim) _ _, _, _]) _ _) : args -> getPrimitive prim x ctx args
         XObj (Lst (XObj (Defn _) _ _ : _)) _ _ : _ -> pure (ctx, Left (HasStaticCall xobj info))
         XObj (Lst (XObj (Interface _ _) _ _ : _)) _ _ : _ -> pure (ctx, Left (HasStaticCall xobj info))
         XObj (Lst (XObj (Instantiate _) _ _ : _)) _ _ : _ -> pure (ctx, Left (HasStaticCall xobj info))
@@ -361,9 +391,11 @@ eval ctx xobj@(XObj o info ty) preference =
         [XObj Address _ _, value] ->
           specialCommandAddress ctx value
         [] -> pure (ctx, dynamicNil)
-        _ -> do
-          pure (evalError ctx ("I did not understand the form `" ++ pretty xobj ++ "`") (xobjInfo xobj))
-    checkArity params args =
+        _ -> pure (evalError ctx ("I did not understand the form `" ++ pretty xobj ++ "`") (xobjInfo xobj))
+    badArity name params args i = case checkArity name params args of
+      Left err -> pure (evalError ctx err i)
+      Right () -> error "badarity"
+    checkArity name params args =
       let la = length args
           withRest = any ((":rest" ==) . getName) params
           lp = length params - (if withRest then 2 else 0)
@@ -373,7 +405,9 @@ eval ctx xobj@(XObj o info ty) preference =
               if la < lp
                 then
                   Left
-                    ( "expected " ++ show lp
+                    ( name
+                        ++ " expected "
+                        ++ show lp
                         ++ " arguments but received only "
                         ++ show la
                         ++ ".\n\nYou’ll have to provide "
@@ -382,7 +416,10 @@ eval ctx xobj@(XObj o info ty) preference =
                     )
                 else
                   Left
-                    ( "expected " ++ show lp ++ " arguments, but received "
+                    ( name
+                        ++ " expected "
+                        ++ show lp
+                        ++ " arguments, but received "
                         ++ show la
                         ++ ".\n\nThe arguments "
                         ++ intercalate ", " (map pretty (drop lp args))
@@ -772,19 +809,17 @@ primitiveDefmodule _ ctx [] =
 -- | "NORMAL" COMMANDS (just like the ones in Command.hs, but these need access to 'eval', etc.)
 
 -- | Command for loading a Carp file.
-commandLoad :: CommandCallback
-commandLoad ctx [xobj@(XObj (Str path) i _)] =
+commandLoad :: UnaryCommandCallback
+commandLoad ctx xobj@(XObj (Str path) i _) =
   loadInternal ctx xobj path i DoesReload
-commandLoad ctx [x] =
+commandLoad ctx x =
   pure $ evalError ctx ("Invalid args to `load`: " ++ pretty x) (xobjInfo x)
-commandLoad _ _ = error "commandload"
 
-commandLoadOnce :: CommandCallback
-commandLoadOnce ctx [xobj@(XObj (Str path) i _)] =
+commandLoadOnce :: UnaryCommandCallback
+commandLoadOnce ctx xobj@(XObj (Str path) i _) =
   loadInternal ctx xobj path i Frozen
-commandLoadOnce ctx [x] =
+commandLoadOnce ctx x =
   pure $ evalError ctx ("Invalid args to `load-once`: " ++ pretty x) (xobjInfo x)
-commandLoadOnce _ _ = error "commandloadonce"
 
 loadInternal :: Context -> XObj -> String -> Maybe Info -> ReloadMode -> IO (Context, Either EvalError XObj)
 loadInternal ctx xobj path i reloadMode = do
@@ -942,10 +977,10 @@ loadInternal ctx xobj path i reloadMode = do
           fileToLoad = fpath </> realName
           mainToLoad = fpath </> "main.carp"
        in do
-            (newCtx, res) <- commandLoad ctx [XObj (Str fileToLoad) Nothing Nothing]
+            (newCtx, res) <- commandLoad ctx (XObj (Str fileToLoad) Nothing Nothing)
             case res of
               ret@(Right _) -> pure (newCtx, ret)
-              Left _ -> commandLoad ctx [XObj (Str mainToLoad) Nothing Nothing]
+              Left _ -> commandLoad ctx (XObj (Str mainToLoad) Nothing Nothing)
 
 -- | Load several files in order.
 loadFiles :: Context -> [FilePath] -> IO Context
@@ -954,19 +989,19 @@ loadFiles = loadFilesExt commandLoad
 loadFilesOnce :: Context -> [FilePath] -> IO Context
 loadFilesOnce = loadFilesExt commandLoadOnce
 
-loadFilesExt :: CommandCallback -> Context -> [FilePath] -> IO Context
+loadFilesExt :: UnaryCommandCallback -> Context -> [FilePath] -> IO Context
 loadFilesExt loadCmd ctxStart filesToLoad = foldM load ctxStart filesToLoad
   where
     load :: Context -> FilePath -> IO Context
     load ctx file = do
-      (newCtx, ret) <- loadCmd ctx [XObj (Str file) Nothing Nothing]
+      (newCtx, ret) <- loadCmd ctx (XObj (Str file) Nothing Nothing)
       case ret of
         Left err -> throw (EvalException err)
         Right _ -> pure newCtx
 
 -- | Command for reloading all files in the project (= the files that has been loaded before).
-commandReload :: CommandCallback
-commandReload ctx _ = do
+commandReload :: NullaryCommandCallback
+commandReload ctx = do
   let paths = projectFiles (contextProj ctx)
       f :: Context -> (FilePath, ReloadMode) -> IO Context
       f context (_, Frozen) | not (projectForceReload (contextProj context)) = pure context
@@ -984,14 +1019,13 @@ commandReload ctx _ = do
   pure (newCtx, dynamicNil)
 
 -- | Command for expanding a form and its macros.
-commandExpand :: CommandCallback
-commandExpand ctx [xobj] = macroExpand ctx xobj
-commandExpand  _ _ = error "commandexpand"
+commandExpand :: UnaryCommandCallback
+commandExpand ctx xobj = macroExpand ctx xobj
 
 -- | This function will show the resulting C code from an expression.
 -- | i.e. (Int.+ 2 3) => "_0 = 2 + 3"
-commandC :: CommandCallback
-commandC ctx [xobj] = do
+commandC :: UnaryCommandCallback
+commandC ctx xobj = do
   let globalEnv = contextGlobalEnv ctx
       typeEnv = contextTypeEnv ctx
   (newCtx, result) <- expandAll evalDynamic ctx xobj
@@ -1007,7 +1041,6 @@ commandC ctx [xobj] = do
                 c = cDeps ++ cXObj
             liftIO (putStr c)
             pure (newCtx, dynamicNil)
-commandC _ _ = error "commandc"
 
 -- | Helper function for commandC
 printC :: XObj -> String

src/Expand.hs

@@ -201,8 +201,24 @@ expand eval ctx xobj =
               Right (XObj (Lst [XObj Macro _ _, _, XObj (Arr _) _ _, _]) _ _) ->
                 --trace ("Found macro: " ++ pretty xobj ++ " at " ++ prettyInfoFromXObj xobj)
                 eval ctx'' xobj
-              Right (XObj (Lst [XObj (Command callback) _ _, _]) _ _) ->
-                getCommand callback ctx args
+              Right (XObj (Lst [XObj (Command (NullaryCommandFunction nullary)) _ _, _, _]) _ _) ->
+                nullary ctx''
+              Right (XObj (Lst [XObj (Command (UnaryCommandFunction unary)) _ _, _, _]) _ _) ->
+                case expandedArgs of
+                  Right [x] -> unary ctx'' x
+                  _ -> error "expanding args"
+              Right (XObj (Lst [XObj (Command (BinaryCommandFunction binary)) _ _, _, _]) _ _) ->
+                case expandedArgs of
+                  Right [x, y] -> binary ctx'' x y
+                  _ -> error "expanding args"
+              Right (XObj (Lst [XObj (Command (TernaryCommandFunction ternary)) _ _, _, _]) _ _) ->
+                case expandedArgs of
+                  Right [x, y, z] -> ternary ctx'' x y z
+                  _ -> error "expanding args"
+              Right (XObj (Lst [XObj (Command (VariadicCommandFunction variadic)) _ _, _, _]) _ _) ->
+                case expandedArgs of
+                  Right ea -> variadic ctx'' ea
+                  _ -> error "expanding args"
               Right _ ->
                 pure
                   ( ctx'',

src/Obj.hs

@@ -203,15 +203,32 @@ instance Eq PrimitiveFunctionType where
 instance Show PrimitiveFunctionType where
   show _ = "Primitive { ... }"
 
-type CommandCallback = Context -> [XObj] -> IO (Context, Either EvalError XObj)
+type NullaryCommandCallback = Context -> IO (Context, Either EvalError XObj)
 
-newtype CommandFunctionType = CommandFunction {getCommand :: CommandCallback}
+type UnaryCommandCallback = Context -> XObj -> IO (Context, Either EvalError XObj)
+
+type BinaryCommandCallback = Context -> XObj -> XObj -> IO (Context, Either EvalError XObj)
+
+type TernaryCommandCallback = Context -> XObj -> XObj -> XObj -> IO (Context, Either EvalError XObj)
+
+type VariadicCommandCallback = Context -> [XObj] -> IO (Context, Either EvalError XObj)
+
+data CommandFunctionType
+  = NullaryCommandFunction NullaryCommandCallback
+  | UnaryCommandFunction UnaryCommandCallback
+  | BinaryCommandFunction BinaryCommandCallback
+  | TernaryCommandFunction TernaryCommandCallback
+  | VariadicCommandFunction VariadicCommandCallback
 
 instance Eq CommandFunctionType where
   _ == _ = True
 
 instance Show CommandFunctionType where
-  show _ = "CommandFunction { ... }"
+  show (NullaryCommandFunction _) = "NullaryCommandFunction { ... }"
+  show (UnaryCommandFunction _) = "UnaryCommandFunction { ... }"
+  show (BinaryCommandFunction _) = "BinaryCommandFunction { ... }"
+  show (TernaryCommandFunction _) = "TernaryCommandFunction { ... }"
+  show (VariadicCommandFunction _) = "VariadicCommandFunction { ... }"
 
 newtype TemplateCreator = TemplateCreator {getTemplateCreator :: TypeEnv -> Env -> Template}
 
@@ -319,12 +336,12 @@ setPath (XObj (Lst [extr@(XObj (External _) _ _), XObj (Sym _ _) si st, ty]) i t
 setPath x _ =
   error ("Can't set path on " ++ show x)
 
-
 -- | Convert an Obj to a pretty string representation.
 -- | Reuses `pretty`.
 prettyObj :: Obj -> String
 prettyObj = pretty . buildXObj
-  where buildXObj o = XObj o Nothing Nothing
+  where
+    buildXObj o = XObj o Nothing Nothing
 
 -- | Convert an XObj to a pretty string representation.
 pretty :: XObj -> String

src/StartingEnv.hs

@@ -225,82 +225,96 @@ dynamicModule =
     }
   where
     path = ["Dynamic"]
+    spath = SymPath path
     bindings =
-      Map.fromList $
-        [ addCommand (SymPath path "list?") 1 commandIsList "checks whether the argument is a list." "(list? '()) ; => true",
-          addCommand (SymPath path "array?") 1 commandIsArray "checks whether the arguments is an array." "(array? []) ; => true",
-          addCommand (SymPath path "symbol?") 1 commandIsSymbol "checks whether the argument is a symbol." "(symbol? 'x) ; => true",
-          addCommand (SymPath path "length") 1 commandLength "returns the length of the argument (must be an array, string or list)." "(length '(1 2 3)) ; => 3",
-          addCommand (SymPath path "car") 1 commandCar "gets the head of a list or array." "(car '(1 2 3)) ; => 1",
-          addCommand (SymPath path "cdr") 1 commandCdr "gets the tail of a list or array." "(cdr '(1 2 3)) ; => '(2 3)",
-          addCommand (SymPath path "last") 1 commandLast "gets the last element of a list or array." "(last '(1 2 3)) ; => 3",
-          addCommand (SymPath path "all-but-last") 1 commandAllButLast "gets all elements except for the last one of a list or array." "(all-but-last '(1 2 3)) ; => '(1 2)",
-          addCommand (SymPath path "cons") 2 commandCons "adds an element to the front of an array or list" "(cons 1 '(2 3)) ; => '(1 2 3)",
-          addCommand (SymPath path "cons-last") 2 commandConsLast "adds an element to the back of an array or list" "(cons-last 3 '(1 2)) ; => '(1 2 3)",
-          addCommand (SymPath path "append") 2 commandAppend "appends two lists or arrays." "(append '(1 2) '(3 4)) ; => '(1 2 3 4)",
-          addCommandConfigurable (SymPath path "array") Nothing commandArray "creates an array from a collection of elements." "(array 1 2 3) ; => [1 2 3]",
-          addCommandConfigurable (SymPath path "list") Nothing commandList "creates an array from a collection of elements." "(list 1 2 3) ; => (1 2 3)",
-          addCommand (SymPath path "macro-error") 1 commandMacroError "logs an error and errors out of a macro." "(macro-error \"this is wrong\")",
-          addCommandConfigurable (SymPath path "macro-log") Nothing commandMacroLog "logs a message in a macro." "(macro-log \"this will be printed at compile time\")",
-          addCommandConfigurable (SymPath path "str") Nothing commandStr "stringifies its arguments." "(str 1 \" \" 2 \" \" 3) ; => \"1 2 3\"",
-          addCommand (SymPath path "not") 1 commandNot "negates its boolean argument." "(not false) ; => true",
-          addCommand (SymPath path "=") 2 commandEq "compares its arguments for equality." "(= 1 2) ; => false",
-          addCommand (SymPath path "<") 2 commandLt "checks whether its first argument is less than its second." "(< 1 2) ; => true",
-          addCommand (SymPath path ">") 2 commandGt "checks whether its first argument is greater than its second." "(> 1 2) ; => false",
-          addCommand (SymPath path "+") 2 commandPlus "adds its two arguments." "(+ 1 2) ; => 3",
-          addCommand (SymPath path "-") 2 commandMinus "subtracts its second argument from its first." "(- 1 2) ; => -1",
-          addCommand (SymPath path "/") 2 commandDiv "divides its first argument by its second." "(/ 4 2) ; => 2",
-          addCommand (SymPath path "*") 2 commandMul "multiplies its two arguments." "(* 2 3) ; => 6",
-          addCommand (SymPath path "c") 1 commandC "prints the C code emitted for a binding." "(c '(+ 2 3)) ; => int _3 = Int__PLUS_(2, 3);",
-          addCommand (SymPath path "quit") 0 commandQuit "quits the program." "(quit)",
-          addCommand (SymPath path "cat") 0 commandCat "spits out the generated C code." "(cat)",
-          addCommand (SymPath path "run") 0 commandRunExe "runs the built executable." "(run)",
-          addCommand (SymPath path "build") 0 (commandBuild False) "builds the current code to an executable." "(build)",
-          addCommand (SymPath path "reload") 0 commandReload "reloads all currently loaded files that weren’t marked as only loading once (see `load` and `load-once`)." "(reload)",
-          addCommand (SymPath path "env") 0 commandListBindings "lists all current bindings." "(env)",
-          addCommand (SymPath path "project") 0 commandProject "prints the current project state." "(project)",
-          addCommand (SymPath path "load") 1 commandLoad "loads a file into the current environment." "(load \"myfile.carp\")",
-          addCommand (SymPath path "load-once") 1 commandLoadOnce "loads a file and prevents it from being reloaded (see `reload`)." "(load-once \"myfile.carp\")",
-          addCommand (SymPath path "expand") 1 commandExpand "expands a macro and prints the result." "(expand '(when true 1)) ; => (if true 1 ())",
-          addCommand (SymPath path "host-arch") 0 commandHostArch "prints the host architecture (as returned by the Haskell function `System.Info.arch`)." "(host-arch)",
-          addCommand (SymPath path "host-os") 0 commandHostOS "prints the host operating system (as returned by the Haskell function `System.Info.os`)." "(host-os)",
-          addCommand (SymPath path "system-include") 1 commandAddSystemInclude "adds a system include, i.e. a C `#include` with angle brackets (`<>`)." "(system-include \"stdint.h\")",
-          addCommand (SymPath path "relative-include") 1 commandAddRelativeInclude "adds a relative include, i.e. a C `include` with quotes. It also prepends the current directory." "(relative-include \"myheader.h\")",
-          addCommand (SymPath path "save-docs-internal") 1 commandSaveDocsInternal "is the internal companion command to `save-docs`. `save-docs` should be called instead." "(save-docs-internal 'Module)",
-          addCommand (SymPath path "read-file") 1 commandReadFile "reads a file into a string." "(read-file \"myfile.txt\")",
-          addCommand (SymPath path "write-file") 2 commandWriteFile "writes a string to a file." "(write-file \"myfile\" \"hello there!\")",
-          addCommand (SymPath path "host-bit-width") 0 commandHostBitWidth "gets the bit width of the host platform." "(host-bit-width) ; => your host machine’s bit width, e.g. 32 or 64",
-          addCommandConfigurable (SymPath path "s-expr") Nothing commandSexpression "returns the s-expression associated with a binding. When the binding is a type, the deftype form is returned instead of the type's module by default. Pass an optional bool argument to explicitly request the module for a type instead of its definition form. If the bool is true, the module for the type will be returned. Returns an error when no definition is found for the binding." "(s-expr foo), (s-expr foo true)",
-          makePrim "quote" 1 "quotes any value." "(quote x) ; where x is an actual symbol" (\_ ctx [x] -> pure (ctx, Right x)),
-          makeVarPrim "file" "returns the file a symbol was defined in." "(file mysymbol)" primitiveFile,
-          makeVarPrim "line" "returns the line a symbol was defined on." "(line mysymbol)" primitiveLine,
-          makeVarPrim "column" "returns the column a symbol was defined on." "(column mysymbol)" primitiveColumn,
-          makePrim "info" 1 "prints all information associated with a symbol." "(info mysymbol)" primitiveInfo,
-          makeVarPrim "register-type" "registers a new type from C." "(register-type Name <optional: c-name> <optional: members>)" primitiveRegisterType,
-          makePrim "defmacro" 3 "defines a new macro." "(defmacro name [args :rest restargs] body)" primitiveDefmacro,
-          makePrim "defndynamic" 3 "defines a new dynamic function, i.e. a function available at compile time." "(defndynamic name [args] body)" primitiveDefndynamic,
-          makePrim "defdynamic" 2 "defines a new dynamic value, i.e. a value available at compile time." "(defdynamic name value)" primitiveDefdynamic,
-          makePrim "members" 1 "returns the members of a type as an array." "(members MyType)" primitiveMembers,
-          makeVarPrim "defmodule" "defines a new module in which `expressions` are defined." "(defmodule MyModule <expressions>)" primitiveDefmodule,
-          makePrim "meta-set!" 3 "sets a new key and value pair on the meta map associated with a symbol." "(meta-set! mysymbol \"mykey\" \"myval\")" primitiveMetaSet,
-          makePrim "meta" 2 "gets the value under `\"mykey\"` in the meta map associated with a symbol. It returns `()` if the key isn’t found." "(meta mysymbol \"mykey\")" primitiveMeta,
-          makePrim "definterface" 2 "defines a new interface (which could be a function or symbol)." "(definterface mysymbol MyType)" primitiveDefinterface,
-          makeVarPrim "register" "registers a new function. This is used to define C functions and other symbols that will be available at link time." "(register name <signature> <optional: override>)" primitiveRegister,
-          makeVarPrim "deftype" "defines a new sumtype or struct." "(deftype Name <members>)" primitiveDeftype,
-          makePrim "use" 1 "uses a module, i.e. imports the symbols inside that module into the current module." "(use MyModule)" primitiveUse,
-          makePrim "eval" 1 "evaluates a list." "(eval mycode)" primitiveEval,
-          makePrim "defined?" 1 "checks whether a symbol is defined." "(defined? mysymbol)" primitiveDefined,
-          makePrim "deftemplate" 4 "defines a new C template." "(deftemplate symbol Type declString defString)" primitiveDeftemplate,
-          makePrim "implements" 2 "designates a function as an implementation of an interface." "(implements zero Maybe.zero)" primitiveImplements,
-          makePrim "type" 1 "prints the type of a symbol." "(type mysymbol)" primitiveType,
-          makePrim "kind" 1 "prints the kind of a symbol." "(kind mysymbol)" primitiveKind,
-          makeVarPrim "help" "prints help." "(help)" primitiveHelp
-        ]
-          ++ [ ("String", Binder emptyMeta (XObj (Mod dynamicStringModule) Nothing Nothing)),
-               ("Symbol", Binder emptyMeta (XObj (Mod dynamicSymModule) Nothing Nothing)),
-               ("Project", Binder emptyMeta (XObj (Mod dynamicProjectModule) Nothing Nothing)),
-               ("Path", Binder emptyMeta (XObj (Mod dynamicPathModule) Nothing Nothing))
-             ]
+      Map.fromList $ nullaries ++ unaries ++ binaries ++ variadics ++ prims
+    nullaries =
+      let f = addNullaryCommand . spath
+       in [ f "quit" commandQuit "quits the program." "(quit)",
+            f "cat" commandCat "spits out the generated C code." "(cat)",
+            f "run" commandRunExe "runs the built executable." "(run)",
+            f "build" (commandBuild False) "builds the current code to an executable." "(build)",
+            f "reload" commandReload "reloads all currently loaded files that weren’t marked as only loading once (see `load` and `load-once`)." "(reload)",
+            f "env" commandListBindings "lists all current bindings." "(env)",
+            f "project" commandProject "prints the current project state." "(project)",
+            f "host-arch" commandHostArch "prints the host architecture (as returned by the Haskell function `System.Info.arch`)." "(host-arch)",
+            f "host-os" commandHostOS "prints the host operating system (as returned by the Haskell function `System.Info.os`)." "(host-os)",
+            f "host-bit-width" commandHostBitWidth "gets the bit width of the host platform." "(host-bit-width) ; => your host machine’s bit width, e.g. 32 or 64"
+          ]
+    unaries =
+      let f = addUnaryCommand . spath
+       in [ f "list?" commandIsList "checks whether the argument is a list." "(list? '()) ; => true",
+            f "array?" commandIsArray "checks whether the arguments is an array." "(array? []) ; => true",
+            f "symbol?" commandIsSymbol "checks whether the argument is a symbol." "(symbol? 'x) ; => true",
+            f "length" commandLength "returns the length of the argument (must be an array, string or list)." "(length '(1 2 3)) ; => 3",
+            f "car" commandCar "gets the head of a list or array." "(car '(1 2 3)) ; => 1",
+            f "cdr" commandCdr "gets the tail of a list or array." "(cdr '(1 2 3)) ; => '(2 3)",
+            f "last" commandLast "gets the last element of a list or array." "(last '(1 2 3)) ; => 3",
+            f "all-but-last" commandAllButLast "gets all elements except for the last one of a list or array." "(all-but-last '(1 2 3)) ; => '(1 2)",
+            f "macro-error" commandMacroError "logs an error and errors out of a macro." "(macro-error \"this is wrong\")",
+            f "not" commandNot "negates its boolean argument." "(not false) ; => true",
+            f "c" commandC "prints the C code emitted for a binding." "(c '(+ 2 3)) ; => int _3 = Int__PLUS_(2, 3);",
+            f "load" commandLoad "loads a file into the current environment." "(load \"myfile.carp\")",
+            f "load-once" commandLoadOnce "loads a file and prevents it from being reloaded (see `reload`)." "(load-once \"myfile.carp\")",
+            f "expand" commandExpand "expands a macro and prints the result." "(expand '(when true 1)) ; => (if true 1 ())",
+            f "system-include" commandAddSystemInclude "adds a system include, i.e. a C `#include` with angle brackets (`<>`)." "(system-include \"stdint.h\")",
+            f "relative-include" commandAddRelativeInclude "adds a relative include, i.e. a C `include` with quotes. It also prepends the current directory." "(relative-include \"myheader.h\")",
+            f "save-docs-internal" commandSaveDocsInternal "is the internal companion command to `save-docs`. `save-docs` should be called instead." "(save-docs-internal 'Module)",
+            f "read-file" commandReadFile "reads a file into a string." "(read-file \"myfile.txt\")"
+          ]
+    binaries =
+      let f = addBinaryCommand . spath
+       in [ f "cons" commandCons "adds an element to the front of an array or list" "(cons 1 '(2 3)) ; => '(1 2 3)",
+            f "cons-last" commandConsLast "adds an element to the back of an array or list" "(cons-last 3 '(1 2)) ; => '(1 2 3)",
+            f "append" commandAppend "appends two lists or arrays." "(append '(1 2) '(3 4)) ; => '(1 2 3 4)",
+            f "=" commandEq "compares its arguments for equality." "(= 1 2) ; => false",
+            f "<" commandLt "checks whether its first argument is less than its second." "(< 1 2) ; => true",
+            f ">" commandGt "checks whether its first argument is greater than its second." "(> 1 2) ; => false",
+            f "+" commandPlus "adds its two arguments." "(+ 1 2) ; => 3",
+            f "-" commandMinus "subtracts its second argument from its first." "(- 1 2) ; => -1",
+            f "/" commandDiv "divides its first argument by its second." "(/ 4 2) ; => 2",
+            f "*" commandMul "multiplies its two arguments." "(* 2 3) ; => 6",
+            f "write-file" commandWriteFile "writes a string to a file." "(write-file \"myfile\" \"hello there!\")"
+          ]
+    variadics =
+      let f = addVariadicCommand . spath
+       in [ f "array" commandArray "creates an array from a collection of elements." "(array 1 2 3) ; => [1 2 3]",
+            f "list" commandList "creates an array from a collection of elements." "(list 1 2 3) ; => (1 2 3)",
+            f "macro-log" commandMacroLog "logs a message in a macro." "(macro-log \"this will be printed at compile time\")",
+            f "str" commandStr "stringifies its arguments." "(str 1 \" \" 2 \" \" 3) ; => \"1 2 3\"",
+            f "s-expr" commandSexpression "returns the s-expression associated with a binding. When the binding is a type, the deftype form is returned instead of the type's module by default. Pass an optional bool argument to explicitly request the module for a type instead of its definition form. If the bool is true, the module for the type will be returned. Returns an error when no definition is found for the binding." "(s-expr foo), (s-expr foo true)"
+          ]
+    prims =
+      [ makePrim "quote" 1 "quotes any value." "(quote x) ; where x is an actual symbol" (\_ ctx [x] -> pure (ctx, Right x)),
+        makeVarPrim "file" "returns the file a symbol was defined in." "(file mysymbol)" primitiveFile,
+        makeVarPrim "line" "returns the line a symbol was defined on." "(line mysymbol)" primitiveLine,
+        makeVarPrim "column" "returns the column a symbol was defined on." "(column mysymbol)" primitiveColumn,
+        makePrim "info" 1 "prints all information associated with a symbol." "(info mysymbol)" primitiveInfo,
+        makeVarPrim "register-type" "registers a new type from C." "(register-type Name <optional: c-name> <optional: members>)" primitiveRegisterType,
+        makePrim "defmacro" 3 "defines a new macro." "(defmacro name [args :rest restargs] body)" primitiveDefmacro,
+        makePrim "defndynamic" 3 "defines a new dynamic function, i.e. a function available at compile time." "(defndynamic name [args] body)" primitiveDefndynamic,
+        makePrim "defdynamic" 2 "defines a new dynamic value, i.e. a value available at compile time." "(defdynamic name value)" primitiveDefdynamic,
+        makePrim "members" 1 "returns the members of a type as an array." "(members MyType)" primitiveMembers,
+        makeVarPrim "defmodule" "defines a new module in which `expressions` are defined." "(defmodule MyModule <expressions>)" primitiveDefmodule,
+        makePrim "meta-set!" 3 "sets a new key and value pair on the meta map associated with a symbol." "(meta-set! mysymbol \"mykey\" \"myval\")" primitiveMetaSet,
+        makePrim "meta" 2 "gets the value under `\"mykey\"` in the meta map associated with a symbol. It returns `()` if the key isn’t found." "(meta mysymbol \"mykey\")" primitiveMeta,
+        makePrim "definterface" 2 "defines a new interface (which could be a function or symbol)." "(definterface mysymbol MyType)" primitiveDefinterface,
+        makeVarPrim "register" "registers a new function. This is used to define C functions and other symbols that will be available at link time." "(register name <signature> <optional: override>)" primitiveRegister,
+        makeVarPrim "deftype" "defines a new sumtype or struct." "(deftype Name <members>)" primitiveDeftype,
+        makePrim "use" 1 "uses a module, i.e. imports the symbols inside that module into the current module." "(use MyModule)" primitiveUse,
+        makePrim "eval" 1 "evaluates a list." "(eval mycode)" primitiveEval,
+        makePrim "defined?" 1 "checks whether a symbol is defined." "(defined? mysymbol)" primitiveDefined,
+        makePrim "deftemplate" 4 "defines a new C template." "(deftemplate symbol Type declString defString)" primitiveDeftemplate,
+        makePrim "implements" 2 "designates a function as an implementation of an interface." "(implements zero Maybe.zero)" primitiveImplements,
+        makePrim "type" 1 "prints the type of a symbol." "(type mysymbol)" primitiveType,
+        makePrim "kind" 1 "prints the kind of a symbol." "(kind mysymbol)" primitiveKind,
+        makeVarPrim "help" "prints help." "(help)" primitiveHelp
+      ]
+        ++ [ ("String", Binder emptyMeta (XObj (Mod dynamicStringModule) Nothing Nothing)),
+             ("Symbol", Binder emptyMeta (XObj (Mod dynamicSymModule) Nothing Nothing)),
+             ("Project", Binder emptyMeta (XObj (Mod dynamicProjectModule) Nothing Nothing)),
+             ("Path", Binder emptyMeta (XObj (Mod dynamicPathModule) Nothing Nothing))
+           ]
 
 -- | A submodule of the Dynamic module. Contains functions for working with strings in the repl or during compilation.
 dynamicStringModule :: Env
@@ -316,14 +330,22 @@ dynamicStringModule =
   where
     path = ["Dynamic", "String"]
     bindings =
-      Map.fromList
-        [ addCommand (SymPath path "char-at") 2 commandCharAt "gets the nth character of a string." "(String.char-at \"hi\" 1) ; => \\i",
-          addCommand (SymPath path "index-of") 2 commandIndexOf "gets the index of a character in a string (or returns `-1` if the character is not found)." "(index-of \"hi\" \\i) ; => 1",
-          addCommand (SymPath path "slice") 3 commandSubstring "creates a substring from a beginning index to an end index." "(String.slice \"hello\" 1 3) ; => \"ell\"",
-          addCommand (SymPath path "length") 1 commandStringLength "gets the length of a string." "(String.length \"hi\") ; => 2",
-          addCommand (SymPath path "concat") 1 commandStringConcat "concatenates a list of strings together." "(String.concat [\"hi \" \"there\"]) ; => \"hi there\"",
-          addCommand (SymPath path "split-on") 2 commandStringSplitOn "split a string at separator." "(String.split-on \"-\" \"hi-there\") ; => [\"hi \" \"there\"]"
-        ]
+      Map.fromList $unaries ++ binaries ++ ternaries
+    spath = SymPath path
+    unaries =
+      let f = addUnaryCommand . spath
+       in [ f "length" commandStringLength "gets the length of a string." "(String.length \"hi\") ; => 2",
+            f "concat" commandStringConcat "concatenates a list of strings together." "(String.concat [\"hi \" \"there\"]) ; => \"hi there\""
+          ]
+    binaries =
+      let f = addBinaryCommand . spath
+       in [ f "char-at" commandCharAt "gets the nth character of a string." "(String.char-at \"hi\" 1) ; => \\i",
+            f "index-of" commandIndexOf "gets the index of a character in a string (or returns `-1` if the character is not found)." "(index-of \"hi\" \\i) ; => 1",
+            f "split-on" commandStringSplitOn "split a string at separator." "(String.split-on \"-\" \"hi-there\") ; => [\"hi \" \"there\"]"
+          ]
+    ternaries =
+      let f = addTernaryCommand . spath
+       in [f "slice" commandSubstring "creates a substring from a beginning index to an end index." "(String.slice \"hello\" 1 3) ; => \"ell\""]
 
 -- | A submodule of the Dynamic module. Contains functions for working with symbols in the repl or during compilation.
 dynamicSymModule :: Env
@@ -338,13 +360,18 @@ dynamicSymModule =
     }
   where
     path = ["Dynamic", "Symbol"]
-    bindings =
-      Map.fromList
-        [ addCommand (SymPath path "concat") 1 commandSymConcat "concatenates a list of symbols together." "(Symbol.concat ['x 'y 'z]) ; => 'xyz",
-          addCommand (SymPath path "prefix") 2 commandSymPrefix "prefixes a symbol with a module." "(Symbol.prefix 'Module 'fun) ; => Module.fun",
-          addCommand (SymPath path "from") 1 commandSymFrom "converts a variety of types to a symbol." "(Symbol.from true) ; => True",
-          addCommand (SymPath path "str") 1 commandSymStr "converts a symbol to a string." "(Symbol.str 'x) ; => \"x\""
-        ]
+    bindings = Map.fromList $unaries ++ binaries
+    spath = SymPath path
+    unaries =
+      let f = addUnaryCommand . spath
+       in [ f "concat" commandSymConcat "concatenates a list of symbols together." "(Symbol.concat ['x 'y 'z]) ; => 'xyz",
+            f "from" commandSymFrom "converts a variety of types to a symbol." "(Symbol.from true) ; => True",
+            f "str" commandSymStr "converts a symbol to a string." "(Symbol.str 'x) ; => \"x\""
+          ]
+    binaries =
+      let f = addBinaryCommand . spath
+       in [ f "prefix" commandSymPrefix "prefixes a symbol with a module." "(Symbol.prefix 'Module 'fun) ; => Module.fun"
+          ]
 
 -- | A submodule of the Dynamic module. Contains functions for working with the active Carp project.
 dynamicProjectModule :: Env
@@ -359,11 +386,16 @@ dynamicProjectModule =
     }
   where
     path = ["Dynamic", "Project"]
-    bindings =
-      Map.fromList
-        [ addCommand (SymPath path "config") 2 commandProjectConfig "sets a project config key." "(Project.config \"paren-balance-hints\" false)",
-          addCommand (SymPath path "get-config") 1 commandProjectGetConfig "gets a project config value under a key." "(Project.get-config \"paren-balance-hints\")"
-        ]
+    bindings = Map.fromList $unaries ++ binaries
+    spath = SymPath path
+    unaries =
+      let f = addUnaryCommand . spath
+       in [ f "get-config" commandProjectGetConfig "gets a project config value under a key." "(Project.get-config \"paren-balance-hints\")"
+          ]
+    binaries =
+      let f = addBinaryCommand . spath
+       in [ f "config" commandProjectConfig "sets a project config key." "(Project.config \"paren-balance-hints\" false)"
+          ]
 
 -- | A submodule of the Dynamic module. Contains functions for working with paths.
 dynamicPathModule :: Env
@@ -378,11 +410,13 @@ dynamicPathModule =
     }
   where
     path = ["Dynamic", "Path"]
-    bindings =
-      Map.fromList
-        [ addCommand (SymPath path "directory") 1 commandPathDirectory "takes the basename of a string taken to be a filepath.\n\nHistorical note: this is a command because it used to power one of the `include` macros." "(Path.directory \"dir/file\") ; => \"dir\"",
-          addCommand (SymPath path "absolute") 1 commandPathAbsolute "converts a filepath to absolute." "(Path.absolute \"dir/file\") ; => \"/home/foo/dir/file\""
-        ]
+    bindings = Map.fromList unaries
+    spath = SymPath path
+    unaries =
+      let f = addUnaryCommand . spath
+       in [ f "directory" commandPathDirectory "takes the basename of a string taken to be a filepath.\n\nHistorical note: this is a command because it used to power one of the `include` macros." "(Path.directory \"dir/file\") ; => \"dir\"",
+            f "absolute" commandPathAbsolute "converts a filepath to absolute." "(Path.absolute \"dir/file\") ; => \"/home/foo/dir/file\""
+          ]
 
 -- | The global environment before any code is run.
 startingGlobalEnv :: Bool -> Env