diff options
author | Ian Price <ianprice90@googlemail.com> | 2015-06-05 22:46:44 +0100 |
---|---|---|
committer | Ian Price <ianprice90@googlemail.com> | 2015-06-18 04:14:41 +0100 |
commit | ce1cc2706c62e2e497a44d88465ae31e1f289aa4 (patch) | |
tree | 7d7610050bd132c68b2d3154f19cc332fe632121 /module/language/js-il/compile-javascript.scm | |
parent | dbe6247acfb40da8ca51f642aa6994ef36a56315 (diff) | |
download | guile-ce1cc2706c62e2e497a44d88465ae31e1f289aa4.tar.gz |
Temp commit
Diffstat (limited to 'module/language/js-il/compile-javascript.scm')
-rw-r--r-- | module/language/js-il/compile-javascript.scm | 104 |
1 files changed, 104 insertions, 0 deletions
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm new file mode 100644 index 000000000..21b6fc9c6 --- /dev/null +++ b/module/language/js-il/compile-javascript.scm @@ -0,0 +1,104 @@ +(define-module (language js-il compile-javascript) + #:use-module (ice-9 match) + #:use-module ((language js-il) #:renamer (symbol-prefix-proc 'il:)) + #:use-module (language javascript) + #:export (compile-javascript)) + +(define (compile-javascript exp env opts) + (values (compile-exp exp) env env)) + +(define *scheme* (make-id "scheme")) + +(define (name->id name) + (make-id (rename name))) + +(define (rename name) + (format #f "kont_~a" name)) + +(define (compile-exp exp) + ;; TODO: handle ids for js + (match exp + (($ il:program (and entry ($ il:var name _)) body) + (let ((entry-call + (make-return + (make-call (name->id name) + (list + (make-id "undefined") + (make-refine *scheme* (make-const "initial_cont"))))))) + (make-call (make-function '() (append (map compile-exp body) + (list (compile-exp entry) entry-call))) + '()))) + + (($ il:function #f params body) + (make-function (map rename params) (list (compile-exp body)))) + + (($ il:function name params body) + ;; TODO: split il:function into closure (with self) and cont types + (make-function (map rename (cons name params)) (list (compile-exp body)))) + + (($ il:local bindings body) + (make-block (append (map compile-exp bindings) (list (compile-exp body))))) + + (($ il:var id exp) + (make-var (rename id) (compile-exp exp))) + + (($ il:continue k exp) + (make-return (make-call (name->id k) (list (compile-exp exp))))) + + (($ il:branch test then else) + (make-conditional (make-call (make-refine *scheme* (make-const "is_true")) + (list (compile-exp test))) + (list (compile-exp then)) + (list (compile-exp else)))) + + (($ il:const c) + (compile-const c)) + + (($ il:primcall name args) + (make-call (make-refine (make-refine *scheme* (make-const "primitives")) + (make-const (symbol->string name))) + (map name->id args))) + + (($ il:call name args) + (make-return + (make-call (make-refine (name->id name) (make-const "fun")) + (map name->id (cons name args))))) + + (($ il:jscall name args) + (make-return (make-call (name->id name) (map name->id args)))) + + (($ il:closure label nfree) + (make-new + (make-call (make-refine *scheme* (make-const "Closure")) + (list (name->id label) (make-const nfree))))) + + (($ il:values vals) + (make-new + (make-call (make-refine *scheme* (make-const "Values")) + (map name->id vals)))) + + (($ il:id name) + (name->id name)))) + +(define (compile-const c) + (cond ((number? c) + (make-const c)) + ((eqv? c #t) + (make-refine *scheme* (make-const "TRUE"))) + ((eqv? c #f) + (make-refine *scheme* (make-const "FALSE"))) + ((eqv? c '()) + (make-refine *scheme* (make-const "EMPTY"))) + ((unspecified? c) + (make-refine *scheme* (make-const "UNSPECIFIED"))) + ((symbol? c) + (make-new + (make-call + (make-refine *scheme* (make-const "Symbol")) + (list (make-const (symbol->string c)))))) + ((list? c) + (make-call + (make-refine *scheme* (make-const "list")) + (map compile-const c))) + (else + (throw 'uncompilable-const c)))) |