Primitive refactors (#1070)

* refactor: move primitive errors; refactor primtiveInfo

This commit is the first in what will hopefully be a series of helpful
primitive refactors. To start, we:

- Move some inline `evalError` strings into a `PrimitiveError` module,
  (similar to the `TypeError`/`Types` module relationship
- Add `Reifiable` instances for String and Int types to take these
  types to their XObj representation.
- Add info utility functions for converting Info data to an XObj
- Refactor the `info` primitive:

  - Use monadic combinators + `maybe` instead of nested cases.
  - Use helper lookup functions that take a *context*--nearly *all*
    lookup calls currently extract some env, typically without doing
    anything to it, to pass it to lookup. This is a sign the boundary is
    incorrect and lookups should take the context instead--this will allow
    us to eliminate a ton of local `globalEnv`, `typeEnv`, etc. bindings.
  - Don't print hidden bindings
  - Indent printed meta information.
  - Color bindings blue

* chore: format code

* refactor: improve names for lookups that take a context

* feat: print hidden binders when calling info

Someone calling info might be interested in hidden binders as well, for
debugging purposes, etc. To enable this, we provide a version of show
for binders that prints hidden binders.

I've also made the printing of meta values in info more generic.

CarpHask.cabal

@@ -55,6 +55,7 @@ library
                        StructUtils,
                        Path,
                        Interfaces,
+                       PrimitiveError
                        Primitives,
                        Validate,
                        Reify,

src/Lookup.hs

@@ -2,6 +2,7 @@ module Lookup where
 
 import qualified Data.Map as Map
 import Data.Maybe (catMaybes, mapMaybe)
+import Env
 import qualified Meta
 import Obj
 import Types
@@ -28,6 +29,32 @@ lookupInEnv path@(SymPath (p : ps) name) env =
         Just parent -> lookupInEnv path parent
         Nothing -> Nothing
 
+-- | Lookup a binder in a context's typeEnv.
+lookupBinderInTypeEnv :: Context -> SymPath -> Maybe Binder
+lookupBinderInTypeEnv ctx path =
+  let typeEnv = (getTypeEnv (contextTypeEnv ctx))
+   in lookupBinder path typeEnv
+
+-- | Lookup a binder in a context's globalEnv.
+lookupBinderInGlobalEnv :: Context -> SymPath -> Maybe Binder
+lookupBinderInGlobalEnv ctx path =
+  let global = (contextGlobalEnv ctx)
+   in lookupBinder path global
+
+-- | Lookup a binder in a context's contextEnv.
+lookupBinderInContextEnv :: Context -> SymPath -> Maybe Binder
+lookupBinderInContextEnv ctx path =
+  let ctxEnv = contextEnv ctx
+   in lookupBinder path ctxEnv
+
+-- | Performs a multiLookupEverywhere but drops envs from the result and wraps
+-- the results in a Maybe.
+multiLookupBinderEverywhere :: Context -> SymPath -> Maybe [Binder]
+multiLookupBinderEverywhere ctx (SymPath _ name) =
+  case map snd (multiLookupEverywhere name (contextEnv ctx)) of
+    [] -> Nothing
+    xs -> Just xs
+
 -- | Like 'lookupInEnv' but only returns the Binder (no Env)
 lookupBinder :: SymPath -> Env -> Maybe Binder
 lookupBinder path env = snd <$> lookupInEnv path env

src/Obj.hs

@@ -564,23 +564,27 @@ metaIsTrue metaData key =
 data Binder = Binder {binderMeta :: MetaData, binderXObj :: XObj} deriving (Eq)
 
 instance Show Binder where
-  show binder = showBinderIndented 0 (getName (binderXObj binder), binder)
+  show binder = showBinderIndented 0 False (getName (binderXObj binder), binder)
 
-showBinderIndented :: Int -> (String, Binder) -> String
-showBinderIndented indent (name, Binder _ (XObj (Mod env) _ _)) =
+-- | Show a binder even if its hidden.
+forceShowBinder :: Binder -> String
+forceShowBinder binder = showBinderIndented 0 True (getName (binderXObj binder), binder)
+
+showBinderIndented :: Int -> Bool -> (String, Binder) -> String
+showBinderIndented indent _ (name, Binder _ (XObj (Mod env) _ _)) =
   replicate indent ' ' ++ name ++ " : Module = {\n"
     ++ prettyEnvironmentIndented (indent + 4) env
     ++ "\n"
     ++ replicate indent ' '
     ++ "}"
-showBinderIndented indent (name, Binder _ (XObj (Lst [XObj (Interface t paths) _ _, _]) _ _)) =
+showBinderIndented indent _ (name, Binder _ (XObj (Lst [XObj (Interface t paths) _ _, _]) _ _)) =
   replicate indent ' ' ++ name ++ " : " ++ show t ++ " = {\n    "
     ++ joinWith "\n    " (map show paths)
     ++ "\n"
     ++ replicate indent ' '
     ++ "}"
-showBinderIndented indent (name, Binder meta xobj) =
-  if metaIsTrue meta "hidden"
+showBinderIndented indent showHidden (name, Binder meta xobj) =
+  if (not showHidden) && metaIsTrue meta "hidden"
     then ""
     else
       replicate indent ' ' ++ name
@@ -658,7 +662,7 @@ prettyEnvironment = prettyEnvironmentIndented 0
 prettyEnvironmentIndented :: Int -> Env -> String
 prettyEnvironmentIndented indent env =
   joinLines $
-    filter (/= "") (map (showBinderIndented indent) (Map.toList (envBindings env)))
+    filter (/= "") (map (showBinderIndented indent False) (Map.toList (envBindings env)))
       ++ let modules = envUseModules env
           in if null modules
                then []
@@ -676,7 +680,7 @@ prettyEnvironmentChain env =
               ++ joinLines
                 ( filter
                     (/= "")
-                    (map (showBinderIndented 4) (Map.toList (envBindings env)))
+                    (map (showBinderIndented 4 False) (Map.toList (envBindings env)))
                 )
           else "'" ++ name ++ "' " ++ otherInfo ++ ":\n    Too big to show bindings."
       )

src/PrimitiveError.hs

@@ -0,0 +1,59 @@
+module PrimitiveError where
+
+import Obj
+import TypeError
+import Types
+
+data PrimitiveError
+  = ArgumentTypeError String String String XObj
+  | ArgumentArityError XObj String [XObj]
+  | MissingInfo XObj
+  | ForewardImplementsMeta
+  | RegisterTypeError
+  | SymbolNotFoundError SymPath
+
+data PrimitiveWarning
+  = NonExistentInterfaceWarning XObj
+  | DefinitionTypeChangeWarning XObj Ty
+
+instance Show PrimitiveError where
+  show (ArgumentTypeError fun ty position actual) =
+    "`" ++ fun ++ "` expected " ++ ty ++ " as its " ++ position
+      ++ " argument, but got `"
+      ++ pretty actual
+      ++ "`"
+  show (ArgumentArityError fun numberExpected args) =
+    "`" ++ (show (getPath fun)) ++ "`" ++ "expected " ++ numberExpected
+      ++ " arguments "
+      ++ ", but got "
+      ++ show (length args)
+  show (MissingInfo x) =
+    "No information about object: " ++ pretty x
+  show (ForewardImplementsMeta) =
+    "Can't set the `implements` meta on a global definition before it is declared."
+  show (RegisterTypeError) =
+    "I don't understand this usage of `register-type`.\n\n"
+      ++ "Valid usages :\n"
+      ++ "  (register-type Name)\n"
+      ++ "  (register-type Name [field0 Type, ...])\n"
+      ++ "  (register-type Name c-name)\n"
+      ++ "  (register-type Name c-name [field0 Type, ...]"
+  show (SymbolNotFoundError path) =
+    "I can’t find the symbol `" ++ show path ++ "`"
+
+instance Show PrimitiveWarning where
+  show (NonExistentInterfaceWarning x) =
+    "The interface "
+      ++ show (getPath x)
+      ++ " is not defined."
+      ++ " Did you define it using `definterface`?"
+  show (DefinitionTypeChangeWarning annXObj previousType) =
+    "Definition at " ++ prettyInfoFromXObj annXObj ++ " changed type of '" ++ show (getPath annXObj)
+      ++ "' from "
+      ++ show previousType
+      ++ " to "
+      ++ show (forceTy annXObj)
+
+toEvalError :: Context -> XObj -> PrimitiveError -> (Context, Either EvalError XObj)
+toEvalError ctx xobj perr =
+  evalError ctx (show perr) (xobjInfo xobj)

src/Primitives.hs

@@ -18,7 +18,7 @@ import Interfaces
 import Lookup
 import qualified Meta as Meta
 import Obj
-import Path (takeFileName)
+import PrimitiveError
 import Project
 import Reify
 import Sumtypes
@@ -45,16 +45,7 @@ makeVarPrim name doc example callback =
 
 argumentErr :: Context -> String -> String -> String -> XObj -> IO (Context, Either EvalError XObj)
 argumentErr ctx fun ty number actual =
-  pure
-    ( evalError
-        ctx
-        ( "`" ++ fun ++ "` expected " ++ ty ++ " as its " ++ number
-            ++ " argument, but got `"
-            ++ pretty actual
-            ++ "`"
-        )
-        (xobjInfo actual)
-    )
+  pure (toEvalError ctx actual (ArgumentTypeError fun ty number actual))
 
 makePrim' :: String -> Maybe Int -> String -> String -> Primitive -> (String, Binder)
 makePrim' name maybeArity docString example callback =
@@ -101,66 +92,45 @@ makePrim' name maybeArity docString example callback =
            in XObj (Arr (map (tosym . intToArgName) [1 .. arity])) Nothing Nothing
         Nothing -> XObj (Arr [(XObj (Sym (SymPath [] "") Symbol) Nothing Nothing)]) Nothing Nothing
 
+infoXObjOrError :: Context -> (Context, Either EvalError XObj) -> Maybe Info -> Maybe XObj -> (Context, Either EvalError XObj)
+infoXObjOrError ctx err i = maybe err (\xobj -> (ctx, Right xobj {xobjInfo = i}))
+
 primitiveFile :: Primitive
-primitiveFile x@(XObj _ i t) ctx args =
+primitiveFile x@(XObj _ i _) ctx args =
   pure $ case args of
-    [] -> go i
-    [XObj _ mi _] -> go mi
-    _ ->
-      evalError
-        ctx
-        ("`file` expected 0 or 1 arguments, but got " ++ show (length args))
-        (xobjInfo x)
+    [] -> infoXObjOrError ctx err i (getFileAsXObj fppl i)
+    [XObj _ mi _] -> infoXObjOrError ctx err i (getFileAsXObj fppl mi)
+    _ -> toEvalError ctx x (ArgumentArityError x "0 or 1" args)
   where
-    err = evalError ctx ("No information about object " ++ pretty x) (xobjInfo x)
-    go =
-      maybe
-        err
-        ( \info ->
-            let fppl = projectFilePathPrintLength (contextProj ctx)
-                file = infoFile info
-                file' = case fppl of
-                  FullPath -> file
-                  ShortPath -> takeFileName file
-             in (ctx, Right (XObj (Str file') i t))
-        )
+    fppl = projectFilePathPrintLength (contextProj ctx)
+    err = toEvalError ctx x (MissingInfo x)
 
 primitiveLine :: Primitive
-primitiveLine x@(XObj _ i t) ctx args =
+primitiveLine x@(XObj _ i _) ctx args =
   pure $ case args of
-    [] -> go i
-    [XObj _ mi _] -> go mi
-    _ ->
-      evalError
-        ctx
-        ("`line` expected 0 or 1 arguments, but got " ++ show (length args))
-        (xobjInfo x)
+    [] -> infoXObjOrError ctx err i (getLineAsXObj i)
+    [XObj _ mi _] -> infoXObjOrError ctx err i (getLineAsXObj mi)
+    _ -> toEvalError ctx x (ArgumentArityError x "0 or 1" args)
   where
-    err = evalError ctx ("No information about object " ++ pretty x) (xobjInfo x)
-    go = maybe err (\info -> (ctx, Right (XObj (Num IntTy (fromIntegral (infoLine info))) i t)))
+    err = toEvalError ctx x (MissingInfo x)
 
 primitiveColumn :: Primitive
-primitiveColumn x@(XObj _ i t) ctx args =
+primitiveColumn x@(XObj _ i _) ctx args =
   pure $ case args of
-    [] -> go i
-    [XObj _ mi _] -> go mi
-    _ ->
-      evalError
-        ctx
-        ("`column` expected 0 or 1 arguments, but got " ++ show (length args))
-        (xobjInfo x)
+    [] -> infoXObjOrError ctx err i (getColumnAsXObj i)
+    [XObj _ mi _] -> infoXObjOrError ctx err i (getColumnAsXObj mi)
+    _ -> toEvalError ctx x (ArgumentArityError x "0 or 1" args)
   where
-    err = evalError ctx ("No information about object " ++ pretty x) (xobjInfo x)
-    go = maybe err (\info -> (ctx, Right (XObj (Num IntTy (fromIntegral (infoColumn info))) i t)))
+    err = toEvalError ctx x (MissingInfo x)
 
 primitiveImplements :: Primitive
-primitiveImplements _ ctx [x@(XObj (Sym interface@(SymPath _ _) _) _ _), (XObj (Sym (SymPath prefixes name) _) info _)] =
+primitiveImplements call ctx [x@(XObj (Sym interface@(SymPath _ _) _) _ _), (XObj (Sym (SymPath prefixes name) _) _ _)] =
   do
     (maybeInterface, maybeImpl) <- pure ((lookupBinder interface tyEnv), (lookupBinder (SymPath modules name) global))
     case (maybeInterface, maybeImpl) of
       (_, Nothing) ->
         if null modules
-          then pure (evalError ctx "Can't set the `implements` meta on a global definition before it is declared." info)
+          then pure (toEvalError ctx call ForewardImplementsMeta)
           else updateMeta (Meta.stub (SymPath modules name)) ctx
       (Nothing, Just implBinder) ->
         (warn >> updateMeta implBinder ctx)
@@ -170,13 +140,8 @@ primitiveImplements _ ctx [x@(XObj (Sym interface@(SymPath _ _) _) _ _), (XObj (
     global = contextGlobalEnv ctx
     tyEnv = getTypeEnv . contextTypeEnv $ ctx
     (SymPath modules _) = consPath (union (contextPath ctx) prefixes) (SymPath [] name)
-    warn =
-      emitWarning
-        ( "The interface "
-            ++ show (getPath x)
-            ++ " is not defined."
-            ++ " Did you define it using `definterface`?"
-        )
+    warn :: IO ()
+    warn = emitWarning (show (NonExistentInterfaceWarning x))
     addToInterface :: Binder -> Binder -> IO (Context, Either EvalError XObj)
     addToInterface inter impl =
       either
@@ -210,14 +175,12 @@ primitiveImplements _ ctx [x@(XObj (Sym interface@(SymPath _ _) _) _ _), (XObj (
             else Meta.updateBinderMeta implBinder "implements" (XObj (Lst (x : impls)) inf ty)
         updateImplementations implBinder _ =
           Meta.updateBinderMeta implBinder "implements" (XObj (Lst [x]) (Just dummyInfo) (Just DynamicTy))
+primitiveImplements x ctx [(XObj (Sym _ _) _ _), y] =
+  pure $ toEvalError ctx x (ArgumentTypeError "implements" "a symbol" "second" y)
 primitiveImplements _ ctx [x, _] =
-  pure $ evalError ctx ("`implements` expects symbol arguments.") (xobjInfo x)
+  pure $ toEvalError ctx x (ArgumentTypeError "implements" "a symbol" "first" x)
 primitiveImplements x@(XObj _ _ _) ctx args =
-  pure $
-    evalError
-      ctx
-      ("`implements` expected 2 arguments, but got " ++ show (length args))
-      (xobjInfo x)
+  pure $ toEvalError ctx x (ArgumentArityError x "2" args)
 
 define :: Bool -> Context -> XObj -> IO Context
 define hidden ctx@(Context globalEnv _ typeEnv _ proj _ _ _) annXObj =
@@ -255,14 +218,9 @@ define hidden ctx@(Context globalEnv _ typeEnv _ proj _ _ _) annXObj =
       unless (areUnifiable (forceTy annXObj) previousType) warn
       where
         previousType = forceTy (binderXObj binder)
+        warn :: IO ()
         warn =
-          emitWarning
-            ( "Definition at " ++ prettyInfoFromXObj annXObj ++ " changed type of '" ++ show (getPath annXObj)
-                ++ "' from "
-                ++ show previousType
-                ++ " to "
-                ++ show (forceTy annXObj)
-            )
+          emitWarning (show (DefinitionTypeChangeWarning annXObj previousType))
     implementInterfaces :: Binder -> IO Context
     implementInterfaces binder =
       pure
@@ -293,19 +251,7 @@ primitiveRegisterType _ ctx [x@(XObj (Sym (SymPath [] t) _) _ _), (XObj (Str ove
   primitiveRegisterTypeWithFields ctx x t (Just override) members
 primitiveRegisterType _ ctx [x@(XObj (Sym (SymPath [] t) _) _ _), members] =
   primitiveRegisterTypeWithFields ctx x t Nothing members
-primitiveRegisterType _ ctx _ =
-  pure
-    ( evalError
-        ctx
-        ( "I don't understand this usage of `register-type`.\n\n"
-            ++ "Valid usages :\n"
-            ++ "  (register-type Name)\n"
-            ++ "  (register-type Name [field0 Type, ...])\n"
-            ++ "  (register-type Name c-name)\n"
-            ++ "  (register-type Name c-name [field0 Type, ...]"
-        )
-        Nothing
-    )
+primitiveRegisterType x ctx _ = pure (toEvalError ctx x RegisterTypeError)
 
 primitiveRegisterTypeWithoutFields :: Context -> String -> (Maybe String) -> IO (Context, Either EvalError XObj)
 primitiveRegisterTypeWithoutFields ctx t override = do
@@ -343,77 +289,50 @@ primitiveRegisterTypeWithFields ctx x t override members =
       _ -> Nothing
 
 notFound :: Context -> XObj -> SymPath -> IO (Context, Either EvalError XObj)
-notFound ctx x path =
-  pure (evalError ctx ("I can’t find the symbol `" ++ show path ++ "`") (xobjInfo x))
+notFound ctx x path = pure (toEvalError ctx x (SymbolNotFoundError path))
 
 primitiveInfo :: Primitive
-primitiveInfo _ ctx [target@(XObj (Sym path@(SymPath _ name) _) _ _)] = do
-  let env = contextEnv ctx
-      typeEnv = contextTypeEnv ctx
+primitiveInfo _ ctx [target@(XObj (Sym path@(SymPath _ _) _) _ _)] = do
   case path of
     SymPath [] _ ->
-      -- First look in the type env, then in the global env:
-      case lookupBinder path (getTypeEnv typeEnv) of
-        Nothing -> printer env True True (lookupBinder path env)
-        found -> do
-          _ <- printer env True True found -- this will print the interface itself
-          printer env True False (lookupBinder path env) -- this will print the locations of the implementers of the interface
+      (printIfFound (lookupBinderInTypeEnv ctx path))
+        >> maybe
+          (notFound ctx target path)
+          (\binders -> foldM (\_ binder -> printer binder) (ctx, dynamicNil) binders)
+          ( (fmap (: []) (lookupBinderInContextEnv ctx path))
+              <|> (multiLookupBinderEverywhere ctx path)
+          )
     _ ->
-      case lookupBinder path env of
+      case lookupBinderInContextEnv ctx path of
         Nothing -> notFound ctx target path
-        found -> printer env False True found
+        Just found -> printer found
   where
-    printer env allowLookupEverywhere errNotFound binderPair = do
-      let proj = contextProj ctx
-      case binderPair of
-        Just (binder@(Binder metaData x@(XObj _ (Just i) _))) ->
-          do
-            liftIO $ putStrLn (show binder ++ "\nDefined at " ++ prettyInfo i)
-            printDoc metaData proj x
-        Just (binder@(Binder metaData x)) ->
-          do
-            liftIO $ print binder
-            printDoc metaData proj x
-        Nothing
-          | allowLookupEverywhere ->
-            case multiLookupEverywhere name env of
-              [] ->
-                if errNotFound
-                  then notFound ctx target path
-                  else pure (ctx, dynamicNil)
-              binders -> do
-                liftIO $
-                  mapM_
-                    ( \(_, binder@(Binder metaData x@(XObj _ i _))) ->
-                        case i of
-                          Just i' -> do
-                            putStrLnWithColor
-                              White
-                              (show binder ++ "\nDefined at " ++ prettyInfo i')
-                            _ <- printDoc metaData proj x
-                            pure ()
-                          Nothing -> putStrLnWithColor White (show binder)
-                    )
-                    binders
-                pure (ctx, dynamicNil)
-          | errNotFound -> notFound ctx target path
-          | otherwise -> pure (ctx, dynamicNil)
-    printDoc metaData proj x = do
-      case Meta.get "doc" metaData of
-        Just (XObj (Str val) _ _) -> liftIO $ putStrLn ("Documentation: " ++ val)
-        Nothing -> pure ()
-        _ -> error "printdoc"
-      case Meta.get "implements" metaData of
-        Just xobj@(XObj _ info _) -> do
-          case info of
-            Just _ -> putStrLn $ "Implementing: " ++ getName xobj
-            Nothing -> pure ()
-        Nothing -> pure ()
-      liftIO $ when (projectPrintTypedAST proj) $ putStrLnWithColor Yellow (prettyTyped x)
-      pure (ctx, dynamicNil)
+    printIfFound :: Maybe Binder -> IO (Context, Either EvalError XObj)
+    printIfFound binder = maybe (pure (ctx, dynamicNil)) printer binder
+
+    printer (binder@(Binder metaData x@(XObj _ (Just i) _))) =
+      (putStrLnWithColor Blue (forceShowBinder binder))
+        >> putStrLn ("  Defined at " ++ prettyInfo i)
+        >> printMeta metaData (contextProj ctx) x
+        >> pure (ctx, dynamicNil)
+    printer (binder@(Binder metaData x)) =
+      (print binder)
+        >> printMeta metaData (contextProj ctx) x
+        >> pure (ctx, dynamicNil)
+    printMeta :: MetaData -> Project -> XObj -> IO ()
+    printMeta metaData proj x =
+      (maybe (pure ()) (printMetaVal "Documentation" ((either (const "") id) . unwrapStringXObj)) (Meta.get "doc" metaData))
+        >> maybe (pure ()) (printMetaVal "Implements" getName) (Meta.get "implements" metaData)
+        >> maybe (pure ()) (printMetaVal "Private" pretty) (Meta.get "private" metaData)
+        >> maybe (pure ()) (printMetaVal "Hidden" pretty) (Meta.get "hidden" metaData)
+        >> maybe (pure ()) (printMetaVal "Signature" pretty) (Meta.get "sig" metaData)
+        >> when (projectPrintTypedAST proj) (putStrLnWithColor Yellow (prettyTyped x))
+
+    printMetaVal :: String -> (XObj -> String) -> XObj -> IO ()
+    printMetaVal s f xobj = putStrLn ("  " ++ s ++ ": " ++ (f xobj))
 primitiveInfo _ ctx [notName] =
   argumentErr ctx "info" "a name" "first" notName
-primitiveInfo _ _ _ = error "primitiveinfo"
+primitiveInfo x ctx xs = pure $ toEvalError ctx x (ArgumentArityError x "1" xs)
 
 dynamicOrMacroWith :: Context -> (SymPath -> [XObj]) -> Ty -> String -> XObj -> IO (Context, Either EvalError XObj)
 dynamicOrMacroWith ctx producer ty name body = do
@@ -569,7 +488,6 @@ primitiveDefinterface xobj ctx [nameXObj@(XObj (Sym path@(SymPath [] name) _) _
                   )
                   (xobjInfo xobj)
           _ -> error "updateinterface"
-
 primitiveDefinterface _ ctx [name, _] =
   pure (evalError ctx ("`definterface` expects a name as first argument, but got `" ++ pretty name ++ "`") (xobjInfo name))
 primitiveDefinterface _ _ _ = error "primitivedefinterface"

src/Reify.hs

@@ -1,8 +1,13 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
 -- | Module Reify provides a typeclass and instances for turning internal compiler types and data into
 -- corresponding representations in the Carp language.
 module Reify where
 
+import Info
 import Obj
+import System.FilePath
 import Types
 
 -- | The Reifiable class ranges over internal Carp compiler types that
@@ -37,3 +42,22 @@ instance Reifiable Ty where
   reify TypeTy = XObj (Sym (SymPath [] (show TypeTy)) Symbol) Nothing (Just Universe)
   reify UnitTy = XObj (Sym (SymPath [] "Unit") Symbol) Nothing (Just TypeTy)
   reify t = XObj (Sym (SymPath [] (show t)) Symbol) Nothing (Just TypeTy)
+
+instance Reifiable String where
+  reify s = (XObj (Str s) Nothing (Just StringTy))
+
+instance Reifiable Int where
+  reify i = (XObj (Num IntTy (fromIntegral i)) Nothing (Just IntTy))
+
+getInfoAsXObj :: (Reifiable a) => (Info -> a) -> Maybe Info -> Maybe XObj
+getInfoAsXObj f i = fmap (reify . f) i
+
+getFileAsXObj :: FilePathPrintLength -> Maybe Info -> Maybe XObj
+getFileAsXObj FullPath = getInfoAsXObj infoFile
+getFileAsXObj ShortPath = getInfoAsXObj (takeFileName . infoFile)
+
+getLineAsXObj :: Maybe Info -> Maybe XObj
+getLineAsXObj = getInfoAsXObj infoLine
+
+getColumnAsXObj :: Maybe Info -> Maybe XObj
+getColumnAsXObj = getInfoAsXObj infoColumn