#include "ml-string.h"
#include "ml.h"
+#include "ml-texp.h"
#include "mlenv.h"
#include "motorenv.h"
#include "motoroutput.h"
#include "util_check.h"
#include "util_random.h"
#include "util_string.h"
+#include "util_wsplitter.h"
#include "expr.h"
#include "utf8.h"
#include "utf16.h"
*/
/*DOC:
+===eq===
+ (eq STRING STRING...) -> 1 or NIL
+ (string-eq STRING STRING...) -> 1 or NIL
+
+全てのSTRINGが同じ時、1を返す。
+
+*/
+//#AFUNC eq ml_string_eq
+//#AFUNC string-eq ml_string_eq
+//#WIKIFUNC eq
+//#WIKIFUNC string-eq
+MNode* ml_string_eq (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring v1, v2;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+
+ v1 = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ while (arg) {
+ v2 = eval_str (arg->car (), mlenv);
+ if (v1 == v2) {
+ } else {
+ return newMNode_bool (false);
+ }
+ nextNode (arg);
+ }
+ return newMNode_bool (true);
+}
+
+/*DOC:
+===ne===
+ (ne STRING STRING) -> 1 or NIL
+ (string-ne STRING STRING) -> 1 or NIL
+
+STRINGが異なる時、1を返す。
+
+*/
+//#AFUNC ne ml_string_ne
+//#AFUNC string-ne ml_string_ne
+//#WIKIFUNC ne
+//#WIKIFUNC string-ne
+MNode* ml_string_ne (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring v1, v2;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+
+ v1 = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ if (! arg)
+ throw (uErrorWrongNumber);
+ v2 = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg)
+ throw (uErrorWrongNumber);
+
+ return newMNode_bool (v1 != v2);
+}
+
+//#AFUNC lt ml_string_lt
+//#AFUNC string-lt ml_string_lt
+//#WIKIFUNC lt
+//#WIKIFUNC string-lt
+MNode* ml_string_lt (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring v1, v2;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+ v1 = eval_str (arg->car (), mlenv);
+ nextNodeNonNil (arg);
+ v2 = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg)
+ throw (uErrorWrongNumber);
+
+ return newMNode_bool (v1 < v2);
+}
+
+//#AFUNC le ml_string_le
+//#AFUNC string-le ml_string_le
+//#WIKIFUNC le
+//#WIKIFUNC string-le
+MNode* ml_string_le (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring v1, v2;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+ v1 = eval_str (arg->car (), mlenv);
+ nextNodeNonNil (arg);
+ v2 = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg)
+ throw (uErrorWrongNumber);
+
+ return newMNode_bool (v1 <= v2);
+}
+
+//#AFUNC gt ml_string_gt
+//#AFUNC string-gt ml_string_gt
+//#WIKIFUNC gt
+//#WIKIFUNC string-gt
+MNode* ml_string_gt (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring v1, v2;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+ v1 = eval_str (arg->car (), mlenv);
+ nextNodeNonNil (arg);
+ v2 = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg)
+ throw (uErrorWrongNumber);
+
+ return newMNode_bool (v1 > v2);
+}
+
+//#AFUNC ge ml_string_ge
+//#AFUNC string-ge ml_string_ge
+//#WIKIFUNC ge
+//#WIKIFUNC string-ge
+MNode* ml_string_ge (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring v1, v2;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+ v1 = eval_str (arg->car (), mlenv);
+ nextNodeNonNil (arg);
+ v2 = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg)
+ throw (uErrorWrongNumber);
+
+ return newMNode_bool (v1 >= v2);
+}
+
+/*DOC:
+===emptyp===
+ (emptyp TEXT...) -> 1 or NIL
+
+文字列TEXTの長さが0の時、1を返す。
+
+*/
+//#AFUNC emptyp ml_emptyp
+//#WIKIFUNC emptyp
+MNode* ml_emptyp (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring u;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+
+ while (arg) {
+ u = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ if (u.size () > 0)
+ return newMNode_bool (false);
+ }
+ return newMNode_bool (true);
+}
+
+/*DOC:
+===not-emptyp===
+ (not-emptyp TEXT...) -> 1 or NIL
+
+文字列TEXTの長さが0でない時、1を返す。
+
+*/
+//#AFUNC not-emptyp ml_not_emptyp
+//#WIKIFUNC not-emptyp
+MNode* ml_not_emptyp (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring u;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+
+ while (arg) {
+ u = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ if (u.size () == 0)
+ return newMNode_bool (false);
+ }
+ return newMNode_bool (true);
+}
+
+/*DOC:
===concat===
(concat STRING...) -> STRING
-パラメータの文字列を連結して一つの文字列を返す。
+パラメータの文字列STRINGを連結して一つの文字列を返す。
*/
//#AFUNC concat ml_concat
AutoDelete<ustring> a1;
a1 = new ustring;
- a1 ()->reserve (256);
+// a1 ()->reserve (256);
while (arg) {
a1 ()->append (eval_str (arg->car (), mlenv));
===megabyte===
(megabyte NUMBER) -> STRING
+数値NUMBERをK、M、G、T、P単位（1024の倍数）の文字列に変換する。
+
*/
//#AFUNC megabyte ml_megabyte
//#WIKIFUNC megabyte
===c3===
(c3 INTEGER) -> STRING
+数値INTEGERを3桁ごとにカンマ区切りの文字列に変換する。
+
*/
//#AFUNC c3 ml_c3
//#WIKIFUNC c3
MNode* ml_regexp_match (MNode* cell, MlEnv* mlenv) {
MNode* arg = cell->cdr ();
ustring reg;
- ustring t;
+ ustring text;
boost::wregex::flag_type f = boost::regex_constants::normal;
bool ans;
std::vector<MNode*> params;
setParams (arg, 2, ¶ms, kwlist, &keywords, NULL);
reg = eval_str (params[0], mlenv);
- t = eval_str (params[1], mlenv);
- if (eval_bool (keywords[0], mlenv))
+ text = eval_str (params[1], mlenv);
+ if (keywords[0] && eval_bool (keywords[0], mlenv))
f |= boost::regex_constants::icase;
-#if 0
- mlenv->env->regtext = utow (t);
- std::wstring wreg = utow (reg);
- boost::wregex wre (wreg, f);
- ans = regex_search (mlenv->env->regtext, mlenv->env->regmatch, wre, boost::regex_constants::match_single_line);
-#endif
- ans = wsearch_env (mlenv, t, mlenv->env->regmatch, reg, f);
+ ans = wsearch_env (mlenv->regenv, text, reg, f);
return newMNode_bool (ans);
}
if (arg)
throw (uErrorWrongNumber);
- if (0 <= n && n < mlenv->env->regmatch.size ()) {
- ans = newMNode_str (new ustring (wtou (std::wstring (mlenv->env->regmatch[n].first, mlenv->env->regmatch[n].second))));
+ if (0 <= n && n < mlenv->regenv.regmatch.size ()) {
+ ans = newMNode_str (new ustring (wtou (std::wstring (mlenv->regenv.regmatch[n].first, mlenv->regenv.regmatch[n].second))));
}
return ans;
MNode* ml_prematch (MNode* cell, MlEnv* mlenv) {
MNode* arg = cell->cdr ();
MNode* ans = NULL;
- std::wstring::const_iterator b = mlenv->env->regtext.begin ();
+ std::wstring::const_iterator b = mlenv->regenv.regtext.begin ();
if (arg)
throw (uErrorWrongNumber);
- ans = newMNode_str (new ustring (wtou (std::wstring (b, mlenv->env->regmatch[0].first))));
+ ans = newMNode_str (new ustring (wtou (std::wstring (b, mlenv->regenv.regmatch[0].first))));
return ans;
}
MNode* ml_postmatch (MNode* cell, MlEnv* mlenv) {
MNode* arg = cell->cdr ();
MNode* ans = NULL;
- std::wstring::const_iterator e = mlenv->env->regtext.end ();
+ std::wstring::const_iterator e = mlenv->regenv.regtext.end ();
if (arg)
throw (uErrorWrongNumber);
- ans = newMNode_str (new ustring (wtou (std::wstring (mlenv->env->regmatch[0].second, e))));
+ ans = newMNode_str (new ustring (wtou (std::wstring (mlenv->regenv.regmatch[0].second, e))));
return ans;
}
MNode* ml_string_filter (MNode* cell, MlEnv* mlenv) {
MNode* arg = cell->cdr ();
ustring reg;
- ustring t;
+ ustring text;
boost::wregex::flag_type f = boost::regex_constants::normal;
size_t max = 0;
+ MNodePtr t;
std::vector<MNode*> params;
std::vector<MNode*> keywords;
static paramList kwlist[] = {
setParams (arg, 2, ¶ms, kwlist, &keywords, NULL);
reg = eval_str (params[0], mlenv);
- t = eval_str (params[1], mlenv);
- if (eval_bool (keywords[0], mlenv))
+ text = eval_str (params[1], mlenv);
+ if (keywords[0] && eval_bool (keywords[0], mlenv))
f |= boost::regex_constants::icase;
- if (eval_bool (keywords[1], mlenv)) {
- max = eval_int (keywords[1], mlenv);
- if (max < 0)
+ if (evkw (1, t)) {
+ int num = to_int (t ());
+ if (num < 0) {
max = 0;
+ } else {
+ max = num;
+ }
}
-#if 0
- mlenv->env->regtext = utow (t);
- std::wstring wreg = utow (reg);
- boost::wregex wre (wreg, f);
-// if (regex_search (mlenv->env->regtext, mlenv->env->regmatch, wre, boost::regex_constants::match_single_line)) {
-#endif
- if (wsearch_env (mlenv, t, mlenv->env->regmatch, reg, f)) {
-// return newMNode_str (new ustring (wtou (std::wstring (mlenv->env->regmatch[0].first, mlenv->env->regmatch[0].second))));
- ustring ans = wtou (std::wstring (mlenv->env->regmatch[0].first, mlenv->env->regmatch[0].second));
+ if (wsearch_env (mlenv->regenv, text, reg, f)) {
+ ustring ans = wtou (std::wstring (mlenv->regenv.regmatch[0].first, mlenv->regenv.regmatch[0].second));
if (max > 0) {
substring (ans, 0, max, true, ans);
}
return newMNode_str (new ustring (ans));
} else {
- return newMNode_str (new ustring);
+ return NULL; // unmatched
}
}
/*DOC:
-===split===
- (split REGEX STRING) -> STRING_LIST
+===regexp-replace===
+ (regexp-replace REGEX TO_TEXT TEXT [#i | :i BOOL] [#g | #global | :g BOOL | :global BOOL]) -> TEXT
*/
-//#AFUNC split ml_split
-//#WIKIFUNC split
-MNode* ml_split (MNode* cell, MlEnv* mlenv) {
+//#AFUNC regexp-replace ml_regexp_replace
+//#WIKIFUNC regexp-replace
+MNode* ml_regexp_replace (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring reg;
+ ustring to;
+ ustring text;
+ boost::wregex::flag_type f = boost::regex_constants::normal;
+ boost::match_flag_type mf = boost::regex_constants::match_default;
+ bool fglobal = false;
+ ustring ans;
+ std::vector<MNode*> params;
+ std::vector<MNode*> keywords;
+ static paramList kwlist[] = {
+ {CharConst ("i"), true},
+ {CharConst ("g"), true},
+ {CharConst ("global"), true},
+ {NULL, 0, 0}
+ };
+
+ setParams (arg, 3, ¶ms, kwlist, &keywords, NULL);
+ reg = eval_str (params[0], mlenv);
+ to = eval_str (params[1], mlenv);
+ text = eval_str (params[2], mlenv);
+ if (keywords[0] && eval_bool (keywords[0], mlenv))
+ f |= boost::regex_constants::icase;
+ if (keywords[1] && eval_bool (keywords[1], mlenv))
+ fglobal = true;
+ if (keywords[2] && eval_bool (keywords[2], mlenv))
+ fglobal = true;
+
+ if (! fglobal)
+ mf |= boost::regex_constants::format_first_only;
+ ans = wreplace (text, reg, to, f, mf);
+
+ return newMNode_str (new ustring (ans));
+}
+
+/*DOC:
+===regexp-split===
+ (regexp-split REGEX STRING [#i | :i BOOL]) -> (PREMATCH_STRING POSTMATCH_STRING)
+
+*/
+//#AFUNC regexp-split ml_regexp_split
+//#WIKIFUNC regexp-split
+MNode* ml_regexp_split (MNode* cell, MlEnv* mlenv) {
MNode* arg = cell->cdr ();
ustring reg;
- ustring t;
+ ustring text;
+ boost::wregex::flag_type f = boost::regex_constants::normal;
MNodeList ans;
+ std::vector<MNode*> params;
+ std::vector<MNode*> keywords;
+ static paramList kwlist[] = {
+ {CharConst ("i"), true},
+ {NULL, 0, 0}
+ };
- if (! arg)
- throw (uErrorWrongNumber);
+ setParams (arg, 2, ¶ms, kwlist, &keywords, NULL);
+ reg = eval_str (params[0], mlenv);
+ text = eval_str (params[1], mlenv);
+ if (keywords[0] && eval_bool (keywords[0], mlenv))
+ f |= boost::regex_constants::icase;
- reg = eval_str (arg->car (), mlenv);
- nextNodeNonNil (arg);
- t = eval_str (arg->car (), mlenv);
- nextNode (arg);
+ if (wsearch_env (mlenv->regenv, text, reg, f)) {
+ std::wstring::const_iterator b = mlenv->regenv.regtext.begin ();
+ std::wstring::const_iterator e = mlenv->regenv.regtext.end ();
+ ans.append (newMNode_str (new ustring (wtou (std::wstring (b, mlenv->regenv.regmatch[0].first)))));
+ ans.append (newMNode_str (new ustring (wtou (std::wstring (mlenv->regenv.regmatch[0].second, e)))));
+ } else {
+ ans.append (newMNode_str (new ustring (text)));
+ ans.append (NULL);
+ }
- if (arg)
- throw (uErrorWrongNumber);
+ return ans.release ();
+}
- try {
- std::wstring wt = utow (t);
- std::wstring wreg = utow (reg);
- boost::wregex wre (wreg);
- WSplitter sp (wt, wre);
+/*DOC:
+===split===
+ (split REGEX STRING [#keep] [#i]) -> STRING_LIST
+ (split REGEX STRING #vector [#keep] [#i]) -> STRING_VECTOR
+
+*/
+//#AFUNC split ml_split
+//#WIKIFUNC split
+MNode* ml_split (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring reg;
+ ustring text;
+ bool flagKeep = false;
+ bool flagVector = false;
+ ListMakerPtr ans;
+ std::vector<MNode*> params;
+ std::vector<MNode*> keywords;
+ static paramList kwlist[] = {
+ {CharConst ("keep"), true}, // 空フィールドの削除をしない
+ {CharConst ("vector"), true},
+// {CharConst ("i"), true},
+ {NULL, 0, 0}
+ };
- while (sp.next ()) {
- ans.append (newMNode_str (new ustring (sp.cur ())));
+ setParams (arg, 2, ¶ms, kwlist, &keywords, NULL);
+ reg = eval_str (params[0], mlenv);
+ text = eval_str (params[1], mlenv);
+ if (keywords[0] && eval_bool (keywords[0], mlenv))
+ flagKeep = true;
+ if (keywords[1] && eval_bool (keywords[1], mlenv))
+ flagVector = true;
+// if (keywords[1] && eval_bool (keywords[1], mlenv))
+// flagReg |= boost::regex_constants::icase;
+ if (flagVector)
+ ans = new ListMakerVector;
+ else
+ ans = new ListMakerList;
+
+ if (reg.length () == 0) {
+ uiterator b = text.begin ();
+ uiterator e = text.end ();
+ uiterator s;
+ while (b < e) {
+ s = b;
+ nextChar (b, e);
+ ans.append (newMNode_str (new ustring (s, b)));
+ }
+ } else {
+ try {
+ std::wstring wt = utow (text);
+ std::wstring wreg = utow (reg);
+ boost::wregex wre (wreg);
+ WSplitter sp (wt, wre);
+ size_t m = wt.length () + 1;
+
+ bool (WSplitter::*nfn)();
+ if (flagKeep)
+ nfn = &WSplitter::nextSep;
+ else
+ nfn = &WSplitter::next;
+ while ((sp.*nfn) ()) {
+ ans.append (newMNode_str (new ustring (sp.cur ())));
+ m --;
+ if (m == 0)
+ throw (uErrorRegexp);
+ }
+ if (flagKeep)
+ ans.append (newMNode_str (new ustring (sp.cur ())));
+ } catch (boost::regex_error& err) {
+ throw (uErrorRegexp);
}
- } catch (boost::regex_error& err) {
- throw (uErrorRegexp);
}
return ans.release ();
}
/*DOC:
===string-join===
- (string-join TEXT [STRING | ARRAY | LIST]...) -> STRING
+ (string-join TEXT [STRING | ARRAY | LIST | VECTOR]...) -> STRING
*/
//#AFUNC string-join ml_string_join
if (! isNil (a->car ()))
ans.append (a->car ()->to_string ());
}
+ } else if (val ()->isVector ()) {
+ size_t n = val ()->vectorSize ();
+ size_t i;
+ for (i = 0; i < n; ++ i) {
+ if (i > 0)
+ ans.append (sep);
+ MNode* a = val ()->vectorGet (i);
+ if (! isNil (a))
+ ans.append (a->to_string ());
+ }
} else {
var = val ()->to_string ();
if (c == 0)
/*DOC:
===password-crypt===
- (password-crypt PASSWORD) -> STRING
+ (password-crypt PASSWORD [#md5 | #sha256 | #sha512]) -> STRING
+
+deprecated.
*/
//#AFUNC password-crypt ml_password_crypt
MNode* ml_password_crypt (MNode* cell, MlEnv* mlenv) {
MNode* arg = cell->cdr ();
ustring pass;
+ passCryptFormat format;
+ std::vector<MNode*> params;
+ std::vector<MNode*> keywords;
+ static paramList kwlist[] = {
+ {CharConst ("md5"), true},
+ {CharConst ("sha256"), true},
+ {CharConst ("sha512"), true},
+// {CharConst ("bf"), true},
+ {NULL, 0, 0}
+ };
- if (! arg)
- throw (uErrorWrongNumber);
- pass = eval_str (arg->car (), mlenv);
- nextNode (arg);
- if (arg)
- throw (uErrorWrongNumber);
-
- return newMNode_str (new ustring (passCrypt (pass)));
+ format = FORMAT_MD5;
+ setParams (arg, 1, ¶ms, kwlist, &keywords, NULL);
+ pass = eval_str (params[0], mlenv);
+ if (keywords[0] && eval_bool (keywords[0], mlenv))
+ format = FORMAT_MD5;
+ if (keywords[1] && eval_bool (keywords[1], mlenv))
+ format = FORMAT_SHA256;
+ if (keywords[2] && eval_bool (keywords[2], mlenv))
+ format = FORMAT_SHA512;
+// if (keywords[3] && eval_bool (keywords[3], mlenv))
+// format = FORMAT_BF;
+
+ return newMNode_str (new ustring (passCrypt (pass, format)));
}
/*DOC:
(substring STR INDEX LENGTH) -> STRING
(substring STR INDEX) -> STRING
+INDEX number of the first character of STR is 0.
+
*/
//#AFUNC substring ml_substring
//#WIKIFUNC substring
}
/*DOC:
+===tail-substring===
+ (tail-substring STR INDEX LENGTH) -> STRING
+ (tail-substring STR INDEX) -> STRING
+
+INDEX number of the last character of STR is 0.
+
+*/
+//#AFUNC tail-substring ml_tail_substring
+//#WIKIFUNC tail-substring
+MNode* ml_tail_substring (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring str;
+ size_t index;
+ size_t length;
+ int mode;
+ ustring ans;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+ str = eval_str (arg->car (), mlenv);
+ nextNodeNonNil (arg);
+ index = eval_int (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg) {
+ mode = 3;
+ length = eval_int (arg->car (), mlenv);
+ nextNode (arg);
+ } else {
+ mode = 2;
+ }
+ if (arg)
+ throw (uErrorWrongNumber);
+
+ size_t s = strLength (str);
+ if (mode == 3)
+ substring (str, s - index - 1, length, 1, ans);
+ else
+ substring (str, s - index - 1, 0, 0, ans);
+ return newMNode_str (new ustring (ans));
+}
+
+/*DOC:
===length===
- (length STR) -> NUMBER
+ (length STRING) -> NUMBER
*/
//#AFUNC length ml_length
}
/*DOC:
+===byte-length===
+ (byte-length STRING) -> NUMBER
+
+*/
+//#AFUNC byte-length ml_byte_length
+//#WIKIFUNC byte-length
+MNode* ml_byte_length (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring str;
+ size_t ans;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+ str = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg)
+ throw (uErrorWrongNumber);
+
+ ans = str.length ();
+ return newMNode_num (ans);
+}
+
+/*DOC:
===pad0===
(pad0 NUMBER STRING) -> STRING
(pad0 NUMBER STRING_LIST) -> STRING_LIST
}
/*DOC:
+===date-format, gmdate-format===
+ (date-format FORMAT INTEGER) -> STRING
+ (gmdate-format FORMAT INTEGER) -> STRING
+
+ ${Y:4}, ${Y:2}
+ ${M:2}, ${M}
+ ${D:2}, ${D}
+ ${h:2}, ${h}
+ ${m:2}, ${m}
+ ${s:2}, ${s}
+ ${W}, ${w}
+
+*/
+//#AFUNC date-format ml_date_format
+//#WIKIFUNC date-format
+MNode* ml_date_format (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring format;
+ time_t tm;
+ struct tm tmv;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+ format = eval_str (arg->car (), mlenv);
+ nextNodeNonNil (arg);
+ tm = eval_int (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg)
+ throw (uErrorWrongNumber);
+
+ localtime_r (&tm, &tmv);
+ return newMNode_str (new ustring (formatDateString (format, tmv)));
+}
+
+//#AFUNC gmdate-format ml_gmdate_format
+//#WIKIFUNC gmdate-format
+MNode* ml_gmdate_format (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring format;
+ time_t tm;
+ struct tm tmv;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+ format = eval_str (arg->car (), mlenv);
+ nextNodeNonNil (arg);
+ tm = eval_int (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg)
+ throw (uErrorWrongNumber);
+
+ gmtime_r (&tm, &tmv);
+ return newMNode_str (new ustring (formatDateString (format, tmv)));
+}
+
+/*DOC:
===to-string===
(to-string OBJECT) -> STRING
}
/*DOC:
-===to-sexp===
- (to-sexp STRING) -> OBJECT
+===to-symbol===
+ (to-symbol STRING) -> SYMBOL
+
+*/
+//#AFUNC to-symbol ml_to_symbol
+//#WIKIFUNC to-symbol
+MNode* ml_to_symbol (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ MNodePtr text;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+ text = eval (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg)
+ throw (uErrorWrongNumber);
+
+ if (text ()) {
+ if (text ()->isSym ()) {
+ return text.release ();
+ } else {
+ return newMNode_sym (new ustring (text ()->to_string ()));
+ }
+ } else {
+ return NULL;
+ }
+}
+
+/*DOC:
+===dump-to-texp, dump-to-sexp===
+ (dump-to-texp OBJECT...) -> STRING
+ (dump-to-sexp OBJECT...) -> STRING
+
+*/
+//#AFUNC dump-to-texp ml_dump_to_texp
+//#AFUNC dump-to-sexp ml_dump_to_texp
+//#WIKIFUNC dump-to-texp
+//#WIKIFUNC dump-to-sexp
+MNode* ml_dump_to_texp (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ MNodePtr e;
+ ustring text;
+
+ while (arg) {
+ e = eval (arg->car (), mlenv);
+ nextNode (arg);
+ if (text.length () > 0)
+ text.append (CharConst (" "));
+ text.append (dump_to_texp (e ()));
+ }
+ return newMNode_str (new ustring (text));
+}
+
+/*DOC:
+//===to-sexp===
+// (to-sexp STRING) -> OBJECT
+===read-texp, read-sexp===
+ (read-sexp STRING) -> OBJECT
+ (read-texp STRING) -> OBJECT
*/
-//#AFUNC to-sexp ml_to_sexp
-//#WIKIFUNC to-sexp
-MNode* ml_to_sexp (MNode* cell, MlEnv* mlenv) {
+// //#AFUNC to-sexp ml_to_sexp
+// //#WIKIFUNC to-sexp
+//#AFUNC read-texp ml_read_texp
+//#AFUNC read-sexp ml_read_texp
+//#WIKIFUNC read-texp
+//#WIKIFUNC read-sexp
+MNode* ml_read_texp (MNode* cell, MlEnv* mlenv) {
MNode* arg = cell->cdr ();
ustring text;
- MotorSexp ml (NULL);
+ MotorTexp ml (NULL);
if (! arg)
throw (uErrorWrongNumber);
else
return NULL;
}
+
+/*DOC:
+===is-ascii63===
+ (is-ascii63 STRING) -> BOOL
+
+*/
+//#AFUNC is-ascii63 ml_is_ascii63
+//#WIKIFUNC is-ascii63
+MNode* ml_is_ascii63 (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ ustring text;
+ bool ans;
+
+ if (! arg)
+ throw (uErrorWrongNumber);
+ text = eval_str (arg->car (), mlenv);
+ nextNode (arg);
+ if (arg)
+ throw (uErrorWrongNumber);
+
+// ans = checkASCII (text);
+ ans = matchASCII (text.begin (), text.end ());
+
+ return newMNode_bool (ans);
+}
+
+/*DOC:
+===sort-string===
+ (sort-string LIST [#asc] [#desc]) -> LIST
+
+*/
+//#AFUNC sort-string ml_sort_string
+//#WIKIFUNC sort-string
+MNode* ml_sort_string (MNode* cell, MlEnv* mlenv) {
+ MNode* arg = cell->cdr ();
+ MNodePtr h;
+ bool fdesc = false;
+ MNode* a;
+ std::vector<MNode*> list;
+ MNodeList ans;
+ std::vector<MNode*> params;
+ std::vector<MNode*> keywords;
+ static paramList kwlist[] = {
+ {CharConst ("asc"), true},
+ {CharConst ("desc"), true},
+ {NULL, 0, 0}
+ };
+
+ setParams (arg, 1, ¶ms, kwlist, &keywords, NULL);
+ h = eval (params[0], mlenv);
+ if (keywords[0] && eval_bool (keywords[0], mlenv))
+ fdesc = false;
+ if (keywords[1] && eval_bool (keywords[1], mlenv))
+ fdesc = true;
+
+ a = h ();
+ while (a) {
+ if (a->isCons ()) {
+ if (a->car () && a->car ()->isStr ()) {
+ list.push_back (a->car ());
+ } else {
+ list.push_back (NULL);
+ }
+ nextNode (a);
+ } else {
+ break;
+ }
+ }
+
+ int s, i, j, k;
+ int n = list.size ();
+ for (i = 1; i < n; i ++) {
+ j = i;
+ while (j > 0) {
+ k = (j - 1) / 2;
+ if (! list[k])
+ if (! list[j])
+ break;
+ else
+ if (fdesc)
+ break;
+ else ;
+ else if (! list[j])
+ if (fdesc)
+ ;
+ else
+ break;
+ else if (fdesc ^ (*list[k]->str >= *list[j]->str))
+ break;
+// swap (v[k], v[j]);
+ a = list[j]; list[j] = list[k]; list[k] = a;
+ j = k;
+ }
+ }
+ for (; n > 0; n --) {
+// swap (v[0], v[n - 1]);
+ a = list[n - 1]; list[n - 1] = list[0]; list[0] = a;
+ for (i = 1; i < n - 1; i ++) {
+ j = i;
+ while (j > 0) {
+ k = (j - 1) / 2;
+// if (! list[k] || ! list[j])
+// break;
+ if (! list[k])
+ if (! list[j])
+ break;
+ else
+ if (fdesc)
+ break;
+ else ;
+ else if (! list[j])
+ if (fdesc)
+ ;
+ else
+ break;
+ else if (fdesc ^ (*list[k]->str >= *list[j]->str))
+ break;
+// swap (v[k], v[j]);
+ a = list[j]; list[j] = list[k]; list[k] = a;
+ j = k;
+ }
+ }
+ }
+
+ n = list.size ();
+ for (i = 0; i < n; i ++) {
+ ans.append (list[i]);
+ }
+ return ans.release ();
+}
+
+/*DOC:
+===to-upper===
+ (to-upper STRING) -> STRING
+
+*/
+//#AFUNC to-upper ml_to_upper
+//#WIKIFUNC to-upper
+MNode* ml_to_upper (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);
+
+ return newMNode_str (new ustring (toUpper (text)));
+}
+
+/*DOC:
+===to-lower===
+ (to-lower STRING) -> STRING
+
+*/
+//#AFUNC to-lower ml_to_lower
+//#WIKIFUNC to-lower
+MNode* ml_to_lower (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);
+
+ 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 ()));
+}
OSDN Git Service
