Esempio n. 1
0
thing_th *Primordial_Err(thing_th *messages, int shallReg) {
    err_th *this_error=calloc(1, sizeof(err_th));
    this_error->kind=error_k;
    this_error->CAR=Atom("err");
    this_error->CDR=messages;
    return shallReg ? reg_thing((thing_th *)this_error) : (thing_th *)this_error;
}
Esempio n. 2
0
thing_th *funky_def(thing_th *args) {
    switch(th_kind(Car(args))) {
        case atom_k:
            return env_set(sym(Car(args)),
                           define_procedure(Cdr(args)));
        case cons_k:
            return define_procedure(args);
        default:
            return Err(Cons(Atom(ERRMSG_TYPES),
                            Cons(Atom(ERRMSG_BADDEF), NULL)));
    }
    if(th_kind(Car(args))==atom_k)
        return env_set(sym(Car(args)), 
                       define_procedure(Cdr(args)));
    return define_procedure(args);
}
Esempio n. 3
0
static thing_th *dup_cell(thing_th *thing) {
    switch(th_kind(thing)) {
        case number_k:
            return Number(sym(thing));
        case string_k:
            return String(sym(thing));
        case atom_k:
            return Atom(sym(thing));
        case cons_k:
            return Cons(Car(thing), Cdr(thing));
        case error_k:
            return Err(Cdr(thing));
        case procedure_k:
            return Proc(Car(thing), Cdr(thing));
        case macro_k:
            return Mac(Car(thing), Cdr(thing));
        case gen_k:
            return Gen(Car(thing), Cdr(thing));
        case routine_k:
            return Routine(call_rt(thing));
        case method_k:
            return Method(call_rt(thing));
        case grid_k:
            return duplicate_grid(thing);
        case null_k:
            return NULL;
    }
}
Esempio n. 4
0
void CheckConnectorUsageMain( CgContext *cg, Symbol *program, Stmt *fStmt)
{
  Symbol *outConn, *lSymb;
  Type *cType;
  int len, cid;
  Binding *lBind;
  
  outConn = cg->theHal->varyingOut;
  if (!outConn || !outConn->type)
    return;
  cType = outConn->type;
  cid = static_cast< TypeStruct * >( cType )->variety;
  len = cg->theHal->GetConnectorRegister(cid, 1, Atom(), NULL);
  ApplyToTopExpressions( cg, CheckConnectorUsage, fStmt, NULL, 0);
  lSymb = static_cast< TypeStruct * >( cg->theHal->varyingOut->type )->members->symbols;
  // This doesn't work!  The output value is always written by the return statement!  RSG
  while (lSymb) {
    lBind = lSymb->details.var.bind;
    if (lBind) {
      if ((lBind->properties & BIND_WRITE_REQUIRED) &&
          !(lBind->properties & BIND_WAS_WRITTEN))
      {
        SemanticWarning( cg, &program->loc, WARNING_S_CMEMBER_NOT_WRITTEN,
                        cg->GetString( lBind->name ));
      }
    }
    lSymb = lSymb->next;
  }
} // CheckConnectorUsageMain
Esempio n. 5
0
File: alloc.c Progetto: OpenXT/ocaml
CAMLprim value caml_alloc_dummy_float (value size)
{
  mlsize_t wosize = Int_val(size) * Double_wosize;

  if (wosize == 0) return Atom(0);
  return caml_alloc (wosize, 0);
}
Esempio n. 6
0
value sys_remove(value name)
{
  int ret;
  ret = unlink(String_val(name));
  if (ret != 0) sys_error(String_val(name));
  return Atom(0);
}
Esempio n. 7
0
HEADER_DECLARE
Term* Spec(atom_t atom, int size){
    FRAME_ENTER;
    FRAME_LOCAL(tatom) = Atom(atom);
    FRAME_LOCAL(tsize) = Integer(size);
    FRAME_RETURN(Term*, Functor2(atom_slash, tatom, tsize));
}
Esempio n. 8
0
static value alloc_host_entry(struct hostent *entry)
{
  value res;
  value name = Val_unit, aliases = Val_unit;
  value addr_list = Val_unit, adr = Val_unit;

  Begin_roots4 (name, aliases, addr_list, adr);
    name = copy_string((char *)(entry->h_name));
    /* PR#4043: protect against buggy implementations of gethostbyname()
       that return a NULL pointer in h_aliases */
    if (entry->h_aliases)
      aliases = copy_string_array((const char**)entry->h_aliases);
    else
      aliases = Atom(0);
    entry_h_length = entry->h_length;
#ifdef h_addr
    addr_list = alloc_array(alloc_one_addr, (const char**)entry->h_addr_list);
#else
    adr = alloc_one_addr(entry->h_addr);
    addr_list = alloc_small(1, 0);
    Field(addr_list, 0) = adr;
#endif
    res = alloc_small(4, 0);
    Field(res, 0) = name;
    Field(res, 1) = aliases;
    switch (entry->h_addrtype) {
    case PF_UNIX:          Field(res, 2) = Val_int(0); break;
    case PF_INET:          Field(res, 2) = Val_int(1); break;
    default: /*PF_INET6 */ Field(res, 2) = Val_int(2); break;
    }
    Field(res, 3) = addr_list;
  End_roots();
  return res;
}
Esempio n. 9
0
File: str.c Progetto: Athas/mosml
value blit_string(value s1, value offset1, value s2, value offset2, value len) /* ML */
{
  bcopy(&Byte(s1, Long_val(offset1)),
        &Byte(s2, Long_val(offset2)),
        Int_val(len));
  return Atom(0);
}
Esempio n. 10
0
File: alloc.c Progetto: OpenXT/ocaml
CAMLprim value caml_alloc_dummy(value size)
{
  mlsize_t wosize = Int_val(size);

  if (wosize == 0) return Atom(0);
  return caml_alloc (wosize, 0);
}
Esempio n. 11
0
void Parser::atom() {
    if (tokens[look].type == REGEX_) {
        atoms.push_back(Atom(REG, 0, 0, tokens[look].value, Column()));
        match(REGEX_);
    } else {
        match(LESSTHAN);
        if (tokens[look].type == TOKEN) {
            match(TOKEN);
        } else {
            column();
            cols[col[1]] = col[0];
            atoms.push_back(Atom(COLUMN, 0, 0, col[1], Column()));
        }
        match(GREATETHAN);
    }
}
Esempio n. 12
0
static inline value copy_string_option_array(const char** strs, int len)
{
  if (!len) return Atom(0);
  else {
    CAMLparam0();
    CAMLlocal2(v_str, v_res);
    int i;

    v_res = caml_alloc(len, 0);

    for (i = 0; i < len; ++i) {
      const char *str = strs[i];
      if (str == NULL) Field(v_res, i) = Val_None;
      else {
        value v_opt;
        v_str = caml_copy_string(str);
        v_opt = caml_alloc_small(1, 0);
        Field(v_opt, 0) = v_str;
        Store_field(v_res, i, v_opt);
      }
    }

    CAMLreturn(v_res);
  }
}
Esempio n. 13
0
File: ml_gtk.c Progetto: CRogers/obc
CAMLprim value ml_gtk_init (value argv)
{
    CAMLparam1 (argv);
    int argc = Wosize_val(argv), i;
    CAMLlocal1 (copy);

    copy = (argc ? alloc (argc, Abstract_tag) : Atom(0));
    for (i = 0; i < argc; i++) Field(copy,i) = Field(argv,i);
    if( !gtk_init_check (&argc, (char ***)&copy) ){
      ml_raise_gtk ("ml_gtk_init: initialization failed");
    }

    argv = (argc ? alloc (argc, 0) : Atom(0));
    for (i = 0; i < argc; i++) modify(&Field(argv,i), Field(copy,i));
    CAMLreturn (argv);
}
Esempio n. 14
0
Molecule H3()
{
    int nAtoms = 3;

    Eigen::Vector3d H1( 0.735000, 0.000000, -1.333333);
    Eigen::Vector3d H2(-0.735000, 0.000000, -1.333333);
    Eigen::Vector3d H3( 0.000000, 0.000000,  2.666667);

    Eigen::MatrixXd geom(3, nAtoms);
    geom.col(0) = H1.transpose();
    geom.col(1) = H2.transpose();
    geom.col(2) = H3.transpose();
    Eigen::Vector3d charges, masses;
    charges << 1.0, 1.0, 1.0;
    masses  << 1.0078250, 1.0078250, 1.0078250;

    std::vector<Atom> atoms;
    double radiusH = (1.20 * 1.20) / convertBohrToAngstrom;
    atoms.push_back( Atom("Hydrogen", "H", charges(0), masses(0), radiusH, H1, 1.0) );
    atoms.push_back( Atom("Hydrogen", "H", charges(1), masses(1), radiusH, H2, 1.0) );
    atoms.push_back( Atom("Hydrogen", "H", charges(2), masses(2), radiusH, H3, 1.0) );

    std::vector<Sphere> spheres;
    Sphere sph2(H1, radiusH);
    Sphere sph3(H2, radiusH);
    Sphere sph4(H3, radiusH);
    spheres.push_back(sph2);
    spheres.push_back(sph3);
    spheres.push_back(sph4);

    enum pointGroup { pgC1, pgC2, pgCs, pgCi, pgD2, pgC2v, pgC2h, pgD2h };
    Symmetry pGroup;
    switch(group) {
    case(pgC1):
        pGroup = buildGroup(0, 0, 0, 0);
        break;
    case(pgC2v):
        // C2v as generated by Oyz and Oxz
        pGroup = buildGroup(2, 1, 2, 0);
        break;
    default:
        pGroup = buildGroup(0, 0, 0, 0);
        break;
    }

    return Molecule(nAtoms, charges, masses, geom, atoms, spheres, pGroup);
};
Esempio n. 15
0
value sys_close(value fd)
{
	if (close(VAL_TO_INT(fd)) != 0) {
		sys_error(NULL);
	}

	return Atom(0);
}
Esempio n. 16
0
static thing_th *breakout_character(int inputChar) {
    char *label;
    thing_th *atom;
    asprintf(&label, "%c", inputChar);
    atom=Atom(label);
    erase_string(label);
    return atom;
}
Esempio n. 17
0
/* ML type : dbconn_ -> dbresultstatus */
EXTERNML value db_resultstatus(value conn) {
  MYSQL *mysql = DBconn_val(conn);
  switch (mysql_errno(mysql)) {
  case ER_EMPTY_QUERY:  
    return Atom(Empty_query);
  case 0:                       /* No error */
    {
      /* If mysql_num_fields==0, query was a command */
      if (mysql_num_fields(mysql) == 0)
        return Atom(Command_ok);
      else
        return Atom(Tuples_ok);
    }
  default: 
    return Atom(Nonfatal_error);
  }
}
Esempio n. 18
0
 Residue make_residue(const string &name, const Mat &coords) {
     Residue residue;
     residue.name = name;
     for (int i = 0; i < coords.rows(); i++) {
         residue.push_back(Atom(_atom_names[name][i], coords(i, 0), coords(i, 1), coords(i, 2)));
     }
     return residue;
 }
Esempio n. 19
0
static thing_th *rejigger_with_left_as_cons(thing_th *left,
                                            thing_th *right,
                                            thing_th *bacro) {
    thing_th *arg1=Cons(Car(left), Cdr(left));
    set_car(left, Atom(sym(bacro)));
    set_cdr(left, Cons(arg1, Cons(right, NULL)));
    return left;
}
Esempio n. 20
0
value sys_catch_break(value onoff)
{
  if (Tag_val(onoff))
    mysignal(SIGINT, intr_handler);
  else
    mysignal(SIGINT, SIG_DFL);
  return Atom(0);
}
Esempio n. 21
0
/** @see molecule.h */
Molecule::Molecule(int numAtoms, int *Z, double *r3, double *Q) {
    for (int i = 0; i < numAtoms; ++i) {
	double q = (Q) ? Q[i] : double(Z[i]);
	Center center = {{ r3[0+i*3], r3[1+i*3], r3[2+i*3] }};
	_atoms.push_back(Atom(Z[i], q));
	_centers.push_back(center);
    }
}
Esempio n. 22
0
CAMLprim value unix_environment(value unit)
{
  if (environ != NULL) {
    return copy_string_array((const char**)environ);
  } else {
    return Atom(0);
  }
}
int AbstractXApplication::exec() {
    /* Show window */
    XMapWindow(_display, _window);

    while(!(_flags & Flag::Exit)) {
        XEvent event;

        /* Closed window */
        if(XCheckTypedWindowEvent(_display, _window, ClientMessage, &event) &&
                Atom(event.xclient.data.l[0]) == _deleteWindow) {
            return 0;
        }

        while(XCheckWindowEvent(_display, _window, INPUT_MASK, &event)) {
            switch(event.type) {
            /* Window resizing */
            case ConfigureNotify: {
                Vector2i size(event.xconfigure.width, event.xconfigure.height);
                if(size != _viewportSize) {
                    _viewportSize = size;
                    viewportEvent(size);
                    _flags |= Flag::Redraw;
                }
            }
            break;

            /* Key/mouse events */
            case KeyPress:
            case KeyRelease: {
                KeyEvent e(static_cast<KeyEvent::Key>(XLookupKeysym(&event.xkey, 0)), static_cast<InputEvent::Modifier>(event.xkey.state), {event.xkey.x, event.xkey.y});
                event.type == KeyPress ? keyPressEvent(e) : keyReleaseEvent(e);
            }
            break;
            case ButtonPress:
            case ButtonRelease: {
                MouseEvent e(static_cast<MouseEvent::Button>(event.xbutton.button), static_cast<InputEvent::Modifier>(event.xkey.state), {event.xbutton.x, event.xbutton.y});
                event.type == ButtonPress ? mousePressEvent(e) : mouseReleaseEvent(e);
            }
            break;

            /* Mouse move events */
            case MotionNotify: {
                MouseMoveEvent e(static_cast<InputEvent::Modifier>(event.xmotion.state), {event.xmotion.x, event.xmotion.y});
                mouseMoveEvent(e);
            }
            break;
            }
        }

        if(_flags & Flag::Redraw) {
            _flags &= ~Flag::Redraw;
            drawEvent();
        } else Utility::sleep(5);
    }

    return 0;
}
Esempio n. 24
0
File: Atom.cpp Progetto: SEDS/GAME
Atom Atom::create_impl (T parent, const GAME::Xml::String & kind)
{
  // Generate the relative id for the new folder.
  size_t counter = parent.relid_counter ();
  parent.relid_counter (counter + 1);

  // Generate a unique id for the new folder.
  return Atom (parent.ptr (), kind, counter);
}
Esempio n. 25
0
/* ML type : dbconn_ -> dbresultstatus */
EXTERNML value db_resultstatus(value conn) {
  MYSQL *mysql = DBconn_val(conn);
  switch (mysql_errno(mysql)) {
  case ER_EMPTY_QUERY:  
    return Atom(Empty_query);
  case 0:                       /* No error */
    {
      /* If mysql_field_count==0, query was a command */
      /* 2002-07-25: In MySQL 3.23 and later, must use mysql_field_count */
      if (mysql_field_count(mysql) == 0)
        return Atom(Command_ok);
      else
        return Atom(Tuples_ok);
    }
  default: 
    return Atom(Nonfatal_error);
  }
}
Esempio n. 26
0
static thing_th *grid_keys(grid_th *grid) {
    char **keys=grid_keys_list(grid->data);
    char **kw=keys;
    thing_th *allKeys;
    if(!keys)
        return NULL;
    if(!*keys) {
        wipe_keys_list(keys);
        return NULL;
    }
    allKeys=Cons(Atom(*kw++), NULL);
    while(kw && *kw) {
        append(allKeys, Cons(Atom(*kw), NULL));
        kw++;
    }
    wipe_keys_list(keys);
    return allKeys;
}
Esempio n. 27
0
Atom get_atom(Residue rd, AtomType at) {
  Hierarchy mhd(rd.get_particle());
  for (unsigned int i=0; i< mhd.get_number_of_children(); ++i) {
    Atom a(mhd.get_child(i));
    if (a.get_atom_type() == at) return a;
  }
  IMP_LOG(VERBOSE, "Atom not found " << at << std::endl);
  return Atom();
}
Esempio n. 28
0
static thing_th *rejigger_with_left_as_atom(thing_th *left,
                                            thing_th *right,
                                            thing_th *bacro) {
    thing_th *bcall=Cons(Atom(sym(bacro)),
                         Cons(Car(left),
                              Cons(right, NULL)));
    set_car(left, bcall);
    return left;
}
Esempio n. 29
0
void
PatchPortModule::store_location()
{
	const float x = static_cast<float>(property_x());
	const float y = static_cast<float>(property_y());

	const LV2URIMap& uris = App::instance().uris();

	const Atom& existing_x = _model->get_property(uris.ingenui_canvas_x);
	const Atom& existing_y = _model->get_property(uris.ingenui_canvas_y);

	if (existing_x.type() != Atom::FLOAT || existing_y.type() != Atom::FLOAT
			|| existing_x.get_float() != x || existing_y.get_float() != y) {
		Resource::Properties props;
		props.insert(make_pair(uris.ingenui_canvas_x, Atom(x)));
		props.insert(make_pair(uris.ingenui_canvas_y, Atom(y)));
		App::instance().engine()->put(_model->path(), props, Resource::INTERNAL);
	}
}
Esempio n. 30
0
static int establish_bacros(thing_th *bacroGrid) {
    if(!bacroGrid) return 1;
    Set(bacroGrid, "~>", Atom("rapply"));
    Set(bacroGrid, "<~", Atom("safely-apply"));
    Set(bacroGrid, "->", Atom("rcall"));
    Set(bacroGrid, "<-", Atom("call"));
    Set(bacroGrid, "<S", Atom("strict-apply"));
    Set(bacroGrid, "S>", Atom("strict-rapply"));
    Set(bacroGrid, ":", Atom("pair"));
    Set(bacroGrid, ".", Atom("get"));
    return 0;
}