fixing primitive application

This commit is contained in:
Danny Yoo 2011-03-09 16:35:26 -05:00
parent 094da406fe
commit 488137a6af
5 changed files with 140 additions and 63 deletions

View File

@ -116,7 +116,7 @@ EOF
[(MakeCompiledProcedure? op)
(list (MakeCompiledProcedure-label op))]
[(ApplyPrimitiveProcedure? op)
empty]
(list (ApplyPrimitiveProcedure-label op))]
[(LookupLexicalAddress? op)
empty]
[(LookupToplevelAddress? op)
@ -313,13 +313,21 @@ EOF
(symbol->string (MakeCompiledProcedure-label op)))]
[(ApplyPrimitiveProcedure? op)
(error 'assemble-op-expression)]
(format "MACHINE.proc(~a, ~a)"
(ApplyPrimitiveProcedure-arity op)
(ApplyPrimitiveProcedure-label op))]
[(LookupLexicalAddress? op)
(error 'assemble-op-expression)]
(format "MACHINE.env[MACHINE.env.length - 1 - ~a][~a]"
(LookupLexicalAddress-depth op))]
[(LookupToplevelAddress? op)
(error 'assemble-op-expression)]
(format "MACHINE.env[MACHINE.env.length - 1 - ~a][~a]"
(LookupToplevelAddress-depth op)
(LookupToplevelAddress-pos op))]
[(GetControlStackLabel? op)
(error 'assemble-op-expression)]
(format "MACHINE.control[MACHINE.control.length-1].label")]
#;[(compiled-procedure-env)
#;(format "(~a.env)" (assemble-input (first inputs)))]
@ -407,8 +415,14 @@ EOF
(error 'assemble-op-statement)]
[(ExtendEnvironment/Prefix!? op)
;; fixme
(error 'assemble-op-statement)]
(let: ([names : (Listof Symbol) (ExtendEnvironment/Prefix!-names op)])
(format "MACHINE.env.push([~a]);"
(string-join (map (lambda: ([n : Symbol])
(format "MACHINE.params.currentNamespace[~s] || Primitives[~s]"
(symbol->string n)
(symbol->string n)))
names)
",")))]
[(InstallClosureValues!? op)
(error 'assemble-op-statement)]))

View File

@ -393,7 +393,7 @@
[(EnvLexicalReference? target)
;; The optimization is right here.
(make-EnvLexicalReference (+ (EnvLexicalReference-depth target) n))])
(make-ApplyPrimitiveProcedure n))
(make-ApplyPrimitiveProcedure n after-call))
,(make-PopEnvironment n 0))))
after-call))))

View File

@ -124,7 +124,11 @@
;; Applies the primitive procedure that's stored in the proc register, using
;; the arity number of values that are bound in the environment as arguments
;; to that primitive.
(define-struct: ApplyPrimitiveProcedure ([arity : Natural])
;;
;; If the primitive needs to capture the current continutation, it can get the
;; immediate address at label.
(define-struct: ApplyPrimitiveProcedure ([arity : Natural]
[label : Symbol])
#:transparent)
;; Gets the value stored at the given depth in the environment.

View File

@ -9,73 +9,106 @@
// No error trapping at the moment.
var Primitives = {
'display': function(argl) {
MACHINE.params.currentDisplayer(argl[0]);
},
'newline': function(argl) {
MACHINE.params.currentDisplayer("\n");
},
var Primitives = (function() {
var NULL = [];
return {
'display': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
MACHINE.params.currentDisplayer(firstArg);
},
'displayln': function(argl){
MACHINE.params.currentDisplayer(argl[0]);
MACHINE.params.currentDisplayer("\n");
},
'newline': function(arity, returnLabel) {
MACHINE.params.currentDisplayer("\n");
},
'pi' : Math.PI,
'displayln': function(arity, returnLabel){
var firstArg = MACHINE.env[MACHINE.env.length-1];
MACHINE.params.currentDisplayer(firstArg);
MACHINE.params.currentDisplayer("\n");
},
'e' : Math.E,
'pi' : Math.PI,
'=': function(argl) {
return argl[0] === argl[1][0];
},
'e' : Math.E,
'<': function(argl) {
return argl[0] < argl[1][0];
},
'+': function(argl) {
return argl[0] + argl[1][0];
},
'*': function(argl) {
return argl[0] * argl[1][0];
},
'-': function(argl) {
return argl[0] - argl[1][0];
},
'/': function(argl) {
return argl[0] / argl[1][0];
},
'=': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
return firstArg === secondArg;
},
'cons': function(argl) {
return [argl[0], argl[1][0]];
},
'<': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
return firstArg < secondArg;
},
'+': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
'list': function(argl) {
return argl;
},
return firstArg + secondArg;
},
'*': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
return firstArg * secondArg;
},
'-': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
return firstArg - secondArg;
},
'/': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
return firstArg / secondArg;
},
'car': function(argl) {
return argl[0][0];
},
'cons': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
return [firstArg, secondArg];
},
'cdr': function(argl) {
return argl[0][1];
},
'list': function(arity, returnLabel) {
var result = NULL;
for (var i = 0; i < arity; i++) {
result = [MACHINE.env[MACHINE.env.length - (arity - i)],
result];
}
return result;
},
'null' : undefined,
'car': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
return firstArg[0];
},
'null?': function(argl) {
return argl[0] === undefined;
}
'cdr': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
return firstArg[1];
},
'null' : NULL,
'null?': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
return firstArg === NULL;
}
};
})();
var Frame = function(label) {
this.label = label;
};
// A closure consists of its free variables as well as a label
// into its text segment.
var Closure = function(label, arity, closedVals, displayName) {
@ -133,8 +166,9 @@ var MACHINE={callsBeforeTrampoline: 100,
proc:undefined,
env: [],
control : [],
params: {currentDisplayer: function(v) {},
currentErrorHandler: function(e) {}}};
params: { currentDisplayer: function(v) {},
currentErrorHandler: function(e) {},
currentNamespace: {}}};
var trampoline = function(initialJump, success, fail) {

View File

@ -125,6 +125,31 @@
"MACHINE.env[0]")
"12345")
;; Toplevel Environment loading
(test (E-single (make-PerformStatement (make-ExtendEnvironment/Prefix! '(pi)))
"String(MACHINE.env[0]).slice(0, 5)")
"3.141")
;; Simple application
(test (E-many (list (make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
(make-AssignPrimOpStatement 'proc
(make-LookupToplevelAddress 0 0 '+))
(make-PushEnvironment 2)
(make-AssignImmediateStatement (make-EnvLexicalReference 0)
(make-Const 3))
(make-AssignImmediateStatement (make-EnvLexicalReference 1)
(make-Const 4))
(make-AssignPrimOpStatement 'val
(make-ApplyPrimitiveProcedure 2 'done))
'done))
"7")
;; A do-nothing closure
(test (E-many (list (make-GotoStatement (make-Label 'afterLambda))
'closureStart