urflibs/repl.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; and now for something completely different...
   3 ;; UrForth/C Forth Engine!
   4 ;; Copyright (C) 2023 Ketmar Dark // Invisible Vector
   5 ;; GPLv3 ONLY
   6 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   7 ;; simple REPL
   8 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   9
  10 $include-once <linore.f>
  11 $IF $DEBUGGER
  12 $include-once <debugger.f>
  13 $ENDIF
  14
  15
  16 vocabulary ufo-repl-support
  17 also-defs: ufo-repl-support
  18
  19 false value editor-active?
  20 0 value restart-word-cfa
  21
  22 : .ok  ( -- )
  23   compiler:exec? if
  24     ." ok"
  25     depth ?dup if ."  (" 0 .r ." )" endif
  26   else ."  more..."
  27   endif cr
  28   flush-emit tty:raw-flush
  29 ;
  30
  31 : interp-done  ( -- )
  32   .ok
  33   rp0! restart-word-cfa execute-tail
  34 ;
  35
  36 : draw-prompt  ( -- )
  37   " \r\e[0;1;5m>\e[0m" tty:raw-type
  38 ;
  39
  40
  41 ..: linore:on-before-draw  ( FALSE -- FALSE / TRUE )
  42   editor-active? if
  43     dup ifnot draw-prompt endif
  44   endif
  45 ;..
  46
  47
  48 ;; do not allow debugger to abort on bad forth word
  49 ..: forth:(interpret-word-not-found-post)  ( addr count -- addr count )
  50   space xtype ." ? -- wut?!" cr
  51   compiler:exec! sp0!
  52   interp-done
  53 ;..
  54
  55
  56 : repl-loop
  57   tty:tty? " cannot run REPL on non-TTY" ?not-error
  58   begin
  59     linore:reset
  60     true to ufo-repl-support:editor-active?
  61     1 to linore:start-x
  62     tty:size drop to linore:draw-width
  63     flush-emit linore:edit-line
  64     false to ufo-repl-support:editor-active?
  65     linore:accept-result linore:result-^d = if break endif
  66     linore:accept-result +if
  67       ['] ufo-repl-support:interp-done (user-interpret-next-line) !
  68       0 linore:line + c!  ;; finish TIB with 0 byte
  69       linore:line drop tib ! >in 0!  ;; setup TIB
  70       cr tty:raw-flush
  71       interpret
  72       ufo-repl-support:interp-done
  73     endif
  74   again
  75 ;
  76
  77 ' repl-loop to ufo-repl-support:restart-word-cfa
  78
  79 prev-defs
  80
  81
  82 : ufo-run-repl  ( -- )
  83   sp0! rp0! ['] ufo-repl-support:repl-loop execute-tail
  84 ;