Finished My First Scheme Compiler

No optimizations. Simply translates code like that

(test-ssa
(scheme-into-symta
'((define a 2)
(define (f x) (x (_quote +) 1))
(f a))))


into C/C++ statements as follows

#include "../runtime.h"

static int f15308_pool;
static void f15308(regs_t *regs);
static int f15309_pool;
static int f15316_pool;
static void f15316(regs_t *regs);
static int f15317_pool;
static int f15318_pool;
static void f15318(regs_t *regs);
static int f15319_pool;
static int f15321_pool;
static void f15321(regs_t *regs);
static int f15322_pool;
static int f15329_pool;
static void f15329(regs_t *regs);
static int f15330_pool;
static int f15333_pool;
static void f15333(regs_t *regs);
static void f15330(regs_t *regs);
static int f15331_pool;
static void f15331(regs_t *regs);
static int f15332_pool;
static void f15332(regs_t *regs);
static void f15322(regs_t *regs);
static int f15323_pool;
static int f15325_pool;
static void f15325(regs_t *regs);
static int f15326_pool;
static int f15327_pool;
static void f15327(regs_t *regs);
static uint8_t s15328_bytes[] = {43,0};
static void *s15328;
static void f15326(regs_t *regs);
static void f15323(regs_t *regs);
static int f15324_pool;
static void f15324(regs_t *regs);
static void f15319(regs_t *regs);
static int f15320_pool;
static void f15320(regs_t *regs);
static void f15317(regs_t *regs);
static void f15309(regs_t *regs);
static uint8_t s15310_bytes[] = {116,97,103,95,111,102,0};
static void *s15310;
static uint8_t s15311_bytes[] = {95,102,110,95,105,102,0};
static void *s15311;
static uint8_t s15312_bytes[] = {108,105,115,116,0};
static void *s15312;
static uint8_t s15313_bytes[] = {97,114,114,97,121,0};
static void *s15313;
static uint8_t s15314_bytes[] = {99,99,0};
static void *s15314;
static uint8_t s15315_bytes[] = {114,101,97,100,95,102,105,108,101,95,97,115,95,116,101,120,116,0};
static void *s15315;
static void inits15335(regs_t *regs);
void entry(regs_t *regs) {
static int done_init = 0;
if (done_init) goto skip_init;
inits15335(regs);
done_init = 1;
skip_init:;
MOVE(C, run);
ARRAY(E, 1);
ALLOC(R, f15308, f15308_pool, 0);
STORE(E, 0, R);
CALL_TAGGED(C);
}

static void f15308(regs_t *regs) {
CHECK_NARGS(2, v_empty);
ALLOC(C, f15309, f15309_pool, 1);
STORE(C, 0, E);
ARRAY(E, 1);
ALLOC(R, f15316, f15316_pool, 0);
STORE(E, 0, R);
CALL(C);
}

static void f15316(regs_t *regs) {
CHECK_NARGS(7, v_empty);
ALLOC(C, f15317, f15317_pool, 1);
STORE(C, 0, E);
ARRAY(E, 1);
ALLOC(R, f15318, f15318_pool, 0);
STORE(E, 0, R);
CALL(C);
}

static void f15318(regs_t *regs) {
CHECK_NARGS(4, v_empty);
ALLOC(C, f15319, f15319_pool, 1);
STORE(C, 0, E);
ARRAY(A, 1);
ALLOC(R, f15321, f15321_pool, 1);
STORE(R, 0, E);
/* known closure */
STORE(A, 0, R);
MOVE(E, A);
CALL(C);
}

static void f15321(regs_t *regs) {
CHECK_NARGS(2, v_empty);
ALLOC(R, f15322, f15322_pool, 2);
COPY(R, 0, P, 0);
STORE(R, 1, E);
/* known closure */
MOVE(C, R);
ARRAY(A, 1);
ALLOC(R, f15329, f15329_pool, 1);
COPY(R, 0, P, 0);
/* known closure */
STORE(A, 0, R);
MOVE(E, A);
CALL(C);
}

static void f15329(regs_t *regs) {
CHECK_NARGS(2, v_empty);
ALLOC(R, f15330, f15330_pool, 2);
COPY(R, 0, P, 0);
STORE(R, 1, E);
/* known closure */
MOVE(C, R);
ARRAY(E, 1);
ALLOC(R, f15333, f15333_pool, 0);
STORE(E, 0, R);
CALL(C);
}

static void f15333(regs_t *regs) {
CHECK_NARGS(2, v_empty);
LOAD(C, E, 0);
ARRAY(A, 1);
COPY(A, 0, E, 1);
MOVE(E, A);
CALL_TAGGED(C);
}

static void f15330(regs_t *regs) {
CHECK_NARGS(1, v_empty);
LOAD(R, P, 0);
LOAD(C, R, 2);
ARRAY(A, 2);
ALLOC(R, f15331, f15331_pool, 3);
COPY(R, 0, P, 0);
STORE(R, 1, E);
COPY(R, 2, P, 1);
/* known closure */
STORE(A, 0, R);
LOAD(R, P, 0);
COPY(A, 1, R, 1);
MOVE(E, A);
CALL_TAGGED(C);
}

static void f15331(regs_t *regs) {
CHECK_NARGS(1, v_empty);
LOAD(A, E, 0);
LOAD(R, P, 0);
STORE(R, 3, A);
ALLOC(R, f15332, f15332_pool, 2);
COPY(R, 0, P, 1);
COPY(R, 1, P, 2);
/* known closure */
MOVE(C, R);
ARRAY(A, 1);
COPY(A, 0, E, 0);
MOVE(E, A);
CALL(C);
}

static void f15332(regs_t *regs) {
CHECK_NARGS(1, v_empty);
LOAD(R, P, 0);
LOAD(C, R, 0);
ARRAY(A, 2);
LOAD(R, P, 1);
COPY(A, 0, R, 0);
COPY(A, 1, E, 0);
MOVE(E, A);
CALL_TAGGED(C);
}

static void f15322(regs_t *regs) {
CHECK_NARGS(1, v_empty);
ALLOC(R, f15323, f15323_pool, 3);
COPY(R, 0, P, 0);
STORE(R, 1, E);
COPY(R, 2, P, 1);
/* known closure */
MOVE(C, R);
ARRAY(E, 1);
ALLOC(R, f15325, f15325_pool, 0);
STORE(E, 0, R);
CALL(C);
}

static void f15325(regs_t *regs) {
CHECK_NARGS(2, v_empty);
ALLOC(C, f15326, f15326_pool, 1);
STORE(C, 0, E);
ARRAY(A, 1);
ALLOC(R, f15327, f15327_pool, 1);
STORE(R, 0, E);
/* known closure */
STORE(A, 0, R);
MOVE(E, A);
CALL(C);
}

static void f15327(regs_t *regs) {
CHECK_NARGS(1, v_empty);
LOAD(R, P, 0);
LOAD(C, R, 1);
ARRAY(A, 3);
COPY(A, 0, E, 0);
STORE(A, 1, s15328);
FIXNUM(R, 1);
STORE(A, 2, R);
MOVE(E, A);
CALL_TAGGED(C);
}

static void f15326(regs_t *regs) {
CHECK_NARGS(1, v_empty);
LOAD(C, E, 0);
ARRAY(A, 1);
LOAD(R, P, 0);
COPY(A, 0, R, 0);
MOVE(E, A);
CALL_TAGGED(C);
}

static void f15323(regs_t *regs) {
CHECK_NARGS(1, v_empty);
LOAD(A, E, 0);
LOAD(R, P, 0);
STORE(R, 2, A);
ALLOC(R, f15324, f15324_pool, 2);
COPY(R, 0, P, 1);
COPY(R, 1, P, 2);
/* known closure */
MOVE(C, R);
ARRAY(A, 1);
COPY(A, 0, E, 0);
MOVE(E, A);
CALL(C);
}

static void f15324(regs_t *regs) {
CHECK_NARGS(1, v_empty);
LOAD(R, P, 0);
LOAD(C, R, 0);
ARRAY(A, 2);
LOAD(R, P, 1);
COPY(A, 0, R, 0);
COPY(A, 1, E, 0);
MOVE(E, A);
CALL_TAGGED(C);
}

static void f15319(regs_t *regs) {
CHECK_NARGS(1, v_empty);
FIXNUM(R, 2);
MOVE(A, R);
LOAD(R, P, 0);
STORE(R, 1, A);
ALLOC(R, f15320, f15320_pool, 2);
STORE(R, 0, E);
COPY(R, 1, P, 0);
/* known closure */
MOVE(C, R);
ARRAY(A, 1);
FIXNUM(R, 2);
STORE(A, 0, R);
MOVE(E, A);
CALL(C);
}

static void f15320(regs_t *regs) {
CHECK_NARGS(1, v_empty);
LOAD(R, P, 0);
LOAD(C, R, 0);
ARRAY(A, 2);
LOAD(R, P, 1);
COPY(A, 0, R, 0);
COPY(A, 1, E, 0);
MOVE(E, A);
CALL_TAGGED(C);
}

static void f15317(regs_t *regs) {
CHECK_NARGS(1, v_empty);
LOAD(C, E, 0);
ARRAY(A, 4);
LOAD(R, P, 0);
COPY(A, 0, R, 0);
STORE(A, 1, v_void);
STORE(A, 2, v_void);
STORE(A, 3, v_void);
MOVE(E, A);
CALL_TAGGED(C);
}

static void f15309(regs_t *regs) {
CHECK_NARGS(1, v_empty);
LOAD(R, P, 0);
LOAD(C, R, 1);
ARRAY(A, 8);
LOAD(R, P, 0);
COPY(A, 0, R, 0);
COPY(A, 1, E, 0);
STORE(A, 2, s15310);
STORE(A, 3, s15311);
STORE(A, 4, s15312);
STORE(A, 5, s15313);
STORE(A, 6, s15314);
STORE(A, 7, s15315);
MOVE(E, A);
CALL_TAGGED(C);
}

static void inits15335(regs_t *regs) {
TEXT(s15315, (char*)s15315_bytes);
TEXT(s15314, (char*)s15314_bytes);
TEXT(s15313, (char*)s15313_bytes);
TEXT(s15312, (char*)s15312_bytes);
TEXT(s15311, (char*)s15311_bytes);
TEXT(s15310, (char*)s15310_bytes);
f15320_pool = regs->new_pool();
f15324_pool = regs->new_pool();
TEXT(s15328, (char*)s15328_bytes);
f15327_pool = regs->new_pool();
f15326_pool = regs->new_pool();
f15325_pool = regs->new_pool();
f15323_pool = regs->new_pool();
f15332_pool = regs->new_pool();
f15331_pool = regs->new_pool();
f15333_pool = regs->new_pool();
f15330_pool = regs->new_pool();
f15329_pool = regs->new_pool();
f15322_pool = regs->new_pool();
f15321_pool = regs->new_pool();
f15319_pool = regs->new_pool();
f15318_pool = regs->new_pool();
f15317_pool = regs->new_pool();
f15316_pool = regs->new_pool();
f15309_pool = regs->new_pool();
f15308_pool = regs->new_pool();
}


post you're code

does it have GC? If not it's shit

>>2

It is part of symta codebase. Still havent implemented GC, because I plan to rewrite the runtime in Symta itself and a few hundred megs should be enough to compile the codebase.

>>3
post you're code

>>4


(defparameter *ssa-env* nil)
(defparameter *ssa-out* nil) ; where resulting assembly code is stored
(defparameter *ssa-ns* nil) ; unique name of current function
(defparameter *ssa-fns* nil)

(defparameter *ssa-closure* nil) ; other lambdas', this lambda references
(defparameter *ssa-inits* nil)

(defparameter *compiler-meta-info* (make-hash-table :test 'eq))

(to set-meta meta object
! (setf (gethash object *compiler-meta-info*) meta)
! object)

(to get-meta object ! gethash object *compiler-meta-info*)

(defun ssa-name (name) (symbol-name (gensym name)))

(to ssa name &rest args ! push `(,name ,@args) *ssa-out*)

(to ssa-get-parent-index parent
! p = position-if (fn e ! equal parent e) (car *ssa-closure*)
! when p (ret p) ; already added to the current closure
! setf (car *ssa-closure*) `(,@(car *ssa-closure*) ,parent)
! - (length (car *ssa-closure*)) 1)

(to ssa-path-to-sym x es
! unless es (ret nil)
! head = car es
! tail = cdr es
! when (eql (first head) :all) ; reference to the whole arglist?
(setf head (second head))
(unless (equal x (car head)) (ret (ssa-path-to-sym x tail)))
(when (eq es *ssa-env*) (ret (list :all nil))) ; it is an argument of the current function
(ret (list :all (ssa-get-parent-index (cdr head))))
! p = position-if (fn v ! equal x (car v)) head
! unless p (ret (ssa-path-to-sym x tail))
! when (eq es *ssa-env*) (ret (list p nil)) ; it is an argument of the current function
! list p (ssa-get-parent-index (cdr (nth p head))))

(to ssa-symbol x value
! match (ssa-path-to-sym x *ssa-env*)
((pos parent)
(! base = if parent 'r 'e
#|(if parent
(ssa 'store 'p parent value)
(ssa 'copy 'e value))
(ret nil)|#
! when parent (ssa 'load 'r 'p parent) ; symbol resides in parent environment
! when (eql pos :all)
(when value (error "can't set ~a" x))
(unless (eql base 'r) (ssa 'move 'r base))
(ret nil)
! if value
(ssa 'store base pos value)
(ssa 'load 'r base pos)))
(else (error "undefined variable: ~a" x)))

(to ssa-atom x
! cond
((integerp x) (ssa 'fixnum 'r x))
((stringp x) (ssa-symbol x nil))
((eql x 'run) (ssa 'move 'r "run"))
((eql x :void) (ssa 'move 'r "v_void"))
(t (error "unexpected ~a" x)))

(to ssa-quote-list-rec xs
! `("list" ,@(m x xs (if (listp x) (ssa-quote-list-rec x) `("_quote" ,x)))))

(to ssa-quote-list xs
! name = ssa-name "list"
! ssa 'move 'r name
! push `(,name ,(ssa-quote-list-rec xs)) *ssa-inits*)

(to ssa-quoted-symbol s
! name = ssa-name "s"
! ssa 'text name s
! ssa 'move 'r name)

(to ssa-quote x
! cond
((stringp x) (ssa-quoted-symbol x))
((integerp x) (ssa-atom x))
((listp x) (ssa-quote-list x))
(t (error "unsupported quoted value: ~a" x)))

(to ssa-resolved name ! cons name *ssa-ns*)

(to ssa-fn args body o
! f = ssa-name "f"
! cs = nil
! (! *ssa-out* = nil
! *ssa-ns* = f
! *ssa-env* = if (stringp args)
(cons `(:all ,(ssa-resolved args)) *ssa-env*)
(cons (mapcar #'ssa-resolved args) *ssa-env*)
! *ssa-closure* = cons nil *ssa-closure*
! ssa 'label *ssa-ns*
! if (stringp args)
(ssa 'check_varargs (get-meta o))
(ssa 'check_nargs (length args) (get-meta o))
! produce-ssa body
! push *ssa-out* *ssa-fns*
! setf cs (car *ssa-closure*)
)
! nparents = length cs
;; check if we really need new closure here, because in some cases we can reuse parent's closure
;; a single argument to a function could be passed in register, while a closure would be created if required
;; a single reference closure could be itself held in a register
;; for now we just capture required parent's closure
! ssa 'closure 'r f nparents
! i = -1
! e c cs (! if (equal c *ssa-ns*) ; self?
(ssa 'store 'r (incf i) 'e)
(ssa 'copy 'r (incf i) 'p (ssa-get-parent-index c)))
! ssa 'known_closure)

(to ssa-apply f as
;; FIXME: if it is a lambda call, we don't have to change env or create a closure, just push env
! produce-ssa f
! known-closure = eql (first (car *ssa-out*)) 'known_closure
! ssa 'move 'c 'r
! ssa 'array 'a (length as)
! i = -1
! e a as (! produce-ssa a
! ssa 'store 'a (incf i) 'r)
! ssa 'move 'e 'a ; replace current frame with new environment
! if known-closure (ssa 'call 'c) (ssa 'call_tagged 'c))

(to ssa-set k place value
! produce-ssa value
! ssa 'move 'a 'r
! ssa-symbol place 'a
! produce-ssa `(,k ,value))

(to ssa-form xs
! match xs
(("_fn" as body) (ssa-fn as body xs))
(("_quote" x) (ssa-quote x))
(("_set" k place value) (ssa-set k place value))
(("_goto" x) (ssa-goto x))
(("_show" x) (ssa-show x))
(("_move" dst src) (ssa 'move dst src))
((f . as) (ssa-apply f as))
(else (error "invalid CPS form: ~a" xs)))

(to produce-ssa x ! if (listp x) (ssa-form x) (ssa-atom x))

(to peephole-optimize xs
! match xs
(((''move a b) (''move b c) . zs) `((move ,a ,c) ,@(peephole-optimize zs)))
(((''move a b) (''load b c d) . zs) `((load ,a ,c ,d) ,@(peephole-optimize zs)))
(((''store a b c) (''move c d) . zs) `((store ,a ,b ,d) ,@(peephole-optimize zs)))
(((''store a b ''r) (''load ''r d e) . zs) `((copy ,a ,b ,d ,e) ,@(peephole-optimize zs)))
(((''move a b) (''store b c d) (''known_closure) (''closure d x y) (''array b e) . zs)
`((store ,a ,c ,d) (closure ,d ,x ,y) (array ,a ,e) ,@(peephole-optimize zs)))
(((''move a b) (''known_closure) (''store b c d) (''closure b e f) . zs)
`((store ,a ,c ,d) (closure ,a ,e ,f) ,@(peephole-optimize zs)))
((z . zs) (cons z (peephole-optimize zs)))
(nil nil))

(to cps-to-ssa x
! *ssa-out* = nil
! *ssa-fns* = nil
! produce-ssa x
! setf *ssa-inits*
(m x *ssa-inits*
(! name = first x
! expr = second x
! list name (ssa-compile-entry "run" "init_{name}" '("list") expr)))
! rs = apply #'concatenate 'list `(,@(reverse *ssa-fns*) ,*ssa-out*)
! rs = peephole-optimize rs
! nreverse rs)

(to cps-fn-nargs args body
! kk = ssa-name "k"
! `("_fn" (,kk ,@args) ,(produce-cps kk body)))

(to cps-fn-varargs args body
! kk = ssa-name "k"
! `("_fn" ,args (,args ("_fn" (,kk) ,(produce-cps kk body)) ("_quote" "get") 0)))

(to cps-fn k args body o
! `(,k ,(set-meta (get-meta o)
(if (stringp args)
(cps-fn-varargs args body)
(cps-fn-nargs args body)))))

(to cps-const? x ! or (not (listp x)) (equal (first x) "_quote"))

(to cps-apply k f as o
! fas = `(,f ,@as)
! (g . gs) = m a fas (if (cps-const? a) a (ssa-name "a"))
! r = `(,g ,k ,@gs)
! rgs = reverse `(,g ,@gs)
! ras = reverse fas
! while rgs
;; treat quoted and _fn values as constants
(unless (cps-const? (car ras))
(setf r (produce-cps (set-meta (get-meta o) `("_fn" (,(car rgs)) ,r)) (car ras))))
(pop rgs)
(pop ras)
! r)

(to cps-set k place value o
! unless (stringp place) (bad-sexp o "_set cant handle `{place}`")
! unless (listp value) (ret `("_set" ,k ,place ,value))
! v = ssa-name "value"
! r = produce-cps (set-meta (get-meta o) `("_fn" (,v) ("_set" ,k ,place ,v))) value
! r)

(to lambda-sequence xs prev
! next = ssa-name "a"
! if xs `(("_fn" (,next) ,(lambda-sequence (cdr xs) next)) ,(car xs)) prev)

(to cps-form k xs
! match xs
(("_fn" as body) (cps-fn k as body xs))
(("_if" cnd then else) (cps-form k `("_fn_if" ,cnd ("_fn" () ,then) ("_fn" () ,else))))
(("_let" xs . body)
(if (= (length body) 1)
(setf body (car body))
(setf body (lambda-sequence body :void)))
(cps-form k `(("_fn" ,(m x xs (first x)) ,body) ,@(m x xs (second x)))))
(("_quote" x) `(,k ,xs))
(("_set" place value) (cps-set k place value xs))
;;(("_goto" x) (cps-goto k x))
;;(("_show" x) (cps-show k x))
((f . as) (cps-apply k f as xs))
(else `(,k :void)))

(to cps-atom k x ! `(,k ,x))

(to produce-cps k x ! if (listp x) (cps-form k x) (cps-atom k x))

(defparameter *compiled* nil)

(to to-c-emit &rest args ! (push (apply #'format nil args) *compiled*))

(defparameter *pool-size* 64)

(defun ssa-to-c (entry xs)
(let ((*compiled* nil)
(statics nil)
(decls nil)
(inits nil)
(data-name (ssa-name "data"))
(inits-name (ssa-name "inits"))
(data nil)
)
(e x *ssa-inits* (to-c-emit "static void *~a;" (first x)))
(e x *ssa-inits* (to-c-emit "~a" (second x)))
(to-c-emit "static void ~a(regs_t *regs);" inits-name)
(to-c-emit "void ~a(regs_t *regs) {" entry)
(to-c-emit " static int done_init = 0;")
(to-c-emit " if (done_init) goto skip_init;")
(to-c-emit " ~a(regs);" inits-name)
(to-c-emit " done_init = 1;")
(to-c-emit " skip_init:;")
(e x xs
(match x
((''label label-name)
(push (format nil "static void ~a(regs_t *regs);" label-name) decls)
(to-c-emit "}~%")
(to-c-emit "static void ~a(regs_t *regs) {" label-name)
;;(to-c-emit " D;");
)
((''call name) (to-c-emit " CALL(~a);" name))
((''call_tagged name) (to-c-emit " CALL_TAGGED(~a);" name))
((''goto name) (to-c-emit " ~a(regs);" name))
((''array place size) (to-c-emit " ARRAY(~a, ~a);" place size))
((''closure place name size)
(progn
(push (format nil "static int ~a_pool;" name) decls)
(push (format nil "~a_pool = regs->new_pool();" name) inits)
(to-c-emit " ALLOC(~a, ~a, ~a_pool, ~a);" place name name size)))
((''load dst src off) (to-c-emit " LOAD(~a, ~a, ~a);" dst src off))
((''store dst off src) (to-c-emit " STORE(~a, ~a, ~a);" dst off src))
((''copy dst p src q) (to-c-emit " COPY(~a, ~a, ~a, ~a);" dst p src q))
((''move dst src) (to-c-emit " MOVE(~a, ~a);" dst src))
((''known_closure) (to-c-emit " /* known closure */"))
((''fixnum dst str) (to-c-emit " FIXNUM(~a, ~s);" dst str))
((''text name str)
(let ((bytes `(,@(m c (coerce str 'list) (char-code c)) 0)))
(push (format nil "static uint8_t ~a_bytes[] = {~{~a~^,~}};" name bytes) decls)
(push (format nil "static void *~a;" name) decls)
(push (format nil "TEXT(~a, (char*)~a_bytes);" name name) inits)))
((''list dst xs)
(let ((name (ssa-name "s")))
(to-c-emit " MOVE(~a, ~a);" dst name))
(abort))
((''check_nargs expected meta) (to-c-emit " CHECK_NARGS(~a, ~a);" expected (or meta "v_empty")))
((''check_varargs meta) (to-c-emit " CHECK_VARARGS(~a);" (or meta "v_empty")))
(else (error "invalid ssa: ~a" x))))
(to-c-emit "}~%")
(to-c-emit "static void ~a(regs_t *regs) {" inits-name)
(when (or *ssa-inits* inits)
(e i inits (to-c-emit " ~a" i))
(e x *ssa-inits*
(progn
(to-c-emit " init_~a(regs);" (first x))
(to-c-emit " LOAD(~a, E, 0);" (first x)))))
(to-c-emit "}~%")
(format nil "~{~a~%~}" (reverse (append *compiled* decls)))))

(to ssa-compile k entry fn-expr
! *ssa-inits* = nil
! cps = produce-cps k fn-expr
! ssa = cps-to-ssa cps
! ssa-to-c entry ssa)

(to ssa-compile-entry k entry builtins expr
! fn-expr = `("_fn" ("host") ("host" ("_fn" ,builtins ,expr) ,@(m b builtins `("_quote" ,b))))
! ssa-compile `("_move" r ,k) entry fn-expr)

(defparameter *ssa-builtins* '("tag_of" "_fn_if" "list" "array" "cc" "read_file_as_text"))

(to ssa-produce-file file src
! text = ssa-compile-entry "run" "entry" *ssa-builtins* src
! header = "#include \"../runtime.h\""
! save-text-file file (format nil "~a~%~%~a" header text))

(defparameter *native-files-folder* "/Users/nikita/Documents/prj/symta/libs/symta/native/")

(to shell command &rest args
! s = (make-string-output-stream)
! sb-ext:run-program command args :output s :search t :wait t
! get-output-stream-string s)

(to c-runtime-compiler dst src ! shell "gcc" "-g" #|"-O3" "-DNDEBUG"|# "-o" dst src)
(to c-compiler dst src ! shell "gcc" "-g" #|"-O3" "-DNDEBUG"|# "-fpic" "-shared" "-o" dst src)

(to compile-runtime main-file
! src-file = "{*native-files-folder*}../runtime.c"
! result = c-runtime-compiler main-file src-file
! when (string/= result "")
(e l (split #\Newline result) (format t "~a~%" l)))

(to convert-symbols o
! if (symbolp o)
(let ((n (symbol-name o)))
(if (lower-case-p (aref n 0))
n
(string-downcase n)))
(if (atom o) o (m x o (convert-symbols x))))

(to scheme-into-symta xs
! xs = convert-symbols xs
! xs = m x xs
(if (and (listp x) (equal (first x) "define"))
(if (listp (second x))
(list (car (second x)) `("_fn" ,(cdr (second x)) ("_let" () ,@(cddr x))))
(cdr x))
(list (ssa-name "d") x))
! `("_let" ,(m x xs `(,(first x) :void))
,@(m x xs `("_set" ,(first x) ,(second x)))))

(to test-ssa src
! main-file = "{*native-files-folder*}/runtime"
! compile-runtime main-file
! c-file = "{*native-files-folder*}test.c"
! exe-file = "{c-file}.bin"
! ssa-produce-file c-file src
! result = c-compiler exe-file c-file
! when (string/= result "")
(e l (split #\Newline result) (format t "~a~%" l))
! result = shell main-file exe-file
! e l (butlast (split #\Newline result)) (format t "~a~%" l)
)


I AM CODE

i can't fuggen get it into my text editor to read without losing indentation

nayway thanks for posting I had a rough look over it and it's pretty cool

>>2
GC is shit.

>>7
your editor probably does it's own indentation.

>>8
I highly doubt it could be understood with a quick look. But the main idea is to copy links to the used arglists, during the creation of closure. This trades memory for access speed.

>>10
I don't understand it at all. I also have questions:
1) Isn't symta a one man project? Are you behind it?
2) Is this common lisp? Do you code often in common lisp? Why common lisp?

>>11
Go back to /g/, you fucking noob ``coder''.

>>12
What's the problem? I never browsed /g/. Since you bring this up, I'll mention the boards I've browsed.
b, ck, fit, k, i, ic, prog, vip, lounge.

>>13
/g/ is a codeword for 4chan, you stupid nooblet. You didn't even use any forward slashes. Go back to where you belong.

>>14
/g/ is the technology imageboard on 4chan. How the fuck am I supposed to guess you're telling me to gb24chan? codeword my ass. I didn't use any forward slashes because I didn't have to, I don't have to adhere to whatever syntactical nuisance you make up! I asked him some questions. What's the problem?

>>15
You don't even know who is behind symta, you cant even reorganize the language being used, you use ``code'' instead of program, you question the use of common lisp.

Get out of here, noob.

>>16
I don't know who is behind symta because even though on average I spent 6 hours on /prog/ daily for years, I was too busy trolling to notice the autistic retards keyboard-spazing over some faggots name.

Even though CL is a nice language, I'd say that C++ is the real deal nowadays.

>>17
CONFIRMED IT, YOU'RE NEW HERE. GO BACK TO YOUR IMAGEBOARDS AND REDDITS YOU FUCKIN NOOB

>>18
Are you serious or am I trolling you without even trying? I've been on /prog/ longer than you, betting my money on that. Talkin about chip on the shoulder.

I'm not saying CL isn't a good language. If only we could have an efficient modern CL. But C++ is good enough.

>>19
>LEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELLELEEEEEEEEEEEEEEEEEEEEEEEEEEEL
>LE TROLL FACE ;D LELLEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELLLELELELELELE LE E/G/IN TROLLING /B/RO LELE LELELELLELEELE ELELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEL
>U R LE 4CHAN TROLL MASTER LELELELELLELELELELELLELELELELLELELE
>LE MASTER TROLL FACE >;) LEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELLE
>LE E/G/IN TROLL MAYMAYS LELELELELLEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELLELELLELELELLEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELE
>LE CPLUSPLUS FACE >:O LELELELELELELLELELELLELELELELLELELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEELELELELELELELLELELELLELELELELLELELEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEL

LEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEL

>>20
confirmed shitposter. All I can really say to >>1 is that I'm sorry I've fagged up his thread with my stupid questions, but I was always curious about Symta.

>>21
confirmed noob. All I can really say is you don't even recognize who that is either. Fuckin noob.

>>22
I code lots. Provide source code and I'll point out the bugs. Other than that, I'm not interested in your bullshyt.

>>23
``CODE''

>>11

Isn't symta a one man project? Are you behind it?

Yes. Symta is a common name for a series of Lisp spin-offs. I've used previous versions to recreate Warcaft 2 engine (http://www.youtube.com/watch?v=-k8jkeFfnl0), and while they were useful at designing software, I they had cryptic syntax, were slow, centered around Common Lisp and had little modularity support. So the latest version is going to be standalone and self-hosting, while fixing all other deficiencies.

Is this common lisp?

Yes. The >>5-snipped is good old Common Lisp.

Do you code often in common lisp?

I do coding in all kinds of languages. At my workplace I had C#, JavaScript, T-SQL and C/C++.

Why common lisp?

It was my first Lisp environment and CL has good compiler. But I would still recommend Scheme over CL, because Scheme is easier to learn and has better design (i.e. simpler core, no car or cdr on empty list).

>>25
Nobody asked you, you stupid ``coding'' russian.

>>26
>>11 asked him.

Anyway, >>11, I'm sorry you had to deal with that autist

>>25

I do coding

It's called ``apping'' these days, grandpa.

>>28
I'm an EXPERT APPER.

Ape.

Apps for the Apes.

Planet of the Apps.

We're waiting for the next killer Ape.

I got a new navigation Ape that helps me to the store and tells me what to buy.

The find my Iphone Ape tore my friend's face off because it thought she stole my phone.

Ape developers are working on genetically engineering the next talking and dancing monkey.

Web interfaces are being depreciated by the new user friendly Apes.

So you need to allocate memory dynamically (I guess with malloc) to run such simple program? Your compiler is shit.

>>32
no bully. and it can be improved. However I too and made sad when I see such large c outputs for scheme code. I had this reaction to a similar output from stalin.

>>25
That is jaw dropping! You wrote WC2 by yourself? What the fuck! That makes me want to look at your code but that's what I always say and I never do anything... Real life > what I want.

>>28
Not even the stupidest marketing snot at Apple calls it that way.

>>34

The source code is available at http://sym.at.ua/load/symcraft_v0_1/1-1-0-3

>>33

However I too and made sad when I see such large c outputs for scheme code. I had this reaction to a similar output from stalin.

Because that C/C++ output consists mostly of MOVs and JMPs, so it is as verbose as assembly. I've future plans to generate directly x86-64 assembly, which will use real registers, instead of regs_t struct. Compiled code uses just 6 registers (more if optimizations are done):

void *E; // current environment
void *P; // parent environment
void *A; // args scratchpad
void *C; // code pointer
void *R; // return value


>>26

From now on I'll use "coding" just to troll you.

>>37
Be one step ahead; use "apping".

>>32

Nope. It allocates from heap, with pools for each lambda type.

>>38

_{app my anus}

like me on facehub

lelelelele n00b xDDDDDDDDDDDDDDddd

fork me on gitbook

fork my dongles