A categorical programming language
Revisión | 9e2117fa3082abbb63bef99824bc7007c7307b9a (tree) |
---|---|
Tiempo | 2023-01-25 12:16:19 |
Autor | Corbin <cds@corb...> |
Commiter | Corbin |
Use a faster sorting routine.
SRFI-132 replaces SRFI-1's quadratic-time approach with a good old
O(n lg n) approach.
@@ -1,4 +1,4 @@ | ||
1 | -(import (srfi-1)) | |
1 | +(import (srfi-132)) | |
2 | 2 | (import (chicken pretty-print)) |
3 | 3 | (import (chicken time)) |
4 | 4 | (import (matchable)) |
@@ -39,7 +39,7 @@ | ||
39 | 39 | (match ty |
40 | 40 | ['1 "*"] |
41 | 41 | ['2 (if elt "true" "false")] |
42 | - ['N (if (nat? elt) (little-endian->number elt) "…")] | |
42 | + ['N (if (nat? elt) (number->string (little-endian->number elt)) "…")] | |
43 | 43 | [`(pair ,f ,g) |
44 | 44 | (string-append "(" (elt->str f (car elt)) ", " (elt->str g (cdr elt)) ")")] |
45 | 45 | [t elt])) |
@@ -69,7 +69,9 @@ | ||
69 | 69 | |
70 | 70 | ; need the type to display the value properly |
71 | 71 | (define (packs->strs ps) |
72 | - (delete-duplicates (map (lambda (q) (elt->str (car q) (cdr q))) ps))) | |
72 | + (list-delete-neighbor-dups | |
73 | + string=? | |
74 | + (list-sort string<? (map (lambda (q) (elt->str (car q) (cdr q))) ps)))) | |
73 | 75 | |
74 | 76 | (define (cammy-image expr) |
75 | 77 | (time |
@@ -187,6 +187,7 @@ | ||
187 | 187 | ((== expr 'fst) (caro i o)) |
188 | 188 | ((== expr 'snd) (cdro i o)) |
189 | 189 | ((== expr 'dup) (conso i i o)) |
190 | + ((== expr 'swap) (fresh (p1 p2) (conso p1 p2 i) (conso p2 p1 o))) | |
190 | 191 | ((fresh (f g o1 o2) (== expr `(pair ,f ,g)) (conso o1 o2 o) |
191 | 192 | (eval° f i o1) (eval° g i o2))) |
192 | 193 | ((== expr 't) (== i 'star) (== o #t)) |
@@ -196,5 +197,6 @@ | ||
196 | 197 | ((== expr 'zero) (== i 'star) (zeroo o)) |
197 | 198 | ((== expr 'succ) (succ° i o)) |
198 | 199 | ((fresh (f g) (== expr `(pr ,f ,g)) (pr° f g i o))) |
200 | + ((== expr 'n-add) (fresh (i1 i2) (conso i1 i2 i) (+o i1 i2 o))) | |
199 | 201 | )) |
200 | 202 | ) |
@@ -12,7 +12,7 @@ in pkgs.stdenv.mkDerivation { | ||
12 | 12 | buildInputs = [ |
13 | 13 | pkgs.chicken |
14 | 14 | ] ++ (with eggs; [ |
15 | - matchable mini-kanren | |
15 | + srfi-132 matchable mini-kanren | |
16 | 16 | ]); |
17 | 17 | |
18 | 18 | src = ./.; |
@@ -43,5 +43,33 @@ rec { | ||
43 | 43 | |
44 | 44 | ]; |
45 | 45 | }; |
46 | + | |
47 | + srfi-132 = eggDerivation { | |
48 | + name = "srfi-132-1.0.0"; | |
49 | + | |
50 | + src = fetchegg { | |
51 | + name = "srfi-132"; | |
52 | + version = "1.0.0"; | |
53 | + sha256 = "1id6kdf7ydf97bvc5xjnp4bz8q324mqfc656d96rdpcqn2sqkdfh"; | |
54 | + }; | |
55 | + | |
56 | + buildInputs = [ | |
57 | + srfi-133 | |
58 | + ]; | |
59 | + }; | |
60 | + | |
61 | + srfi-133 = eggDerivation { | |
62 | + name = "srfi-133-1.6.1"; | |
63 | + | |
64 | + src = fetchegg { | |
65 | + name = "srfi-133"; | |
66 | + version = "1.6.1"; | |
67 | + sha256 = "0c13cnb8v4p1mmi8rj9kgay9vq6n7vq9xxz4qprh265x1f3q4ikm"; | |
68 | + }; | |
69 | + | |
70 | + buildInputs = [ | |
71 | + | |
72 | + ]; | |
73 | + }; | |
46 | 74 | } |
47 | 75 |
@@ -1,2 +1,3 @@ | ||
1 | 1 | matchable |
2 | 2 | mini-kanren |
3 | +srfi-132 |