A categorical programming language
| リビジョン | 9e2117fa3082abbb63bef99824bc7007c7307b9a (tree) |
|---|---|
| 日時 | 2023-01-25 12:16:19 |
| 作者 | Corbin <cds@corb...> |
| コミッター | Corbin |
Use a faster sorting routine.
SRFI-132 replaces SRFI-1's quadratic-time approach with a good old
O(n lg n) approach.
movelist/cammy-repl.scm (diff) movelist/cammyo.scm (diff) movelist/default.nix (diff) movelist/eggs.nix (diff) movelist/eggs.scm (diff)| @@ -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 |
Fork