2019-07-05 07:07:16 +00:00
|
|
|
;; ------------ Boolean Logic ----------------------------------
|
2019-07-04 14:09:13 +00:00
|
|
|
(def and
|
|
|
|
(lm (a b)
|
|
|
|
(nand (nand a b) (nand a b))))
|
|
|
|
|
|
|
|
(def or
|
|
|
|
(lm (a b)
|
|
|
|
(nand (nand a a) (nand b b))))
|
|
|
|
|
|
|
|
(def not
|
|
|
|
(lm (a)
|
|
|
|
(nand a a)))
|
|
|
|
|
|
|
|
(def nor
|
|
|
|
(lm (a b)
|
|
|
|
(not (or a b))))
|
|
|
|
|
|
|
|
|
2019-07-05 07:07:16 +00:00
|
|
|
;; ------------ Boolean Logic ----------------------------------
|
|
|
|
|
|
|
|
;; greater than:
|
|
|
|
(def gt (lm (a b) (lt b a)))
|
|
|
|
|
|
|
|
;; equal:
|
|
|
|
(def eq (lm (a b) (and (not (lt a b)) (not (lt b a)))))
|
|
|
|
|
|
|
|
;; not equal:
|
|
|
|
(def neq (lm (a b)
|
|
|
|
(not (eq a b))))
|
|
|
|
|
|
|
|
;; great equal:
|
|
|
|
(def geq (lm (a b) (or (eq a b) (gt a b))))
|
|
|
|
|
|
|
|
;; lower equal:
|
|
|
|
(def leq (lm (a b) (or (eq a b) (lt a b))))
|
|
|
|
|
|
|
|
;; ------------ Arithmetic ----------------------------------
|
|
|
|
;; Available: Numbers on Z, add, inv
|
|
|
|
|
|
|
|
;; sub: a - b:
|
|
|
|
(def sub (lm (a b) (add a (inv b))))
|
|
|
|
|
|
|
|
;; mult: a * b
|
|
|
|
(def mult (lm (a b)
|
|
|
|
(if (eq b 1)
|
|
|
|
a
|
|
|
|
(add a (mult a (sub b 1))))))
|
|
|
|
|
|
|
|
;; div: a / b (result: integer)
|
|
|
|
(def div (lm (a b)
|
|
|
|
(if (leq a 0)
|
|
|
|
0
|
|
|
|
(add 1 (div (sub a b) b)))))
|
|
|
|
|
|
|
|
(def modsubr (lm (a b last)
|
|
|
|
(if (lt a 0) last
|
|
|
|
(modsubr (sub a b) b a))))
|
|
|
|
(def mod (lm (a b) (modsubr a b 0)))
|
|
|
|
|
|
|
|
(def sum (lm (a b erg)
|
|
|
|
(if (gt a b)
|
|
|
|
erg
|
|
|
|
(sum (add a 1) b (add erg a)))))
|
|
|
|
|
|
|
|
;; ------------ Open TODO's ----------------------------------
|
|
|
|
|
|
|
|
(def dispatch (lm (a b which)
|
|
|
|
(if (eq which 0) a b)))
|
|
|
|
|
|
|
|
;; (def cons (lm (a b)
|
|
|
|
;; (lm (x) (dispatch a b x))))
|
|
|
|
(def cons (lm (a b)
|
|
|
|
(lm (x) (if (eq x 0) a b))))
|
|
|
|
|
|
|
|
(def car (lm (cell) (cell 0)))
|
|
|
|
(def cdr (lm (cell) (cell 1)))
|
|
|
|
|
|
|
|
;; (define (cons x y)
|
|
|
|
;; (define (dispatch m)
|
|
|
|
;; (cond ((= m 0) x)
|
|
|
|
;; ((= m 1) y)
|
|
|
|
;; (else (error "Argument not 0 or 1 -- CONS" m))))
|
|
|
|
;; dispatch)
|
|
|
|
;; (define (car z) (z 0))
|
|
|
|
;; (define (cdr z) (z 1))
|
|
|
|
|
|
|
|
;; ------------ Open TODO's ----------------------------------
|
|
|
|
;; * Garbage Collection
|
|
|
|
;; * Multi Threading (each function within it's own thread
|
|
|
|
;; * Eval with empty body or empty parameter list?
|
|
|
|
;; (def zero (lm (x) (0)))
|
|
|
|
;; * lexical scoping like:
|
|
|
|
;; (def a (lm (x y z)
|
|
|
|
;; (def abc (fn args))
|
|
|
|
;; (fn abc args))))
|
2019-07-04 14:09:13 +00:00
|
|
|
|
|
|
|
|
|
|
|
;; Local Variables:
|
|
|
|
;; mode: scheme
|
|
|
|
;; eval: (message "main()")
|
|
|
|
;; fill-column: 55
|
|
|
|
;; comment-column: 40
|
|
|
|
;; indent-tabs-mode: nil
|
|
|
|
;; tab-width: 2
|
|
|
|
;; c-basic-offset: 2
|
|
|
|
;; End:
|
2019-07-05 07:07:16 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(def a (lm (x) (lm (y) (add x y))))
|
|
|
|
nil 0x0
|
|
|
|
a
|
|
|
|
#fn
|
|
|
|
(a 1)
|
|
|
|
#fn
|
|
|
|
(def b (a 1))
|
|
|
|
nil 0x0
|
|
|
|
b
|
|
|
|
#fn
|
|
|
|
(b 5)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
((a 1) 4)
|
|
|
|
eval_fn_call: expected function body as list
|
|
|
|
|
|
|
|
|
|
|
|
- mindestens 2 sachen sind noch kaputt:
|
|
|
|
- wenn ich einen funktionsaufruf am anfang habe das eine funktion
|
|
|
|
zurückgibt gehts nicht
|
|
|
|
- und im allgemeinen findet man nicht die variable in einem
|
|
|
|
funktionsaufruf einer zurückgegebenen funktion
|