suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

still fixing module imports

Browse Source
This commit is contained in:
Danny Yoo 2011-05-22 20:16:31 -04:00
parent 08b5273a9b
commit 28585e3eb0
8 changed files with 94 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
bootstrapped-primitives.rkt
View File

@ -4,11 +4,13 @@
"il-structs.rkt"
"compiler.rkt"
"compiler-structs.rkt"
"typed-parse.rkt")
"typed-parse.rkt"
"where-is-collects.rkt")
(require/typed "parameters.rkt"
(current-defined-name (Parameterof (U Symbol LamPositionalName))))
(require/typed "parse-bytecode.rkt"
(parse-bytecode (Path -> Expression)))
@ -17,6 +19,17 @@
;; We'll hardcode the compilation of some Racket modules here.
(: hardcoded-modules-to-compile (Listof Path))
(define hardcoded-modules-to-compile
(list
(build-path collects-path "racket" "private" "modbeg.rkt")
))
;; The primitive code necessary to do call/cc
(: call/cc-label Symbol)
@ -85,7 +98,16 @@
(define (get-bootstrapping-code)
(append
;; module code
(apply append (map (lambda: ([p : Path])
(compile (parse-bytecode p)
'val
next-linkage/drop-multiple))
hardcoded-modules-to-compile))
;; Other primitives
(make-bootstrapped-primitive-code
'map
'(letrec ([map (lambda (f l)

4
kernel-primitives.rkt
View File

@ -60,6 +60,10 @@
'call-with-values
'apply
'printf
'map
'for-each
'current-print
))
(define-predicate KernelPrimitiveName? KernelPrimitiveName)

25
parse-bytecode.rkt
View File

@ -1,11 +1,32 @@
#lang racket/base
(require "version-case/version-case.rkt"
racket/file
(prefix-in whalesong: "version.rkt")
(for-syntax racket/base))
(version-case
[(version>= (version) "5.1.1")
(begin
(require "parse-bytecode-5.1.1.rkt")
(provide (all-from-out "parse-bytecode-5.1.1.rkt")))]
(provide (except-out (all-from-out "parse-bytecode-5.1.1.rkt")
parse-bytecode)))]
[else
(error 'parse-bytecode "Whalesong doesn't have a compatible parser for Racket ~a" (version))])
(error 'parse-bytecode "Whalesong doesn't have a compatible parser for Racket ~a" (version))])
(provide (rename-out [my-parse-bytecode parse-bytecode]))
(define (my-parse-bytecode x)
(cond
[(path? x)
(parse-bytecode x)]
[else
(parse-bytecode x)]))
(define cache-dir (build-path (find-system-path 'pref-dir)
"whalesong"
whalesong:version))
(unless (directory-exists? cache-dir)
(make-directory* cache-dir))

17
path-rewriter.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require "parameters.rkt"
"where-is-collects.rkt"
racket/path
racket/contract
racket/list
@ -34,7 +35,7 @@
(string->symbol
(string-append "collects/"
(path->string
(find-relative-path collects a-path))))]
(find-relative-path collects-path a-path))))]
[(within-this-project-path? a-path)
(string->symbol
(string-append "whalesong/"
@ -49,24 +50,14 @@
#f])))
(define collects
(normalize-path
(let ([p (find-system-path 'collects-dir)])
(cond
[(relative-path? p)
(find-executable-path (find-system-path 'exec-file)
(find-system-path 'collects-dir))]
[else
p]))))
(define (within-root? a-path)
(within? (current-root-path) a-path))
(define (within-collects? a-path)
(within? collects a-path))
(within? collects-path a-path))
(define (within-this-project-path? a-path)

3
simulator/simulator.rkt
View File

@ -453,6 +453,9 @@
[(InstallModuleEntry!? op)
(printf "installing module ~s\n"
(ModuleName-name
(InstallModuleEntry!-path op)))
(hash-set! (machine-modules m)
(ModuleName-name (InstallModuleEntry!-path op))
(make-module-record (InstallModuleEntry!-name op)

23
tests/test-compiler.rkt
View File

@ -3,7 +3,11 @@
(require "../simulator/simulator.rkt"
"../simulator/simulator-structs.rkt"
"../simulator/simulator-helpers.rkt"
"test-helpers.rkt")
"../parameters.rkt"
"test-helpers.rkt"
racket/runtime-path)
(define-runtime-path this-test-path ".")
@ -1335,11 +1339,12 @@
#:with-bootstrapping? #t)
(test '(module foo racket/base
(printf "hello world"))
(make-undefined)
#:as-main-module 'foo)
(parameterize ([current-module-path (build-path this-test-path "foo.rkt")])
(test '(module foo racket/base
(printf "hello world"))
(make-undefined)
#:as-main-module 'whalesong/tests/foo.rkt
#:with-bootstrapping? #t))
@ -1347,7 +1352,7 @@
;; begin0 is still broken.
#;(test '(letrec ([f (lambda (x)
(test '(letrec ([f (lambda (x)
(if (= x 0)
0
(+ x (f (sub1 x)))))])
@ -1357,14 +1362,14 @@
#;(test '(let () (define (f x y z)
(test '(let () (define (f x y z)
(values y x z))
(call-with-values (lambda () (f 3 1 4))
(lambda args (list args))))
'((1 3 4))
#:with-bootstrapping? #t)
#;(test '(let () (define (f x y z)
(test '(let () (define (f x y z)
(begin0 (values y x z)
(display "")))
(call-with-values (lambda () (f 3 1 4))

4
version.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang typed/racket/base
(provide version)
(: version String)
(define version "1.0")

18
where-is-collects.rkt Normal file
View File

@ -0,0 +1,18 @@
#lang typed/racket/base
(require/typed racket/path
(normalize-path (Path -> Path)))
(require/typed typed/racket/base
(relative-path? (Any -> Boolean))
(find-executable-path (Path Path -> Path)))
(provide collects-path)
(define collects-path
(normalize-path
(let ([p (find-system-path 'collects-dir)])
(cond
[(relative-path? p)
(find-executable-path (find-system-path 'exec-file)
(find-system-path 'collects-dir))]
[else
p]))))