• R/O
  • HTTP
  • SSH
  • HTTPS

提交

标签
No Tags

Frequently used words (click to add to your profile)

javac++androidlinuxc#windowsobjective-ccocoa誰得qtpythonphprubygameguibathyscaphec計画中(planning stage)翻訳omegatframeworktwitterdomtestvb.netdirectxゲームエンジンbtronarduinopreviewer

A categorical programming language


Commit MetaInfo

修订版b79c5ebb049c3faa59ab38748214eac30d6067e0 (tree)
时间2023-09-26 10:46:18
作者Corbin <cds@corb...>
CommiterCorbin

Log Message

Successfully insert and fetch a nested AST.

What is left before making a blog post? Probably trails and names, at
least. Modules can wait. Laws can wait. Jets are important, but can be
added later.

更改概述

差异

--- a/bk/bk.scm
+++ b/bk/bk.scm
@@ -1,7 +1,8 @@
11 (import scheme
22 (chicken blob)
33 (chicken process-context)
4- srfi-1
4+ (srfi 1)
5+ (only (srfi 95) sort)
56 (only matchable match match-lambda)
67 (git))
78
@@ -23,8 +24,27 @@
2324
2425 (define (bk-insert path expr)
2526 (let ((repo (repository-open (symbol->string path))))
26- (print ((insert-tree repo) expr))))
27+ (print (oid->string ((insert-tree repo) expr)))))
28+
29+(define ((fetch-tree repo) obj)
30+ (match (object-type obj)
31+ ['blob (string->symbol (blob->string (blob-content obj)))]
32+ ['tree (let* ((roots (filter
33+ (lambda (p) (= 0 (string-length (car p))))
34+ (tree-entries obj)))
35+ (tes (map cdr roots))
36+ (sorted (sort tes string<? tree-entry-name)))
37+ (map
38+ (lambda (te) ((fetch-tree repo)
39+ (tree-entry->object repo te)))
40+ sorted))]))
41+
42+(define (bk-fetch path hash)
43+ (let* ((repo (repository-open (symbol->string path)))
44+ (obj (repository-ref repo (string->oid hash))))
45+ (print ((fetch-tree repo) obj))))
2746
2847 (match (map (lambda (s) (read (open-input-string s)))
2948 (command-line-arguments))
30- [('insert path expr) (bk-insert path expr)])
49+ [('insert path expr) (bk-insert path expr)]
50+ [('fetch path hash) (bk-fetch path (symbol->string hash))])
--- a/bk/default.nix
+++ b/bk/default.nix
@@ -16,6 +16,20 @@ in pkgs.stdenv.mkDerivation {
1616 pkgs.chicken
1717 ] ++ (with eggs; [
1818 srfi-1 matchable
19+ (srfi-95.overrideAttrs (attrs: rec {
20+ prePatch = ''
21+ rm Makefile
22+ '';
23+ buildInputs = attrs.buildInputs ++ (with eggs; [
24+ test
25+ ]);
26+ preBuild = ''
27+ export HOME=$(pwd)
28+ '';
29+ preInstall = ''
30+ export HOME=$(pwd)
31+ '';
32+ }))
1933 (git.overrideAttrs (attrs: {
2034 prePatch = ''
2135 sed -i -e '/asize/d' libgit2.scm
--- a/bk/eggs.nix
+++ b/bk/eggs.nix
@@ -59,6 +59,20 @@ rec {
5959 ];
6060 };
6161
62+ records = eggDerivation {
63+ name = "records-1.4";
64+
65+ src = fetchegg {
66+ name = "records";
67+ version = "1.4";
68+ sha256 = "187fsi0kb50vwc64fn4ijb5q3jfyyn95bn9v6hqp4xfjfic9fll9";
69+ };
70+
71+ buildInputs = [
72+ srfi-1
73+ ];
74+ };
75+
6276 srfi-1 = eggDerivation {
6377 name = "srfi-1-0.5.1";
6478
@@ -73,6 +87,20 @@ rec {
7387 ];
7488 };
7589
90+ srfi-63 = eggDerivation {
91+ name = "srfi-63-0.5";
92+
93+ src = fetchegg {
94+ name = "srfi-63";
95+ version = "0.5";
96+ sha256 = "0db3vfac2p2zfmnw0m3gcixq4zyp60dil6gpwhh4nybkw1m14jv7";
97+ };
98+
99+ buildInputs = [
100+ records
101+ ];
102+ };
103+
76104 srfi-69 = eggDerivation {
77105 name = "srfi-69-0.4.3";
78106
@@ -87,6 +115,20 @@ rec {
87115 ];
88116 };
89117
118+ srfi-95 = eggDerivation {
119+ name = "srfi-95-2.0";
120+
121+ src = fetchegg {
122+ name = "srfi-95";
123+ version = "2.0";
124+ sha256 = "150jmcb5c48j66sl2pk0nh3v0r8li57qipq22zg8br2bgf40wrqi";
125+ };
126+
127+ buildInputs = [
128+ srfi-63
129+ ];
130+ };
131+
90132 test = eggDerivation {
91133 name = "test-1.2";
92134
--- a/bk/eggs.scm
+++ b/bk/eggs.scm
@@ -1,4 +1,5 @@
11 srfi-1
2+srfi-95
23 matchable
34 ; git requires a bunch of stuff not handled by egg2nix
45 git
--- a/flake.nix
+++ b/flake.nix
@@ -44,7 +44,7 @@
4444 };
4545 in {
4646 packages = {
47- inherit jelly movelist sampler;
47+ inherit jelly movelist sampler bk;
4848 default = cammy;
4949 };
5050 devShells.default = pkgs.mkShell {