Add some lisp functions.

diff --git a/lib/util_const.cc b/lib/util_const.cc
index 72f79c8..5f2dbad 100644 (file)
--- a/lib/util_const.cc
+++ b/lib/util_const.cc
@@ -35,7 +35,7 @@ ustring  uNil2 (CharConst ("()"));
 ustring  uLF (CharConst ("\n"));
 ustring  uCRLF (CharConst ("\r\n"));
 ustring  uSPC (CharConst (" "));
-ustring  uR (CharConst ("R"));
+ustring  uR (CharConst ("_R"));
 ustring  uDash (CharConst ("-"));
 ustring  uSlash (CharConst ("/"));
 //ustring  uSlash2 (CharConst ("//"));

diff --git a/lib/util_random.cc b/lib/util_random.cc
index dc80947..044d713 100644 (file)
--- a/lib/util_random.cc
+++ b/lib/util_random.cc
@@ -10,7 +10,7 @@
 
 static int  Inited = 0;
 static unsigned long  Seed;
-static ustring  RChar (CharConst ("ABCDEFGHJKLMNPQRTUVWXYZabcdefghijkmnopqrstuvwxyz23456789"));
+//static ustring  RChar (CharConst ("ABCDEFGHJKLMNPQRTUVWXYZabcdefghijkmnopqrstuvwxyz23456789"));
 static ustring  SaltChar (CharConst ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"));
 
 static void  init () {
@@ -26,41 +26,16 @@ static void  init () {
 
 static void  enc (unsigned long v, char* b) {
     int  i;
-    int  n = RChar.size ();
+//    int  n = RChar.size ();
+    int  n = SaltChar.size ();
 
     for (i = 0; i < 5; i ++) {
-       b[i] = RChar[v % n];
+//     b[i] = RChar[v % n];
+       b[i] = SaltChar[v % n];
        v /= n;
     }
 }
 
-#if 0
-ustring  randomKey () {
-    char  b[128];
-    ustring  ans;
-    ssize_t  s;
-
-    if (! Inited)
-       init ();
-    s = snprintf (b, 128, "%.8x%.8x%.8x%.8x", random (), random (), random (), random ());
-    ans = ustring (b, s);
-    return ans;
-}
-#endif
-#if 0
-ustring  smallRandomKey () {
-    char  b[128];
-    ustring  ans;
-    ssize_t  s;
-
-    if (! Inited)
-       init ();
-    s = snprintf (b, 128, "%.8x%.8x", random (), random ());
-    ans = ustring (b, s);
-    return ans;
-}
-#endif
-
 ustring  randomKey () {
     char  b[32];
 
@@ -114,3 +89,9 @@ ustring  makeSalt () {
     b[11] = '$';
     return ustring (b, 12);
 }
+
+double  randDouble () { 
+    if (! Inited)
+       init ();
+    return random () / double (0x80000000UL);
+} 

diff --git a/lib/util_random.h b/lib/util_random.h
index a57c5e6..c40c7f7 100644 (file)
--- a/lib/util_random.h
+++ b/lib/util_random.h
@@ -7,5 +7,6 @@ ustring  randomKey ();
 ustring  randomKey (unsigned long n);
 ustring  smallRandomKey ();
 ustring  makeSalt ();
+double  randDouble ();
 
 #endif /* UTIL_RANDOM_H */

diff --git a/modules/ml-db.cc b/modules/ml-db.cc
index fcc72a5..91d3309 100644 (file)
--- a/modules/ml-db.cc
+++ b/modules/ml-db.cc
@@ -205,6 +205,29 @@ MNode*  ml_db_x_write (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     return NULL;
 }
 
+/*DOC:
+====delete====
+ (delete KEY) -> NIL
+
+*/
+//#SFUNC       delete  ml_db_x_delete  $db-rw
+MNode*  ml_db_x_delete (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
+    MNode*  arg = cell->cdr ();
+    MLDb*  obj = MObjRef<MLDb> (mobj, cMLDbID);
+    ustring  key;
+
+    if (!arg) 
+       throw (uErrorWrongNumber);
+    key = eval_str (arg->car (), mlenv);
+    nextNode (arg);
+    if (arg) 
+       throw (uErrorWrongNumber);
+
+    obj->db.del (key);
+
+    return NULL;
+}
+
 static void  set_read_vars (ustring& val, std::vector<ustring>& vars, std::vector<int>& type, MlEnv* mlenv) {
     if (vars.size () > 0) {
        uiterator  b = val.begin ();

diff --git a/modules/ml-db.h b/modules/ml-db.h
index ce1b47c..cfdbfea 100644 (file)
--- a/modules/ml-db.h
+++ b/modules/ml-db.h
@@ -33,6 +33,7 @@ MNode*  ml_db_read (MNode* cell, MlEnv* mlenv);
 MNode*  ml_db_rw (MNode* cell, MlEnv* mlenv);
 MNode*  ml_db_x_read (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
 MNode*  ml_db_x_write (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_db_x_delete (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
 MNode*  ml_db_x_read_array (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
 MNode*  ml_db_x_write_array (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
 MNode*  ml_db_x_select (MNode* cell, MlEnv* mlenv, MLFunc* mobj);

diff --git a/modules/ml-math.cc b/modules/ml-math.cc
index cc87250..52ca4aa 100644 (file)
--- a/modules/ml-math.cc
+++ b/modules/ml-math.cc
@@ -4,6 +4,7 @@
 #include "motorenv.h"
 #include "expr.h"
 #include "util_const.h"
+#include "util_random.h"
 #include <exception>
 #include <math.h>
 
@@ -180,3 +181,19 @@ MNode*  ml_fraction (MNode* cell, MlEnv* mlenv) {
     double  v = arg1_double (cell, mlenv);
     return newMNode_num (v - floor (v));
 }
+
+/*DOC:
+===random===
+ (random) -> NUMBER
+
+*/
+//#AFUNC       random  ml_random
+//#WIKIFUNC    random  ml_random
+MNode*  ml_random (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+
+    if (arg)
+       throw (uErrorWrongNumber);
+
+    return newMNode_num (randDouble ());
+}

diff --git a/modules/ml-math.h b/modules/ml-math.h
index 31f99a4..fa3f05c 100644 (file)
--- a/modules/ml-math.h
+++ b/modules/ml-math.h
@@ -12,5 +12,6 @@ MNode*  ml_mod (MNode* cell, MlEnv* mlenv);
 MNode*  ml_ceil (MNode* cell, MlEnv* mlenv);
 MNode*  ml_floor (MNode* cell, MlEnv* mlenv);
 MNode*  ml_fraction (MNode* cell, MlEnv* mlenv);
+MNode*  ml_random (MNode* cell, MlEnv* mlenv);
 
 #endif /* ML_MATH_H */

diff --git a/modules/ml-string.cc b/modules/ml-string.cc
index 67663ef..5215425 100644 (file)
--- a/modules/ml-string.cc
+++ b/modules/ml-string.cc
@@ -4,6 +4,7 @@
 #include "motorenv.h"
 #include "motoroutput.h"
 #include "util_const.h"
+#include "util_random.h"
 #include "util_string.h"
 #include "expr.h"
 #include "utf8.h"
@@ -591,3 +592,19 @@ MNode*  ml_string_format (MNode* cell, MlEnv* mlenv) {
 
     return newMNode_str (new ustring (formatString (format, par)));
 }
+
+/*DOC:
+===random-key===
+ (random-key) -> STRING
+
+*/
+//#AFUNC       random-key      ml_random_key
+//#WIKIFUNC    random-key      ml_random_key
+MNode*  ml_random_key (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+
+    if (arg)
+       throw (uErrorWrongNumber);
+
+    return newMNode_str (new ustring (randomKey ()));
+}

diff --git a/modules/ml-string.h b/modules/ml-string.h
index eee2d3d..2ed1101 100644 (file)
--- a/modules/ml-string.h
+++ b/modules/ml-string.h
@@ -21,5 +21,6 @@ MNode*  ml_length (MNode* cell, MlEnv* mlenv);
 MNode*  ml_pad0 (MNode* cell, MlEnv* mlenv);
 MNode*  ml_ellipsis (MNode* cell, MlEnv* mlenv);
 MNode*  ml_string_format (MNode* cell, MlEnv* mlenv);
+MNode*  ml_random_key (MNode* cell, MlEnv* mlenv);
 
 #endif /* ML_STRING_H */