From 4eb42d48f9e7cbe05bea3f73503e7f15a2e676f7 Mon Sep 17 00:00:00 2001 From: Sharjeel Khan Date: Fri, 11 Nov 2022 03:53:13 -0500 Subject: [PATCH] New Newlisps cfold --- koka_bench/newlisp/newlisp-macro-cfold.nl | 88 +++++++++++++++++ koka_bench/newlisp/newlisp-macro-deriv.nl | 96 +++++++++++++++++++ koka_bench/newlisp/newlisp-macro-nqueens.nl | 44 +++++++++ .../newlisp/newlisp-slow-fexpr-cfold.nl | 86 +++++++++++++++++ .../newlisp/newlisp-slow-fexpr-deriv.nl | 93 ++++++++++++++++++ .../newlisp/newlisp-slow-fexpr-nqueens.nl | 32 +++++++ 6 files changed, 439 insertions(+) create mode 100644 koka_bench/newlisp/newlisp-macro-cfold.nl create mode 100644 koka_bench/newlisp/newlisp-macro-deriv.nl create mode 100644 koka_bench/newlisp/newlisp-macro-nqueens.nl create mode 100644 koka_bench/newlisp/newlisp-slow-fexpr-cfold.nl create mode 100644 koka_bench/newlisp/newlisp-slow-fexpr-deriv.nl create mode 100644 koka_bench/newlisp/newlisp-slow-fexpr-nqueens.nl diff --git a/koka_bench/newlisp/newlisp-macro-cfold.nl b/koka_bench/newlisp/newlisp-macro-cfold.nl new file mode 100644 index 0000000..65a2f5d --- /dev/null +++ b/koka_bench/newlisp/newlisp-macro-cfold.nl @@ -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) diff --git a/koka_bench/newlisp/newlisp-macro-deriv.nl b/koka_bench/newlisp/newlisp-macro-deriv.nl new file mode 100644 index 0000000..9c522f8 --- /dev/null +++ b/koka_bench/newlisp/newlisp-macro-deriv.nl @@ -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) diff --git a/koka_bench/newlisp/newlisp-macro-nqueens.nl b/koka_bench/newlisp/newlisp-macro-nqueens.nl new file mode 100644 index 0000000..4bc3d48 --- /dev/null +++ b/koka_bench/newlisp/newlisp-macro-nqueens.nl @@ -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) diff --git a/koka_bench/newlisp/newlisp-slow-fexpr-cfold.nl b/koka_bench/newlisp/newlisp-slow-fexpr-cfold.nl new file mode 100644 index 0000000..02a03d7 --- /dev/null +++ b/koka_bench/newlisp/newlisp-slow-fexpr-cfold.nl @@ -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) diff --git a/koka_bench/newlisp/newlisp-slow-fexpr-deriv.nl b/koka_bench/newlisp/newlisp-slow-fexpr-deriv.nl new file mode 100644 index 0000000..0f397e4 --- /dev/null +++ b/koka_bench/newlisp/newlisp-slow-fexpr-deriv.nl @@ -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) diff --git a/koka_bench/newlisp/newlisp-slow-fexpr-nqueens.nl b/koka_bench/newlisp/newlisp-slow-fexpr-nqueens.nl new file mode 100644 index 0000000..5dd7a05 --- /dev/null +++ b/koka_bench/newlisp/newlisp-slow-fexpr-nqueens.nl @@ -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)