Permalink
Browse files

repl: normal apply

  • Loading branch information...
1 parent 267bd11 commit e67cb29b5d1939d01b26456d51c5764c64b22470 @sile committed May 7, 2012
View
Binary file not shown.
View
@@ -1,16 +1,40 @@
(begin
(define __int__ 1)
+ (define __symbol__ 4)
(define __undef__ 9)
+ (define __apply__ 101)
+ (define __symget__ 50)
(define !cp-number (lambda (n)
(flat-list __int__ (int->list n))))
(define !cp-undef (lambda ()
(flat-list __undef__)))
+ (define !cp-apply (lambda (fn args)
+ ;; TODO: handling tail call
+ (flat-list (map compile args) (compile fn) __apply__ (length args))))
+
+ (define !cp-symbol-value (lambda (sym)
+ ;; TODO: handling local variable
+ (let ((name (map char->integer (string->list (symbol->string sym)))))
+ (flat-list __symbol__ (short->list (length name)) name __symget__))))
+
+ (define !cp-pair (lambda (pair)
+ (case (car pair)
+ ((lambda) )
+ ;; etc
+ (else
+ (!cp-apply (car pair) (cdr pair))))))
+
+ (define !cp-symbol (lambda (sym)
+ (!cp-symbol-value sym)))
+
(define compile (lambda (exp)
(case (type-of exp)
((number) (!cp-number exp))
+ ((pair) (!cp-pair exp))
+ ((symbol) (!cp-symbol exp))
(else (!cp-undef)))))
(define eval (lambda (exp . environment-specifier)
View
Binary file not shown.
@@ -96,8 +96,8 @@
(define !parse-number (lambda (in)
(case (peek-char in)
- ((#\-) (read-char in) (* -1 (!parse-number-impl in)))
- ((#\+) (read-char in) (!parse-number-impl in))
+ ((#\-) (read-char in) (if (memv (peek-char in) *delimiters*) '- (* -1 (!parse-number-impl in))))
+ ((#\+) (read-char in) (if (memv (peek-char in) *delimiters*) '+ (!parse-number-impl in)))
(else (!parse-number-impl in)))))
(define !parse-port (lambda (in)
View
Binary file not shown.
View
@@ -16,9 +16,19 @@
(!write-number-impl (* -1 n)))
(!write-number-impl n))))
+ (define !write-symbol (lambda (sym)
+ (write-string (symbol->string sym))))
+
+ (define !write-procedure (lambda (proc)
+ (write-string "<PROC>")))
+
(define write (lambda (x)
(case (type-of x)
((number) (!write-number x))
- (else (write-string "Not Implemented")))
+ ((symbol) (!write-symbol x))
+ ((procedure) (!write-procedure x))
+ (else (if (eq x (undef))
+ (write-string "<UNDEF>")
+ (write-string "Not Implemented"))))
(newline))) ; XXX
)
View
Binary file not shown.
View
@@ -129,4 +129,12 @@
(cons (bit-field n offset (+ offset 8)) acc)))
'()
(range-list 0 3))))
+
+ (define short->list (lambda (n) ; bit-endian
+ (reduce (lambda (acc i)
+ (let ((offset (* i 8)))
+ (cons (bit-field n offset (+ offset 8)) acc)))
+ '()
+ (range-list 0 1))))
+
)
@@ -410,6 +410,10 @@ namespace psil {
push(env, Int::make(n2));
}
+ static void _symbol_to_string(Environment& env, uint1 arity) {
+ push(env, String::make(to<Symbol>(pop(env))->getName()));
+ }
+
static void registerNatives() {
reg("EQ", _eq);
reg("EQ?", _eq);
@@ -468,6 +472,7 @@ namespace psil {
reg("STRING->SYMBOL", _string_to_symbol);
reg("STRING-LENGTH", _string_length);
reg("UNDEF", _undef);
+ reg("SYMBOL->STRING", _symbol_to_string);
regval("STDIN", &Port::STDIN);
regval("STDOUT", &Port::STDOUT);

0 comments on commit e67cb29

Please sign in to comment.