New Newlisps cfold
This commit is contained in:
Sharjeel Khan
88
koka_bench/newlisp/newlisp-macro-cfold.nl
Normal file
88
koka_bench/newlisp/newlisp-macro-cfold.nl
Normal file
@@ -0,0 +1,88 @@
|
|||||||
|
#!/usr/bin/env newlisp
|
||||||
|
|
||||||
|
(define cont list)
|
||||||
|
(define cont? list?)
|
||||||
|
;(define cont (lambda (l) (array (length l) l)))
|
||||||
|
;(define cont? array?)
|
||||||
|
|
||||||
|
(define (evaluate_case access c) (cond
|
||||||
|
((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b)))
|
||||||
|
((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access)))
|
||||||
|
((list? c) (letn (
|
||||||
|
tests (list and (list list? access) (list = (length c) (list length access)))
|
||||||
|
tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c))
|
||||||
|
(list tests body_func)
|
||||||
|
(letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i))
|
||||||
|
inner_test (inner_test__inner_body_func 0)
|
||||||
|
inner_body_func (inner_test__inner_body_func 1)
|
||||||
|
)
|
||||||
|
(recurse (append tests (list inner_test))
|
||||||
|
(expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func)
|
||||||
|
(+ i 1))))))
|
||||||
|
(recurse tests (lambda (b) b) 0))
|
||||||
|
) tests__body_func))
|
||||||
|
(true (list (list = access c) (lambda (b) b)))
|
||||||
|
))
|
||||||
|
|
||||||
|
(define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i)))
|
||||||
|
(append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2)))))
|
||||||
|
(true '((true ("none matched"))))))
|
||||||
|
|
||||||
|
(macro (my-match X) X)
|
||||||
|
(constant 'my-match (lambda-macro (X) (expand (list let (list '__MATCH_SYM 'X) (cons cond (my-match-helper '__MATCH_SYM (args) 0))) 'X)))
|
||||||
|
|
||||||
|
|
||||||
|
(define (mk-expr n v) (cond ((= n 0) (cond ((= v 0) (list 'VR 1 0))
|
||||||
|
(true (list 'VL v 0))))
|
||||||
|
(true (list 'A (mk-expr (- n 1) (+ v 1)) (mk-expr (- n 1) (max (- v 1) 0))))))
|
||||||
|
|
||||||
|
(define (append-add a b) (my-match a
|
||||||
|
('A c d) (list 'A c (append-add d b))
|
||||||
|
a (list 'A a b)))
|
||||||
|
|
||||||
|
(define (append-mul a b) (my-match a
|
||||||
|
('M c d) (list 'M c (append-mul d b))
|
||||||
|
a (list 'M a b)))
|
||||||
|
|
||||||
|
(define (reassoc e) (my-match e
|
||||||
|
('A a b) (append-add (reassoc a) (reassoc b))
|
||||||
|
('M c d) (append-mul (reassoc a) (reassoc b))
|
||||||
|
e e))
|
||||||
|
|
||||||
|
(define (cfold e) (my-match e
|
||||||
|
('A a b) (letn (ap (cfold a)
|
||||||
|
bp (cfold b))
|
||||||
|
(my-match ap
|
||||||
|
('VL s t) (my-match bp
|
||||||
|
('VL m n) (list 'VL (+ s m) 0)
|
||||||
|
('A m ('VL n p)) (list 'A (list 'VL (+ s n) 0) m)
|
||||||
|
('A ('VL m n) p) (list 'A (list 'VL (+ s m) 0) p)
|
||||||
|
ep (list 'A ap bp)
|
||||||
|
)
|
||||||
|
ep (list 'A ap bp)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
('M c d) (letn (cp (cfold c)
|
||||||
|
dp (cfold dec))
|
||||||
|
(my-match cp
|
||||||
|
('VL s t) (my-match dp
|
||||||
|
('VL m n) (list 'VL (* s m) 0)
|
||||||
|
('M m ('VL n p)) (list 'M (list 'VL (* s n) 0) m)
|
||||||
|
('M ('VL m n) p) (list 'M (list 'VL (* s m) 0) p)
|
||||||
|
ep (list 'M cp dp)
|
||||||
|
)
|
||||||
|
ep (list 'M ap bp)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
e e))
|
||||||
|
|
||||||
|
(define (eval e) (my-match e
|
||||||
|
('VR a b) 0
|
||||||
|
('VL c d) c
|
||||||
|
('A e f) (+ (eval e) (eval f))
|
||||||
|
('M l r) (* (eval l) (eval r))))
|
||||||
|
|
||||||
|
|
||||||
|
(println (eval (cfold (reassoc (mk-expr (integer (main-args 2)) 1)))))
|
||||||
|
|
||||||
|
(exit)
|
||||||
96
koka_bench/newlisp/newlisp-macro-deriv.nl
Normal file
96
koka_bench/newlisp/newlisp-macro-deriv.nl
Normal file
@@ -0,0 +1,96 @@
|
|||||||
|
#!/usr/bin/env newlisp
|
||||||
|
|
||||||
|
(define cont list)
|
||||||
|
(define cont? list?)
|
||||||
|
;(define cont (lambda (l) (array (length l) l)))
|
||||||
|
;(define cont? array?)
|
||||||
|
|
||||||
|
(define (evaluate_case access c) (cond
|
||||||
|
((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b)))
|
||||||
|
((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access)))
|
||||||
|
((list? c) (letn (
|
||||||
|
tests (list and (list list? access) (list = (length c) (list length access)))
|
||||||
|
tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c))
|
||||||
|
(list tests body_func)
|
||||||
|
(letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i))
|
||||||
|
inner_test (inner_test__inner_body_func 0)
|
||||||
|
inner_body_func (inner_test__inner_body_func 1)
|
||||||
|
)
|
||||||
|
(recurse (append tests (list inner_test))
|
||||||
|
(expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func)
|
||||||
|
(+ i 1))))))
|
||||||
|
(recurse tests (lambda (b) b) 0))
|
||||||
|
) tests__body_func))
|
||||||
|
(true (list (list = access c) (lambda (b) b)))
|
||||||
|
))
|
||||||
|
|
||||||
|
(define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i)))
|
||||||
|
(append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2)))))
|
||||||
|
(true '((true ("none matched"))))))
|
||||||
|
|
||||||
|
(macro (my-match X) X)
|
||||||
|
(constant 'my-match (lambda-macro (X) (expand (list let (list '__MATCH_SYM 'X) (cons cond (my-match-helper '__MATCH_SYM (args) 0))) 'X)))
|
||||||
|
|
||||||
|
|
||||||
|
(define (addD nI mI) (my-match (list nI mI)
|
||||||
|
(('VL n x) ('VL m y)) (list 'VL (+ n m) x)
|
||||||
|
(('VL 0 x) f) f
|
||||||
|
(f ('VL 0 y)) f
|
||||||
|
(f ('VL n y)) (addD (list 'VL n y) f)
|
||||||
|
(('VL n x) ('A ('VL m y) f)) (addD (list 'VL (+ n m) y) f)
|
||||||
|
(f ('A ('VL m y) g)) (addD (list 'VL m y) (addD f g))
|
||||||
|
(('A f g) h) (addD f (addD g h))
|
||||||
|
(f g) (list 'A f g)))
|
||||||
|
|
||||||
|
(define (mulD nI mI) (my-match (list nI mI)
|
||||||
|
(('VL n x) ('VL m y)) (list 'VL (* n m) x)
|
||||||
|
(('VL 0 x) f) (list 'VL 0 x)
|
||||||
|
(f ('VL 0 y)) (list 'VL 0 y)
|
||||||
|
(('VL 1 x) f) f
|
||||||
|
(f ('VL 1 y)) f
|
||||||
|
(f ('VL n y)) (mulD (list 'VL n y) f)
|
||||||
|
(('VL n x) ('M ('VL m y) f)) (mulD (list 'VL (* n m) y) f)
|
||||||
|
(f ('M ('VL m y) g)) (mulD (list 'VL m y) (mulD f g))
|
||||||
|
(('M f g) h) (mulD f (mulD g h))
|
||||||
|
(f g) (list 'M f g)))
|
||||||
|
|
||||||
|
(define (powD nI mI) (my-match (list nI mI)
|
||||||
|
(('VL n x) ('VL m y)) (list 'VL (pow n m) x)
|
||||||
|
(f ('VL 0 y)) (list 'VL 1 y)
|
||||||
|
(f ('VL 1 y)) f
|
||||||
|
(('VL 0 y) f) (list 'VL 1 y)
|
||||||
|
(f g) (list 'P f g)))
|
||||||
|
|
||||||
|
(define (lnD nI) (my-match nI
|
||||||
|
('VL 1 x) (list 'VL 0 x)
|
||||||
|
(f) (list 'L f 0)))
|
||||||
|
|
||||||
|
(define (derv x e) (my-match e
|
||||||
|
('VL a b) ('VL 0 b)
|
||||||
|
('VR y b) (cond ((= x y) ('VL 1 b))
|
||||||
|
(true ('VL 0 b)))
|
||||||
|
('A f g) (addD (derv x f) (derv x g))
|
||||||
|
('M f g) (addD (mulD f (derv x g)) (mulD g (derv x f)))
|
||||||
|
('P f g) (mulD (powD f g) (addD (mul (mul g (derv x f)) (powd f (list 'VL -1 0))) (mulD (lnD f) (derv x g))))
|
||||||
|
('L f) (mulD (derv x f) (powD f (list 'VL -1 0)))
|
||||||
|
|
||||||
|
))
|
||||||
|
|
||||||
|
(define (countD nI) (my-match (nI)
|
||||||
|
('VL 1 x) 1
|
||||||
|
('VR 1 x) 1
|
||||||
|
('A f g) (+ (countD f) (countD g))
|
||||||
|
('M f g) (+ (countD f) (countD g))
|
||||||
|
('P f g) (+ (countD f) (countD g))
|
||||||
|
('L f g) (countD f))))
|
||||||
|
|
||||||
|
(define (nest-aux s f n x) (cond ((= n 0) x)
|
||||||
|
(true (nest-aux s f (- n 1) (f (- s n) x)))))
|
||||||
|
|
||||||
|
(define (nest f n e) (nest-aux n f n e))
|
||||||
|
|
||||||
|
(define (deriv i f) d)
|
||||||
|
|
||||||
|
(println (nest deriv (integer (main-args 2)) (powr (list 'VR "x" 0) (list 'VR "x" 0)))))))
|
||||||
|
|
||||||
|
(exit)
|
||||||
44
koka_bench/newlisp/newlisp-macro-nqueens.nl
Normal file
44
koka_bench/newlisp/newlisp-macro-nqueens.nl
Normal file
@@ -0,0 +1,44 @@
|
|||||||
|
#!/usr/bin/env newlisp
|
||||||
|
|
||||||
|
(define cont list)
|
||||||
|
(define cont? list?)
|
||||||
|
;(define cont (lambda (l) (array (length l) l)))
|
||||||
|
;(define cont? array?)
|
||||||
|
|
||||||
|
(define (evaluate_case access c) (cond
|
||||||
|
((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b)))
|
||||||
|
((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access)))
|
||||||
|
((list? c) (letn (
|
||||||
|
tests (list and (list list? access) (list = (length c) (list length access)))
|
||||||
|
tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c))
|
||||||
|
(list tests body_func)
|
||||||
|
(letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i))
|
||||||
|
inner_test (inner_test__inner_body_func 0)
|
||||||
|
inner_body_func (inner_test__inner_body_func 1)
|
||||||
|
)
|
||||||
|
(recurse (append tests (list inner_test))
|
||||||
|
(expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func)
|
||||||
|
(+ i 1))))))
|
||||||
|
(recurse tests (lambda (b) b) 0))
|
||||||
|
) tests__body_func))
|
||||||
|
(true (list (list = access c) (lambda (b) b)))
|
||||||
|
))
|
||||||
|
|
||||||
|
(define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i)))
|
||||||
|
(append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2)))))
|
||||||
|
(true '((true ("none matched"))))))
|
||||||
|
|
||||||
|
(macro (my-match X) X)
|
||||||
|
(constant 'my-match (lambda-macro (X) (expand (list let (list '__MATCH_SYM 'X) (cons cond (my-match-helper '__MATCH_SYM (args) 0))) 'X)))
|
||||||
|
|
||||||
|
(define (extendS q acc xss) (my-match xss
|
||||||
|
))
|
||||||
|
|
||||||
|
(define (findS n q) (cond ((= q 0) (list nil))
|
||||||
|
true (extendS n nil (findS n (- q 1)))))
|
||||||
|
|
||||||
|
(define (nqueens n) (length (findS n n)))
|
||||||
|
|
||||||
|
(println (nqueens (integer (main-args 2))))
|
||||||
|
|
||||||
|
(exit)
|
||||||
86
koka_bench/newlisp/newlisp-slow-fexpr-cfold.nl
Normal file
86
koka_bench/newlisp/newlisp-slow-fexpr-cfold.nl
Normal file
@@ -0,0 +1,86 @@
|
|||||||
|
#!/usr/bin/env newlisp
|
||||||
|
|
||||||
|
(define cont list)
|
||||||
|
(define cont? list?)
|
||||||
|
;(define cont (lambda (l) (array (length l) l)))
|
||||||
|
;(define cont? array?)
|
||||||
|
|
||||||
|
(define (evaluate_case access c) (cond
|
||||||
|
((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b)))
|
||||||
|
((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access)))
|
||||||
|
((list? c) (letn (
|
||||||
|
tests (list and (list list? access) (list = (length c) (list length access)))
|
||||||
|
tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c))
|
||||||
|
(list tests body_func)
|
||||||
|
(letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i))
|
||||||
|
inner_test (inner_test__inner_body_func 0)
|
||||||
|
inner_body_func (inner_test__inner_body_func 1)
|
||||||
|
)
|
||||||
|
(recurse (append tests (list inner_test))
|
||||||
|
(expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func)
|
||||||
|
(+ i 1))))))
|
||||||
|
(recurse tests (lambda (b) b) 0))
|
||||||
|
) tests__body_func))
|
||||||
|
(true (list (list = access c) (lambda (b) b)))
|
||||||
|
))
|
||||||
|
|
||||||
|
(define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i)))
|
||||||
|
(append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2)))))
|
||||||
|
(true '((true ("none matched"))))))
|
||||||
|
(define-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0)))))
|
||||||
|
|
||||||
|
|
||||||
|
(define (mk-expr n v) (cond ((= n 0) (cond ((= v 0) (list 'VR 1 0))
|
||||||
|
(true (list 'VL v 0))))
|
||||||
|
(true (list 'A (mk-expr (- n 1) (+ v 1)) (mk-expr (- n 1) (max (- v 1) 0))))))
|
||||||
|
|
||||||
|
(define (append-add a b) (my-match a
|
||||||
|
('A c d) (list 'A c (append-add d b))
|
||||||
|
a (list 'A a b)))
|
||||||
|
|
||||||
|
(define (append-mul a b) (my-match a
|
||||||
|
('M c d) (list 'M c (append-mul d b))
|
||||||
|
a (list 'M a b)))
|
||||||
|
|
||||||
|
(define (reassoc e) (my-match e
|
||||||
|
('A a b) (append-add (reassoc a) (reassoc b))
|
||||||
|
('M c d) (append-mul (reassoc a) (reassoc b))
|
||||||
|
e e))
|
||||||
|
|
||||||
|
(define (cfold e) (my-match e
|
||||||
|
('A a b) (letn (ap (cfold a)
|
||||||
|
bp (cfold b))
|
||||||
|
(my-match ap
|
||||||
|
('VL s t) (my-match bp
|
||||||
|
('VL m n) (list 'VL (+ s m) 0)
|
||||||
|
('A m ('VL n p)) (list 'A (list 'VL (+ s n) 0) m)
|
||||||
|
('A ('VL m n) p) (list 'A (list 'VL (+ s m) 0) p)
|
||||||
|
ep (list 'A ap bp)
|
||||||
|
)
|
||||||
|
ep (list 'A ap bp)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
('M c d) (letn (cp (cfold c)
|
||||||
|
dp (cfold dec))
|
||||||
|
(my-match cp
|
||||||
|
('VL s t) (my-match dp
|
||||||
|
('VL m n) (list 'VL (* s m) 0)
|
||||||
|
('M m ('VL n p)) (list 'M (list 'VL (* s n) 0) m)
|
||||||
|
('M ('VL m n) p) (list 'M (list 'VL (* s m) 0) p)
|
||||||
|
ep (list 'M cp dp)
|
||||||
|
)
|
||||||
|
ep (list 'M ap bp)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
e e))
|
||||||
|
|
||||||
|
(define (eval e) (my-match e
|
||||||
|
('VR a b) 0
|
||||||
|
('VL c d) c
|
||||||
|
('A e f) (+ (eval e) (eval f))
|
||||||
|
('M l r) (* (eval l) (eval r))))
|
||||||
|
|
||||||
|
|
||||||
|
(println (eval (cfold (reassoc (mk-expr (integer (main-args 2)) 1)))))
|
||||||
|
|
||||||
|
(exit)
|
||||||
93
koka_bench/newlisp/newlisp-slow-fexpr-deriv.nl
Normal file
93
koka_bench/newlisp/newlisp-slow-fexpr-deriv.nl
Normal file
@@ -0,0 +1,93 @@
|
|||||||
|
#!/usr/bin/env newlisp
|
||||||
|
|
||||||
|
(define cont list)
|
||||||
|
(define cont? list?)
|
||||||
|
;(define cont (lambda (l) (array (length l) l)))
|
||||||
|
;(define cont? array?)
|
||||||
|
|
||||||
|
(define (evaluate_case access c) (cond
|
||||||
|
((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b)))
|
||||||
|
((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access)))
|
||||||
|
((list? c) (letn (
|
||||||
|
tests (list and (list list? access) (list = (length c) (list length access)))
|
||||||
|
tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c))
|
||||||
|
(list tests body_func)
|
||||||
|
(letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i))
|
||||||
|
inner_test (inner_test__inner_body_func 0)
|
||||||
|
inner_body_func (inner_test__inner_body_func 1)
|
||||||
|
)
|
||||||
|
(recurse (append tests (list inner_test))
|
||||||
|
(expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func)
|
||||||
|
(+ i 1))))))
|
||||||
|
(recurse tests (lambda (b) b) 0))
|
||||||
|
) tests__body_func))
|
||||||
|
(true (list (list = access c) (lambda (b) b)))
|
||||||
|
))
|
||||||
|
|
||||||
|
(define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i)))
|
||||||
|
(append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2)))))
|
||||||
|
(true '((true ("none matched"))))))
|
||||||
|
(define-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0)))))
|
||||||
|
|
||||||
|
(define (addD nI mI) (my-match (list nI mI)
|
||||||
|
(('VL n x) ('VL m y)) (list 'VL (+ n m) x)
|
||||||
|
(('VL 0 x) f) f
|
||||||
|
(f ('VL 0 y)) f
|
||||||
|
(f ('VL n y)) (addD (list 'VL n y) f)
|
||||||
|
(('VL n x) ('A ('VL m y) f)) (addD (list 'VL (+ n m) y) f)
|
||||||
|
(f ('A ('VL m y) g)) (addD (list 'VL m y) (addD f g))
|
||||||
|
(('A f g) h) (addD f (addD g h))
|
||||||
|
(f g) (list 'A f g)))
|
||||||
|
|
||||||
|
(define (mulD nI mI) (my-match (list nI mI)
|
||||||
|
(('VL n x) ('VL m y)) (list 'VL (* n m) x)
|
||||||
|
(('VL 0 x) f) (list 'VL 0 x)
|
||||||
|
(f ('VL 0 y)) (list 'VL 0 y)
|
||||||
|
(('VL 1 x) f) f
|
||||||
|
(f ('VL 1 y)) f
|
||||||
|
(f ('VL n y)) (mulD (list 'VL n y) f)
|
||||||
|
(('VL n x) ('M ('VL m y) f)) (mulD (list 'VL (* n m) y) f)
|
||||||
|
(f ('M ('VL m y) g)) (mulD (list 'VL m y) (mulD f g))
|
||||||
|
(('M f g) h) (mulD f (mulD g h))
|
||||||
|
(f g) (list 'M f g)))
|
||||||
|
|
||||||
|
(define (powD nI mI) (my-match (list nI mI)
|
||||||
|
(('VL n x) ('VL m y)) (list 'VL (pow n m) x)
|
||||||
|
(f ('VL 0 y)) (list 'VL 1 y)
|
||||||
|
(f ('VL 1 y)) f
|
||||||
|
(('VL 0 y) f) (list 'VL 1 y)
|
||||||
|
(f g) (list 'P f g)))
|
||||||
|
|
||||||
|
(define (lnD nI) (my-match nI
|
||||||
|
('VL 1 x) (list 'VL 0 x)
|
||||||
|
(f) (list 'L f 0)))
|
||||||
|
|
||||||
|
(define (derv x e) (my-match e
|
||||||
|
('VL a b) ('VL 0 b)
|
||||||
|
('VR y b) (cond ((= x y) ('VL 1 b))
|
||||||
|
(true ('VL 0 b)))
|
||||||
|
('A f g) (addD (derv x f) (derv x g))
|
||||||
|
('M f g) (addD (mulD f (derv x g)) (mulD g (derv x f)))
|
||||||
|
('P f g) (mulD (powD f g) (addD (mul (mul g (derv x f)) (powd f (list 'VL -1 0))) (mulD (lnD f) (derv x g))))
|
||||||
|
('L f) (mulD (derv x f) (powD f (list 'VL -1 0)))
|
||||||
|
|
||||||
|
))
|
||||||
|
|
||||||
|
(define (countD nI) (my-match (nI)
|
||||||
|
('VL 1 x) 1
|
||||||
|
('VR 1 x) 1
|
||||||
|
('A f g) (+ (countD f) (countD g))
|
||||||
|
('M f g) (+ (countD f) (countD g))
|
||||||
|
('P f g) (+ (countD f) (countD g))
|
||||||
|
('L f g) (countD f))))
|
||||||
|
|
||||||
|
(define (nest-aux s f n x) (cond ((= n 0) x)
|
||||||
|
(true (nest-aux s f (- n 1) (f (- s n) x)))))
|
||||||
|
|
||||||
|
(define (nest f n e) (nest-aux n f n e))
|
||||||
|
|
||||||
|
(define (deriv i f) d)
|
||||||
|
|
||||||
|
(println (nest deriv (integer (main-args 2)) (powr (list 'VR "x" 0) (list 'VR "x" 0)))))))
|
||||||
|
|
||||||
|
(exit)
|
||||||
32
koka_bench/newlisp/newlisp-slow-fexpr-nqueens.nl
Normal file
32
koka_bench/newlisp/newlisp-slow-fexpr-nqueens.nl
Normal file
@@ -0,0 +1,32 @@
|
|||||||
|
#!/usr/bin/env newlisp
|
||||||
|
|
||||||
|
(define cont list)
|
||||||
|
(define cont? list?)
|
||||||
|
;(define cont (lambda (l) (array (length l) l)))
|
||||||
|
;(define cont? array?)
|
||||||
|
|
||||||
|
(define (evaluate_case access c) (cond
|
||||||
|
((and (list? c) (= 2 (length c)) (= 'unquote (c 0))) (list (list = access (c 1)) (lambda (b) b)))
|
||||||
|
((symbol? c) (list true (expand (lambda (b) (list let (list 'c 'access) b)) 'c 'access)))
|
||||||
|
((list? c) (letn (
|
||||||
|
tests (list and (list list? access) (list = (length c) (list length access)))
|
||||||
|
tests__body_func (local (recurse) (setq recurse (lambda (tests body_func i) (if (= i (length c))
|
||||||
|
(list tests body_func)
|
||||||
|
(letn ( inner_test__inner_body_func (evaluate_case (list access i) (c i))
|
||||||
|
inner_test (inner_test__inner_body_func 0)
|
||||||
|
inner_body_func (inner_test__inner_body_func 1)
|
||||||
|
)
|
||||||
|
(recurse (append tests (list inner_test))
|
||||||
|
(expand (lambda (b) (body_func (inner_body_func b))) 'body_func 'inner_body_func)
|
||||||
|
(+ i 1))))))
|
||||||
|
(recurse tests (lambda (b) b) 0))
|
||||||
|
) tests__body_func))
|
||||||
|
(true (list (list = access c) (lambda (b) b)))
|
||||||
|
))
|
||||||
|
|
||||||
|
(define (my-match-helper x_sym cases i) (cond ((< i (- (length cases) 1)) (let (test__body_func (evaluate_case x_sym (cases i)))
|
||||||
|
(append (list (list (test__body_func 0) ((test__body_func 1) (cases (+ i 1))))) (my-match-helper x_sym cases (+ i 2)))))
|
||||||
|
(true '((true ("none matched"))))))
|
||||||
|
(define-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0)))))
|
||||||
|
|
||||||
|
(exit)
|
||||||
Reference in New Issue
Block a user