# Factor interpreter in Factor

## Slava Pestov — 2004-11-01 02:11:48

    Hi everybody,

    I have implemented a reflective Factor interpreter in Factor, along with

    a basic trace and stepper tool. This code should work with Factor 0.67.

    ---->8-------------

    USE: vectors

    USE: namespaces

    USE: logic

    USE: kernel

    USE: combinators

    USE: lists

    USE: words

    USE: stack

    USE: errors

    USE: continuations

    USE: strings

    USE: prettyprint

    USE: stdio

    ! A Factor interpreter written in Factor. Used by compiler for

    ! partial evaluation, also for trace and step.

    ! Meta-stacks

    SYMBOL: meta-rs

    : >R meta-rs get vector-push ;

    : R> meta-rs get vector-pop ;

    SYMBOL: meta-ds

    : >D meta-ds get vector-push ;

    : D> meta-ds get vector-pop ;

    SYMBOL: meta-ns

    SYMBOL: meta-cs

    ! Call frame

    SYMBOL: meta-cf

    : init-interpreter ( -- )

         10 <vector> meta-rs set

         10 <vector> meta-ds set

         10 <vector> meta-ns set

         10 <vector> meta-cs set

         f meta-cf set ;

    : done? ( -- ? )

         meta-cf get not meta-rs get vector-empty? and ;

    ! Callframe.

    : next ( -- obj )

         meta-cf get [

             uncons meta-cf set

         ] [

             R> meta-cf set next

         ] ifte* ;

    : host-word ( word -- )

         #! Swap in the meta-interpreter's stacks, execute the word,

         #! swap in the old stacks. This is so messy.

          >D datastack >D

          meta-ds get set-datastack

          >r execute datastack r> tuck vector-push

          set-datastack meta-ds set ;

    : meta-call ( quot -- )

         #! Note we do tail call optimization here.

         meta-cf get [ >R ] when* meta-cf set ;

    : meta-word ( word -- )

         dup "metaword" word-property dup [

             nip call

         ] [

             drop dup compound? [

                 word-parameter meta-call

             ] [

                 host-word

             ] ifte

         ] ifte ;

    : do ( obj -- )

         dup word? [ meta-word ] [ >D ] ifte ;

    : interpret ( quot -- )

         #! The quotation is called with each word as its executed.

         done? [ drop ] [ [ next swap call ] keep interpret ] ifte ;

    : (run) ( -- )

         [ do ] interpret ;

    : set-metaword ( word quot -- )

         "metaword" set-word-property ;

    \ >r   [ D> >R ] set-metaword

    \ r>   [ R> >D ] set-metaword

    \ >n   [ D> meta-ns get vector-push ] set-metaword

    \ n>   [ meta-ns get vector-pop >D ] set-metaword

    \ namestack* [ meta-ns get >D ] set-metaword

    \ set-namestack* [ D> meta-ns set ] set-metaword

    \ >c   [ D> meta-cs get vector-push ] set-metaword

    \ c>   [ meta-cs get vector-pop >D ] set-metaword

    \ call [ D> meta-call ] set-metaword

    \ execute [ D> meta-word ] set-metaword

    \ ifte [ D> D> D> [ nip ] [ drop ] ifte meta-call ] set-metaword

    \ datastack [ meta-ds get vector-clone >D ] set-metaword

    \ callstack [ meta-rs get vector-clone >D ] set-metaword

    \ set-datastack [ D> vector-clone meta-ds set ] set-metaword

    \ set-callstack [ D> vector-clone meta-rs set ] set-metaword

    ! Some useful tools

    : report ( obj -- )

         meta-rs get vector-length " " fill write . flush ;

    : (trace) ( -- )

         [ dup report do ] interpret ;

    : trace ( quot -- )

         #! Trace execution of a quotation by printing each word as

         #! its executed, and each literal as its pushed. Each line

         #! is indented by the call stack height.

         [

             init-interpreter

             meta-cf set

             (trace)

             meta-ds get set-datastack

         ] with-scope ;

    : step-banner ( -- )

         "The following words control the single-stepper:" print

         "&s      -- print stepper data stack" print

         "&r      -- print stepper call stack" print

         "&n      -- print stepper name stack" print

         "&c      -- print stepper catch stack" print

         "&*      -- single step" print

         "(trace) -- trace until end" print

         "(run)   -- run until end" print ;

    : step ( quot -- )

         #! Single-step through execution of a quotation.

         init-interpreter

         meta-cf set

         step-banner ;

    : &s

         #! Print stepper data stack.

         meta-ds get [ . ] vector-each ;

    : &r

         #! Print stepper call stack.

         meta-rs get [ . ] vector-each meta-cf get . ;

    : &n

         #! Print stepper name stack.

         meta-ns get [ . ] vector-each ;

    : &c

         #! Print stepper catch stack.

         meta-cs get [ . ] vector-each ;

    : not-done ( quot -- )

         done? [ "Stepper is done." print drop ] [ call ] ifte ;

    : &*

         #! Step into current word.

         [ next dup report do ] not-done ;