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;
}
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);
}
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;
}
}
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
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);
}
value sys_remove(value name)
{
int ret;
ret = unlink(String_val(name));
if (ret != 0) sys_error(String_val(name));
return Atom(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));
}
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;
}
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);
}
CAMLprim value caml_alloc_dummy(value size)
{
mlsize_t wosize = Int_val(size);
if (wosize == 0) return Atom(0);
return caml_alloc (wosize, 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);
}
}
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);
}
}
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 ***)©) ){
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);
}
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);
};
value sys_close(value fd)
{
if (close(VAL_TO_INT(fd)) != 0) {
sys_error(NULL);
}
return Atom(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;
}
/* 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);
}
}
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;
}
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;
}
value sys_catch_break(value onoff)
{
if (Tag_val(onoff))
mysignal(SIGINT, intr_handler);
else
mysignal(SIGINT, SIG_DFL);
return Atom(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);
}
}
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;
}
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);
}
/* 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);
}
}
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;
}
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();
}
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;
}
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);
}
}
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;
}
