Underload/a interpreter in scheme
Jump to navigation
Jump to search
This is an 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