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) && i >= 0) {
 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         if (i >= 0) {
 351             pool = findLocal (name);
 352             if (pool) {
 353                 return getLocalAry (pool, name, i);
 354             } else {
 355                 return getGlobalAry (name, i);
 356             }
 357         }
 358     } else {
 359         throw (padEmpty (name) + uErrorBadName);
 360     }
 361     return NULL;
 362 }
 363
 364 ustring  MlEnv::getAry_string (const ustring& name, size_t i) {
 365     MNode*  v = getAry (name, i);
 366     if (v)
 367         return v->to_string ();
 368     else
 369         return uEmpty;
 370 }
 371
 372 size_t  MlEnv::getArySize (const ustring& name) {
 373     MotorVar*  pool;
 374
 375     if (validName (name)) {
 376         pool = findLocal (name);
 377         if (pool) {
 378             return getLocalArySize (pool, name);
 379         } else {
 380             return getGlobalArySize (name);
 381         }
 382     } else {
 383         throw (padEmpty (name) + uErrorBadName);
 384     }
 385     return 0;
 386 }
 387
 388 void  MlEnv::beginLocal () {
 389     MotorVar*  v = new MotorVar;
 390     mlPool->localVar.push_back (v);
 391 }
 392
 393 void  MlEnv::setLocalVar (const ustring& name, MNode* val) {
 394     MotorVar*  pool = &mlPool->localVar.back ();
 395     if (validName (name)) {
 396         pool->setVar (name, val);
 397 #ifdef DEBUG
 398         logSetVar (name, val, true);
 399 #endif /* DEBUG */
 400     } else {
 401         MNodePtr  p;
 402         p = val;
 403 #ifdef DEBUG
 404         logSetVarError (name, val);
 405 #endif /* DEBUG */
 406     }
 407 }
 408
 409 void  MlEnv::defineLocalVar (const ustring& name) {
 410     MotorVar*  pool = &mlPool->localVar.back ();
 411     if (validName (name)) {
 412         pool->setVar (name, NULL);
 413     }
 414 }
 415
 416 void  MlEnv::endLocal () {
 417     mlPool->localVar.pop_back ();
 418 }
 419
 420 MotorVar*  MlEnv::findLocal (const ustring& name) {
 421     boost::ptr_vector<MotorVar>::reverse_iterator  t;
 422     MotorVar::iterator  it;
 423
 424     for (t = mlPool->localVar.rbegin (); t != mlPool->localVar.rend (); t ++) {
 425         it = t->find (name);
 426         if (it != t->end ()) {
 427             return &*t;
 428         }
 429     }
 430     return NULL;
 431 }
 432
 433 #ifdef DEBUG
 434 void  MlEnv::logSetVar (const ustring& name, MNode* val, bool flocal) {
 435     if (! log || mlPool->nolog)
 436         return;
 437     *log << "   [";
 438     if (flocal)
 439         *log << "*";
 440     *log <<  name << " <= ";
 441     if (val)
 442         *log << val->dump_string_short ();
 443     else
 444         *log << uNil;
 445     *log << "]\n";
 446 }
 447
 448 void  MlEnv::logSetVarError (const ustring& name, MNode* val) {
 449     if (! log)
 450         return;
 451     *log << "   error: [";
 452     *log <<  name << " <= ";
 453     if (val)
 454         *log << val->dump_string_short ();
 455     *log << "]\n";
 456 }
 457
 458 void  MlEnv::logSetAryError (const ustring& name, size_t i, MNode* val) {
 459     if (! log)
 460         return;
 461     *log << "   error: [" <<  name << uUScore << i << " <= ";
 462     if (val)
 463         *log << val->dump_string_short ();
 464     *log << "]\n";
 465 }
 466
 467 void  MlEnv::logSetArySizeError (const ustring& name, size_t n) {
 468     if (! log)
 469         return;
 470     *log << "   [" <<  name << "_n" << " <= " << n << "]\n";
 471 }
 472 #endif
 473
 474 void  MlEnv::push_linenum (MNode* c, int ln) {
 475     mlPool->linenum.insert (std::pair<MNode*, int> (c, ln));
 476 }
 477
 478 void  MlEnv::logLinenum (MNode* c) {
 479     boost::unordered_map<MNode*, int>::iterator  i;
 480
 481     i = mlPool->linenum.find (c);
 482     if (i == mlPool->linenum.end ()) {
 483         *log << "<none>: ";
 484     } else {
 485         *log << i->second << ": ";
 486     }
 487 }
 488
 489 void  MlEnv::logSexp (MNode* c) {
 490     int  i;
 491
 492     if (!mlPool->nolog && log && c && c->isCons ()) {
 493         for (i = 0; i < mlPool->includeCount; i ++)
 494             *log << ":";
 495         logLinenum (c);
 496 //      *log << c->dump_string_short () << "\n";
 497         if (c->car () && c->car ()->isSym ()
 498             && (match (*c->car ()->sym, CharConst ("defun")) || matchHead (*c->car ()->sym, CharConst ("defun-")))
 499             && c->cdr () && c->cdr ()->isCons ()
 500             && c->cdr ()->cdr () && c->cdr ()->cdr ()->isCons ()) {
 501             *log << "(" << c->car ()->dump_string ();
 502             if (c->cdr ()->car ()) {
 503                 *log << " " << c->cdr ()->car ()->dump_string ();
 504             } else {
 505                 *log << " ()";
 506             }
 507             if (c->cdr ()->cdr ()->car ()) {
 508                 *log << " " << c->cdr ()->cdr ()->car ()->dump_string () << " ...\n";
 509             } else {
 510                 *log << " () ...\n";
 511             }
 512         } else {
 513             *log << c->dump_string_short () << "\n";
 514         }
 515     }
 516 }
 517
 518 void  MlEnv::setMStack (MLFunc* mobj) {
 519     MlFTable::MStackVal*  t = &mlFTable->mstack.back ();
 520
 521     assert (t->mobj == NULL);
 522     t->mobj = mobj;
 523 }
 524
 525 void  MlEnv::execDatastoreFunc () {
 526     int  i;
 527
 528     for (i = 0; i < datastoreFuncStack.size (); i ++) {
 529         datastoreFuncStack[i].second (datastoreFuncStack[i].first);
 530     }
 531 }
 532