miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fixed cfold

Browse Source
This commit is contained in:
Sharjeel Khan
2022-11-11 04:01:08 -05:00
parent 4eb42d48f9
commit d440260d1c
5 changed files with 32 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
koka_bench/newlisp/newlisp-macro-cfold.nl
View File

@@ -31,7 +31,6 @@
(macro (my-match X) X) (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))) (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)) (define (mk-expr n v) (cond ((= n 0) (cond ((= v 0) (list 'VR 1 0))
(true (list 'VL v 0)))) (true (list 'VL v 0))))
(true (list 'A (mk-expr (- n 1) (+ v 1)) (mk-expr (- n 1) (max (- v 1) 0)))))) (true (list 'A (mk-expr (- n 1) (+ v 1)) (mk-expr (- n 1) (max (- v 1) 0))))))
@@ -49,9 +48,9 @@
('M c d) (append-mul (reassoc a) (reassoc b)) ('M c d) (append-mul (reassoc a) (reassoc b))
e e)) e e))
(define (cfold e) (my-match e (define (cfoldD e) (my-match e
('A a b) (letn (ap (cfold a) ('A a b) (letn (ap (cfoldD a)
bp (cfold b)) bp (cfoldD b))
(my-match ap (my-match ap
('VL s t) (my-match bp ('VL s t) (my-match bp
('VL m n) (list 'VL (+ s m) 0) ('VL m n) (list 'VL (+ s m) 0)
@@ -62,8 +61,8 @@
ep (list 'A ap bp) ep (list 'A ap bp)
) )
) )
('M c d) (letn (cp (cfold c) ('M c d) (letn (cp (cfoldD c)
dp (cfold dec)) dp (cfoldD dec))
(my-match cp (my-match cp
('VL s t) (my-match dp ('VL s t) (my-match dp
('VL m n) (list 'VL (* s m) 0) ('VL m n) (list 'VL (* s m) 0)
@@ -76,13 +75,13 @@
) )
e e)) e e))
(define (eval e) (my-match e (define (evalD e) (my-match e
('VR a b) 0 ('VR a b) 0
('VL c d) c ('VL c d) c
('A e f) (+ (eval e) (eval f)) ('A e f) (+ (evalD e) (evalD f))
('M l r) (* (eval l) (eval r)))) ('M l r) (* (evalD l) (evalD r))))
(println (eval (cfold (reassoc (mk-expr (integer (main-args 2)) 1))))) (println (evalD (cfoldD (reassoc (mk-expr (integer (main-args 2)) 1)))))
(exit) (exit)

2
koka_bench/newlisp/newlisp-macro-deriv.nl
View File

@@ -82,7 +82,7 @@
('A f g) (+ (countD f) (countD g)) ('A f g) (+ (countD f) (countD g))
('M f g) (+ (countD f) (countD g)) ('M f g) (+ (countD f) (countD g))
('P f g) (+ (countD f) (countD g)) ('P f g) (+ (countD f) (countD g))
('L f g) (countD f)))) ('L f g) (countD f)))
(define (nest-aux s f n x) (cond ((= n 0) x) (define (nest-aux s f n x) (cond ((= n 0) x)
(true (nest-aux s f (- n 1) (f (- s n) x))))) (true (nest-aux s f (- n 1) (f (- s n) x)))))

18
koka_bench/newlisp/newlisp-slow-fexpr-cfold.nl
View File

@@ -47,9 +47,9 @@
('M c d) (append-mul (reassoc a) (reassoc b)) ('M c d) (append-mul (reassoc a) (reassoc b))
e e)) e e))
(define (cfold e) (my-match e (define (cfoldD e) (my-match e
('A a b) (letn (ap (cfold a) ('A a b) (letn (ap (cfoldD a)
bp (cfold b)) bp (cfoldD b))
(my-match ap (my-match ap
('VL s t) (my-match bp ('VL s t) (my-match bp
('VL m n) (list 'VL (+ s m) 0) ('VL m n) (list 'VL (+ s m) 0)
@@ -60,8 +60,8 @@
ep (list 'A ap bp) ep (list 'A ap bp)
) )
) )
('M c d) (letn (cp (cfold c) ('M c d) (letn (cp (cfoldD c)
dp (cfold dec)) dp (cfoldD dec))
(my-match cp (my-match cp
('VL s t) (my-match dp ('VL s t) (my-match dp
('VL m n) (list 'VL (* s m) 0) ('VL m n) (list 'VL (* s m) 0)
@@ -74,13 +74,13 @@
) )
e e)) e e))
(define (eval e) (my-match e (define (evalD e) (my-match e
('VR a b) 0 ('VR a b) 0
('VL c d) c ('VL c d) c
('A e f) (+ (eval e) (eval f)) ('A e f) (+ (evalD e) (evalD f))
('M l r) (* (eval l) (eval r)))) ('M l r) (* (evalD l) (evalD r))))
(println (eval (cfold (reassoc (mk-expr (integer (main-args 2)) 1))))) (println (evalD (cfoldD (reassoc (mk-expr (integer (main-args 2)) 1)))))
(exit) (exit)

2
koka_bench/newlisp/newlisp-slow-fexpr-deriv.nl
View File

@@ -79,7 +79,7 @@
('A f g) (+ (countD f) (countD g)) ('A f g) (+ (countD f) (countD g))
('M f g) (+ (countD f) (countD g)) ('M f g) (+ (countD f) (countD g))
('P f g) (+ (countD f) (countD g)) ('P f g) (+ (countD f) (countD g))
('L f g) (countD f)))) ('L f g) (countD f)))
(define (nest-aux s f n x) (cond ((= n 0) x) (define (nest-aux s f n x) (cond ((= n 0) x)
(true (nest-aux s f (- n 1) (f (- s n) x))))) (true (nest-aux s f (- n 1) (f (- s n) x)))))

12
koka_bench/newlisp/newlisp-slow-fexpr-nqueens.nl
View File

@@ -29,4 +29,16 @@
(true '((true ("none matched")))))) (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-macro (my-match x) (eval (list let (list '__MATCH_SYM x) (cons cond (my-match-helper '__MATCH_SYM (args) 0)))))
(define (safe q d xs) ())
(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) (exit)