Underload/a interpreter in scheme
Jump to navigation
Jump to search
This is a Underload interpreter in scheme by User:Jan jelo.
(define(init program) (list(string->list program) '())) (define(program state) (list-ref state 0)) (define(stack state) (list-ref state 1)) ;a (define(a state) (list(cdr(program state)) (cons(string-append "(" (car(stack state)) ")") (cdr(stack state))))) ;! (define(!! state) (list(cdr(program state)) (cdr(stack state)))) ;* (define(** state) (list(cdr(program state)) (cons(string-append(cadr(stack state)) (car(stack state))) (cdr(cdr(stack state)))))) ;: (define(:: state) (list(cdr(program state)) (cons(car(stack state)) (stack state)))) ;~ (define(~~ state) (list(cdr(program state)) (cons(cadr(stack state)) (cons(car(stack state)) (cdr(cdr(stack state))))))) ;^ (define(^^ state) (list(append(string->list(car(stack state))) (cdr(program state))) (cdr(stack state)))) ;S (define(S state) (display(car(stack state))) (list(cdr(program state)) (cdr(stack state)))) ;() (define(bracket state) (define(find state i) (if(= i 0) (list(program state) (cons(substring(car(stack state)) 0 (-(string-length(car(stack state)))1)) (cdr(stack state)))) (find(list(cdr(program state)) (cons(string-append(car(stack state)) (list->string(list(car(program state))))) (cdr(stack state)))) (cond((equal? #\( (car(program state)))(+ i 1)) ((equal? #\) (car(program state)))(- i 1)) (#t i))))) (find(list(cdr(program state)) (cons""(stack state))) 1)) (define(step state) (define(op state) (car(program state))) ((cond ((equal?(op state)#\a)a) ((equal?(op state)#\!)!!) ((equal?(op state)#\:)::) ((equal?(op state)#\~)~~) ((equal?(op state)#\*)**) ((equal?(op state)#\^)^^) ((equal?(op state)#\S)S) ((equal?(op state)#\( )bracket)) state)) (define(run p) (define(exec state) (if(equal? '()(program state)) #f (exec(step state)))) (exec(init p))) (run "(:aSS):aSS") ;(:aSS):aSS