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

moving the bootstrapping primitives code (like call/cc) into bootstrapped-primitives.rkt. About to implement map as well.

Browse Source
This commit is contained in:
dyoo 2011-03-15 13:52:41 -04:00
parent 1c7bac3393
commit 54ee4e8da4
7 changed files with 100 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
bootstrapped-primitives.rkt Normal file
View File

@ -0,0 +1,68 @@
#lang typed/racket/base
(require "expression-structs.rkt"
"lexical-structs.rkt"
"il-structs.rkt"
"lexical-env.rkt"
"helpers.rkt"
"find-toplevel-variables.rkt"
"sets.rkt"
"compile.rkt"
racket/list)
(provide call/cc-label
make-call/cc-code)
;; The primitive code necessary to do call/cc
(: call/cc-label Symbol)
(define call/cc-label 'callCCEntry)
(define call/cc-closure-entry 'callCCClosureEntry)
;; (call/cc f)
;; Tail-calls f, providing it a special object that knows how to do the low-level
;; manipulation of the environment and control stack.
(define (make-call/cc-code)
(statements
(append-instruction-sequences
(make-instruction-sequence
`(,call/cc-label
;; Precondition: the environment holds the f function that we want to jump into.
;; First, move f to the proc register
,(make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0 #f))
;; Next, capture the envrionment and the current continuation closure,.
,(make-PushEnvironment 2 #f)
,(make-AssignPrimOpStatement (make-EnvLexicalReference 0 #f)
(make-CaptureControl 0))
,(make-AssignPrimOpStatement (make-EnvLexicalReference 1 #f)
;; When capturing, skip over f and the two slots we just added.
(make-CaptureEnvironment 3))
,(make-AssignPrimOpStatement (adjust-target-depth (make-EnvLexicalReference 0 #f) 2)
(make-MakeCompiledProcedure call/cc-closure-entry
1 ;; the continuation consumes a single value
(list (make-EnvLexicalReference 0 #f)
(make-EnvLexicalReference 1 #f))
'call/cc))
,(make-PopEnvironment 2 0)))
;; Finally, do a tail call into f.
(compile-procedure-call '()
(extend-lexical-environment/placeholders '() 1)
1
'val
'return)
;; The code for the continuation coe follows. It's supposed to
;; abandon the current continuation, initialize the control and environment, and then jump.
(make-instruction-sequence `(,call/cc-closure-entry
,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
,(make-PerformStatement (make-InstallClosureValues!))
,(make-PerformStatement (make-RestoreControl!))
,(make-PerformStatement (make-RestoreEnvironment!))
,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc)))))))

67
compile.rkt
View File

@ -12,9 +12,7 @@
(provide (rename-out [-compile compile])
compile-procedure-call
append-instruction-sequences
call/cc-label
make-call/cc-code)
adjust-target-depth)
(: current-defined-name (Parameterof (U Symbol False)))
@ -32,10 +30,7 @@
exp)
(list)
target
linkage)
(make-instruction-sequence `(,(make-GotoStatement (make-Label end))))
(make-call/cc-code)
end))))
linkage)))))
@ -652,61 +647,3 @@
(error 'ensure-natural "Not a natural: ~s\n" n)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The primitive code necessary to do call/cc
(: call/cc-label Symbol)
(define call/cc-label 'callCCEntry)
(define call/cc-closure-entry 'callCCClosureEntry)
;; (call/cc f)
;; Tail-calls f, providing it a special object that knows how to do the low-level
;; manipulation of the environment and control stack.
(define (make-call/cc-code)
(append-instruction-sequences
(make-instruction-sequence
`(,call/cc-label
;; Precondition: the environment holds the f function that we want to jump into.
;; First, move f to the proc register
,(make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0 #f))
;; Next, capture the envrionment and the current continuation closure,.
,(make-PushEnvironment 2 #f)
,(make-AssignPrimOpStatement (make-EnvLexicalReference 0 #f)
(make-CaptureControl 0))
,(make-AssignPrimOpStatement (make-EnvLexicalReference 1 #f)
;; When capturing, skip over f and the two slots we just added.
(make-CaptureEnvironment 3))
,(make-AssignPrimOpStatement (adjust-target-depth (make-EnvLexicalReference 0 #f) 2)
(make-MakeCompiledProcedure call/cc-closure-entry
1 ;; the continuation consumes a single value
(list (make-EnvLexicalReference 0 #f)
(make-EnvLexicalReference 1 #f))
(current-defined-name)))
,(make-PopEnvironment 2 0)))
;; Finally, do a tail call into f.
(compile-procedure-call '()
(extend-lexical-environment/placeholders '() 1)
1
'val
'return)
;; The code for the continuation coe follows. It's supposed to
;; abandon the current continuation, initialize the control and environment, and then jump.
(make-instruction-sequence `(,call/cc-closure-entry
,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
,(make-PerformStatement (make-InstallClosureValues!))
,(make-PerformStatement (make-RestoreControl!))
,(make-PerformStatement (make-RestoreEnvironment!))
,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))))))

4
package.rkt
View File

@ -4,6 +4,7 @@
"assemble.rkt"
"typed-parse.rkt"
"il-structs.rkt"
"bootstrapped-primitives.rkt"
racket/runtime-path
racket/port)
@ -21,8 +22,7 @@
(for-each (lambda (code)
(displayln code op))
(map assemble-basic-block
(fracture (statements
(make-call/cc-code)))))
(fracture (make-call/cc-code))))
;; The runtime code
(call-with-input-file* runtime.js

1
simulator-primitives.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require "simulator-structs.rkt"
"compile.rkt"
"bootstrapped-primitives.rkt"
racket/math
(for-syntax racket/base))

31
simulator.rkt
View File

@ -7,6 +7,7 @@
(require "il-structs.rkt"
"simulator-structs.rkt"
"bootstrapped-primitives.rkt"
racket/list
racket/match
(for-syntax racket/base))
@ -30,15 +31,27 @@
(: new-machine ((Listof Statement) -> machine))
(define (new-machine program-text)
(let: ([m : machine (make-machine (make-undefined) (make-undefined) '() '() 0 (list->vector program-text) 0
((inst make-hash Symbol Natural)))])
(let: loop : Void ([i : Natural 0])
(when (< i (vector-length (machine-text m)))
(let: ([stmt : Statement (vector-ref (machine-text m) i)])
(when (symbol? stmt)
(hash-set! (machine-jump-table m) stmt i))
(loop (add1 i)))))
m))
(let*: ([after-bootstrapping : Symbol (make-label 'afterBootstrapping)]
[program-text : (Listof Statement)
(append `(,(make-GotoStatement (make-Label after-bootstrapping)))
(make-call/cc-code)
`(,after-bootstrapping)
program-text)])
(let: ([m : machine (make-machine (make-undefined)
(make-undefined)
'()
'()
0
(list->vector program-text)
0
((inst make-hash Symbol Natural)))])
(let: loop : Void ([i : Natural 0])
(when (< i (vector-length (machine-text m)))
(let: ([stmt : Statement (vector-ref (machine-text m) i)])
(when (symbol? stmt)
(hash-set! (machine-jump-table m) stmt i))
(loop (add1 i)))))
m)))

7
test-assemble.rkt
View File

@ -5,6 +5,7 @@
"parse.rkt"
"il-structs.rkt"
"compile.rkt"
"bootstrapped-primitives.rkt"
racket/port
racket/promise
racket/runtime-path)
@ -45,8 +46,7 @@
;; The support code for call/cc
(string-join (map assemble-basic-block
(fracture (statements
(make-call/cc-code))))
(fracture (make-call/cc-code)))
"\n")
runtime
@ -70,8 +70,7 @@
(display
(string-join (map assemble-basic-block
(fracture (statements
(make-call/cc-code))))
(fracture (make-call/cc-code)))
"\n")
op)

5
test-browser-evaluate.rkt
View File

@ -20,7 +20,6 @@
#'stx)))
(printf " ok (~a milliseconds)\n" (evaluated-t result))))))]))
#|
(test '(begin (define (f x)
(if (= x 0)
0
@ -142,7 +141,7 @@
(displayln (tak 18 12 6)))
"7\n")
|#
(test (read (open-input-file "tests/conform/program1.sch"))
#;(test (read (open-input-file "tests/conform/program0.sch"))
(port->string (open-input-file "tests/conform/expected0.txt")))