On this page:
5.1 Quote
«builtin-quote»
«test-quote»
«test-quote-nothing»
5.2 Uplevel
«builtin-uplevel»
«test-uplevel-quote»
5.3 Intermission:   Utilities
«global-builtins»
«stack-top»
5.4 Execution
«builtin-call-eval»
5.5 Conditional execution
«builtin-when»

5 Builtins

All non-trivial programs will depend on these builtins.

    5.1 Quote

    5.2 Uplevel

    5.3 Intermission: Utilities

    5.4 Execution

    5.5 Conditional execution

5.1 Quote

context-next-code returns the lexically next item of code. The builtin quote can put this on the stack without evaluating it.

(define-builtin
  (quote ctx stack)
  (let-values ([(ctx code) (context-next-code ctx)])
    (if (void? code)
      (interp-error 'quote-nothing)
      (values ctx (cons code stack)))))

We can test this:

(test-case "Quote"
  (let* ([defines (choose-global-builtins 'quote)]
         [ctx (make-context
                #:definitions defines
                ; this renders funny, it should be '(quote hello)
                #:body ''hello)])
    (let-values ([(ctx stack) (interp-run ctx '())])
      (check-equal? ctx (make-context #:definitions defines #:body '()))
      (check-equal? stack '(hello)))))

It should fail if there is nothing to quote:

(test-case "Quote nothing fails"
  (check-exn
    exn:fail?
    (lambda ()
      (let* ([defines (choose-global-builtins 'quote)]
             [ctx (make-context
                    #:definitions defines
                    #:body '(quote))])
        (let-values ([(ctx stack) (interp-run ctx '())])
          #t)))))

5.2 Uplevel

context-uplevel moves into the parent context. Normal execution would undo this move immediately, but the builtin uplevel can take a symbol argument off the top of the stack and use interp-eval to call it while still in the parent context.

(define-builtin
  (uplevel ctx stack)
  (let* ([ctx (context-uplevel ctx)]
         [name (stack-top stack symbol?)])
    (if ctx
      (interp-call ctx (cdr stack) name)
      (interp-error 'root-uplevel))))

A test of quote and uplevel in combination:

(test-case
  "Uplevel quote"
  (let* ([defines
           (hash-set*
             (choose-global-builtins
               'quote 'uplevel)
             'inner-quote '(quote quote uplevel))]
         [ctx (make-context
                #:definitions defines
                #:body '(inner-quote "test"))])
    (let-values ([(ctx stack) (interp-run ctx '())])
      (check-equal? ctx (make-context #:definitions defines #:body '()))
      (check-equal? stack '("test")))))

5.3 Intermission: Utilities

I introduced a few functions there without explaining them. It would be laborious to try and keep track of all defined builtins in order to use them, so let’s keep a set of global builtins and use define-builtin to add to it. define-builtin can use the context and stack, or take some values off the top of the stack using stack-top.

(: *builtins* (Parameterof (Immutable-HashTable Symbol Function)))
(define *builtins* (make-parameter (make-immutable-hash '())))
 
(: add-global-builtin (Symbol Function . -> . Void))
(define (add-global-builtin name builtin)
  (*builtins* (hash-set (*builtins*) name builtin)))
 
(define-syntax define-builtin
  (syntax-rules ()
    [(_ (name stack) body ...)
     (define-builtin (name ctx stack) (values ctx (begin body ...)))]
    ; TODO: I tried removing this repetition with a macro,
    ; but it was pretty tough. 3 arguments seems to be enough anyway.
    [(_ (name stack [v1 t1]) body ...)
     (define-builtin
       (name ctx stack)
       (let ([v1 (stack-top stack t1)])
         (values ctx (begin body ...))))]
    [(_ (name stack [v1 t1] [v2 t2]) body ...)
     (define-builtin
       (name ctx stack)
       (let ([v1 (stack-top stack t1)]
             [v2 (stack-top (cdr stack) t2)])
         (values ctx (begin body ...))))]
    [(_ (name stack [v1 t1] [v2 t2] [v3 t3]) body ...)
     (define-builtin
       (name ctx stack)
       (let ([v1 (stack-top stack t1)]
             [v2 (stack-top (cdr stack) t2)]
             [v3 (stack-top (cddr stack) t3)])
         (values ctx (begin body ...))))]
    [(_ (name ctx stack) body ...)
     (add-global-builtin
       'name
       (Builtin (lambda ([ctx : Context] [stack : Stack]) body ...)))]))
 
; Pick a subset of builtins, for tests
(: choose-global-builtins (->* () #:rest Symbol
                               (Immutable-HashTable Symbol Function)))
(define (choose-global-builtins . names)
  (make-immutable-hash
    (map (lambda ([n : Symbol]) (cons n (hash-ref (*builtins*) n))) names)))

stack-top is a simple utility to make sure the stack has a value on top, optionally with the right type.

(: stack-top (All (T) (case-> (Stack . -> . Any)
                              (Stack #t . -> . Any)
                              (Stack (-> Any Boolean : T) . -> . T))))
(define stack-top
  (case-lambda
    [(stack)
     (if (null? stack)
       (interp-error 'stack-empty)
       (car stack))]
    [(stack pred)
     (cond
       [(null? stack) (interp-error 'stack-empty pred)]
       [(eq? pred #t) (car stack)]
       [(not (pred (car stack)))
        (interp-error 'wrong-type pred (car stack))]
       [else (car stack)])]))

5.4 Execution

The builtins call and eval are just wrappers for interp-call and interp-eval respectively, except that non-Function values evaluate to themselves.

(define-builtin
  (call ctx stack)
  (let ([v (stack-top stack symbol?)]
        [stack (cdr stack)])
    (interp-call ctx stack v)))
 
(define-builtin
  (eval ctx stack)
  (let ([v (stack-top stack)]
        [stack (cdr stack)])
    (if (function? v)
        (interp-eval ctx stack v)
        (values ctx (cons v stack)))))

5.5 Conditional execution

Many languages have at least one conditional, usually named if, and often a handful more for specific situations.

Worst only needs one. Every other conditional can be implemented in terms of when, which conditionally performs a call based on the value of a boolean.

(define-builtin
  (when ctx stack)
  (let* ([name (stack-top stack symbol?)]
         [c (stack-top (cdr stack) boolean?)]
         [stack (cddr stack)])
    (if c
      ; TODO: this could use eval as well
      (interp-call ctx stack name)
      (values ctx stack))))