Dump of the Objects in the Primitive Package

gistfile1.txt

@create $nothing named Primitive Package:
@prop #34299."identifier" "primitive" r
@prop #34299."version" "0.0.1" r
@prop #34299."manifest" {} r
;;#34299.("manifest") = {{#34299, "package"}, {#34300, "dictionary"}, {#34303, "int_proto"}, {#34304, "float_proto"}, {#34306, "str_proto"}, {#34307, "err_proto"}, {#34308, "list_proto"}, {#34309, "map_proto"}, {#34310, "lambda_proto"}}
@prop #34299."relocate" {} r
;;#34299.("relocate") = {"dictionary.int_proto", "dictionary.float_proto", "dictionary.str_proto", "dictionary.err_proto", "dictionary.list_proto", "dictionary.map_proto", "dictionary.lambda_proto", "dictionary.frobs"}
@prop #34299."requires" {} r
;;#34299.("requires") = {{"kernel", ">= 1.0.4"}}
@prop #34299."instructions" {} r
@prop #34299."description" "The primitive package comprises prototype objects for LambdaMOO primitive data-types, utility operations on primitives, and objects for basic functional-style programming." r
@prop #34299."authors" {} r
;;#34299.("authors") = {"Todd Sundsted"}
@prop #34299."homepage" "http://207.210.101.162/packages/primitive" r
@prop #34299."license" "FreeBSD License" r

"***finished***

@create $nothing named Primitive Dictionary:
@prop #34300."int_proto" #34303 r
@prop #34300."float_proto" #34304 r
@prop #34300."str_proto" #34306 r
@prop #34300."err_proto" #34307 r
@prop #34300."list_proto" #34311 r
@prop #34300."map_proto" #34312 r
@prop #34300."frobs" {} r
;;#34300.("frobs") = {#34310}
@prop #34300."lambda_proto" #34310 r

@verb #34300:"lambda" this none this xd
@program #34300:lambda
if (`args[$][1] ! E_TYPE, E_RANGE' == ";")
  args[$] = tostr("return ", args[$][2..$], ";");
endif
return {$lambda_proto, @args};
.

"***finished***

@create $nothing named Base Primitive:

@verb #34301:"_suspend_if_necessary" this none this xd
@program #34301:_suspend_if_necessary
(ticks_left() < 10000 || seconds_left() < 2) && suspend(0);
.

@verb #34301:"type_of typeof" this none this xd
@program #34301:type_of
{?old_school = 0} = args;
return !old_school ? [0 -> $int_proto, 2 -> $str_proto, 3 -> $err_proto, 4 -> $list_proto, 10 -> $map_proto, 9 -> $float_proto][typeof(this)] | typeof(this);
.

@verb #34301:"to_json tojson" this none this xd
@program #34301:to_json
return generate_json(this, @args);
.

"***finished***

@create $nothing named Numeric Primitive:

@verb #34302:"abs" this none this xd
@program #34302:abs
return abs(this);
.

"***finished***

@create #34301 named Integer Prototype:

@verb #34303:"up_to upto" this none this xd #5
@program #34303:up_to
set_task_perms(caller_perms());

{limit, @args} = args;

if (limit < this)
  return this;
endif

lambda = args:_lambdafy();

while (limit >= this)
  this:_suspend_if_necessary();
  args && lambda:call(this);
  this = this + 1;
endwhile

return this - 1;
.

@verb #34303:"down_to downto" this none this xd #5
@program #34303:down_to
set_task_perms(caller_perms());

{limit, @args} = args;

if (limit > this)
  return this;
endif

lambda = args:_lambdafy();

while (limit <= this)
  this:_suspend_if_necessary();
  args && lambda:call(this);
  this = this - 1;
endwhile

return this + 1;
.

"***finished***

@create #34301 named Float Prototype:

"***finished***

@create $nothing named Sequence Primitive:

@verb #34305:"_lambdafy" this none this xd
@program #34305:_lambdafy
args && raise(E_ARGS);

if (`this[1][1] ! E_TYPE, E_RANGE' == $lambda_proto)
  return this[1];

elseif ((t = typeof(this)) == LIST)
  return length(this) == 1 && typeof(this[1]) == LIST ? $lambda(@this[1]) | $lambda(@this);

elseif (t == STR)
  return $lambda(this);

else
  raise(E_INVIND);

endif
.

@verb #34305:"each" this none this xd #5
@program #34305:each
set_task_perms(caller_perms());

lambda = args:_lambdafy();

if ((t = typeof(this)) == MAP)
  for k in (mapkeys(this))
    this:_suspend_if_necessary();
    lambda:call(this[k], k, this);
  endfor
elseif (t == LIST || t == STR)
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    lambda:call(this[i], i, this);
  endfor
else
  raise(E_INVIND);
endif

return this;
.

@verb #34305:"collect map" this none this xd #5
@program #34305:collect
set_task_perms(caller_perms());

lambda = args:_lambdafy();

if ((t = typeof(this)) == MAP)
  result = [];
  for k in (mapkeys(this))
    this:_suspend_if_necessary();
    result[k] = lambda:call(this[k], k, this);
  endfor
elseif (t == LIST)
  result = {};
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    result = {@result, lambda:call(this[i], i, this)};
  endfor
elseif (t == STR)
  result = "";
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    result = tostr(result, lambda:call(this[i], i, this));
  endfor
else
  raise(E_INVIND);
endif

return result;
.

@verb #34305:"inject reduce" this none this xd #5
@program #34305:inject
set_task_perms(caller_perms());

{initial, @args} = args;

lambda = args:_lambdafy();

if ((t = typeof(this)) == MAP)
  for k in (mapkeys(this))
    this:_suspend_if_necessary();
    initial = lambda:call(initial, this[k], k, this);
  endfor
elseif (t == LIST || t == STR)
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    initial = lambda:call(initial, this[i], i, this);
  endfor
else
  raise(E_INVIND);
endif

return initial;
.

@verb #34305:"detect find" this none this xd #5
@program #34305:detect
set_task_perms(caller_perms());

lambda = args:_lambdafy();

if ((t = typeof(this)) == MAP)
  for k in (mapkeys(this))
    this:_suspend_if_necessary();
    if (lambda:call(v = this[k], k, this))
      return [k -> v];
    endif
  endfor
elseif (t == LIST)
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    if (lambda:call(v = this[i], i, this))
      return v;
    endif
  endfor
elseif (t == STR)
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    if (lambda:call(v = this[i], i, this))
      return v;
    endif
  endfor
else
  raise(E_INVIND);
endif

return E_RANGE;
.

@verb #34305:"select find_all" this none this xd #5
@program #34305:select
set_task_perms(caller_perms());

lambda = args:_lambdafy();

if ((t = typeof(this)) == MAP)
  result = [];
  for k in (mapkeys(this))
    this:_suspend_if_necessary();
    if (lambda:call(v = this[k], k, this))
      result[k] = v;
    endif
  endfor
elseif (t == LIST)
  result = {};
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    if (lambda:call(v = this[i], i, this))
      result = {@result, v};
    endif
  endfor
elseif (t == STR)
  result = "";
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    if (lambda:call(v = this[i], i, this))
      result = tostr(result, v);
    endif
  endfor
else
  raise(E_INVIND);
endif

return result;
.

@verb #34305:"reject" this none this xd #5
@program #34305:reject
set_task_perms(caller_perms());

lambda = args:_lambdafy();

if ((t = typeof(this)) == MAP)
  result = [];
  for k in (mapkeys(this))
    this:_suspend_if_necessary();
    if (!lambda:call(v = this[k], k, this))
      result[k] = v;
    endif
  endfor
elseif (t == LIST)
  result = {};
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    if (!lambda:call(v = this[i], i, this))
      result = {@result, v};
    endif
  endfor
elseif (t == STR)
  result = "";
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    if (!lambda:call(v = this[i], i, this))
      result = tostr(result, v);
    endif
  endfor
else
  raise(E_INVIND);
endif

return result;
.

@verb #34305:"every" this none this xd #5
@program #34305:every
set_task_perms(caller_perms());

lambda = args:_lambdafy();

if ((t = typeof(this)) == MAP)
  for k in (mapkeys(this))
    this:_suspend_if_necessary();
    if (!lambda:call(this[k], k, this))
      return 0;
    endif
  endfor
elseif (t == LIST || t == STR)
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    if (!lambda:call(this[i], i, this))
      return 0;
    endif
  endfor
else
  raise(E_INVIND);
endif

return 1;
.

@verb #34305:"some" this none this xd #5
@program #34305:some
set_task_perms(caller_perms());

lambda = args:_lambdafy();

if ((t = typeof(this)) == MAP)
  for k in (mapkeys(this))
    this:_suspend_if_necessary();
    if (lambda:call(this[k], k, this))
      return 1;
    endif
  endfor
elseif (t == LIST || t == STR)
  for i in [1..length(this)]
    this:_suspend_if_necessary();
    if (lambda:call(this[i], i, this))
      return 1;
    endif
  endfor
else
  raise(E_INVIND);
endif

return 0;
.

@verb #34305:"length" this none this xd
@program #34305:length
return length(this);
.

"***finished***

@create #34301 named String Prototype:

@verb #34306:"to_lambda tolambda" this none this xd
@program #34306:to_lambda
return this:_lambdafy();
.

@verb #34306:"eval" this none this xd #5
@program #34306:eval
set_task_perms(caller_perms());

return this:_lambdafy():call(@args);
.

@verb #34306:"index rindex match rmatch" this none this xd
@program #34306:index
return call_function(verb, this, @args);
.

@verb #34306:"split explode" this none this xd
@program #34306:split
{?sep = " "} = args;
l = length(sep);
this = this + sep;
parts = {};
while (this)
  this:_suspend_if_necessary();
  if ((i = index(this, sep)) > 1)
    parts = {@parts, this[1..i - 1]};
  endif
  this = this[i + l..$];
endwhile
return parts;
.

@verb #34306:"trim triml trimr" this none this xd
@program #34306:trim
{?pattern = " "} = args;
if (verb == "trim" || verb == "triml")
  if (this && pattern && (r = match(this, tostr("^%(", pattern, "%)*"))))
    this = this[r[2] + 1..$];
  endif
endif
if (verb == "trim" || verb == "trimr")
  if (this && pattern && (r = match(this, tostr("%(", pattern, "%)*$"))))
    this = this[1..r[1] - 1];
  endif
endif
return this;
.

@verb #34306:"strsub" this none this xd
@program #34306:strsub
if (args && typeof(args[1]) == MAP)
  {subs, ?case = 0} = args;
  for key in (mapkeys(subs))
    this:_suspend_if_necessary();
    this = strsub(this, key, subs[key], case);
  endfor
elseif (args && typeof(args[1]) == LIST)
  {subs, ?case = 0} = args;
  for item in (subs)
    this:_suspend_if_necessary();
    this = strsub(this, item[1], item[2], case);
  endfor
elseif (args && typeof(args[1]) == STR)
  {from, to, ?case = 0} = args;
  this = strsub(this, from, to, case);
else
  raise(E_INVARG);
endif
return this;
.

@verb #34306:"strtr" this none this xd
@program #34306:strtr
{from, to, ?case = 0} = args;
(len = length(from)) == length(to) || raise(E_INVARG);
for i in [1..len]
  this:_suspend_if_necessary();
  this = strsub(this, from[i], to[i], case);
endfor
return this;
.

"***finished***

@create #34301 named Error Prototype:

"***finished***

@create #34301 named List Prototype:

@verb #34308:"to_lambda tolambda" this none this xd
@program #34308:to_lambda
return this:_lambdafy();
.

@verb #34308:"eval" this none this xd #5
@program #34308:eval
set_task_perms(caller_perms());

return this:_lambdafy():call(@args);
.

@verb #34308:"setadd" this none this xd
@program #34308:setadd
return setadd(this, @args);
.

@verb #34308:"setremove" this none this xd
@program #34308:setremove
return setremove(this, @args);
.

@verb #34308:"union" this none this xd
@program #34308:union
{list} = args;

for i in (list)
  this:_suspend_if_necessary();
  this = setadd(this, i);
endfor

return this;
.

@verb #34308:"intersection" this none this xd
@program #34308:intersection
{list} = args;

result = {};

for i in (list)
  this:_suspend_if_necessary();
  if (i in this)
    result = setadd(result, i);
  endif
endfor

return result;
.

@verb #34308:"difference" this none this xd
@program #34308:difference
{list} = args;

for i in (list)
  this:_suspend_if_necessary();
  this = setremove(this, i);
endfor

return this;
.

@verb #34308:"join" this none this xd
@program #34308:join
{?sep = " "} = args;

res = "";

for i in (this)
  this:_suspend_if_necessary();
  i = tostr(i);
  res = res + (res ? sep + i | i);
endfor

return res;
.

@verb #34308:"sort" this none this xd
@program #34308:sort
args && raise(E_ARGS);

l = length(this);
i = 1;
while (i <= l)
  v = this[i];
  j = i - 1;
  while (j > 0)
    this:_suspend_if_necessary();
    if (this[j] <= v)
      break;
    endif
    this[j + 1] = this[j];
    j = j - 1;
  endwhile
  this[j + 1] = v;
  i = i + 1;
endwhile

return this;
.

@verb #34308:"reverse" this none this xd
@program #34308:reverse
args && raise(E_ARGS);

l = length(this);
i = 1;
while (i <= l / 2)
  this:_suspend_if_necessary();
  t = this[i];
  this[i] = this[$ - i + 1];
  this[$ - i + 1] = t;
  i = i + 1;
endwhile

return this;
.

@verb #34308:"slice" this none this xd
@program #34308:slice
nth = args ? length(args) > 1 ? args | args[1] | 1;

res = {};

if (typeof(nth) == LIST)
  for i in (this)
    out = {};
    for n in (nth)
      this:_suspend_if_necessary();
      out = {@out, i[n]};
    endfor
    res = {@res, out};
  endfor
else
  for i in (this)
    this:_suspend_if_necessary();
    res = {@res, i[nth]};
  endfor
endif

return res;
.

"***finished***

@create #34301 named Map Prototype:

@verb #34309:"keys" this none this xd
@program #34309:keys
return mapkeys(this);
.

@verb #34309:"values" this none this xd
@program #34309:values
return mapvalues(this);
.

@verb #34309:"delete" this none this xd
@program #34309:delete
for arg in (args)
  this:_suspend_if_necessary();
  this = mapdelete(this, arg);
endfor

return this;
.

@verb #34309:"value_by_path" this none this xd
@program #34309:value_by_path
{p, ?d = E_RANGE} = args;

{f, @r} = p;

v = `r ? typeof(this[f]) == MAP ? this[f]:value_by_path(r) | E_RANGE | this[f] ! E_RANGE => d';

return v;
.

@verb #34309:"set_value_by_path" this none this xd
@program #34309:set_value_by_path
{p, v} = args;

{f, @r} = p;

this[f] = r ? `typeof(this[f]) == MAP ? this[f] | [] ! E_RANGE => []':set_value_by_path(r, v) | v;

return this;
.

@verb #34309:"merge" this none this xd
@program #34309:merge
{map} = args;
for key in (mapkeys(map))
  this:_suspend_if_necessary();
  this[key] = map[key];
endfor
return this;
.

"***finished***

@create $nothing named Lambda Prototype:

@verb #34310:"create" this none this xd
@program #34310:create
this == $lambda_proto || raise(E_VERBNF);
return $lambda(@args);
.

@verb #34310:"type_of typeof" this none this xd
@program #34310:type_of
return this;
.

@verb #34310:"to_lambda tolambda" this none this xd
@program #34310:to_lambda
return caller;
.

@verb #34310:"_params_and_body" this none this xd
@program #34310:_params_and_body
{args} = args;

if ((l = length(args)) > 1)
  return {args[2..l - 1], args[$]};
else
  return {{}, ""};
endif
.

@verb #34310:"_prepend_assignments" this none this xd
@program #34310:_prepend_assignments
{map, params, body} = args;

for key in (mapkeys(map))
  (ticks_left() < 10000 || seconds_left() < 2) && suspend(0);
  if (key in params)
    params = setremove(params, key);
  else
    raise(E_INVARG, tostr("Not a formal parameter:  ", key));
  endif
  body = tostr(key, " = ", toliteral(map[key]), "; ", body);
endfor

return {params, body};
.

@verb #34310:"partial" this none this xd
@program #34310:partial
{?map = []} = args;

{params, body} = this:_params_and_body(caller);

{params, body} = this:_prepend_assignments(map, params, body);

return $lambda(@params, body);
.

@verb #34310:"bind" this none this xd
@program #34310:bind
{object, ?map = []} = args;

{params, body} = this:_params_and_body(caller);

{params, body} = this:_prepend_assignments(map, params, body);

body = tostr("this = ", toliteral(object), "; ", body);

return $lambda(@params, body);
.

@verb #34310:"call" this none this xd #5
@program #34310:call
set_task_perms(caller_perms());

{params, body} = this:_params_and_body(caller);

if (length(args) < (l = length(params)))
  raise(E_ARGS, tostr("Too few arguments:  ", params:join(", "), " required"));
endif

for i in [1..l]
  (ticks_left() < 10000 || seconds_left() < 2) && suspend(0);
  body = tostr(params[i], " = ", toliteral(args[i]), "; ", body);
endfor

result = eval(body);

result[1] || raise("E_SYNTAX", "Syntax error", result[2]);

return result[2];
.

"***finished***

@create #34308 named List-Based Frob Prototype:

@verb #34311:"*" this none this xd #5
@program #34311:*
set_task_perms(caller_perms());

/* only lists */
typeof(this) == LIST || raise(E_INVIND, "Only type list");

/* don't respond to calls from built-ins */
{_, name, programmer, location, _} = callers()[1];
if (name && programmer == $nothing && location == $nothing)
  return;
endif

if (this && (prototype = this[1]) in $frobs)
  return prototype:(verb)(@args);
endif

return pass(@args);
.

"***finished***

@create #34309 named Map-Based Frob Prototype:

@verb #34312:"*" this none this xd #5
@program #34312:*
set_task_perms(caller_perms());

/* only maps */
typeof(this) == MAP || raise(E_INVIND, "Only type map");

/* don't respond to calls from built-ins */
{_, name, programmer, location, _} = callers()[1];
if (name && programmer == $nothing && location == $nothing)
  return;
endif

if (this && `prototype = this["prototype"] ! E_RANGE' in $frobs)
  return prototype:(verb)(@args);
endif

return pass(@args);
.

"***finished***