feat: add machine-info primitive draft (#1269)

* feat: add machine-info primitive draft

* feat: rename machine-info to structured-info

* fix: use the right primitive name in structured-info error

* refactor: remove unnecessary code

src/Primitives.hs

@@ -16,10 +16,12 @@ import Data.Maybe (fromJust, fromMaybe)
 import Deftype
 import Emit
 import Env (addUsePath, contextEnv, insert, lookupBinderEverywhere, lookupEverywhere, lookupMeta, searchValueBinder)
+import EvalError
 import Infer
 import Info
 import Interfaces
 import Managed
+import qualified Map
 import qualified Meta
 import Obj
 import PrimitiveError
@@ -347,6 +349,48 @@ primitiveInfo _ ctx target@(XObj (Sym path@(SymPath _ name) _) _ _) =
 primitiveInfo _ ctx notName =
   argumentErr ctx "info" "a name" "first" notName
 
+-- | Get information about a binding.
+primitiveStructuredInfo :: UnaryPrimitiveCallback
+primitiveStructuredInfo (XObj _ i _) ctx (XObj (Sym path _) _ _) =
+  case lookupBinderInTypeEnv ctx path of
+    Right bind -> return (ctx, Right $ workOnBinder bind)
+    Left _ ->
+      case lookupBinderInContextEnv ctx path of
+        Right bind -> return (ctx, Right $ workOnBinder bind)
+        Left e -> return $ throwErr e ctx i
+  where
+    workOnBinder :: Binder -> XObj
+    workOnBinder (Binder metaData (XObj _ (Just (Info l c f _ _)) t)) =
+      makeX
+        ( Lst
+            [ (maybe (makeX (Lst [])) reify t),
+              makeX
+                ( Lst
+                    [ makeX (Str f),
+                      makeX (Num IntTy (Integral l)),
+                      makeX (Num IntTy (Integral c))
+                    ]
+                ),
+              metaList metaData
+            ]
+        )
+    workOnBinder (Binder metaData (XObj _ _ t)) =
+      makeX
+        ( Lst
+            [ (maybe (makeX (Lst [])) reify t),
+              makeX (Lst []),
+              metaList metaData
+            ]
+        )
+    metaList :: MetaData -> XObj
+    metaList (MetaData m) =
+      makeX (Lst (map genPair (Map.toList m)))
+      where
+        genPair (s, x) = makeX (Lst [XObj (Str s) Nothing Nothing, x])
+    makeX o = XObj o Nothing Nothing
+primitiveStructuredInfo _ ctx notName =
+  argumentErr ctx "structured-info" "a name" "first" notName
+
 dynamicOrMacroWith :: Context -> (SymPath -> [XObj]) -> Ty -> String -> XObj -> IO (Context, Either EvalError XObj)
 dynamicOrMacroWith ctx producer ty name body = do
   let qpath = qualifyPath ctx (SymPath [] name)

src/StartingEnv.hs

@@ -297,6 +297,7 @@ dynamicModule =
       let f = makeUnaryPrim . spath
        in [ f "quote" (\_ ctx x -> pure (ctx, Right x)) "quotes any value." "(quote x) ; where x is an actual symbol",
             f "info" primitiveInfo "prints all information associated with a symbol." "(info mysymbol)",
+            f "structured-info" primitiveStructuredInfo "gets all information associated with a symbol as a list of the form `(type|(), info|(), metadata)`." "(structured-info mysymbol)",
             f "managed?" primitiveIsManaged "checks whether a type is managed by Carp by checking whether `delete` was implemented for it. For an explanation of memory management, you can reference [this document](https://carp-lang.github.io/carp-docs/Memory.html)." "(register-type Unmanaged \"void*\")\n(managed? Unmanaged) ; => false",
             f "members" primitiveMembers "returns the members of a type as an array." "(members MyType)",
             f "use" primitiveUse "uses a module, i.e. imports the symbols inside that module into the current module." "(use MyModule)",