Skip to content

Instantly share code, notes, and snippets.

@toddsundsted

toddsundsted/gist:1398354

Created November 27, 2011 22:51
Download ZIP

Revisions

  1. toddsundsted created this gist Nov 27, 2011.
    822 changes: 822 additions & 0 deletions gistfile1.txt
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,822 @@
    @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***