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

some cleanup; also turning on the context preservation stuff in hopes that it will make the generated code smaller

Browse Source
This commit is contained in:
Danny Yoo 2011-09-28 14:23:53 -04:00
parent 657d74e37b
commit b7489b5b0c
11 changed files with 36 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/kernel-primitives.rkt
View File

@ -27,6 +27,7 @@
'>=
'cons
'car
'caar
'cdr
'cadr
'caddr
@ -81,6 +82,7 @@
'srcloc-position
'srcloc-span
'error
'raise-type-error
))
(define-predicate KernelPrimitiveName? KernelPrimitiveName)

21
examples/maze.rkt
View File

@ -1,21 +0,0 @@
#lang planet dyoo/whalesong
;; Maze generation via Recursive Backtracking technique.
;; http://weblog.jamisbuck.org/2010/12/27/maze-generation-recursive-backtracking
(define-struct cell (carved visited) #:mutable #:transparent)
(define (make-grid width height f)
(build-vector
width
(lambda (i)
(build-vector
height
(lambda (j)
(f i j))))))
(define grid (make-grid 20 20
(lambda (i j)
(make-cell 0 #f))))
grid

4
get-module-bytecode.rkt
View File

@ -81,7 +81,8 @@
(lambda (ip)
(get-compiled-code-from-port ip)))
)])
(get-module-code p)))
(parameterize ([compile-context-preservation-enabled #t])
(get-module-code p))))
;; get-compiled-code-from-port: input-port -> compiled-code
@ -89,6 +90,7 @@
(define (get-compiled-code-from-port ip)
;(printf "get-compiled-code-from-port\n")
(parameterize ([read-accept-reader #t]
[compile-context-preservation-enabled #t]
[current-namespace base-namespace])
(define stx (read-syntax (object-name ip) ip))
;(printf "got stx; now expanding out the images\n")

2
js-assembler/package.rkt
View File

@ -442,7 +442,7 @@ M.modules[~s] =
(newline op)
(fprintf op "(function(M, SUCCESS, FAIL, PARAMS) {")
(make (list only-bootstrapped-code) packaging-configuration)
(make (list (my-force only-bootstrapped-code)) packaging-configuration)
(fprintf op "})(plt.runtime.currentMachine,\nfunction(){ plt.runtime.setReadyTrue(); },\nfunction(){},\n{});\n")))

26
js-assembler/runtime-src/baselib-primitives.js
View File

@ -88,6 +88,16 @@
);
var checkRational = baselib.check.checkRational;
var checkPair = baselib.check.checkPair;
var checkCaarPair = baselib.check.makeCheckArgumentType(
function(x) {
return isPair(x) && isPair(x.first);
},
'caarable value');
var checkCadrPair = baselib.check.makeCheckArgumentType(
function(x) {
return isPair(x) && isPair(x.first);
},
'cadrable value');
var checkList = baselib.check.checkList;
var checkListofChars = baselib.check.makeCheckListofArgumentType(baselib.chars.isChar,
'character');
@ -557,8 +567,6 @@
});
installPrimitiveProcedure(
'car',
1,
@ -567,6 +575,20 @@
return firstArg.first;
});
installPrimitiveProcedure(
'caar',
1,
function (M) {
var firstArg = checkCaarPair(M, 'caar', 0);
return firstArg.first.first;
});
installPrimitiveProcedure(
'cadr',
1,
function (M) {
var firstArg = checkCadrPair(M, 'cadr', 0);
return firstArg.first.rest;
});
installPrimitiveProcedure(
'cdr',
1,

2
lang/kernel.rkt
View File

@ -336,7 +336,7 @@ negative?
eqv?
caar
;; cadr
cadr
;; cdar
;; cddr
;; caaar

6
make/make-structs.rkt
View File

@ -77,8 +77,6 @@
(: only-bootstrapped-code : StatementsSource)
(: only-bootstrapped-code : (MyPromise StatementsSource))
(define only-bootstrapped-code
(make-StatementsSource (get-bootstrapping-code)))
(my-delay (make-StatementsSource (get-bootstrapping-code))))

2
parameters.rkt
View File

@ -87,7 +87,7 @@
;; Turns on caching of compiled programs, so that repeated compilations
;; will reuse existing work.
(: current-with-cache? (Parameterof Boolean))
(define current-with-cache? (make-parameter #f))
(define current-with-cache? (make-parameter #t))

3
parser/parse-bytecode-5.1.1.rkt
View File

@ -10,8 +10,7 @@
;; Parsing Racket 5.1.1 bytecode structures into our own structures.
(require "typed-module-path.rkt"
"path-rewriter.rkt"
(require "path-rewriter.rkt"
"../compiler/expression-structs.rkt"
"../compiler/lexical-structs.rkt"
"../parameters.rkt"

3
parser/parse-bytecode-5.1.2.rkt
View File

@ -12,8 +12,7 @@
;; Parsing Racket 5.1.2 bytecode structures into our own structures.
(require "typed-module-path.rkt"
"path-rewriter.rkt"
(require "path-rewriter.rkt"
"../compiler/expression-structs.rkt"
"../compiler/lexical-structs.rkt"
"../parameters.rkt"

63
parser/typed-module-path.rkt
View File

@ -1,63 +0,0 @@
#lang typed/racket/base
(define-type RelativeString String)
(define-type UserString String)
(define-type PackageString String)
(define-type ModulePath (U (List 'quote Symbol)
RelativeString
(Pairof 'lib (Pairof RelativeString (Listof RelativeString)))
Symbol
(List 'file String)
(List 'planet Symbol)
(List 'planet String)
(Pairof 'planet
(Pairof RelativeString
(Pairof (U (List UserString PackageString)
(List UserString PackageString Natural)
(List UserString PackageString Natural MinorVersion))
(Listof RelativeString))))))
(define-type MinorVersion (U Natural
(List Natural Natural)
(List '= Natural)
(List '+ Natural)
(List '- Natural)))
(require/typed racket/base
[opaque ModulePathIndex module-path-index?]
[opaque ResolvedModulePath resolved-module-path?]
[module-path-index-resolve
(ModulePathIndex -> ResolvedModulePath)]
[module-path-index-join
((U ModulePath #f)
(U ModulePathIndex ResolvedModulePath #f) ->
ModulePathIndex)]
[module-path-index-split
(ModulePathIndex -> (values (U ModulePath #f)
(U ModulePathIndex ResolvedModulePath #f)))]
[resolved-module-path-name
(ResolvedModulePath -> (U Path Symbol))]
[make-resolved-module-path ((U Symbol Path) -> ResolvedModulePath)])
(provide
ModulePath
ResolvedModulePath
ModulePathIndex
module-path-index-resolve
module-path-index-join
module-path-index-split)