Skip to content
This repository
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 306 lines (250 sloc) 7.034 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305
# 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.
Something went wrong with that request. Please try again.