Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
306 lines (250 sloc) 6.87 KB
# This is the standard prelude for LX.
inline C <<end
#include "bytes.h"
#include "prim.h"
#include "module.na.h"
end
def false '()
def cons: obj:
asm (run x y):
lw val argl 0
lw tmp argl 1
lw tmp tmp 0
cons val val tmp
jr continue
def become: obj:
inline C (run x y keep_y) <<end
datum x, y;
x = n_x;
y = n_y;
become(&x, &y, datum2int(n_keep_y));
return nil;
end
def is?: obj:
inline C (run x y) <<end
if (n_x == n_y) return int2datum(1);
return nil;
end
# Define a trampoline for loading modules.
def module: obj: inline C (run.) "return lxc_module_module.instrs;"
# Now load the real module module so we can load any module.
module = module.run.run
def pr: obj:
inline C (run x) <<end
pr(n_x);
return ok_sym;
end
def prx: obj:
inline C (run x) <<end
prx(n_x);
return ok_sym;
end
def π 3.14159
def true 1
def (not x) (? x false true)
def call: obj:
inline C (run d msg argl) <<end
return call(n_d, n_msg, n_argl);
end
def error: obj:
inline C run <<end
return report_error(args);
end
def inspect: obj:
(has-method? c m a):
def sig ("%s:%d" % m a).intern
def (scan x):
if (is? x '()): return false
if (is? sig x.car): return true
scan x.cdr
scan (inspect.methods c)
inline C (same-type? x y) <<end
if (datum_mtab(n_x) == datum_mtab(n_y)) return int2datum(1);
return nil;
end
inline C (method-count c) <<end
return ((method_table) datum_mtab(n_c))->size;
end
inline C (method-name c n) <<end
size_t n = datum2int(n_n);
method_table table;
table = (method_table) datum_mtab(n_c);
return table->items[n].name;
end
(methods c):
def (build n methods):
if n > (inspect.method-count c) - 1: return methods
return (build (n + 1) (cons (inspect.method-name c n) methods))
build 0 '()
# TODO replace this with
def (promise? x): inspect.has-method? x 'wait
def (ensure try finally):
def success [do (finally.) x]
def failure [do (finally.) (error x y)]
try:run.wait+ success failure
import array
import tuple
def (map f a):
if (is? a '()): return a
def x (f a.car) # evaluate x before the rest
cons x (map f a.cdr)
import pair list
import bytes
def (assq x a):
if (is? a '()): return a
if (is? x a.car.car): return a.car
assq x a.cdr
def (make-dict.):
def items '()
def dict: obj:
(set key value):
def pair (assq key items)
if pair:
pair.set-cdr! value
else:
items = (cons (cons key value) items)
(run key):
def pair (assq key items)
if pair: return pair.cdr
. '()
. dict
import (file-io as open)
def (make-queue.):
def front '()
def rear '()
def queue: obj:
(empty?.): is? front '()
(front.):
if (queue.empty?): error "front called on an empty queue"
front.car
(run item):
def new (cons item '())
if (queue.empty?):
front = new
rear = new
else:
rear.set-cdr! new
rear = new
. queue
(remove!.):
def item queue.front
queue.delete!
. item
(delete!.):
if (queue.empty?): error "delete! called on an empty queue"
front = front.cdr
. queue
(consume! f):
if (queue.empty?):
. 'ok
else:
f queue.remove!
queue.consume! f
. queue
def (make-promise.):
def status 'pending # or resolved or broken
def value '()
def err-name '()
def err-val '()
# a queue of functions to run upon success
# they must be safe to run directly -- they must do the right thing
def success-queue (make-queue.)
# a queue of functions to run upon success
# they must be safe to run directly -- they must do the right thing
def err-queue (make-queue.)
def (resolved?.) (is? status 'resolved)
def (pending?.) (is? status 'pending)
def (broken?.) (is? status 'broken)
def (queue-for-success f):
if (pending?.) (success-queue f)
if (resolved?.) (f value)
def (queue-for-err f):
if (pending?.) (err-queue f)
if (broken?.) (f err-name err-val)
def (process state err):
status = state
success-queue = '()
err-queue = '()
def promise: obj:
# This is the fully general wait function.
# f is a unary function to filter the value upon fulfillment
# h is a binary function to filter the error notice upon breakage
#
# There are four possiblities for the resolution of the new promise:
#
# 1. The original promise is fulfilled, the filter is successful, and
# this promise is fulfilled.
#
# 2. The original promise is fulfilled, the filter raises an error, and
# this promise is broken.
#
# 3. The original promise is broken, the error handler is successful,
# and this promise is fulfilled.
#
# 4. The original promise is broken, the error handler raises an error,
# and this promise is broken.
(wait+ f h):
def pp (make-promise.)
def p (pp.car)
def s (pp.cdr)
queue-for-success [schedule-task (make-task+ (fn () (f x)) s)]
queue-for-err [schedule-task (make-task+ (fn () (h x y)) s)]
. p
# if there is an error, just re-raise it
(wait f): promise.wait+ f [error x y]
# if the promise is fulfilled, just return the value
(wait-for-error h): promise.wait+ [do x] h
(send msg args): promise.wait [call x msg args]
def sink: obj:
(run val):
if (resolved?.): error "already resolved"
status = 'resolved
value = val
success-queue.consume! [x val]
process 'resolved
(break! name val):
if (broken?.): error "already broken"
status = 'broken
err-name = name
err-val = val
err-queue.consume! [x name val]
process 'broken
cons promise sink
def (make-broken-promise name val):
def pp (make-promise.)
(pp.cdr).break! name val
. pp
# expects a thunk, returns a (promise, task) pair
def (make-task f):
def p (make-promise.)
def promise p.car
def sink p.cdr
def task (make-task+ f sink)
cons promise task
# expects a thunk and a sink, returns a task
def (make-task+ f sink): obj:
(run.): sink (f.)
(break! x): sink.break! 'error x
def (schedule-task task):
*tasks* task
# expects a thunk, returns a promise
def (make-and-schedule-task f):
def task-pair (make-task f)
schedule-task task-pair.cdr
task-pair.car
def (send rcv msg args):
? (inspect.has-method? rcv 'send):
rcv.send msg args
make-and-schedule-task [call rcv msg args]
def *tasks* (make-queue.)
def (process-tasks.):
if (not *tasks*.empty?):
def task (*tasks*.remove!)
task.
# if there was an error
# task.break!
process-tasks.
# Load and execute the main program.
module.run-file *args*.car
# Process the work queue.
process-tasks.