Rewrite main.scm so it does not read the whole wordlist at once

This commit is contained in:
heyarne 2022-07-08 16:40:09 +02:00
commit 39cbc34e18
3 changed files with 46 additions and 33 deletions

3
.envrc
View file

@ -1 +1,4 @@
use flake
export CHICKEN_REPOSITORY_PATH="$(pwd)/.eggs"
export CHICKEN_INSTALL_REPOSITORY="$(pwd)/.eggs"

View file

@ -30,28 +30,32 @@
};
in {
devShells.default = pkgs.mkShell rec {
buildInputs = [
lua
# fennel
pkgs.chicken
# pkgs.guile_3_0
# pkgs.gcc
# pkgs.gambit
buildInputs = with pkgs; [
chicken
openssl
gcc
];
LD_LIBRARY_PATH = "${lib.makeLibraryPath buildInputs}";
};
packages.default = pkgs.mkDerivation rec {
buildInputs = [
pkgs.chicken
# pkgs.guile_3_0
pkgs.gcc
pkgs.gambit
packages.default = pkgs.stdenv.mkDerivation rec {
name = "seizethemeans";
src = ./.;
buildInputs = with pkgs; [
chicken
openssl
gcc
];
buildPhase = ''
chicken ./main.scm -explicit-use
gcc
'';
installPhase = ''
mkdir -p $out/bin
cp main $out/bin/seize-the-means
'';
LD_LIBRARY_PATH = "${lib.makeLibraryPath buildInputs}";
};

View file

@ -1,34 +1,40 @@
(import (chicken io)
(import (chicken condition)
(chicken io)
(chicken process-context)
(chicken random)
(chicken format))
(define *api-url* (get-environment-variable "MASTODON_API_URL"))
(define *access-token* (get-environment-variable "MASTODON_ACCESS_TOKEN"))
(define file "./words.txt")
(define (file-lines file-path)
(define (file-num-lines file-path)
(let ((file (open-input-file file-path)))
(let loop ((lines '())
(cur (read-line file)))
(if (eof-object? cur)
(let loop ((num-lines 0))
(if (eof-object? (read-line file))
(begin (close-input-port file)
(reverse lines))
(loop (cons cur lines)
(read-line file))))))
num-lines)
(loop (+ 1 num-lines))))))
(define lines (file-lines "./words.txt"))
(define (file-line-at file-path n)
(let ((file (open-input-file file-path)))
(let loop ((m 0)
(cur (read-line file)))
(cond
((= m n)
(begin
(close-input-port file)
cur))
(define (list-nth ls n)
(if (zero? n)
(car ls)
(list-nth (cdr ls) (- n 1))))
((eof-object? cur)
(begin
(close-input-port file)
(signal (format "~s is greater than the number of lines in ~s" n file-path))))
(else (loop (+ 1 m) (read-line file)))))))
(define (list-remove-nth ls n)
(if (zero? n)
(cdr ls)
(cons (car ls) (list-remove-nth (cdr ls) (- n 1)))))
(let ((nth (pseudo-random-integer (length lines))))
(let* ((n (pseudo-random-integer (file-num-lines file)))
(line (file-line-at file n)))
(display "Seize the means of ")
(display (list-nth lines nth))
(display line)
(display "\n"))