-
Notifications
You must be signed in to change notification settings - Fork 6
/
scm2secd.secd
1 lines (1 loc) · 7.27 KB
/
scm2secd.secd
1
(DUM LDC () LDF ((lst) (LDC () LD lst EQ SEL (LDC ok JOIN) (LDC () LD lst CDR CONS LD lst CAR CONS LDF ((hd tl) (LDC () LD hd CDR CONS LD hd CAR CONS LDF ((sym val) (LDC () LD val LD sym LD secd-bind! AP 2 CONS LD tl LD set-secd-env AP 1 CONS CAR RTN)) AP RTN)) AP JOIN) RTN)) CONS LDF (() (LDC () READ CONS LDF ((inp) (LD inp LD eof-object? AP 1 SEL (STOP JOIN) (LDC () LDC (STOP) LD inp LD secd-compile AP 1 LD append AP 2 PRINT CONS LD repl AP 0 CONS CAR JOIN) RTN)) AP RTN)) CONS LDF ((s) (LD s TYPE LDC cons EQ SEL (LD s LD compile-form AP 1 JOIN) (LD s LD symbol? AP 1 SEL (LD s LDC LD LD list AP 2 JOIN) (LD s LDC LDC LD list AP 2 JOIN) JOIN) RTN)) CONS LDF ((f) (LDC () LD f CDR CONS LD f CAR CONS LDF ((hd tl) (LDC quote LD hd EQ SEL (LD tl CAR LDC LDC LD list AP 2 JOIN) (LDC quasiquote LD hd EQ SEL (LD tl CAR LD compile-quasiquote AP 1 LDC (LDC ()) LD append AP 2 JOIN) (LDC + LD hd EQ SEL (LDC (ADD) LD tl CAR LD secd-compile AP 1 LD tl CDR CAR LD secd-compile AP 1 LD append AP 3 JOIN) (LDC - LD hd EQ SEL (LDC (SUB) LD tl CAR LD secd-compile AP 1 LD tl CDR CAR LD secd-compile AP 1 LD append AP 3 JOIN) (LDC * LD hd EQ SEL (LDC (MUL) LD tl CAR LD secd-compile AP 1 LD tl CDR CAR LD secd-compile AP 1 LD append AP 3 JOIN) (LDC / LD hd EQ SEL (LDC (DIV) LD tl CAR LD secd-compile AP 1 LD tl CDR CAR LD secd-compile AP 1 LD append AP 3 JOIN) (LDC remainder LD hd EQ SEL (LDC (REM) LD tl CAR LD secd-compile AP 1 LD tl CDR CAR LD secd-compile AP 1 LD append AP 3 JOIN) (LDC <= LD hd EQ SEL (LDC (LEQ) LD tl CAR LD secd-compile AP 1 LD tl CDR CAR LD secd-compile AP 1 LD append AP 3 JOIN) (LDC eq? LD hd EQ SEL (LDC (EQ) LD tl CAR LD secd-compile AP 1 LD tl CDR CAR LD secd-compile AP 1 LD append AP 3 JOIN) (LDC cons LD hd EQ SEL (LDC (CONS) LD tl CAR LD secd-compile AP 1 LD tl CDR CAR LD secd-compile AP 1 LD append AP 3 JOIN) (LDC secd-type LD hd EQ SEL (LDC (TYPE) LD tl CAR LD secd-compile AP 1 LD append AP 2 JOIN) (LDC pair? LD hd EQ SEL (LDC (TYPE LDC cons EQ) LD tl CAR LD secd-compile AP 1 LD append AP 2 JOIN) (LDC car LD hd EQ SEL (LDC (CAR) LD tl CAR LD secd-compile AP 1 LD append AP 2 JOIN) (LDC cdr LD hd EQ SEL (LDC (CDR) LD tl CAR LD secd-compile AP 1 LD append AP 2 JOIN) (LDC cadr LD hd EQ SEL (LDC (CDR CAR) LD tl CAR LD secd-compile AP 1 LD append AP 2 JOIN) (LDC caddr LD hd EQ SEL (LDC (CDR CDR CAR) LD tl CAR LD secd-compile AP 1 LD append AP 2 JOIN) (LDC if LD hd EQ SEL (LDC () LDC (JOIN) LD tl CDR CDR CAR LD secd-compile AP 1 LD append AP 2 CONS LDC (JOIN) LD tl CDR CAR LD secd-compile AP 1 LD append AP 2 CONS LD tl CAR LD secd-compile AP 1 CONS LDF ((condc thenb elseb) (LD elseb LD list AP 1 LD thenb LD list AP 1 LDC (SEL) LD condc LD append AP 4 RTN)) AP JOIN) (LDC lambda LD hd EQ SEL (LDC () LDC (RTN) LD tl CDR CAR LD secd-compile AP 1 LD append AP 2 CONS LD tl CAR CONS LDF ((args body) (LD body LD args LD list AP 2 LDC LDF LD list AP 2 RTN)) AP JOIN) (LDC let LD hd EQ SEL (LDC () LD tl CDR CAR CONS LD tl CAR LD unzip AP 1 CONS LDF ((bindings body) (LDC () LD bindings CDR CAR CONS LD bindings CAR CONS LDF ((args exprs) (LDC (AP) LDC (RTN) LD body LD secd-compile AP 1 LD append AP 2 LD args LD list AP 2 LDC LDF LD list AP 2 LD exprs LD compile-bindings AP 1 LD append AP 3 RTN)) AP RTN)) AP JOIN) (LDC letrec LD hd EQ SEL (LDC () LD tl CDR CAR CONS LD tl CAR LD unzip AP 1 CONS LDF ((bindings body) (LDC () LD bindings CDR CAR CONS LD bindings CAR CONS LDF ((args exprs) (LDC (RAP) LDC (RTN) LD body LD secd-compile AP 1 LD append AP 2 LD args LD list AP 2 LDC LDF LD list AP 2 LD exprs LD compile-bindings AP 1 LDC (DUM) LD append AP 4 RTN)) AP RTN)) AP JOIN) (LDC begin LD hd EQ SEL (LDC (LDC ()) LD tl LD compile-begin-acc AP 2 JOIN) (LDC cond LD hd EQ SEL (LD tl LD compile-cond AP 1 JOIN) (LDC write LD hd EQ SEL (LDC (PRINT) LD tl CAR LD secd-compile AP 1 LD append AP 2 JOIN) (LDC read LD hd EQ SEL (LDC (READ) JOIN) (LDC eval LD hd EQ SEL (LDC (CONS LD secd-from-scheme AP AP) LD tl CAR LD secd-compile AP 1 LDC (LDC () LDC () LDC () CONS) LD append AP 3 JOIN) (LDC secd-apply LD hd EQ SEL (LDC (AP) LD tl CAR LD secd-compile AP 1 LD tl CDR CAR LD secd-compile AP 1 LD append AP 3 JOIN) (LDC quit LD hd EQ SEL (LDC (STOP) JOIN) (LDC () LD tl LD length AP 1 CONS LD hd LD symbol? AP 1 SEL (LD hd LDC LD LD list AP 2 JOIN) (LD hd LD secd-compile AP 1 JOIN) CONS LDF ((compiled-head nbinds) (LD nbinds LDC AP LD list AP 2 LD compiled-head LD tl LD compile-n-bindings AP 1 LD append AP 3 RTN)) AP JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) RTN)) AP RTN)) CONS LDF ((lst) (LD lst LD null? AP 1 SEL (LDC () JOIN) (LD lst TYPE LDC cons EQ SEL (LDC () LD lst CDR CONS LD lst CAR CONS LDF ((hd tl) (LD hd TYPE LDC cons EQ LD secd-not AP 1 SEL (LDC CONS LD hd LDC LDC LD list AP 3 LD tl LD compile-quasiquote AP 1 LD append AP 2 JOIN) (LDC unquote LD hd CAR EQ SEL (LDC (CONS) LD hd CDR CAR LD secd-compile AP 1 LD tl LD compile-quasiquote AP 1 LD append AP 3 JOIN) (LDC unquote-splicing LD hd CAR EQ SEL (LDC Error:_unquote-splicing_TODO LD display AP 1 JOIN) (LDC (CONS) LD hd LD compile-quasiquote AP 1 LD tl LD compile-quasiquote AP 1 LD append AP 3 JOIN) JOIN) JOIN) RTN)) AP JOIN) (LD lst LDC LDC LD list AP 2 JOIN) JOIN) RTN)) CONS LDF ((conds) (LD conds LD null? AP 1 SEL (LDC (LDC ()) JOIN) (LDC () LD conds CAR CDR CAR CONS LD conds CAR CAR CONS LDF ((this-cond this-expr) (LDC else LD this-cond EQ SEL (LD this-expr LD secd-compile AP 1 JOIN) (LDC (JOIN) LD conds CDR LD compile-cond AP 1 LD append AP 2 LD list AP 1 LDC (JOIN) LD this-expr LD secd-compile AP 1 LD append AP 2 LD list AP 1 LDC (SEL) LD this-cond LD secd-compile AP 1 LD append AP 4 JOIN) RTN)) AP JOIN) RTN)) CONS LDF ((stmts acc) (LD stmts LD null? AP 1 SEL (LDC (CAR) LD acc LD append AP 2 JOIN) (LDC (CONS) LD stmts CAR LD secd-compile AP 1 LD acc LD append AP 3 LD stmts CDR LD compile-begin-acc AP 2 JOIN) RTN)) CONS LDF ((xs) (DUM LDC () LDF ((xs acc) (LD xs LD null? AP 1 SEL (LD acc JOIN) (LD acc LDC 1 ADD LD xs CDR LD len AP 2 JOIN) RTN)) CONS LDF ((len) (LDC 0 LD xs LD len AP 2 RTN)) RAP RTN)) CONS LDF ((bs) (LD bs LD null? AP 1 SEL (LDC () JOIN) (LD bs CAR LD secd-compile AP 1 LD bs CDR LD compile-n-bindings AP 1 LD append AP 2 JOIN) RTN)) CONS LDF ((bs) (LD bs LD null? AP 1 SEL (LDC (LDC ()) JOIN) (LDC (CONS) LD bs CAR LD secd-compile AP 1 LD bs CDR LD compile-bindings AP 1 LD append AP 3 JOIN) RTN)) CONS LDF ((ps) (DUM LDC () LDF ((pairs z1 z2) (LD pairs LD null? AP 1 SEL (LD z2 LD z1 LD list AP 2 JOIN) (LDC () LD pairs CDR CONS LD pairs CAR CONS LDF ((pair rest) (LDC () LD pair CDR CAR CONS LD pair CAR CONS LDF ((p1 p2) (LD p2 LD list AP 1 LD z2 LD append AP 2 LD p1 LD list AP 1 LD z1 LD append AP 2 LD rest LD unzipt AP 3 RTN)) AP RTN)) AP JOIN) RTN)) CONS LDF ((unzipt) (LDC () LDC () LD ps LD unzipt AP 3 RTN)) RAP RTN)) CONS LDF ((b) (LD b SEL (LDC 2 LDC 1 EQ JOIN) (LDC 1 LDC 1 EQ JOIN) RTN)) CONS LDF ((secd-not unzip compile-bindings compile-n-bindings length compile-begin-acc compile-cond compile-quasiquote compile-form secd-compile repl set-secd-env) (LDC () LDC secd LD defined? AP 1 SEL (LDF ((obj) (LDC sym LD obj TYPE EQ RTN)) LDC symbol? CONS LDF ((obj) (LDC int LD obj TYPE EQ RTN)) LDC number? CONS LDF ((obj) (LDC () LD obj EQ RTN)) LDC null? CONS LD list AP 3 LD set-secd-env AP 1 JOIN) (LDC () JOIN) CONS LD repl AP 0 CONS CAR RTN)) RAP STOP)