Underload/a interpreter in scheme

From Esolang
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