From 4a8413cfc8c6c46d94742b84912cabc4529af5e1 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Sun, 8 May 2011 19:03:41 -0400 Subject: [PATCH] continuing to parse lams. temporarily broken --- assemble.rkt | 1 + expression-structs.rkt | 25 +++++++++++- il-structs.rkt | 6 --- parse-bytecode-5.1.1.rkt | 47 +++++++++++++++++------ sample-small-file-bytecode.rkt | 14 +++++++ sample-small-file.rkt | 9 +++++ test-parse-bytecode-5.1.1.rkt | 69 ++++++++++++++++++++++++++++++++++ 7 files changed, 151 insertions(+), 20 deletions(-) create mode 100644 sample-small-file-bytecode.rkt create mode 100644 sample-small-file.rkt create mode 100644 test-parse-bytecode-5.1.1.rkt diff --git a/assemble.rkt b/assemble.rkt index 233d46a..dbc9497 100644 --- a/assemble.rkt +++ b/assemble.rkt @@ -8,6 +8,7 @@ "assemble-expression.rkt" "assemble-perform-statement.rkt" "collect-jump-targets.rkt" + "expression-structs.rkt" racket/string racket/list) diff --git a/expression-structs.rkt b/expression-structs.rkt index 917952e..d47d597 100644 --- a/expression-structs.rkt +++ b/expression-structs.rkt @@ -62,17 +62,28 @@ [consequent : Expression] [alternative : Expression]) #:transparent) -(define-struct: CaseLam ([name : (U Symbol False)] +(define-struct: CaseLam ([name : (U Symbol LamPositionalName)] [clauses : (Listof Lam)] [entry-label : Symbol]) #:transparent) -(define-struct: Lam ([name : (U Symbol False)] +(define-struct: Lam ([name : (U Symbol LamPositionalName)] [num-parameters : Natural] [rest? : Boolean] [body : Expression] [closure-map : (Listof Natural)] [entry-label : Symbol]) #:transparent) + +;; We may have more information about the lambda's name. This will show it. +(define-struct: LamPositionalName ([name : Symbol] + [path : String] + [line : Natural] + [column : Natural] + [offset : Natural] + [span : Natural]) #:transparent) + + + (define-struct: Seq ([actions : (Listof Expression)]) #:transparent) (define-struct: Splice ([actions : (Listof Expression)]) #:transparent) (define-struct: App ([operator : Expression] @@ -123,3 +134,13 @@ (: rest-exps ((Listof Expression) -> (Listof Expression))) (define (rest-exps seq) (cdr seq)) + + + + +(: make-label (Symbol -> Symbol)) +(define make-label + (let ([n 0]) + (lambda (l) + (set! n (add1 n)) + (string->symbol (format "~a~a" l n))))) \ No newline at end of file diff --git a/il-structs.rkt b/il-structs.rkt index 45ad227..e93839e 100644 --- a/il-structs.rkt +++ b/il-structs.rkt @@ -395,12 +395,6 @@ #:transparent) (define empty-instruction-sequence (make-instruction-sequence '())) -(: make-label (Symbol -> Symbol)) -(define make-label - (let ([n 0]) - (lambda (l) - (set! n (add1 n)) - (string->symbol (format "~a~a" l n))))) (: statements (InstructionSequence -> (Listof Statement))) diff --git a/parse-bytecode-5.1.1.rkt b/parse-bytecode-5.1.1.rkt index 1100610..aec4bdb 100644 --- a/parse-bytecode-5.1.1.rkt +++ b/parse-bytecode-5.1.1.rkt @@ -30,10 +30,16 @@ (error 'current-module-path-index-resolver)))) +;; seen-lambdas: +(define seen-lambdas (make-parameter (make-hasheq))) + + + ;; parse-bytecode: Input-Port -> Expression (define (parse-bytecode in) - (let ([compilation-top (zo-parse in)]) - (parse-top compilation-top))) + (parameterize ([seen-lambdas (make-hasheq)]) + (let ([compilation-top (zo-parse in)]) + (parse-top compilation-top)))) (define (parse-top a-top) @@ -204,7 +210,7 @@ (match a-provided [(struct provided (name src src-name nom-mod src-phase protected? insp)) ;; fixme: we're not considering all of the fields here... - (make-Provided name src-name)])]) + (make-Provided name src-name)]))]) (let loop ([provides provides]) (cond [(empty? provides) @@ -273,17 +279,21 @@ (define (parse-lam expr) (match expr - [(struct lam (name flags num-params rest? closure-map closure-types max-let-depth body)) + [(struct lam (name flags num-params param-types rest? closure-map closure-types max-let-depth body)) (let ([lam-name (cond [(symbol? name) name] [(vector? name) - ...] + (string->symbol (format "~s" name))] [else - (error - (make-Lam - ...])) - + (error "lam name neither symbol nor vector: ~e" name)])]) + (make-Lam lam-name + num-params + rest? + (parse-lam-body body) + (vector->list closure-map) + (make-label 'lamEntry)))])) + (define (parse-lam-body body) (cond [(expr? body) @@ -296,7 +306,11 @@ (define (parse-closure expr) - (error 'fixme)) + (match expr + [(struct closure (code gen-id)) + ;; Fixme: we must handle cycles here. + (parse-lam code)])) + (define (parse-case-lam exp) (error 'fixme)) @@ -317,10 +331,19 @@ (error 'fixme)) (define (parse-localref expr) - (error 'fixme)) + (match expr + [(struct localref (unbox? pos clear? other-clears? flonum?)) + ;; FIXME: we should use clear? at the very least: as I understand it, + ;; this is here to maintain safe-for-space behavior. + ;; We should also make use of flonum information to generate better code. + (make-LocalRef pos unbox?)])) + (define (parse-toplevel expr) - (error 'fixme)) + (match expr + ;; FIXME: we should also keep track of const? and ready? to produce better code. + [(struct toplevel (depth pos const? ready?)) + (make-ToplevelRef depth pos)])) (define (parse-topsyntax expr) (error 'fixme)) diff --git a/sample-small-file-bytecode.rkt b/sample-small-file-bytecode.rkt new file mode 100644 index 0000000..9151757 --- /dev/null +++ b/sample-small-file-bytecode.rkt @@ -0,0 +1,14 @@ +#lang racket +(require compiler/zo-parse) +(require (for-syntax racket/base)) + +(provide bytecode) + + +(define bytecode + (parameterize ([current-namespace (make-base-namespace)]) + (let ([bc (compile (parameterize ([read-accept-reader #t]) + (read (open-input-file "/home/dyoo/work/js-sicp-5-5/sample-small-file.rkt"))))] + [op (open-output-bytes)]) + (write bc op) + (zo-parse (open-input-bytes (get-output-bytes op)))))) \ No newline at end of file diff --git a/sample-small-file.rkt b/sample-small-file.rkt new file mode 100644 index 0000000..2c3dc91 --- /dev/null +++ b/sample-small-file.rkt @@ -0,0 +1,9 @@ +#lang racket/base +(provide f) +(define (f x) + (* x x)) + + +;; infinite loop +(letrec ([g (lambda () (g))]) + (g)) diff --git a/test-parse-bytecode-5.1.1.rkt b/test-parse-bytecode-5.1.1.rkt new file mode 100644 index 0000000..613a9b1 --- /dev/null +++ b/test-parse-bytecode-5.1.1.rkt @@ -0,0 +1,69 @@ +#lang racket/base + +(require compiler/zo-parse + rackunit + (for-syntax racket/base) + "parse-bytecode-5.1.1.rkt" + "lexical-structs.rkt" + "expression-structs.rkt") + + +(define (run-zo-parse stx) + (parameterize ([current-namespace (make-base-namespace)]) + (let ([bc (compile stx)] + [op (open-output-bytes)]) + (write bc op) + (zo-parse (open-input-bytes (get-output-bytes op)))))) + +(define (run-my-parse stx) + (parameterize ([current-namespace (make-base-namespace)]) + (let ([bc (compile stx)] + [op (open-output-bytes)]) + (write bc op) + (parse-bytecode (open-input-bytes (get-output-bytes op)))))) + + + +(check-equal? (run-my-parse #'"hello world") + (make-Top (make-Prefix (list)) + (make-Constant "hello world"))) + +(check-equal? (run-my-parse #'42) + (make-Top (make-Prefix (list)) + (make-Constant 42))) + +(check-equal? (run-my-parse #'x) + (make-Top (make-Prefix (list (make-GlobalBucket 'x))) + (make-ToplevelRef 0 0))) + + + +;; Lambdas +(run-my-parse #'(lambda (x) x)) + + + + + + + + + + +;; infinite loop +#;(run-zo-parse #'(letrec ([g (lambda () (g))]) + (g))) +#;(run-zo-parse #'(letrec ([g (lambda () (h))] + [h (lambda () (g))]) + (g))) +;; FIXME: we need to handle closure cycles here. + + + + + + + + +;(run-zo-parse #'(lambda (x) (* x x))) +;(run-my-parse #'(lambda (x) (* x x))) \ No newline at end of file