sort-string function.

diff --git a/modules/ml-string.cc b/modules/ml-string.cc
index 435ea08..c7ff800 100644 (file)
--- a/modules/ml-string.cc
+++ b/modules/ml-string.cc
@@ -810,3 +810,108 @@ MNode*  ml_is_ascii63 (MNode* cell, MlEnv* mlenv) {
 
     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, &params, kwlist, &keywords, NULL);
+    h = eval (params[0], mlenv);
+    if (eval_bool (keywords[0], mlenv))
+       fdesc = false;
+    if (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 ();
+}

diff --git a/modules/ml-string.h b/modules/ml-string.h
index 399916a..0a384bb 100644 (file)
--- a/modules/ml-string.h
+++ b/modules/ml-string.h
@@ -28,5 +28,6 @@ MNode*  ml_random_key (MNode* cell, MlEnv* mlenv);
 MNode*  ml_to_string (MNode* cell, MlEnv* mlenv);
 MNode*  ml_to_sexp (MNode* cell, MlEnv* mlenv);
 MNode*  ml_is_ascii63 (MNode* cell, MlEnv* mlenv);
+MNode*  ml_sort_string (MNode* cell, MlEnv* mlenv);
 
 #endif /* ML_STRING_H */