C++ Atom函數代碼示例

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 ***)&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);
}

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);
}