feat: add dynamic-type command (#1148)

* feat: add dynamic-type command

* refactor: use symbols for dynamic-type

core/Macros.carp

@@ -47,7 +47,31 @@
   (defndynamic cddaar [pair] (cdr (cdr (car (car pair)))))
   (defndynamic cddadr [pair] (cdr (cdr (car (cdr pair)))))
   (defndynamic cdddar [pair] (cdr (cdr (cdr (car pair)))))
-  (defndynamic cddddr [pair] (cdr (cdr (cdr (cdr pair))))))
+  (defndynamic cddddr [pair] (cdr (cdr (cdr (cdr pair)))))
+
+  (defmodule List
+    (defndynamic in? [elem l]
+      (cond
+        (empty? l) false
+        (= elem (car l)) true
+        (in? elem (cdr l)))))
+
+  (defndynamic string? [s]
+    (= (dynamic-type s) 'string))
+
+  (defndynamic symbol? [s]
+    (= (dynamic-type s) 'symbol))
+
+  (defndynamic list? [s]
+    (= (dynamic-type s) 'list))
+
+  (defndynamic array? [s]
+    (= (dynamic-type s) 'array))
+
+  (defndynamic number? [s]
+    (List.in? (dynamic-type s) '(int long double float byte)))
+
+)
 
 
 (meta-set! doc "doc" "Set documentation for a binding.")

src/Commands.hs

@@ -414,36 +414,6 @@ commandAddRelativeInclude ctx x =
     _ ->
       pure (evalError ctx ("Argument to 'include' must be a string, but was `" ++ pretty x ++ "`") (xobjInfo x))
 
-commandIsList :: UnaryCommandCallback
-commandIsList ctx x =
-  pure $ case x of
-    XObj (Lst _) _ _ -> (ctx, Right trueXObj)
-    _ -> (ctx, Right falseXObj)
-
-commandIsArray :: UnaryCommandCallback
-commandIsArray ctx x =
-  pure $ case x of
-    XObj (Arr _) _ _ -> (ctx, Right trueXObj)
-    _ -> (ctx, Right falseXObj)
-
-commandIsSymbol :: UnaryCommandCallback
-commandIsSymbol ctx x =
-  pure $ case x of
-    XObj (Sym _ _) _ _ -> (ctx, Right trueXObj)
-    _ -> (ctx, Right falseXObj)
-
-commandIsNumber :: UnaryCommandCallback
-commandIsNumber ctx x =
-  pure $ case x of
-    XObj (Num _ _) _ _ -> (ctx, Right trueXObj)
-    _ -> (ctx, Right falseXObj)
-
-commandIsString :: UnaryCommandCallback
-commandIsString ctx x =
-  pure $ case x of
-    XObj (Str _) _ _ -> (ctx, Right trueXObj)
-    _ -> (ctx, Right falseXObj)
-
 commandArray :: VariadicCommandCallback
 commandArray ctx args =
   pure (ctx, Right (XObj (Arr args) (Just dummyInfo) Nothing))
@@ -835,3 +805,56 @@ commandParse ctx (XObj (Str s) i _) =
     Right (_ : _) -> evalError ctx "parse returned multiple objects" i
 commandParse ctx x =
   pure (evalError ctx ("Argument to `parse` must be a string, but was `" ++ pretty x ++ "`") (xobjInfo x))
+
+commandType :: UnaryCommandCallback
+commandType ctx (XObj x _ _) =
+  pure (ctx, Right (XObj (Sym (SymPath [] (typeOf x)) Symbol) Nothing Nothing))
+  where typeOf (Str _) = "string"
+        typeOf (Sym _ _) = "symbol"
+        typeOf (MultiSym _ _) = "multi-symbol"
+        typeOf (InterfaceSym _) = "interface-symbol"
+        typeOf (Arr _) = "array"
+        typeOf (StaticArr _) = "static-array"
+        typeOf (Lst _) = "list"
+        typeOf (Num IntTy _) = "int"
+        typeOf (Num LongTy _) = "long"
+        typeOf (Num ByteTy _) = "byte"
+        typeOf (Num FloatTy _) = "float"
+        typeOf (Num DoubleTy _) = "double"
+        typeOf (Num _ _) = error "invalid number type for `type` command!"
+        typeOf (Pattern _) = "pattern"
+        typeOf (Chr _) = "char"
+        typeOf (Bol _) = "bool"
+        typeOf (Dict _) = "map"
+        typeOf (Closure _ _) = "closure"
+        typeOf (Defn _) = "defn"
+        typeOf Def = "def"
+        typeOf (Fn _ _) = "fn"
+        typeOf Do = "do"
+        typeOf Let = "let"
+        typeOf LocalDef = "local-def"
+        typeOf While = "while"
+        typeOf Break = "dreak"
+        typeOf If = "if"
+        typeOf (Match _) = "matxch"
+        typeOf (Mod _) = "module"
+        typeOf (Deftype _) = "deftype"
+        typeOf (DefSumtype _) = "def-sum-type"
+        typeOf With = "with"
+        typeOf (External _) = "external"
+        typeOf (ExternalType _) = "external-type"
+        typeOf MetaStub = "meta-stub"
+        typeOf (Deftemplate _) = "deftemplate"
+        typeOf (Instantiate _) = "instantiate"
+        typeOf (Defalias _) = "defalias"
+        typeOf Address = "address"
+        typeOf SetBang = "set!"
+        typeOf Macro = "macro"
+        typeOf Dynamic = "dynamic"
+        typeOf DefDynamic = "defdynamic"
+        typeOf (Command _) = "command"
+        typeOf (Primitive _) = "primitive"
+        typeOf The = "the"
+        typeOf Ref = "ref"
+        typeOf Deref = "deref"
+        typeOf (Interface _ _) = "interface"

src/StartingEnv.hs

@@ -244,11 +244,6 @@ dynamicModule =
     unaries =
       let f = addUnaryCommand . spath
        in [ f "parse" commandParse "parses a string into an expression" "(parse \"(+ 1 2)\") ; => (+ 1 2)",
-            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 "number?" commandIsNumber "checks whether the argument is a number." "(number? 1) ; => true",
-            f "string?" commandIsString "checks whether the argument is a string." "(string? \"hi\") ; => 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)",
@@ -263,7 +258,8 @@ dynamicModule =
             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\")",
             f "hash" commandHash "calculates the hash associated with a value." "(hash '('my 'value)) ; => 3175346968842793108",
-            f "round" commandRound "rounds its numeric argument." "(round 2.4) ; => 2"
+            f "round" commandRound "rounds its numeric argument." "(round 2.4) ; => 2",
+            f "dynamic-type" commandType "Gets the dynamic type as a string." "(dynamic-type '()) ; => \"list\""
           ]
     binaries =
       let f = addBinaryCommand . spath