Commit 655e72fd authored by Niels Möller's avatar Niels Möller
Browse files

*** empty log message ***

Rev: ChangeLog:1.47
Rev: src/command.h:1.7
Rev: src/compiler.scm:1.1
parent 62470a3b
Thu Mar 11 03:01:00 1999 Niels Mller <nisse@lysator.liu.se>
* src/server_pty.c (tty_setctty): Fixed error message.
* src/command.c: Made the builtin commands instances of
command_simple, which means that they can return results directly,
without any continuation function.
Wed Mar 10 17:26:59 1999 <nisse@idonex.se>
* src/command.h (command_simple): New class. Like command, but can
......
......@@ -67,7 +67,7 @@
#define COMMAND_RETURN(r, v) ((r)->c((r), (struct lsh_object *) (v)))
#define COMMAND_SIMPLE(f, a) ((f)->call_simple((f), (a)))
int do_call_simple_command(struct command *c,
int do_call_simple_command(struct command *s,
struct lsh_object *arg,
struct command_continuation *c);
......@@ -85,9 +85,11 @@ int do_call_simple_command(struct command *c,
struct command_continuation *
make_apply(struct command *f, struct command_continuation *c);
#if 0
extern struct command command_I;
extern struct command command_S;
extern struct command command_B;
#endif
struct command *make_listen_command(struct io_backend *backend,
struct lsh_string *interface,
......
(define (atom? o) (not (list? o)))
(define (lambda? o) (and (pair? o) (eq? 'lambda (car o))))
(define (make-lambda formal body) `(lambda ,formal ,body))
(define lambda-formal cadr)
(define lambda-body caddr)
(define make-appliction list)
(define application-op car)
(define application-arg cadr)
(define (normalize-application op args)
(if (null? args) op
(normalize-application (make-appliction op (car args)) (cdr args))))
;; Transform (a b c)-> ((a b) c) and
;; (lambda (a b) ...) -> (lambda a (lambda b ...)
(define (preprocess expr)
(define (do-lambda formals body)
(if (null? formals) body
(do-lambda (cdr formals) (make-lambda (car formals) body))))
(cond ((atom? expr) expr)
((lambda? expr)
(do-lambda (lambda-formal expr)
(preprocess (lambda-body expr))))
(else
(normalize-application (preprocess (car expr))
(map preprocess (cdr expr))))))
(define (free-variable? v expr)
(cond ((atom? expr) (eq? v expr))
((lambda? expr)
(and (not (eq? v (lambda-formal expr)))
(free-variable? v (lambda-body expr))))
(else
(or (free-variable? v (application-op expr))
(free-variable? v (application-arg expr))))))
(define (make-combine op . args)
(normalize-application op args))
(define (translate-normal v expr)
(if (not (free-variable? v expr))
(make-combine 'K expr)
(cond ((atom? expr)
(if (eq? v expr) 'I
(error "translate normal: unexpected bound variable")))
((lambda? expr)
;; Depth first
(translate-normal v
(translate-normal (lambda-formal expr)
(lambda-body expr))))
;; Must be an application
(else
(let ((op (application-op expr))
(arg (application-arg expr)))
(if (and (eq? v arg)
(not (free-variable? v op)))
op
(make-combine 'S
(translate-normal v op)
(translate-normal v arg))))))))
(define (translate expr)
(let ((input (preprocess expr)))
(if (lambda? input)
(translate-normal (lambda-formal input)
(lambda-body input))
(error "translate:Not a lambda expression"))))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment