# SPDX-License-Identifier: BSD-2-Clause
# concise but quite slow: about 73ms at each startup (n=1000)
#(setq mapcar (lambda (a b) (mapcar a b))) \
BEGIN {
_eval(read_str("\
(progn \
(setq quote (lambda (a) (quote a))) \
(setq atom (lambda (a) (atom a))) \
(setq eq (lambda (a b) (eq a b))) \
(setq car (lambda (a) (car a))) \
(setq cdr (lambda (a) (cdr a))) \
(setq cons (lambda (a b) (cons a b))) \
(setq list (lambda a a)) \
(setq not (lambda (a) (not a))) \
(setq null (lambda (a) (null a))) \
(setq equal (lambda (a b) (equal a b))) \
(setq caar (lambda (a) (caar a))) \
(setq cadr (lambda (a) (cadr a))) \
(setq memq (lambda (a b) (memq a b))) \
(setq member (lambda (a b) (member a b))) \
(setq assoc (lambda (a b) (assoc a b))) \
\"lol\" \
(setq setq nil) \
(setq caaar (lambda (a) (caaar a))) \
(setq caadr (lambda (a) (caadr a))) \
(setq cadar (lambda (a) (cadar a))) \
(setq caddr (lambda (a) (caddr a))) \
(setq cdaar (lambda (a) (cdaar a))) \
(setq cdadr (lambda (a) (cdadr a))) \
(setq cddar (lambda (a) (cddar a))) \
(setq cdddr (lambda (a) (cdddr a))) \
(setq rplaca (lambda (a b) (rplaca a b))) \
(setq rplacd (lambda (a b) (rplacd a b))) \
(setq nreverse (lambda (a) (nreverse a))) \
(setq nconc (lambda (a b) (nconc a b))) \
(setq append (lambda (a b) (append a b))) \
(setq string-length (lambda (s) (string-length s))) \
(setq print (lambda (a) (print a))) \
\"you can't use progn as a function, because.\" \
(setq progn nil) \
(setq macro nil) \
(setq expand1 (lambda (a) (expand1 a))) \
(setq eval (lambda (a) (eval a))) \
)"))
_eval(read_str("\
(progn \
(setq mapcar (lambda (f a) \
(label ((map \
(lambda (a r) \
(cond ((eq a nil) (nreverse r)) \
(true (map (cdr a) \
(cons (f (car a)) r))))))) \
(map a nil)))) \
(macro let (lambda (body) \
(label ((names (mapcar car (car body))) \
(values (mapcar cadr (car body)))) \
(list 'progn \
(append \
(list (append \
(list (quote lambda) names) \
(cdr body))) \
values))))) \
(macro q (lambda (x) (list (quote quote) (car x)))) \
(setq foldl (lambda (f z xs) \
(cond ((atom xs) (f z xs)) \
((null xs) z) \
((null (cdr xs)) (f z (car xs))) \
(true (foldl f (f z (car xs)) \
(cdr xs)))))) \
(setq reduce (lambda (f xs) \
(cond ((null xs) nil) \
((atom xs) (f xs)) \
((null (cdr xs)) (f (car xs))) \
(true (foldl f (car xs) (cdr xs)))))) \
(setq mappend (lambda (f xs) \
(reduce append (mapcar f xs)))) \
(macro quasiquote (lambda (lis) \
(label ((qq1 \
(lambda (an) \
(cond ((atom an) (list (quote list) (list 'quote an))) \
((eq (car an) 'unquote) \
(list (quote list) (cadr an))) \
((eq (car an) 'unquote-splicing) \
(cadr an)) \
(true (mapcar qq1 an)))))) \
(cond ((atom (car lis)) (list 'quote (car lis))) \
(true (list (quote reduce) (quote append) \
(cons (quote list) \
(mapcar qq1 (car lis))))))))) \
)"))
_eval(read_str("\
(progn \
(setq only2+ (lambda (a b) (only2+ a b))) \
(setq + (lambda xs (foldl only2+ 0 xs))) \
(setq only2* (lambda (a b) (only2* a b))) \
(setq * (lambda xs (foldl only2* 1 xs))) \
(setq only2- (lambda (a b) (only2- a b))) \
(setq - (lambda xs (reduce only2- xs))) \
(setq only2/ (lambda (a b) (only2/ a b))) \
(setq / (lambda xs (reduce only2/ xs))) \
(setq only2// (lambda (a b) (only2// a b))) \
(setq // (lambda xs (reduce only2// xs))) \
(setq only2% (lambda (a b) (only2% a b))) \
(setq % (lambda xs (reduce only2% xs))) \
(setq only2** (lambda (a b) (only2** a b))) \
(setq ** (lambda xs (reduce only2** xs))) \
(setq atan2 (lambda (a b) (atan2 a b))) \
(setq cos (lambda (x) (cos x))) \
(setq sin (lambda (x) (sin x))) \
(setq exp (lambda (x) (exp x))) \
(setq log (lambda (x) (log x))) \
(setq sqrt (lambda (x) (sqrt x))) \
(setq rand (lambda () (rand))) \
(setq srand (lambda (x) (srand x))) \
(setq int (lambda (x) (int x))) \
(setq system (lambda (x) (system x))) \
(setq tolower (lambda (x) (tolower x))) \
(setq toupper (lambda (x) (toupper x))) \
(setq substr (lambda xs (cond ((eq (list-length xs 2)) \
(substr (car xs) (cadr xs))) \
(true (substr (car xs) (cadr xs) (caddr xs))))))\
(setq index (lambda (s t) (index s t))) \
(setq match (lambda (s r) (match s r))) \
(setq split (lambda (s fs) (split s fs))) \
(setq sub (lambda (r t s) (sub r t s))) \
(setq gsub (lambda (r t s) (gsub r t s))) \
\"no printf/sprintf function values, i've got no apply\" \
(setq sprintf nil) \
(setq printf nil) \
(setq strcat (lambda xs (strcat xs))) \
(setq getline (lambda () (getline))) \
(setq with-ors nil) \
(setq with-output-to nil) \
(setq with-input-from nil) \
(setq fflush nil) \
(setq close nil) \
(setq gc-dot nil) \
(setq gc nil) \
(setq dump-dot nil) \
(setq dump nil) \
)\
"))
# make definition searches happen in the order the definitions are
# written above
_GLOBALS = _nreverse(_GLOBALS)
}
# (setq mapcar \
# (lambda (f a) \
# (label \
# ((map (lambda (a r) \
# (cond ((eq a nil) (nreverse r)) \
# (true (map (cdr a) \
# (cons (f (car a)) \
# r))))))) \
# (map a nil))))