4 (wrap (operative (cases-list) _
7 (if (evaluate (car (car cases-list)) env)
8 (evaluate (car (cdr (car cases-list))) env)
9 (cond-internal (cdr cases-list)))))))
10 (cond-internal cases)))
13 (wrap (operative (left right) _
14 (cond ((and (= left nil) (= right nil)) nil)
15 ((= left nil) (assert false))
16 ((= right nil) (assert false))
17 (true (cons (cons (car left) (car right))
18 (cons-list-zip (cdr left) (cdr right))))))))
20 # Maybe environments should have been association lists
21 (define merge-association-list-with-cons-dict
22 (wrap (operative (a-list cons-dict) _
25 (merge-association-list-with-cons-dict
27 (cons-dict-set cons-dict (car (car a-list)) (cdr (car a-list))))))))
30 (wrap (operative (f xs) _
33 (cons (f (car xs)) (cons-list-map f (cdr xs)))))))
36 (operative outer-args outer-env
37 (define arg-binding (car outer-args))
38 (define function-body (cdr outer-args))
40 (define initial-function-env (cons-dict-set nil :__parent__ outer-env))
42 (wrap (operative inner-args inner-env
44 (cond ((identifier? arg-binding) (cons-dict-set initial-function-env
45 (identifier->symbol arg-binding)
47 ((cons-list? arg-binding) (merge-association-list-with-cons-dict (cons-list-zip (cons-list-map identifier->symbol arg-binding) inner-args)
48 initial-function-env))
49 (true (assert "Must be an identifier or a cons-list" false))))
50 (evaluate-expressions function-body function-env)))))
52 (define and (operative (left right) env
53 (if (evaluate left env)
57 (define or (operative (left right) env
58 (if (evaluate left env)
60 (evaluate right env))))
62 (define quote (operative (quoted-expression) _ quoted-expression))
64 (define nil? (operative (expression) env
65 (= (evaluate expression env) nil)))
67 (define get-current-environment
68 (wrap (operative () env env)))
71 (wrap (operative items _ items)))