View file src/spl/init.spl - Download
(
(def CADR : CDR CAR)
(def GETH0 : GETH 0)
(def GETH1 : GETH 1)
(def GETH2 : GETH 2)
(def GETPROP : ARG x : ARG y :
%x GETTYPE 'a GETTYPE EQ NOT THEN '() :
%y %x GETPROPS GETVENV)
(def PUTPROP : ARG symb : %symb GETPROPS SETVENV %symb SETPROPS)
(def SETPROP : ARG symb : %symb GETPROPS SETVENV %symb SETPROPS)
(def RESTART : 13 TYO 10 TYO "Restarting" PRINTSTRING 13 TYO 10 TYO)
(def LOAD : READFILE MAPEXEC)
(def MAPEXEC : ARG l :
%l NCONSPTHEN () :
%l CAR DUP PRINT EXEC :
%l CDR MAPEXEC)
(def MAPPRINT : ARG l :
%l NCONSPTHEN () :
%l CAR PRINT :
%l CDR MAPPRINT)
(def MAPC : C Q : ARG _f : ARG _x : ARG _l :
%_l NCONSPTHEN I :
%_l CAR %_x %_f EXEC :
%_l CDR %_x '() %_f CONS Q MAPC CONS EXEC)
(def MAPCAR :
C Q (DIVE DIVE DIVE
(GETH0 NCONSPTHEN GETH0
(GETH0 CAR GETH1 GETH2 EXEC
(GETH0 CDR GETH1 Q () GETH2 CONS Q MAPCAR CONS EXEC
(SWAP CONS)
)
)
)
CLIMBDROP CLIMBDROP CLIMBDROP))
(def CONTAINS : C QUOTE : ARG _f : ARG _x : ARG _l :
%_l NCONSPTHEN '() :
%_l CAR %_x %_f EXEC : DUP THEN I :
DROP %_l CDR %_x QUOTE () %_f CONS QUOTE CONTAINS CONS EXEC)
(def UNLIST : ARG l :
%l NCONSPTHEN I :
%l CAR %l CDR UNLIST)
(def ONEOF : ARG l :
%l NCONSPTHEN END :
ALT (%l CAR) :
%l CDR ONEOF)
(def AND : C THEN '())
(def OR : B (DUP THEN I) DROP)
(def EXIT KI)
(def synonym def)
(def MAJPRIO :
GETPRIO GETINCR PLUS SETPRIO)
(def INCRPRIO : ARG i :
GETSTRAT ARG (p . s) :
%p %i PLUS ARG p1 :
%(p1 . s) SETSTRAT)
(def SCHEDULE : ALT END I)
(def BUTLAST : ARG l :
%l NCONSPTHEN '() :
%l CDR NCONSPTHEN '() :
%l CDR BUTLAST %l CAR CONS)
(def defprop : C Q : C Q : C Q : SWAP3 SETPROP)
(def NL : 13 TYO 10 TYO)
(def THROW : SWAP PUSH SETCTX)
(def SETCTXS : ARG ctxs :
%ctxs NCONSPTHEN END :
GETLCTXS %ctxs CDR INSLCTXS SETLCTXS
%ctxs CAR SETCTX)
(def NL : 13 TYO 10 TYO)
(def PRINTL : PRINL NL)
(def PRINTCTX : ARG ctx :
"strat = " PRINTSTRING %ctx CAR 8 PRINTL
"prog = " PRINTSTRING %ctx CDR CAR 8 PRINTL
"stack = " PRINTSTRING %ctx CDR CDR CAR 8 PRINTL
"rstack = " PRINTSTRING %ctx CDR CDR CDR CAR 8 PRINTL
"envir = " PRINTSTRING %ctx CDR CDR CDR CDR CAR 8 PRINTL)
(def FILTRE : GETENV UNIF DUP THEN SETENV END)
(def LIST1 : QUOTE () SWAP CONS)
(def VAR GET)
(def IN : ARG x : ARG y :
%x %y EQUAL THEN 'true :
%y NCONSPTHEN '() :
%y CAR %x IN OR :
%y CDR %x IN)
(def synonym : C QUOTE : C QUOTE : ARG b : ARG a :
%b GETDEF %a SETDEF)
{
(synonym DROP DEP)
(synonym DUP REP)
(synonym SWAP ECH)
(synonym >R DES)
(synonym R> MON)
(synonym MINUS MOINS)
(synonym TIMES FOIS)
(synonym LOGAND ETL)
(synonym LOGOR OUL)
(synonym LOGXOR OXL)
(synonym REMINSTR ENLINSTR)
(synonym GETCTX-REMINSTR GETCTX-ENLINSTR)
(synonym FIRSTINSTR PREMINSTR)
}
(def SEND :
GETCTX-DROPINSTR : INSTR-SEND SETCTXS)
(def RECEIVE :
GETCTX-DROPINSTR : INSTR-RECEIVE SETCTXS)
)