├── .github ├── FUNDING.yml └── workflows │ └── check.yml ├── .gitignore ├── Makefile.in ├── README.md ├── compat └── sicp.scm ├── configure ├── package.scm └── test.scm /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: shirok 2 | -------------------------------------------------------------------------------- /.github/workflows/check.yml: -------------------------------------------------------------------------------- 1 | name: Build and test 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | build-and-test: 7 | runs-on: ubuntu-latest 8 | timeout-minutes: 10 9 | steps: 10 | - uses: actions/checkout@v3 11 | - uses: practical-scheme/setup-gauche@v5 12 | with: 13 | prebuilt-binary: true 14 | - name: Build and check 15 | run: | 16 | ./configure 17 | make 18 | make -s check 19 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.gpd 2 | Makefile 3 | VERSION 4 | *.log 5 | -------------------------------------------------------------------------------- /Makefile.in: -------------------------------------------------------------------------------- 1 | # General info 2 | SHELL = @SHELL@ 3 | prefix = @prefix@ 4 | exec_prefix = @exec_prefix@ 5 | bindir = @bindir@ 6 | libdir = @libdir@ 7 | datadir = @datadir@ 8 | datarootdir = @datarootdir@ 9 | srcdir = @srcdir@ 10 | VPATH = $(srcdir) 11 | 12 | # These may be overridden by make invocators 13 | DESTDIR = 14 | GOSH = "@GOSH@" 15 | GAUCHE_CONFIG = "@GAUCHE_CONFIG@" 16 | GAUCHE_PACKAGE = "@GAUCHE_PACKAGE@" 17 | INSTALL = "@GAUCHE_INSTALL@" -C 18 | 19 | # Other parameters 20 | SOEXT = @SOEXT@ 21 | OBJEXT = @OBJEXT@ 22 | EXEEXT = @EXEEXT@ 23 | LOCAL_PATHS = "@LOCAL_PATHS@" 24 | 25 | # Module-specific stuff 26 | PACKAGE = Gauche-compat-sicp 27 | 28 | ARCHFILES = 29 | SCMFILES = $(srcdir)/compat/sicp.scm 30 | HEADERS = 31 | 32 | TARGET = $(ARCHFILES) 33 | GENERATED = 34 | CONFIG_GENERATED = Makefile config.cache config.log config.status \ 35 | configure.lineno autom4te*.cache $(PACKAGE).gpd 36 | 37 | GAUCHE_PKGINCDIR = "$(DESTDIR)@GAUCHE_PKGINCDIR@" 38 | GAUCHE_PKGLIBDIR = "$(DESTDIR)@GAUCHE_PKGLIBDIR@" 39 | GAUCHE_PKGARCHDIR = "$(DESTDIR)@GAUCHE_PKGARCHDIR@" 40 | 41 | all : $(TARGET) 42 | 43 | check : all 44 | @rm -f test.log 45 | $(GOSH) -I. -I$(srcdir) $(srcdir)/test.scm > test.log 46 | 47 | install : all 48 | $(INSTALL) -m 444 -T $(GAUCHE_PKGINCDIR) $(HEADERS) 49 | $(INSTALL) -m 444 -T $(GAUCHE_PKGLIBDIR) $(SCMFILES) 50 | $(INSTALL) -m 555 -T $(GAUCHE_PKGARCHDIR) $(ARCHFILES) 51 | $(INSTALL) -m 444 -T $(GAUCHE_PKGLIBDIR)/.packages $(PACKAGE).gpd 52 | 53 | uninstall : 54 | $(INSTALL) -U $(GAUCHE_PKGINCDIR) $(HEADERS) 55 | $(INSTALL) -U $(GAUCHE_PKGLIBDIR) $(SCMFILES) 56 | $(INSTALL) -U $(GAUCHE_PKGARCHDIR) $(ARCHFILES) 57 | $(INSTALL) -U $(GAUCHE_PKGLIBDIR)/.packages $(PACKAGE).gpd 58 | 59 | clean : 60 | $(GAUCHE_PACKAGE) compile --clean compat_sicp $(compat_sicp_SRCS) 61 | rm -rf core $(TARGET) $(GENERATED) *~ test.log so_locations 62 | 63 | distclean : clean 64 | rm -rf $(CONFIG_GENERATED) 65 | 66 | maintainer-clean : clean 67 | rm -rf $(CONFIG_GENERATED) VERSION 68 | 69 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Provide minimum set of compatibility features required to run 2 | code in SICP. 3 | 4 | This is a sort of "backburner" project---there's not much yet. 5 | Whatever you found missing, send PR. 6 | 7 | Once we get enough meat, I'll bundle this to the Gauche distribution. 8 | 9 | # How to use 10 | 11 | Clone the repo, or download zip and extract. Then: 12 | 13 | $ ./configure 14 | $ make install 15 | 16 | Now, in gosh prompt or Gauche script you can use `compat.sicp`: 17 | 18 | gosh> (use compat.sicp) 19 | -------------------------------------------------------------------------------- /compat/sicp.scm: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; compat.sicp - some compatibility routines for those learning SICP 3 | ;;; 4 | 5 | (define-module compat.sicp 6 | (use srfi.27) 7 | (use control.pmap) 8 | (use gauche.threads) 9 | (export nil runtime true random false get put get-coercion put-coercion 10 | parallel-execute test-and-set! 11 | cons-stream the-empty-stream stream-null? 12 | user-initial-environment extend)) 13 | (select-module compat.sicp) 14 | 15 | ;; This doesn't make nil as a boolean false, but in SICP nil is exclusively 16 | ;; used to denote an empty list, so it's ok. 17 | (define nil '()) 18 | 19 | ;; Exercise 1.22 20 | (define (runtime) 21 | (round->exact (* (expt 10 6) 22 | (time->seconds (current-time))))) 23 | 24 | ;; Section 1.2 25 | ;; random returns inexact number when the arg is inexact (per SRFI-216) 26 | (define true #t) 27 | (define (random n) 28 | (assume-type n ) 29 | (assume (> n 0)) 30 | (if (exact-integer? n) 31 | (random-integer n) 32 | (inexact (random-integer (ceiling->exact n))))) 33 | 34 | ;; Section 2.3 35 | ;; Boolean false 36 | (define false #f) 37 | 38 | ;; Section 2.4 39 | ;; Symbol properties - a naive implementation 40 | (define *properties* (make-hash-table 'eq?)) 41 | 42 | (define (put op type item) 43 | (hash-table-update! *properties* op (^p (assoc-set! p type item)) '())) 44 | (define (get op type) 45 | (assoc-ref (hash-table-get *properties* op '()) type #f)) 46 | 47 | ;; Section 2.5 48 | 49 | (define *coercions* (make-hash-table 'equal?)) 50 | 51 | (define (put-coercion from to proc) 52 | (hash-table-put! *coercions* (cons from to) proc)) 53 | (define (get-coercion from to) 54 | (hash-table-get *coercions* (cons from to) #f)) 55 | 56 | ;; Section 3.4.2 57 | (define (parallel-execute thunk1 . thunks) 58 | (pmap (^p (p)) (cons thunk1 thunks) (make-fully-concurrent-mapper)) 59 | (undefined)) 60 | 61 | (define *global-lock* (make-mutex)) ;for test-and-set! 62 | 63 | (define (test-and-set! cell) 64 | (assume cell ) 65 | (with-locking-mutex *global-lock* 66 | (^[] (if (car cell) 67 | #t 68 | (begin (set! (car cell) #t) #f))))) 69 | 70 | ;; Section 3.5.1 71 | 72 | (define-syntax cons-stream 73 | (syntax-rules () 74 | [(_ a d) (cons a (delay d))])) 75 | 76 | (define the-empty-stream '#:the-empty-stream) 77 | (define (stream-null? obj) (eq? obj the-empty-stream)) 78 | 79 | ;; Section 4.1.5 80 | (define user-initial-environment (interaction-environment)) 81 | 82 | ;; Section 4.4.4 83 | ;; 'Extend' is bound to a syntax in Gauche's default environment, which 84 | ;; may interfere with extend-if-consistent code; unless the user defines 85 | ;; their own extend first, the compiler refers to the Gauche's extend and 86 | ;; raises an error. We export a dummy 'extend' binding so that 87 | ;; the user won't be confused. 88 | (define extend list) 89 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env gosh 2 | ;; Configuring Gauche-compat-sicp 3 | ;; Run ./configure (or gosh ./configure) to generate Makefiles. 4 | 5 | (use gauche.configure) 6 | (cf-init-gauche-extension) 7 | (cf-output-default) 8 | 9 | ;; Local variables: 10 | ;; mode: scheme 11 | ;; end: 12 | -------------------------------------------------------------------------------- /package.scm: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Gauche-compat-sicp package description 3 | ;; 4 | 5 | (define-gauche-package "Gauche-compat-sicp" 6 | :repository "https://github.com/practical-scheme/Gauche-compat-sicp.git" 7 | :version "1.1" 8 | :description "Compatibility module to run SICP exercises\n\ 9 | This packages adds several primitives assumed by SICP\n\ 10 | excercises." 11 | :require (("Gauche" (>= "0.9.12"))) 12 | :providing-modules (compat.sicp) 13 | :authors ("Shiro Kawai ") 14 | :maintainers () 15 | :licenses ("BSD") 16 | :homepage "https://practical-scheme.net/gauche" 17 | ) 18 | -------------------------------------------------------------------------------- /test.scm: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Test compat.sicp 3 | ;;; 4 | 5 | (use gauche.test) 6 | 7 | (test-start "compat.sicp") 8 | (use compat.sicp) 9 | (test-module 'compat.sicp) 10 | 11 | (test-end :exit-on-failure #t) 12 | --------------------------------------------------------------------------------