hex encoding functions.

[hmh/hhml.git] / modules / ml-math.cc

diff --git a/modules/ml-math.cc b/modules/ml-math.cc
index 6e0f6c8..8c74b18 100644 (file)
--- a/modules/ml-math.cc
+++ b/modules/ml-math.cc
@@ -28,28 +28,53 @@ static double  arg1_double (MNode* cell, MlEnv* mlenv) {
 
 /*DOC:
 ===to-number===
- (to-number OBJECT) -> NUMBER
+ (to-number [#bin | #oct | #hex | #HEX] OBJECT) -> NUMBER
 
 */
 //#AFUNC       to-number       ml_to_number
 //#WIKIFUNC    to-number
 MNode*  ml_to_number (MNode* cell, MlEnv* mlenv) {
     MNode*  arg = cell->cdr ();
-    double  a1;
-
-    if (! arg)
-       throw (uErrorWrongNumber);
-    try {
-       a1 = eval_double (arg->car (), mlenv);
-    } catch (boost::bad_lexical_cast msg) {
-       // 暗黙の変換では、BadValueエラーになるが、to-numberでは、エラーにしない。
-       a1 = 0.0;
+    bool  fhex = false;
+    bool  foct = false;
+    bool  fbin = false;
+    double  ans;
+    std::vector<MNode*>  params;
+    std::vector<MNode*>  keywords;
+    static paramList  kwlist[] = {
+       {CharConst ("hex"), true},
+       {CharConst ("HEX"), true},
+       {CharConst ("oct"), true},
+       {CharConst ("bin"), true},
+       {NULL, 0, 0}
+    };
+
+    setParams (arg, 1, &params, kwlist, &keywords, NULL);
+    evkw_bool (0, fhex);
+    evkw_bool (1, fhex);
+    evkw_bool (2, foct);
+    evkw_bool (3, fbin);
+    if (fhex) {
+       ustring  text;
+       text = eval_str (params[0], mlenv);
+       ans = hextod (text.begin (), text.end (), 16);
+    } else if (foct) {
+       ustring  text;
+       text = eval_str (params[0], mlenv);
+       ans = hextod (text.begin (), text.end (), 8);
+    } else if (fbin) {
+       ustring  text;
+       text = eval_str (params[0], mlenv);
+       ans = hextod (text.begin (), text.end (), 2);
+    } else {
+       try {
+           ans = eval_double (params[0], mlenv);
+       } catch (boost::bad_lexical_cast msg) {
+           // 暗黙の変換では、BadValueエラーになるが、to-numberでは、エラーにしない。
+           ans = 0.0;
+       }
     }
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
-
-    return newMNode_num (a1);
+    return newMNode_num (ans);
 }
 
 /*DOC: