lib/mlenv.cc

   1 #include "mlenv.h"
   2 #include "ml.h"
   3 #include "util_check.h"
   4 #include "util_time.h"
   5 #include "util_string.h"
   6 #include "config.h"
   7 #include "motorconst.h"
   8 #include "motorvar.h"
   9 #include <boost/ptr_container/ptr_vector.hpp>
  10 #include <boost/unordered_map.hpp>
  11
  12 void  MlPool::setStartTime () {
  13     starttime = now ();
  14     limittime = starttime + cDEFAULTTIMELIMIT;
  15 }
  16
  17 bool  MlPool::qtimeup (std::ostream* log) {
  18     if (now () > limittime) {
  19         *log << "timeup\n";
  20         return true;
  21     } else {
  22         return false;
  23     }
  24 }
  25
  26 void  MlPool::inclIncCount () {
  27     if (includeCount == kIncludeMax)
  28         throw (uErrorInclNest);
  29     includeCount ++;
  30 }
  31
  32 bool  MlPool::inclIncCount_nothrow () {
  33     if (includeCount == kIncludeMax)
  34         return false;
  35     includeCount ++;
  36     return true;
  37 }
  38
  39 void  MlPool::declIncCount () {
  40     assert (includeCount > 0);
  41     includeCount --;
  42 }
  43
  44 bool  MlEnv::searchMTable (const ustring& name, FTableVal*& ans) {
  45     FTable::iterator  it;
  46     int  i;
  47
  48     if (mlFTable->mtable && (it = mlFTable->mtable->find (name)) != mlFTable->mtable->end ()) {
  49         ans = it->second;
  50         for (i = mlFTable->mstack.size () - 1; i >= 0; i --) {
  51             if (mlFTable->mstack[i].mfunc->mlid == ans->mlid) {
  52                 // nested error.
  53                 throw (name + ": forbidden.");
  54                 return false;
  55             }
  56         }
  57         return true;
  58     }
  59     return false;
  60 }
  61
  62 bool  MlEnv::searchSTable (const ustring& name, FTableVal*& ans, MLFunc*& mobj) {
  63     int  i;
  64     MlFTable::MStackVal*  t;
  65     FTable::iterator  it;
  66
  67     for (i = mlFTable->mstack.size () - 1; i >= 0; i --) {
  68         t = &mlFTable->mstack[i];
  69         if (t->mobj && t->mfunc->stable && (it = t->mfunc->stable->find (name)) != t->mfunc->stable->end ()) {
  70             ans = it->second;
  71             mobj = t->mobj;
  72             return true;
  73         }
  74     }
  75
  76     return false;
  77 }
  78
  79 bool  MlEnv::searchFTable (const ustring& name, FTableVal*& ans) {
  80     FTable::iterator  it;
  81
  82     if (mlFTable->ftable && (it = mlFTable->ftable->find (name)) != mlFTable->ftable->end ()) {
  83         ans = it->second;
  84         return true;
  85     } else {
  86         return false;
  87     }
  88 }
  89
  90 bool  MlEnv::validName (const ustring& name) {
  91     umatch  m;
  92     static uregex  re_var (rMOTORVAR);
  93
  94     return (regex_match (name, m, re_var));
  95 }
  96
  97 void  MlEnv::setGlobalAry (const ustring& name, size_t i, MNode* val) {
  98     ustring  a (name);
  99     a.append (uUScore);
 100     a.append (to_ustring (i));
 101     mlPool->globalVar.setVar (a, val);
 102 #ifdef DEBUG
 103     logSetVar (a, val);
 104 #endif /* DEBUG */
 105 }
 106
 107 void  MlEnv::setGlobalArySize (const ustring& name, size_t n) {
 108     ustring  a (name);
 109     MNode*  val;
 110     a.append (CharConst ("_n"));
 111     val = newMNode_num (n);
 112     mlPool->globalVar.setVar (a, val);
 113 #ifdef DEBUG
 114     logSetVar (a, val);
 115 #endif /* DEBUG */
 116 }
 117
 118 void  MlEnv::setLocalAry (MotorVar* pool, const ustring& name, size_t i, MNode* val) {
 119     ustring  a (name);
 120     a.append (uUScore);
 121     a.append (to_ustring (i));
 122     pool->setVar (a, val);
 123 #ifdef DEBUG
 124     logSetVar (a, val, true);
 125 #endif /* DEBUG */
 126 }
 127
 128 void  MlEnv::setLocalArySize (MotorVar* pool, const ustring& name, size_t n) {
 129     ustring  a (name);
 130     MNode*  val;
 131     a.append (CharConst ("_n"));
 132     val = newMNode_num (n);
 133     pool->setVar (a, val);
 134 #ifdef DEBUG
 135     logSetVar (a, val, true);
 136 #endif /* DEBUG */
 137 }
 138
 139 MNode*  MlEnv::getGlobalAry (const ustring& name, size_t i) {
 140     ustring  a (name);
 141     a.append (uUScore);
 142     a.append (to_ustring (i));
 143     return mlPool->globalVar.getVar (a);
 144 }
 145
 146 size_t  MlEnv::getGlobalArySize (const ustring& name) {
 147     MNode*  v;
 148     ustring  a (name);
 149     a.append (CharConst ("_n"));
 150     v = mlPool->globalVar.getVar (a);
 151     if (v && v->isReal ()) {
 152         return (size_t)v->real;
 153     } else {
 154         return 0;
 155     }
 156 }
 157
 158 MNode*  MlEnv::getLocalAry (MotorVar* pool, const ustring& name, size_t i) {
 159     ustring  a (name);
 160     a.append (uUScore);
 161     a.append (to_ustring (i));
 162     return pool->getVar (a);
 163 }
 164
 165 size_t  MlEnv::getLocalArySize (MotorVar* pool, const ustring& name) {
 166     MNode*  v;
 167     ustring  a (name);
 168
 169     a.append (CharConst ("_n"));
 170     v = pool->getVar (a);
 171     if (v && v->isReal ()) {
 172         return (size_t)v->real;
 173     } else {
 174         return 0;
 175     }
 176 }
 177
 178 void  MlEnv::setVar (const ustring& name, MNode* val) {
 179     MotorVar*  pool;
 180
 181     if (validName (name)) {
 182         pool = findLocal (name);
 183         if (pool) {
 184             pool->setVar (name, val);
 185 #ifdef DEBUG
 186             logSetVar (name, val, true);
 187 #endif /* DEBUG */
 188         } else {
 189             mlPool->globalVar.setVar (name, val);
 190 #ifdef DEBUG
 191             logSetVar (name, val);
 192 #endif /* DEBUG */
 193         }
 194     } else {
 195         MNodePtr  p;
 196         p = val;
 197 #ifdef DEBUG
 198         logSetVarError (name, val);
 199 #endif /* DEBUG */
 200     }
 201 }
 202
 203 void  MlEnv::setVar_nolog (const ustring& name, MNode* val) {
 204     MotorVar*  pool;
 205
 206     if (validName (name)) {
 207         pool = findLocal (name);
 208         if (pool) {
 209             pool->setVar (name, val);
 210         } else {
 211             mlPool->globalVar.setVar (name, val);
 212         }
 213     } else {
 214         MNodePtr  p;
 215         p = val;
 216 #ifdef DEBUG
 217         logSetVarError (name, val);
 218 #endif /* DEBUG */
 219     }
 220 }
 221
 222 void  MlEnv::setVar2 (const ustring& name, MNode* val) {
 223     ustring  sym;
 224
 225     if (checkAry (name, sym)) {
 226         setAry (sym, val);
 227     } else {
 228         setVar (name, val);
 229     }
 230 }
 231
 232 void  MlEnv::setAry (const ustring& name, size_t i, MNode* val) {
 233     MotorVar*  pool;
 234
 235     if (validName (name)) {
 236         pool = findLocal (name);
 237         if (pool) {
 238             setLocalAry (pool, name, i, val);
 239         } else {
 240             setGlobalAry (name, i, val);
 241         }
 242     } else {
 243         MNodePtr  p;
 244         p = val;
 245 #ifdef DEBUG
 246         logSetAryError (name, i, val);
 247 #endif /* DEBUG */
 248     }
 249 }
 250
 251 void  MlEnv::setArySize (const ustring& name, size_t n) {
 252     MotorVar*  pool;
 253
 254     if (validName (name)) {
 255         pool = findLocal (name);
 256         if (pool) {
 257             setLocalArySize (pool, name, n);
 258         } else {
 259             setGlobalArySize (name, n);
 260         }
 261     } else {
 262         throw (padEmpty (name) + uErrorBadName);
 263 #ifdef DEBUG
 264 //      logSetArySizeError (name, n);
 265 #endif /* DEBUG */
 266     }
 267 }
 268
 269 void  MlEnv::setAry (const ustring& name, MNode* list) {
 270     MotorVar*  pool;
 271     size_t  n = 0;
 272
 273     if (validName (name)) {
 274         pool = findLocal (name);
 275         if (pool) {
 276             if (isNil (list)) {
 277             } else if (list->isCons ()) {
 278                 while (list && list->isCons ()) {
 279                     n ++;
 280                     setLocalAry (pool, name, n, list->car ());
 281                     nextNode (list);
 282                 }
 283             } else if (list->isVector ()) {
 284                 MotorVector::iterator  b = list->vector->begin ();
 285                 MotorVector::iterator  e = list->vector->end ();
 286                 for (; b < e; ++ b) {
 287                     ++ n;
 288                     setLocalAry (pool, name, n, (*b) ());
 289                 }
 290             } else {
 291                 throw (ustring (CharConst ("setting a scalar value to an array.")));
 292             }
 293             setLocalArySize (pool, name, n);
 294         } else {
 295             if (isNil (list)) {
 296             } else if (list->isCons ()) {
 297                 while (list && list->isCons ()) {
 298                     n ++;
 299                     setGlobalAry (name, n, list->car ());
 300                     nextNode (list);
 301                 }
 302             } else if (list->isVector ()) {
 303                 MotorVector::iterator  b = list->vector->begin ();
 304                 MotorVector::iterator  e = list->vector->end ();
 305                 for (; b < e; ++ b) {
 306                     ++ n;
 307                     setGlobalAry (name, n, (*b) ());
 308                 }
 309             } else {
 310                 throw (ustring (CharConst ("setting a scalar value to an array.")));
 311             }
 312             setGlobalArySize (name, n);
 313         }
 314     } else {
 315         throw (padEmpty (name) + uErrorBadName);
 316 #ifdef DEBUG
 317 //      logSetVarError (name, NULL);
 318 #endif /* DEBUG */
 319     }
 320 }
 321
 322 MNode*  MlEnv::getVar (const ustring& name) {
 323     MotorVar*  pool;
 324
 325     if (validName (name)) {
 326         pool = findLocal (name);
 327         if (pool) {
 328             return (pool->getVar (name));
 329         } else {
 330             return (mlPool->globalVar.getVar (name));
 331         }
 332     } else {
 333         throw (padEmpty (name) + uErrorBadName);
 334     }
 335     return NULL;
 336 }
 337
 338 ustring  MlEnv::getVar_string (const ustring& name) {
 339     MNode*  v = getVar (name);
 340     if (v)
 341         return v->to_string ();
 342     else
 343         return uEmpty;
 344 }
 345
 346 MNode*  MlEnv::getAry (const ustring& name, size_t i) {
 347     MotorVar*  pool;
 348
 349     if (validName (name)) {
 350         pool = findLocal (name);
 351         if (pool) {
 352             return getLocalAry (pool, name, i);
 353         } else {
 354             return getGlobalAry (name, i);
 355         }
 356     } else {
 357         throw (padEmpty (name) + uErrorBadName);
 358     }
 359     return NULL;
 360 }
 361
 362 ustring  MlEnv::getAry_string (const ustring& name, size_t i) {
 363     MNode*  v = getAry (name, i);
 364     if (v)
 365         return v->to_string ();
 366     else
 367         return uEmpty;
 368 }
 369
 370 size_t  MlEnv::getArySize (const ustring& name) {
 371     MotorVar*  pool;
 372
 373     if (validName (name)) {
 374         pool = findLocal (name);
 375         if (pool) {
 376             return getLocalArySize (pool, name);
 377         } else {
 378             return getGlobalArySize (name);
 379         }
 380     } else {
 381         throw (padEmpty (name) + uErrorBadName);
 382     }
 383     return 0;
 384 }
 385
 386 void  MlEnv::beginLocal () {
 387     MotorVar*  v = new MotorVar;
 388     mlPool->localVar.push_back (v);
 389 }
 390
 391 void  MlEnv::setLocalVar (const ustring& name, MNode* val) {
 392     MotorVar*  pool = &mlPool->localVar.back ();
 393     if (validName (name)) {
 394         pool->setVar (name, val);
 395 #ifdef DEBUG
 396         logSetVar (name, val, true);
 397 #endif /* DEBUG */
 398     } else {
 399         MNodePtr  p;
 400         p = val;
 401 #ifdef DEBUG
 402         logSetVarError (name, val);
 403 #endif /* DEBUG */
 404     }
 405 }
 406
 407 void  MlEnv::defineLocalVar (const ustring& name) {
 408     MotorVar*  pool = &mlPool->localVar.back ();
 409     if (validName (name)) {
 410         pool->setVar (name, NULL);
 411     }
 412 }
 413
 414 void  MlEnv::endLocal () {
 415     mlPool->localVar.pop_back ();
 416 }
 417
 418 MotorVar*  MlEnv::findLocal (const ustring& name) {
 419     boost::ptr_vector<MotorVar>::reverse_iterator  t;
 420     MotorVar::iterator  it;
 421
 422     for (t = mlPool->localVar.rbegin (); t != mlPool->localVar.rend (); t ++) {
 423         it = t->find (name);
 424         if (it != t->end ()) {
 425             return &*t;
 426         }
 427     }
 428     return NULL;
 429 }
 430
 431 #ifdef DEBUG
 432 void  MlEnv::logSetVar (const ustring& name, MNode* val, bool flocal) {
 433     if (! log || mlPool->nolog)
 434         return;
 435     *log << "   [";
 436     if (flocal)
 437         *log << "*";
 438     *log <<  name << " <= ";
 439     if (val)
 440         *log << val->dump_string_short ();
 441     else
 442         *log << uNil;
 443     *log << "]\n";
 444 }
 445
 446 void  MlEnv::logSetVarError (const ustring& name, MNode* val) {
 447     if (! log)
 448         return;
 449     *log << "   error: [";
 450     *log <<  name << " <= ";
 451     if (val)
 452         *log << val->dump_string_short ();
 453     *log << "]\n";
 454 }
 455
 456 void  MlEnv::logSetAryError (const ustring& name, size_t i, MNode* val) {
 457     if (! log)
 458         return;
 459     *log << "   error: [" <<  name << uUScore << i << " <= ";
 460     if (val)
 461         *log << val->dump_string_short ();
 462     *log << "]\n";
 463 }
 464
 465 void  MlEnv::logSetArySizeError (const ustring& name, size_t n) {
 466     if (! log)
 467         return;
 468     *log << "   [" <<  name << "_n" << " <= " << n << "]\n";
 469 }
 470 #endif
 471
 472 void  MlEnv::push_linenum (MNode* c, int ln) {
 473     mlPool->linenum.insert (std::pair<MNode*, int> (c, ln));
 474 }
 475
 476 void  MlEnv::logLinenum (MNode* c) {
 477     boost::unordered_map<MNode*, int>::iterator  i;
 478
 479     i = mlPool->linenum.find (c);
 480     if (i == mlPool->linenum.end ()) {
 481         *log << "<none>: ";
 482     } else {
 483         *log << i->second << ": ";
 484     }
 485 }
 486
 487 void  MlEnv::logSexp (MNode* c) {
 488     int  i;
 489
 490     if (!mlPool->nolog && log && c && c->isCons ()) {
 491         for (i = 0; i < mlPool->includeCount; i ++)
 492             *log << ":";
 493         logLinenum (c);
 494         if (c->car () && c->car ()->isSym ()
 495             && (match (*ptr_symbol (c->car ()), CharConst ("defun")) || matchHead (*ptr_symbol (c->car ()), CharConst ("defun-")))
 496             && c->cdr () && c->cdr ()->isCons ()
 497             && c->cdr ()->cdr () && c->cdr ()->cdr ()->isCons ()) {
 498             *log << "(" << c->car ()->dump_string ();
 499             if (c->cdr ()->car ()) {
 500                 *log << " " << c->cdr ()->car ()->dump_string ();
 501             } else {
 502                 *log << " ()";
 503             }
 504             if (c->cdr ()->cdr ()->car ()) {
 505                 *log << " " << c->cdr ()->cdr ()->car ()->dump_string () << " ...\n";
 506             } else {
 507                 *log << " () ...\n";
 508             }
 509         } else {
 510             *log << c->dump_string_short () << "\n";
 511         }
 512     }
 513 }
 514
 515 void  MlEnv::setMStack (MLFunc* mobj) {
 516     MlFTable::MStackVal*  t = &mlFTable->mstack.back ();
 517
 518     assert (t->mobj == NULL);
 519     t->mobj = mobj;
 520 }
 521
 522 void  MlEnv::execDatastoreFunc () {
 523     int  i;
 524
 525     for (i = 0; i < datastoreFuncStack.size (); i ++) {
 526         datastoreFuncStack[i].second (datastoreFuncStack[i].first);
 527     }
 528 }
 529