r3/printtng.scm
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Wed, 16 Jan 2019 17:15:58 +0000
changeset 438 1fe179d53161
parent 42 603c96714c6a
permissions -rw-r--r--
Add missing primitive implementation for the plain interpreter.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
35
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     1
(define show-parens
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     2
  (lambda (x mode)
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     3
    (case mode
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     4
      ((eval) (list "(" x ")"))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     5
      ((quote) (list "[" x "]"))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     6
      ((meta-quote) (list "{" x "}"))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     7
      (else (error "Unknown show-mode" mode)))))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     8
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     9
(define show-join
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    10
  (lambda (mid xs)
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    11
    (if (null? xs)
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    12
	'()
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    13
	(reverse (fold (lambda (x acc)
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    14
			 (cons x (cons mid acc)))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    15
		       (list (car xs))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    16
		       (cdr xs))))))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    17
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    18
(define show-tng
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    19
  (lambda (c mode)
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    20
    (let walk ((c c))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    21
      (case (car c)
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    22
	((tuple) (show-join ", " (map walk (cdr c))))
42
603c96714c6a Experimental printing changes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 35
diff changeset
    23
	((atom) (list "#" (symbol->string (cadr c))))
603c96714c6a Experimental printing changes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 35
diff changeset
    24
	((lit) (let ((o (open-output-string)))
603c96714c6a Experimental printing changes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 35
diff changeset
    25
		 (display (cadr c) o)
603c96714c6a Experimental printing changes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 35
diff changeset
    26
		 (get-output-string o)))
35
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    27
	((adj) (list (walk (cadr c)) " " (walk (caddr c))))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    28
	((fun) (show-join " " (map (lambda (entry)
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    29
				     (list (show-tng (car entry) 'quote) ": "
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    30
					   (show-tng (cadr entry) 'eval)))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    31
				   (cdr c))))
42
603c96714c6a Experimental printing changes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 35
diff changeset
    32
	((eval) (if (eq? (car (cadr c)) 'atom)
603c96714c6a Experimental printing changes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 35
diff changeset
    33
		    (symbol->string (cadr (cadr c)))
603c96714c6a Experimental printing changes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 35
diff changeset
    34
		    (show-parens (show-tng (cadr c) 'eval) 'eval)))
603c96714c6a Experimental printing changes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 35
diff changeset
    35
	((quote) (show-parens (show-tng (cadr c) 'quote) 'quote))
35
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    36
	((meta-quote) (show-parens (show-tng (cadr c) 'meta-quote) 'meta-quote))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    37
	((discard) "_")
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    38
	(else (error "Unknown term in show-tng" c))))))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    39
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    40
(define print-tng
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    41
  (lambda (c mode)
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    42
    (let walk ((x (show-tng c mode)))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    43
      (cond
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    44
       ((null? x))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    45
       ((pair? x) (walk (car x)) (walk (cdr x)))
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    46
       (else (display x))))))