From 50fd3f34cb5fa2cdea480a299fc649c7817b14ec Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 2 Feb 2022 14:26:52 -0500 Subject: Fix some broken things --- bs/core.scm | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) (limited to 'bs') diff --git a/bs/core.scm b/bs/core.scm index 61ee8cc..943e586 100644 --- a/bs/core.scm +++ b/bs/core.scm @@ -3,12 +3,17 @@ #:use-module ((system vm program)) #:use-module ((ice-9 rdelim) #:select (read-line)) #:use-module (srfi srfi-1) - #:export (fmt printf pr prn rest last butlast + #:export (fmt printf pr prn + first ffirst rest last butlast true? false? some? empty? -> ->> fn /. curry comp repeat for seq turn + range .. inc dec member? contains? - comment get-source* get-source source)) + comment + ;; obsolete, use (ice-9 session) instead + ;; get-source* get-source source + )) (define (flip f) (lambda (x y) (f y x))) (define (curry f a) (lambda (b) (apply f (cons a (list b))))) @@ -54,6 +59,9 @@ (define (empty? a) (equal? a '())) +(define (first a) + (car a)) + (define (ffirst a) (first (first a))) @@ -148,6 +156,11 @@ [(_ (binding value) body ...) (when binding body ...)])) +(define (range min max step) + (if (< min max) + (cons min (range (+ min step) max step)) + '())) + ;; range operator from http://www.mattknox.com/code.html (define (.. l h . s) (let* ((step (if (null? s) 1 (car s)))) @@ -155,6 +168,13 @@ (range l h step) (reverse (range h l step))))) +(define (! n) + (define (fact n a) + (if (< n 2) + a + (fact (- n 1) (* a n)))) + (fact n 1)) + ;; source utils @@ -163,6 +183,8 @@ ((zero? n) port) (else (read-line port) (skip-lines port (1- n))))) +;; NOTE: this source-lookup code might be obsolete, see (ice-9 session) + (define (get-source* source pname) (let* ([file (source:file source)] [filename (any (fn (x) -- cgit v1.2.3