void
simpleAttributeBinding()
{
string localData;
auto mutator =
TreeMutator::build()
.change("data", [&](string val)
{
cout << "\"data\" closure received something "<<val<<endl;
localData = val;
});
cout << "concrete TreeMutator size=" << sizeof(mutator)
<< " type="<< demangleCxx (showType (mutator))
<< endl;
CHECK (isnil (localData));
Attribute testAttribute(string ("that would be acceptable"));
mutator.setAttribute ("lore", testAttribute);
CHECK ( isnil (localData)); // nothing happens, nothing changed
mutator.setAttribute ("data", testAttribute);
CHECK (!isnil (localData));
cout << "localData changed to: "<<localData<<endl;
CHECK (localData == "that would be acceptable");
}
bool WEXPORT WComboBox::processCmd( WORD id, WORD code )
{
switch( code ) {
case CBN_SELCHANGE:
if( isnil( _changedClient ) || isnil( _changed ) ) break;
(_changedClient->*_changed)();
return TRUE;
case CBN_DBLCLK:
if( isnil( _dblClickClient ) || isnil( _dblClick ) ) break;
(_dblClickClient->*_dblClick)();
return TRUE;
}
return WControl::processCmd( id, code );
}
static action_t cont_apply_arg() {
ref_t first = car(C(cont)->val[1]), rest = cdr(C(cont)->val[1]);
C(cont)->val[2] = cons(expr, C(cont)->val[2]);
if (isnil(C(cont)->val[1])) {
ref_t args = C(cont)->val[2];
expr = NIL;
for(; !isnil(args); args = cdr(args))
expr = cons(car(args), expr);
C(cont)->fn = cont_apply_apply;
return ACTION_APPLY_CONT;
}
C(cont)->val[1] = rest;
return eval_expr(first);
}
/** @test OpaqueHolder with additional storage for subclass.
* When a subclass requires more storage than the base class or
* Interface, we need to create a custom OpaqueHolder, specifying the
* actually necessary storage. Such a custom OpaqueHolder behaves exactly
* like the standard variant, but there is protection against accidentally
* using a standard variant to hold an instance of the larger subclass.
*
* @test Moreover, if the concrete class has a custom operator bool(), it
* will be invoked automatically from OpaqueHolder's operator bool()
*
*/
void
checkSpecialSubclass ()
{
typedef OpaqueHolder<Base, sizeof(Special)> SpecialOpaque;
cout << showSizeof<Base>() << endl;
cout << showSizeof<Special>() << endl;
cout << showSizeof<Opaque>() << endl;
cout << showSizeof<SpecialOpaque>() << endl;
CHECK (sizeof(Special) > sizeof(Base));
CHECK (sizeof(SpecialOpaque) > sizeof(Opaque));
CHECK (sizeof(SpecialOpaque) <= sizeof(Special) + sizeof(void*) + _ALIGN_);
Special s1 (6);
Special s2 (3);
CHECK (!s1); // even value
CHECK (s2); // odd value
CHECK (7 == s1.getIt()); // indeed subclass of DD<7>
CHECK (7 == s2.getIt());
SpecialOpaque ospe0;
SpecialOpaque ospe1 (s1);
SpecialOpaque ospe2 (s2);
CHECK (!ospe0); // note: bool test (isValid)
CHECK (!ospe1); // also forwarded to contained object (myVal_==6 is even)
CHECK ( ospe2);
CHECK ( isnil(ospe0)); // while isnil just checks the empty state
CHECK (!isnil(ospe1));
CHECK (!isnil(ospe2));
CHECK (7 == ospe1->getIt());
CHECK (6 == ospe1.get<Special>().myVal_);
CHECK (3 == ospe2.get<Special>().myVal_);
ospe1 = DD<5>(); // but can be reassigned like any normal Opaque
CHECK (ospe1);
CHECK (5 == ospe1->getIt());
VERIFY_ERROR (WRONG_TYPE, ospe1.get<Special>() );
Opaque normal = DD<5>();
CHECK (normal);
CHECK (5 == normal->getIt());
#if false ////////////////////////////////////////////////////////TODO: restore throwing ASSERT
// Assertion protects against SEGV
VERIFY_ERROR (ASSERTION, normal = s1 );
#endif////////////////////////////////////////////////////////////
}
virtual void
run (Arg)
{
DataSeq src({a1,a2,a3,a4,a5});
DiffSeq diff = generateTestDiff();
CHECK (!isnil (diff));
DataSeq target = src;
DiffApplicator<DataSeq> application(target);
application.consume(diff);
CHECK (isnil (diff));
CHECK (!isnil (target));
CHECK (src != target);
CHECK (target == DataSeq({b1,a3,a5,b2,b3,a4,b4}));
}
static int ktap_lib_pairs(ktap_state *ks)
{
ktap_value *v = kp_arg(ks, 1);
ktap_table *t;
if (G(ks)->mainthread != ks) {
kp_error(ks, "only mainthread can call table pairs\n");
return -1;
}
if (ttistable(v)) {
t = hvalue(v);
} else if (ttisaggrtable(v)) {
t = kp_aggrtable_synthesis(ks, ahvalue(v));
} else if (isnil(v)) {
kp_error(ks, "table is nil in pairs\n");
return 0;
} else {
kp_error(ks, "wrong argument for pairs\n");
return 0;
}
setfvalue(ks->top++, ktap_lib_next);
sethvalue(ks->top++, t);
setnilvalue(ks->top++);
return 3;
}
string const&
MObject::shortID() const
{
if (isnil (shortID_))
shortID_ = initShortID();
return shortID_;
}
oop string_join(oop strlist, oop sepstr) {
size_t total_length = 0;
size_t sep_length;
int needsep = 0;
oop pos;
binary *result;
char *c;
if (!isbinary(sepstr)) die("string_join: sepstr is not a binary");
sep_length = oop_len(sepstr);
for (pos = strlist; ispair(pos); pos = ((pair *) pos)->cdr) {
oop s = ((pair *) pos)->car;
if (!isbinary(s)) die("string_join: element of strlist is not a binary");
if (needsep) total_length += sep_length;
total_length += oop_len(s);
needsep = 1;
}
if (!isnil(pos)) die("string_join: strlist is not a list");
result = raw_alloc(sizeof(binary) + total_length);
init_binary_header(result->header, TYPE_BINARY, total_length);
c = result->data;
needsep = 0;
for (pos = strlist; ispair(pos); pos = ((pair *) pos)->cdr) {
oop s = ((pair *) pos)->car;
if (needsep) {
memcpy(c, ((binary *) sepstr)->data, sep_length);
c += sep_length;
}
memcpy(c, ((binary *) s)->data, oop_len(s));
c += oop_len(s);
needsep = 1;
}
return result;
}
void eval() {
cont = continuation(cont_end, NIL);
C(cont)->expand = YES;
eval:
if (C(cont)->expand)
cont = continuation(cont_macroexpand, continuation(cont_eval, cont));
else if (iscons(expr))
cont = continuation(cont_list, cont);
else if (issymbol(expr))
cont = continuation(cont_symbol, cont);
apply_cont:
assert(iscontinuation(cont));
switch(C(cont)->fn()) {
case ACTION_EVAL:
goto eval;
case ACTION_APPLY_CONT:
goto apply_cont;
case ACTION_DONE:
break;
default:
abort();
}
/* By the time we get here, we should have finished the entire
computation, so should no longer have a continuation.*/
assert(isnil(cont));
}
static Tvalue *table_newkey(ktap_State *ks, Table *t, const Tvalue *key)
{
Node *mp;
mp = mainposition(t, key);
if (!isnil(gval(mp)) || isdummy(mp)) { /* main position is taken? */
Node *othern;
Node *n = getfreepos(t); /* get a free place */
if (n == NULL) { /* cannot find a free place? */
rehash(ks, t, key); /* grow table */
/* whatever called 'newkey' take care of TM cache and GC barrier */
return kp_table_set(ks, t, key); /* insert key into grown table */
}
othern = mainposition(t, gkey(mp));
if (othern != mp) { /* is colliding node out of its main position? */
/* yes; move colliding node into free position */
while (gnext(othern) != mp)
othern = gnext(othern); /* find previous */
gnext(othern) = n; /* redo the chain with `n' in place of `mp' */
*n = *mp; /* copy colliding node into free pos. (mp->next also goes) */
gnext(mp) = NULL; /* now `mp' is free */
setnilvalue(gval(mp));
} else { /* colliding node is in its own main position */
/* new node will go into free position */
gnext(n) = gnext(mp); /* chain new position */
gnext(mp) = n;
mp = n;
}
}
setobj(ks, gkey(mp), key);
return gval(mp);
}
MediaDesc&
MediaAccessFacade::queryFile (string const& name) const
{
if (isnil (name))
throw Invalid ("empty filename passed to MediaAccessFacade.");
UNIMPLEMENTED ("delegate to vault: query accessability of file");
}
virtual void
run (Arg)
{
Rec::Mutator target;
Rec& subject = target;
DiffApplicator<Rec::Mutator> application(target);
// Part I : apply diff to populate
application.consume(populationDiff());
CHECK (!isnil (subject)); // nonempty -- content has been added
CHECK ("X" == subject.getType()); // type was set to "X"
CHECK (1 == subject.get("α").data.get<int>()); // has gotten our int attribute "α"
CHECK (2L == subject.get("β").data.get<int64_t>()); // ... the long attribute "β"
CHECK (3.45 == subject.get("γ").data.get<double>()); // ... and double attribute "γ"
auto scope = subject.scope(); // look into the scope contents...
CHECK ( *scope == CHILD_A); // there is CHILD_A
CHECK (*++scope == CHILD_T); // followed by a copy of CHILD_T
CHECK (*++scope == CHILD_T); // and another copy of CHILD_T
CHECK (*++scope == MakeRec().appendChild(CHILD_B) // and there is a nested Record
.appendChild(CHILD_A) // with CHILD_B
.genNode(SUB_NODE.idi.getSym())); // and CHILD_A
CHECK (isnil(++scope)); // thats all -- no more children
// Part II : apply the second diff
application.consume(mutationDiff());
CHECK (join (subject.keys()) == "α, β, γ"); // the attributes weren't altered
scope = subject.scope(); // but the scope was reordered
CHECK ( *scope == CHILD_T); // CHILD_T
CHECK (*++scope == CHILD_A); // CHILD_A
Rec nested = (++scope)->data.get<Rec>(); // and our nested Record, which too has been altered:
CHECK (nested.get("γ").data.get<double>() == 3.45); // it carries now an attribute "δ", which is again
CHECK (nested.get("δ") == MakeRec().appendChild(CHILD_A) // a nested Record with three children CHILD_A
.appendChild(CHILD_A) //
.appendChild(CHILD_A) //
.genNode("δ")); //
auto subScope = nested.scope(); // and within the nested sub-scope we find
CHECK ( *subScope == CHILD_A); // CHILD_A
CHECK (*++subScope == MakeRec().type("Y") // a yet-again nested sub-Record of type "Y"
.set("β", int64_t(2)) // with just an attribute "β" == 2L
.genNode(CHILD_NODE.idi.getSym())); // (and an empty child scope)
CHECK (*++subScope == CHILD_T); // followed by another copy of CHILD_T
CHECK (isnil (++subScope)); //
CHECK (isnil (++scope)); // and nothing beyond that.
}
static inline ref_t continuation(cont_t fn, ref_t saved_cont) {
ref_t obj = gc_alloc(sizeof(struct continuation), CONTINUATION_POINTER_TAG);
C(obj)->fn = fn;
C(obj)->expand = NO;
C(obj)->saved_cont = saved_cont;
C(obj)->closure = isnil(saved_cont) ? NIL : C(saved_cont)->closure;
init_vals(obj);
return obj;
}
static action_t cont_do() {
ref_t body = C(cont)->val[0];
if (isnil(body)) {
pop_cont();
return ACTION_APPLY_CONT;
}
C(cont)->val[0] = cdr(body);
return eval_expr(car(body));
}
int in_reg2_list(CTXTdeclc Psc psc) {
Cell list,term;
list = reg[2];
XSB_Deref(list);
if (isnil(list)) return TRUE; /* if filter is empty, return all */
while (!isnil(list)) {
term = get_list_head(list);
XSB_Deref(term);
if (isconstr(term)) {
if (psc == get_str_psc(term)) return TRUE;
} else if (isstring(term)) {
if (get_name(psc) == string_val(term)) return TRUE;
}
list = get_list_tail(list);
}
return FALSE;
}
static Node *getfreepos(Table *t)
{
while (t->lastfree > t->node) {
t->lastfree--;
if (isnil(gkey(t->lastfree)))
return t->lastfree;
}
return NULL; /* could not find a free place */
}
ref_t lookup(ref_t symbol) {
assert(issymbol(symbol));
ref_t binding, closure = C(cont)->closure;
while (!isnil(closure)) {
binding = car(closure);
if (car(binding) == symbol)
return cdr(binding);
closure = cdr(closure);
}
return get_value(symbol);
}
/** @test performs the actual test for the option parser test::TestOption */
void doIt (const string cmdline)
{
cout << "Testing invocation with cmdline: " << cmdline << "..." << endl;
Cmdline args(cmdline);
TestOption optparser (args);
const string testID = optparser.getTestID();
cout << "--> Testgroup=" << optparser.getTestgroup() << endl;
cout << "--> Test-ID =" << (isnil(testID)? "--missing--" : testID ) << endl;
cout << "--> remaining=" << args << endl;
}
sexp_t *prim_append(sexp_t *args)
{
sexp_t *lst, *ret;
if (list_len(args) == 0)
return nil;
if (isnil(car(args)))
return prim_append(cdr(args));
if (isnil(cdr(args)))
return copy_list(car(args));
if (!iscons(car(args)) || list_len(car(args)) < 0) {
fprintf(stderr, "error: proper list expected\n");
return NULL;
}
for (ret = lst = copy_list(car(args)); cdr(lst) != nil; lst = cdr(lst))
;
gc_push(&ret);
lst->data = make_cons(car(lst), prim_append(cdr(args)));
gc_pop();
return ret;
}
inline Pipe*
StructFactoryImpl::fabricate (Query<Pipe> const& caps)
{
const Asset::Ident idi (createIdent (caps));
string streamID = caps.extractID ("stream");
if (isnil (streamID)) streamID = "default";
PProcPatt processingPattern = Session::current->defaults (Query<const ProcPatt>("stream("+streamID+")"));
return new Pipe( idi
, streamID
, processingPattern
); ///////////////////////TICKET #565 maybe store the capabilities query within the Struct asset somehow?
}
void kp_table_dump(ktap_State *ks, Table *t)
{
int i, count = 0;
kp_printf(ks, "{");
for (i = 0; i < t->sizearray; i++) {
Tvalue *v = &t->array[i];
if (isnil(v))
continue;
if (count)
kp_printf(ks, ", ");
kp_printf(ks, "(%d: ", i + 1);
kp_showobj(ks, v);
kp_printf(ks, ")");
count++;
}
for (i = 0; i < sizenode(t); i++) {
Node *n = &t->node[i];
if (isnil(gkey(n)))
continue;
if (count)
kp_printf(ks, ", ");
kp_printf(ks, "(");
kp_showobj(ks, gkey(n));
kp_printf(ks, ": ");
kp_showobj(ks, gval(n));
kp_printf(ks, ")");
count++;
}
kp_printf(ks, "}");
}
int kp_table_length(ktap_State *ks, Table *t)
{
int i, len = 0;
for (i = 0; i < t->sizearray; i++) {
Tvalue *v = &t->array[i];
if (isnil(v))
continue;
len++;
}
for (i = 0; i < sizenode(t); i++) {
Node *n = &t->node[i];
if (isnil(gkey(n)))
continue;
len++;
}
return len;
}
inline Timeline*
StructFactoryImpl::fabricate (Query<Timeline> const& caps)
{
TODO ("extract additional properties/capabilities from the query...");
const Asset::Ident idi (createIdent (caps));
string sequenceID = caps.extractID ("sequence");
Query<Sequence> desiredSequence (isnil (sequenceID)? "" : "id("+sequenceID+")");
PSequence sequence = recursive_create_(desiredSequence);
ASSERT (sequence);
RBinding newBinding = Session::current->getRoot().attach (MObject::create (sequence));
ASSERT (newBinding);
PTimeline newTimeline = Timeline::create (idi, newBinding);
ENSURE (newTimeline); ///////////////////////TICKET #565 maybe store the capabilities query within the Struct asset somehow?
return newTimeline.get();
}
/* get the size of the list input from prolog side */
static int getsize (prolog_term list)
{
int size = 0;
prolog_term head;
while (!isnil(list)) {
head = p2p_car(list);
if(!(isinteger(head)))
xsb_abort("A non-integer socket descriptor encountered in a socket operation");
list = p2p_cdr(list);
size++;
}
return size;
}
inline Sequence*
StructFactoryImpl::fabricate (Query<Sequence> const& caps)
{
// when we reach this point it is clear a suitable sequence doesn't yet exist in the model
TODO ("actually extract properties/capabilities from the query...");
string forkID = caps.extractID ("fork");
Query<Fork> desiredFork (isnil (forkID)? "" : "id("+forkID+")");
// PFork fork = Session::current->query (desiredFork); ///////////////////////////////////TICKET #639
// TODO: handle the following cases
// - fork doesn't exist --> create and attach it as root
// - fork exists and is root attached, but belongs already to a sequence --> throw
// - fork exists, but isn't root attached ---> what do do here? steal it??
PSequence newSequence = Sequence::create (createIdent (caps)); ///////////TODO fed fork in here
ENSURE (newSequence); ///////////////////////TICKET #565 maybe store the capabilities query within the Struct asset somehow?
return newSequence.get();
}
static void __attribute__((noreturn)) apply_implementation(closure *self,
int argc,
oop k,
oop f,
...)
{
pair *prev = NULL;
pair *arglist = mknull();
pair *p;
int i;
va_list vl;
oop a;
if (argc < 3) {
wrong_variable_argc(argc, 3);
}
va_start(vl, f);
for (i = (argc - 3) - 1; i >= 0; i--) {
p = alloca(sizeof(pair));
a = va_arg(vl, oop);
*p = (pair) mkpair(a, mknull());
if (prev == NULL) {
arglist = p;
} else {
prev->cdr = p;
}
prev = p;
}
a = va_arg(vl, oop);
if (!(ispair(a) || isnil(a))) {
wrong_type(argc);
}
if (prev == NULL) {
arglist = a;
} else {
prev->cdr = a;
}
va_end(vl);
p = alloca(sizeof(pair));
*p = (pair) mkpair(k, arglist);
arglist = p;
checkedcallfun(f, -1, arglist);
}
static int numusehash(const Table *t, int *nums, int *pnasize)
{
int totaluse = 0; /* total number of elements */
int ause = 0; /* summation of `nums' */
int i = sizenode(t);
while (i--) {
Node *n = &t->node[i];
if (!isnil(gval(n))) {
ause += countint(gkey(n), nums);
totaluse++;
}
}
*pnasize += ause;
return totaluse;
}
static action_t cont_apply_apply() {
ref_t func = C(cont)->val[0], args = expr;
ref_t formals = getformals(func);
size_t arity = getarity(func);
C(cont)->closure = getclosure(func);
for(; arity > 0; arity--, formals = cdr(formals), args = cdr(args))
bind(car(formals), car(args));
if (!isnil(formals))
bind(car(formals), args);
init_vals(cont);
if (isbuiltin(func)) {
getfn(func)();
pop_cont();
}
else
eval_do(getbody(func));
return ACTION_APPLY_CONT;
}
static int ktap_lib_count(ktap_State *ks)
{
Table *tbl = hvalue(GetArg(ks, 1));
Tvalue *k = GetArg(ks, 2);
int n;
Tvalue *v;
if (GetArgN(ks) > 2)
n = nvalue(GetArg(ks, 3));
else
n = 1;
v = kp_table_set(ks, tbl, k);
if (unlikely(isnil(v))) {
setnvalue(v, 1);
} else
setnvalue(v, nvalue(v) + n);
return 0;
}
static action_t cont_fn() {
ref_t formals = car(expr), body = cdr(expr);
size_t arity = 0;
bool rest = NO;
if (!islist(formals))
error("invalid function: formals must be a list");
for(; !isnil(formals); arity++, formals = cdr(formals)) {
ref_t sym = car(formals);
if (sym == sym_amp) {
if (length(cdr(formals)) != 1)
error("invalid function: must have exactly one symbol after &");
rest = YES;
set_car(formals, cadr(formals));
set_cdr(formals, NIL);
break;
}
}
formals = car(expr);
pop_cont();
expr = lambda(formals, body, C(cont)->closure, arity, rest);
return ACTION_APPLY_CONT;
}