bool scan_options(term_t options, int flags, atom_t optype, const opt_spec *specs, ...) { GET_LD va_list args; const opt_spec *s; optvalue values[MAXOPTIONS]; term_t list = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); term_t tmp = PL_new_term_ref(); term_t val = PL_new_term_ref(); int n; if ( truePrologFlag(PLFLAG_ISO) ) flags |= OPT_ALL; va_start(args, specs); for( n=0, s = specs; s->name; s++, n++ ) values[n].ptr = va_arg(args, void *); va_end(args); while ( PL_get_list(list, head, list) ) { atom_t name; int arity; if ( PL_get_name_arity(head, &name, &arity) ) { if ( name == ATOM_equals && arity == 2 ) { _PL_get_arg(1, head, tmp); if ( !PL_get_atom(tmp, &name) ) goto itemerror; _PL_get_arg(2, head, val); } else if ( arity == 1 ) { _PL_get_arg(1, head, val); } else if ( arity == 0 ) PL_put_atom(val, ATOM_true); } else if ( PL_is_variable(head) ) { return PL_error(NULL, 0, NULL, ERR_INSTANTIATION); } else { itemerror: return PL_error(NULL, 0, NULL, ERR_DOMAIN, optype, head); } for( n=0, s = specs; s->name; n++, s++ ) { if ( s->name == name ) { switch((s->type & OPT_TYPE_MASK)) { case OPT_BOOL: { int bval; if ( !PL_get_bool_ex(val, &bval) ) return FALSE; *values[n].b = bval; break; } case OPT_INT: { if ( !PL_get_integer_ex(val, values[n].i) ) return FALSE; break; } case OPT_LONG: { if ( (s->type & OPT_INF) && PL_is_inf(val) ) *values[n].l = LONG_MAX; else if ( !PL_get_long_ex(val, values[n].l) ) return FALSE; break; } case OPT_NATLONG: { if ( !PL_get_long_ex(val, values[n].l) ) return FALSE; if ( *(values[n].l) <= 0 ) return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_not_less_than_one, val); break; } case OPT_SIZE: { if ( (s->type & OPT_INF) && PL_is_inf(val) ) *values[n].sz = (size_t)-1; else if ( !PL_get_size_ex(val, values[n].sz) ) return FALSE; break; } case OPT_DOUBLE: { if ( !PL_get_float_ex(val, values[n].f) ) return FALSE; break; } case OPT_STRING: { char *str; if ( !PL_get_chars(val, &str, CVT_ALL|CVT_EXCEPTION) ) /* copy? */ return FALSE; *values[n].s = str; break; } case OPT_ATOM: { atom_t a; if ( !PL_get_atom_ex(val, &a) ) return FALSE; *values[n].a = a; break; } #ifdef O_LOCALE case OPT_LOCALE: { PL_locale *l; PL_locale **lp = values[n].ptr; if ( !getLocaleEx(val, &l) ) return FALSE; *lp = l; break; } #endif case OPT_TERM: { *values[n].t = val; val = PL_new_term_ref(); /* can't reuse anymore */ break; } default: assert(0); fail; } break; } } if ( !s->name && (flags & OPT_ALL) ) goto itemerror; } if ( !PL_get_nil(list) ) return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, list); succeed; }
static int get_optval(optvalue valp, const opt_spec *spec, term_t val ARG_LD) { switch((spec->type & OPT_TYPE_MASK)) { case OPT_BOOL: { int bval; if ( !PL_get_bool_ex(val, &bval) ) return FALSE; *valp.b = bval; return TRUE; } case OPT_INT: { if ( !PL_get_integer_ex(val, valp.i) ) return FALSE; return TRUE; } case OPT_LONG: { if ( (spec->type & OPT_INF) && PL_is_inf(val) ) *valp.l = LONG_MAX; else if ( !PL_get_long_ex(val, valp.l) ) return FALSE; return TRUE; } case OPT_NATLONG: { if ( !PL_get_long_ex(val, valp.l) ) return FALSE; if ( *(valp.l) <= 0 ) return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_not_less_than_one, val); return TRUE; } case OPT_SIZE: { if ( (spec->type & OPT_INF) && PL_is_inf(val) ) *valp.sz = (size_t)-1; else if ( !PL_get_size_ex(val, valp.sz) ) return FALSE; return TRUE; } case OPT_DOUBLE: { if ( !PL_get_float_ex(val, valp.f) ) return FALSE; return TRUE; } case OPT_STRING: { char *str; if ( !PL_get_chars(val, &str, CVT_ALL|CVT_EXCEPTION) ) /* copy? */ return FALSE; *valp.s = str; return TRUE; } case OPT_ATOM: { atom_t a; if ( !PL_get_atom_ex(val, &a) ) return FALSE; *valp.a = a; return TRUE; } #ifdef O_LOCALE case OPT_LOCALE: { PL_locale *l; PL_locale **lp = valp.ptr; if ( !getLocaleEx(val, &l) ) return FALSE; *lp = l; return TRUE; } #endif case OPT_TERM: { *valp.t = PL_copy_term_ref(val); /* can't reuse anymore */ return TRUE; } default: assert(0); } return FALSE; }