[<<][staapl][>>][..]
Mon May 25 09:34:13 CEST 2009

removed old vm commands

;; quoted here for later reference.  this code is probably broken.

 ;; Entry point for (syntax-only!) live interaction -> prj code
 ;; transformation.
 (define (live->prj code)

   (define default
     (predicates->parsers
      (number?  ((n)  (n tlit)))
      (symbol?  ((w)  ('w tinterpret)))))

   (apply-parsers-ns/default
    '(live) default code))


 ;; Append a line to a log of lines.

 (define (log-line str stack)
   (if (or
        (null? stack)
        (not (equal? str (car stack))))
       (cons str stack)
       stack))



 ;; DIRECT
 (provide vm->native/compile
          live/vm->prj)


 (define (underscore stx)
   (->syntax
    stx
    (string->symbol
     (string-append
      "_"
      (symbol->string (->datum stx))))))


 (define (vm->native/compile code)

   (define default
     (predicates->parsers
      (symbol?      ((w)       (|'| #,(underscore #'w)
                                    |'| _compile macro/default)))
      (number?      ((n)       (n _literal)))))

   (apply-parsers-ns/default
    '(compile-vm) default code))


 (named-parsers
  (compile-vm)

  (0cmd         ((w)       (w)))
  (|:|          ((_ name)  (: #,(underscore #'name) enter)))
  (|;|          ((_)       (_exit))))

   (named-parser-clones (compile-vm)
                        (0cmd pa clear))



   ;; FIXME abstract out ns/default thingy

   (define (live/vm->prj code)

     (define default
       (predicates->parsers
        (symbol?   ((w)   ('#,(underscore #'w) tf
                           _tlit 'dtc tfind texec/w)))
        (number?   ((n)   (n _tlit)))))

     (apply-parsers-ns/default
      '(live-vm) default code))



   ;; FIXME: find a way to extend the other live commands.
   ;; map these to their '_' counterpart

   ;; FIXME: commands that take no args can be simply mapped.
   ;;(define (_command? x)  (element-of x '(ts tss tsx cold ping)))

   (named-parsers
    (live-vm)

    (0cmd      ((w)   (w))) ;; just use same as native
    (_0cmd     ((w)   (#,(underscore #'w)))) ;; special

    (1cmd      ((w)   (_t> #,(underscore #'w)))))


   (named-parser-clones
    (live-vm)

    (0cmd   commit clear pa ppa cold ping)
    (_0cmd  ts tss tsx)
    (1cmd   p ps px kb))




[Reply][About]
[<<][staapl][>>][..]