提交: b79c5ebb049c3faa59ab38748214eac30d6067e0 - cammy (git)

A categorical programming language

Commit MetaInfo

• 修訂: b79c5ebb049c3faa59ab38748214eac30d6067e0 (tree)
• 時間: 2023-09-26 10:46:18
• 作者: Corbin <cds@corb...>
• Commiter: Corbin

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.

Change Summary

• modified: bk/bk.scm
• modified: bk/default.nix
• modified: bk/eggs.nix
• modified: bk/eggs.scm
• modified: flake.nix

差異

--- a/bk/bk.scm
+++ b/bk/bk.scm
@@ -1,7 +1,8 @@
 (import scheme
         (chicken blob)
         (chicken process-context)
-        srfi-1
+        (srfi 1)
+        (only (srfi 95) sort)
         (only matchable match match-lambda)
         (git))
 
@@ -23,8 +24,27 @@
 
 (define (bk-insert path expr)
   (let ((repo (repository-open (symbol->string path))))
-    (print ((insert-tree repo) expr))))
+    (print (oid->string ((insert-tree repo) expr)))))
+
+(define ((fetch-tree repo) obj)
+  (match (object-type obj)
+         ['blob (string->symbol (blob->string (blob-content obj)))]
+         ['tree (let* ((roots (filter
+                                (lambda (p) (= 0 (string-length (car p))))
+                                (tree-entries obj)))
+                       (tes (map cdr roots))
+                       (sorted (sort tes string<? tree-entry-name)))
+                  (map
+                    (lambda (te) ((fetch-tree repo)
+                                  (tree-entry->object repo te)))
+                    sorted))]))
+
+(define (bk-fetch path hash)
+  (let* ((repo (repository-open (symbol->string path)))
+         (obj (repository-ref repo (string->oid hash))))
+    (print ((fetch-tree repo) obj))))
 
 (match (map (lambda (s) (read (open-input-string s)))
             (command-line-arguments))
-       [('insert path expr) (bk-insert path expr)])
+       [('insert path expr) (bk-insert path expr)]
+       [('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 {
     pkgs.chicken
   ] ++ (with eggs; [
     srfi-1 matchable
+    (srfi-95.overrideAttrs (attrs: rec {
+      prePatch = ''
+        rm Makefile
+      '';
+      buildInputs = attrs.buildInputs ++ (with eggs; [
+        test
+      ]);
+      preBuild = ''
+        export HOME=$(pwd)
+      '';
+      preInstall = ''
+        export HOME=$(pwd)
+      '';
+    }))
     (git.overrideAttrs (attrs: {
       prePatch = ''
         sed -i -e '/asize/d' libgit2.scm

--- a/bk/eggs.nix
+++ b/bk/eggs.nix
@@ -59,6 +59,20 @@ rec {
     ];
   };
 
+  records = eggDerivation {
+    name = "records-1.4";
+
+    src = fetchegg {
+      name = "records";
+      version = "1.4";
+      sha256 = "187fsi0kb50vwc64fn4ijb5q3jfyyn95bn9v6hqp4xfjfic9fll9";
+    };
+
+    buildInputs = [
+      srfi-1
+    ];
+  };
+
   srfi-1 = eggDerivation {
     name = "srfi-1-0.5.1";
 
@@ -73,6 +87,20 @@ rec {
     ];
   };
 
+  srfi-63 = eggDerivation {
+    name = "srfi-63-0.5";
+
+    src = fetchegg {
+      name = "srfi-63";
+      version = "0.5";
+      sha256 = "0db3vfac2p2zfmnw0m3gcixq4zyp60dil6gpwhh4nybkw1m14jv7";
+    };
+
+    buildInputs = [
+      records
+    ];
+  };
+
   srfi-69 = eggDerivation {
     name = "srfi-69-0.4.3";
 
@@ -87,6 +115,20 @@ rec {
     ];
   };
 
+  srfi-95 = eggDerivation {
+    name = "srfi-95-2.0";
+
+    src = fetchegg {
+      name = "srfi-95";
+      version = "2.0";
+      sha256 = "150jmcb5c48j66sl2pk0nh3v0r8li57qipq22zg8br2bgf40wrqi";
+    };
+
+    buildInputs = [
+      srfi-63
+    ];
+  };
+
   test = eggDerivation {
     name = "test-1.2";
 

--- a/bk/eggs.scm
+++ b/bk/eggs.scm
@@ -1,4 +1,5 @@
 srfi-1
+srfi-95
 matchable
 ; git requires a bunch of stuff not handled by egg2nix
 git

--- a/flake.nix
+++ b/flake.nix
@@ -44,7 +44,7 @@
         };
       in {
         packages = {
-          inherit jelly movelist sampler;
+          inherit jelly movelist sampler bk;
           default = cammy;
         };
         devShells.default = pkgs.mkShell {