/src/boot/larceny/larceny.scm

 1
 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3
 4(import (rnrs)
 5        (err5rs load)
 6        (primitives current-directory))
 7
 8(import (srfi :1))
 9
10;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11
12(define scheme-implementation 'larceny)
13
14;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15
16(define (print . elts) (for-each display elts))
17
18;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19
20(define *roots* #f)
21
22(define *loaded* '())
23
24(define *included* '())
25
26;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27
28(define (directory-contains file)
29  (lambda (dir)
30    (file-exists?
31     (string-append dir "/" file))))
32
33;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34
35(define (resolve lib)
36  (let ((root (find (directory-contains lib) *roots*)))
37    (if root (string-append root "/" lib) #f)))
38
39;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40
41(define (load-lib lib)
42  
43  (let ((dir (resolve lib)))
44
45    (let ((import-file (string-append dir "/import")))
46
47      (if (file-exists? import-file)
48        
49          (let ((import-list (call-with-input-file import-file read)))
50
51            (for-each require-lib import-list))))
52
53    (let ((include-file (string-append dir "/include")))
54
55      (if (file-exists? include-file)
56        
57          (let ((include-list (call-with-input-file include-file read)))
58
59            (for-each require-lib include-list))))
60
61    (load (string-append dir "/source.scm"))))
62
63;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
64
65(define (require-lib dir)
66  (cond ((not (member dir *loaded*))
67         (print "Loading lib " dir "\n")
68         (load-lib dir)
69         (set! *loaded* (cons dir *loaded*)))))
70
71;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
72
73(load "src/boot/boot.scm")
74
75;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
76
77(define inexact->exact exact)
78
79(define exact->inexact inexact)
80
81(import (primitives modulo))
82
83;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
84
85(import (primitives time))
86
87;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
88
89(import (srfi :19))
90
91(define (current-time-in-nanoseconds)
92  (let ((val (current-time)))
93    (+ (* (time-second val) 1000000000)
94       (time-nanosecond val))))
95
96;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
97
98(print "Abstracting is loaded\n")