prelude.na

# 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.