return boost::lexical_cast<uint64_t> (v);
}
+static int shex (char c) {
+ if ('0' <= c && c <= '9') {
+ return (c - '0');
+ } else if ('a' <= c && c <= 'f') {
+ return (c - 'a' + 10);
+ } else if ('A' <= c && c <= 'F') {
+ return (c - 'A' + 10);
+ } else {
+ return -1;
+ }
+}
+
static int hex (char c) {
if ('0' <= c && c <= '9') {
return (c - '0');
return ans;
}
+double hextod (uiterator b, uiterator e, int base) {
+ double ans = 0.0;
+ int n;
+ int c;
+
+ for (n = 0; b < e; n ++, b ++) {
+ c = shex (*b);
+ if (c < 0 || c >= base)
+ return ans;
+ ans = ans * 16. + c;
+ }
+ return ans;
+}
+
+ustring dtohex (double e, int pad, int base, bool upcase) {
+ double a, b;
+ int r;
+ ustring ans;
+ char d[128];
+ int pos;
+ const char* digs;
+ static const char xdigsLower[] = "0123456789abcdef";
+ static const char xdigsUpper[] = "0123456789ABCDEF";
+
+ pos = 128;
+ b = base;
+ if (upcase)
+ digs = xdigsUpper;
+ else
+ digs = xdigsLower;
+ if (e >= 0) {
+ e = floor (e);
+ while (pos > 0 && e > 0) {
+ a = floor (e / b);
+ r = e - a * b;
+ e = a;
+ if (r < 0) {
+ r = 0;
+ } else if (r >= base) {
+ r = base - 1;
+ }
+ d[--pos] = digs[r];
+ }
+ if (pad > 0) {
+ for (int i = 128 - pos; i < pad; i ++) {
+ d[--pos] = '0';
+ }
+ }
+ ans.assign (d + pos, 128 - pos);
+ } else {
+ }
+ return ans;
+}
+
ustring toCRLF (const ustring& str) {
uiterator b = str.begin ();
uiterator e = str.end ();
ustring zeroPad (int n, const ustring& src);
ustring padEmpty (const ustring& name);
uint32_t hextoul (uiterator b, uiterator e);
+double hextod (uiterator b, uiterator e, int base = 16);
+ustring dtohex (double e, int pad = 0, int base = 16, bool upcase = false);
ustring toCRLF (const ustring& str);
void skipChar (uiterator& b, uiterator e, int ch);
inline void skipSpace (uiterator& b, uiterator e) {skipChar (b, e, ' ');}
return newMNode_str (new ustring (fixUTF8 (str)));
}
+
+/*DOC:
+===hex-encode===
+ (hex-encode STRING...) -> STRING
+ (string-to-hex STRING ...) -> STRING
+
+*/
+//#AFUNC hex-encode ml_hex_encode
+//#AFUNC string-to-hex ml_hex_encode
+//#WIKIFUNC hex-encode
+//#WIKIFUNC string-to-hex
+MNode* ml_hex_encode (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring text;
+ ustring ans;
+
+ while (arg) {
+ text = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ ans.append (hexEncode (text));
+ }
+ return newMNode_str (new ustring (ans));
+}
+
+/*DOC:
+===hex-decode===
+ (hex-decode [#ctrl] STRING...) -> STRING
+ (hex-to-string [#ctrl] STRING ...) -> STRING
+
+*/
+//#AFUNC hex-decode ml_hex_decode
+//#AFUNC hex-to-string ml_hex_decode
+//#WIKIFUNC hex-decode
+//#WIKIFUNC hex-to-string
+MNode* ml_hex_decode (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring text;
+ ustring ans;
+ bool fctrl = false;
+ std::vector<MNode*> keywords;
+ MNode* rest;
+ static paramList kwlist[] = {
+ {CharConst ("ctrl"), true},
+ {NULL, 0, 0}
+ };
+
+ setParams (arg, 0, NULL, kwlist, &keywords, &rest);
+ evkw_bool (0, fctrl);
+ while (rest) {
+ text = eval_str (rest->car (), mlenv);
+ nextNode (rest);
+ ans.append (hexDecode (text));
+ }
+ if (fctrl)
+ return newMNode_str (new ustring (fixUTF8 (ans)));
+ else
+ return newMNode_str (new ustring (omitCtrlX (fixUTF8 (ans))));
+}
MNode* ml_base64_decode (MNode* cell, MlEnv* mlenv);
MNode* ml_base64_url_encode (MNode* cell, MlEnv* mlenv);
MNode* ml_base64_url_decode (MNode* cell, MlEnv* mlenv);
+MNode* ml_hex_encode (MNode* cell, MlEnv* mlenv);
+MNode* ml_hex_decode (MNode* cell, MlEnv* mlenv);
#endif /* ML_ENCODE_H */
/*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, ¶ms, 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:
/*DOC:
===to-string===
- (to-string OBJECT) -> STRING
+ (to-string [#bin | #oct | #hex | #HEX] [:pad NUMBER] OBJECT) -> STRING
*/
//#AFUNC to-string ml_to_string
//#WIKIFUNC to-string
MNode* ml_to_string (MNode* cell, MlEnv* mlenv) {
MNode* arg = cell->cdr ();
+ bool fhex = false;
+ bool fuhex = false;
+ bool foct = false;
+ bool fbin = false;
+ int pad = 0;
ustring text;
+ std::vector<MNode*> params;
+ std::vector<MNode*> keywords;
+ static paramList kwlist[] = {
+ {CharConst ("hex"), true},
+ {CharConst ("HEX"), true},
+ {CharConst ("oct"), true},
+ {CharConst ("bin"), true},
+ {CharConst ("pad"), false},
+ {NULL, 0, 0}
+ };
- if (! arg)
- throw (uErrorWrongNumber);
- text = eval_str (arg->car (), mlenv);
- nextNode (arg);
- if (arg)
- throw (uErrorWrongNumber);
-
+ setParams (arg, 1, ¶ms, kwlist, &keywords, NULL);
+ evkw_bool (0, fhex);
+ evkw_bool (1, fuhex);
+ evkw_bool (2, foct);
+ evkw_bool (3, fbin);
+ evkw_int (4, pad);
+ if (fhex) {
+ text = dtohex (eval_double (params[0], mlenv), pad, 16, false);
+ } else if (fuhex) {
+ text = dtohex (eval_double (params[0], mlenv), pad, 16, true);
+ } else if (foct) {
+ text = dtohex (eval_double (params[0], mlenv), pad, 8);
+ } else if (fbin) {
+ text = dtohex (eval_double (params[0], mlenv), pad, 2);
+ } else {
+ text = eval_str (params[0], mlenv);
+ }
return newMNode_str (new ustring (text));
}
return newMNode_str (new ustring (toLower (text)));
}
-/*DOC:
-===hex-to-dec===
- (hex-to-dec STRING) -> NUMBER
-
-*/
-//#AFUNC hex-to-dec ml_hex_to_dec
-//#WIKIFUNC hex-to-dec
-MNode* ml_hex_to_dec (MNode* cell, MlEnv* mlenv) {
- MNode* arg = cell->cdr ();
- ustring text;
-
- if (! arg)
- throw (uErrorWrongNumber);
- text = eval_str (arg->car (), mlenv);
- nextNode (arg);
- if (arg)
- throw (uErrorWrongNumber);
- if (text.length () > 8)
- throw (uErrorBadArg);
-
- return newMNode_num (hextoul (text.begin (), text.end ()));
-}
MNode* ml_sort_string (MNode* cell, MlEnv* mlenv);
MNode* ml_to_upper (MNode* cell, MlEnv* mlenv);
MNode* ml_to_lower (MNode* cell, MlEnv* mlenv);
-MNode* ml_hex_to_dec (MNode* cell, MlEnv* mlenv);
#endif /* ML_STRING_H */