User:Ledrug/bits

<lang c>#include <ucontext.h>

1. include <stdlib.h>
2. include <stdio.h>
3. include <stdarg.h>
4. include <string.h>

struct hist_t { ucontext_t caller, callee; void **in, *out; int first; struct hist_t *prev; } *hist;

void backtrack() { if (!hist) { puts("backtracking exhausted"); abort(); } setcontext(&hist->callee); }

ucontext_t* hpush() { struct hist_t *h = malloc(sizeof(*h)); h->in = 0; h->out = 0; h->prev = hist; hist = h; return &hist->caller; }

void hpop() { struct hist_t *s = hist; hist = hist->prev;

if (s->in) free(s->in); free(s->callee.uc_stack.ss_sp); free(s);

backtrack(); }

void yield(void *p) { hist->out = p; swapcontext(&hist->callee, &hist->caller); }

void hinit(void **in, void (*func)()) { if (!hist->in) { hist->in = in; getcontext(&hist->callee); hist->callee.uc_stack.ss_sp = malloc(4096); hist->callee.uc_stack.ss_size = 4096; hist->callee.uc_link = &hist->caller; makecontext(&hist->callee, func, 0); setcontext(&hist->callee); } }

1. define amb (getcontext(hpush())+_amb)

void *_amb(int n, ...) { void iter() { int i; for (i = 0; hist->in[i]; i++) yield(hist->in[i]); hpop(); }

int i; va_list ap; void **buf = calloc((1 + n), sizeof(buf[0]));

va_start(ap, n); for (i = 0; i < n; i++) buf[i] = va_arg(ap, void*); va_end(ap);

hinit(buf, iter); return hist->out; }

int main(void) { int join(char *a, char *b) { return a[strlen(a) - 1] == b[0]; }

char *a = amb(3, "the", "that", "a"), *b = amb(3, "frog", "elephant", "thing"), *c = amb(3, "walked", "treaded", "grows"), *d = amb(3, "slowly", "quickly", "deathly");

if (join(a, b) && join(b, c) && join(c, d)) printf("%s %s %s %s\n", a, b, c, d); else amb(0);

// should put a backtrack barrier here

int s[] = {1, 2, 3, 4};

int x = *(int*)amb(4, s, s+1, s+2, s+3); int y = *(int*)amb(3, s, s+1, s+2); int z = *(int*)amb(3, s, s+1, s+2);

//if (! (x > y && y < z && z < x && (x > 4))) // make "thing grows slowly" if (! (x > y && y < z && z < x && !(x & 1))) backtrack();

printf("%d %d %d\n", x, y, z);

return 0; }</lang>

<lang lisp>(defmacro or= (x y) `(setf ,x (logior ,x ,y))) (defmacro and= (x y) `(setf ,x (logand ,x ,y)))

(defconstant +N+ 1) (defconstant +S+ 2) (defconstant +W+ 4) (defconstant +E+ 8) (defconstant +V+ 16)

(defun show-maze (a)

 (let ((h (1- (array-dimension a 0)))

(w (1- (array-dimension a 1))) (g " │││─┘┐┤─└┌├─┴┬┼"))

   (write-line "")
   (loop for y from 0 to h do

(loop for x from 0 to w do (format t "~c" (char g (logand (aref a y x) (lognot +V+))))) (format t "~%"))))

(defun make-maze (w h)

 (let* (xs (size (* (1- w) (1- h)))

(w2 (* 2 w)) (h2 (* 2 h)) (walls (make-array (list (1+ h2) (1+ w2)) :element-type 'integer :initial-element 0)))

   (flet ((visit (y x) (or= (aref walls y x) +V+))

(rand-element (list r) (loop for x in list with c = 1 with sel do (if (zerop (random c)) (setf sel x)) (incf c r) finally (return sel))) (connect (c1 c2) (let ((y1 (car c1)) (y2 (car c2)) (x1 (cdr c1)) (x2 (cdr c2))) (if (= x1 x2) (progn (or= (aref walls (min y1 y2) x1) +S+) (or= (aref walls (1+ (min y1 y2)) x1) +S+) (or= (aref walls (1+ (min y1 y2)) x1) +N+) (or= (aref walls (max y1 y2) x1) +N+)) (progn (or= (aref walls y1 (min x1 x2)) +E+) (or= (aref walls y1 (1+ (min x1 x2))) +E+) (or= (aref walls y1 (1+ (min x1 x2))) +W+) (or= (aref walls y1 (max x1 x2)) +W+))))) (neighbor (cell) (loop with cnt = 0 with next-cell for (dy dx) in '((-2 0) (2 0) (0 2) (0 -2)) do (let ((y (+ (car cell) dy)) (x (+ (cdr cell) dx))) (if (and (array-in-bounds-p walls y x) (not (logtest (aref walls y x) +V+)) (zerop (random (incf cnt)))) (setf next-cell (cons y x)))) finally (return next-cell))))

     (setf xs (append

(loop for y from 0 to h collect (cons (* 2 y) 0) collect (cons (* 2 y) w2) do (let ((y2 (* 2 y))) (visit y2 0) (visit y2 w2) (when (< y2 h2) (connect (cons y2 0) (cons (+ 2 y2) 0)) (connect (cons y2 w2) (cons (+ 2 y2) w2))))) (loop for x from 0 to w collect (cons 0 (* 2 x)) collect (cons h2 (* 2 x)) do (let ((x2 (* 2 x))) (visit 0 x2) (visit h2 x2) (when (< x2 w2) (connect (cons 0 x2) (cons 0 (+ 2 x2))) (connect (cons h2 x2) (cons h2 (+ 2 x2))))))))

     (loop while xs do

 ;(let* ((c (elt xs (random (length xs)))) (c2 (neighbor c))) (let* ((c (rand-element xs 100)) (c2 (neighbor c)))  ;(let* ((c (first xs)) (c2 (neighbor c))) (cond ((not c2) (setf xs (remove c xs :test #'equal))) (t (connect c c2) (visit (car c2) (cdr c2)) (decf size) (push c2 xs) ))))

     (show-maze walls))))

(print (make-maze 42 25))</lang>