Merge pull request #542 from hellerve/gensym

Add gensym

core/Macros.carp

@@ -331,3 +331,16 @@ Otherwise it will fail with the message `msg`.
 The expression must be evaluable at compile time.")
 (defndynamic const-assert [expr msg]
   (if expr () (macro-error msg)))
+
+(doc *gensym-counter* "is a helper counter for `gensym`.")
+(defdynamic *gensym-counter* 1000)
+
+(doc gensym-with "generates symbols dynamically, based on a symbol name.")
+(defndynamic gensym-with [x]
+  (do
+    (defdynamic *gensym-counter* (inc *gensym-counter*))
+    (Symbol.join [x (Symbol.from *gensym-counter*)])))
+
+(doc gensym "generates symbols dynamically as needed.")
+(defndynamic gensym []
+  (gensym-with 'gensym-generated))

docs/core/Dynamic.html

@@ -314,9 +314,9 @@
                 </p>
             </div>
             <div class="binder">
-                <a class="anchor" href="#Sym">
-                    <h3 id="Sym">
-                        Sym
+                <a class="anchor" href="#Symbol">
+                    <h3 id="Symbol">
+                        Symbol
                     </h3>
                 </a>
                 <div class="description">

src/Commands.hs

@@ -738,13 +738,30 @@ commandSymPrefix [x, XObj (Sym (SymPath [] _) _) _ _] =
 commandSymPrefix [_, x] =
   return $ Left (EvalError ("Can’t call `prefix` with " ++ pretty x) (info x))
 
+commandSymFrom :: CommandCallback
+commandSymFrom [x@(XObj (Sym _ _) _ _)] = return $ Right x
+commandSymFrom [XObj (Str s) i t] = return $ Right $ XObj (sFrom_ s) i t
+commandSymFrom [XObj (Pattern s) i t] = return $ Right $ XObj (sFrom_ s) i t
+commandSymFrom [XObj (Chr c) i t] = return $ Right $ XObj (sFrom_ (show c)) i t
+commandSymFrom [XObj n@(Num _ _) i t] =
+  return $ Right $ XObj (sFrom_ (simpleFromNum n)) i t
+commandSymFrom [XObj (Bol b) i t] = return $ Right $ XObj (sFrom_ (show b)) i t
+commandSymFrom [x] =
+  return $ Left (EvalError ("Can’t call `from` with " ++ pretty x) (info x))
+
+sFrom_ s = Sym (SymPath [] s) (LookupGlobal CarpLand AVariable)
+
+simpleFromNum (Num IntTy num) = show (round num :: Int)
+simpleFromNum (Num LongTy num) = show (round num :: Int)
+simpleFromNum (Num _ num) = show num
+
 commandStringDirectory :: CommandCallback
 commandStringDirectory [a] =
   return $ case a of
     XObj (Str s) _ _ ->
       Right (XObj (Str (takeDirectory s)) (Just dummyInfo) (Just StringTy))
     _ ->
-      Left (EvalError ("Can't call directory with " ++ pretty a) (info a))
+      Left (EvalError ("Can't call `directory` with " ++ pretty a) (info a))
 
 commandPlus :: CommandCallback
 commandPlus [a, b] =

src/StartingEnv.hs

@@ -271,12 +271,13 @@ dynamicStringModule = Env { envBindings = bindings
 dynamicSymModule :: Env
 dynamicSymModule = Env { envBindings = bindings
                        , envParent = Nothing
-                       , envModuleName = Just "Sym"
+                       , envModuleName = Just "Symbol"
                        , envUseModules = []
                        , envMode = ExternalEnv
                        , envFunctionNestingLevel = 0 }
-  where bindings = Map.fromList [ addCommand "join" 1 commandSymJoin,
-                                  addCommand "prefix" 2 commandSymPrefix
+  where bindings = Map.fromList [ addCommand "join" 1 commandSymJoin
+                                , addCommand "prefix" 2 commandSymPrefix
+                                , addCommand "from" 1 commandSymFrom
                                 ]
 
 -- | A submodule of the Dynamic module. Contains functions for working with the active Carp project.

test/macros.carp

@@ -47,6 +47,12 @@
 (def xy 1)
 (defndynamic test-join- [] (Symbol.join ['x 'y]))
 (defmacro test-join [] (test-join-))
+(defmacro test-gensym []
+  (let [x (gensym)]
+    (list 'let (array x 1) (list '= x 1))))
+(defmacro test-gensym-with []
+  (let [x (gensym-with 'a)]
+    (list 'let (array x 1) (list '= x 1))))
 
 (deftest test
   (assert-true test
@@ -205,4 +211,10 @@
                 "test file contents\n"
                 (Dynamic.read-file "test/fixture_file.txt")
                 "Dynamic.read-file works as expected")
+  (assert-true test
+               (test-gensym-with)
+               "gensym-with works as expected")
+  (assert-true test
+               (test-gensym)
+               "gensym works as expected")
 )