1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
;;; LaHaShem HaAretz U'Mloah
;;; Stalin 0.8 - A global optimizing compiler for Scheme
;;; Copyright 1993, 1994, and 1995 University of Toronto. All rights reserved.
;;; Copyright 1996 Technion. All rights reserved.
;;; Copyright 1996 and 1997 University of Vermont. All rights reserved.
;;; Copyright 1997, 1998, and 1999 NEC Research Institute, Inc. All rights
;;; reserved.
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
;;; as published by the Free Software Foundation; either version 2
;;; of the License, or (at your option) any later version.
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;; written by:
;;; Jeffrey Mark Siskind
;;; NEC Research Institute, Inc.
;;; 4 Independence Way
;;; Princeton NJ 08540-6620 USA
;;; voice: 609/951-2705
;;; FAX: 609/951-2483
;;; Qobi@research.nj.nec.com
;;; ftp://ftp.nj.nec.com/pub/qobi
;;; http://www.neci.nj.nec.com/homepages/qobi
(module pp (main main))
(define (first x) (car x))
(define (rest x) (cdr x))
(define (second x) (cadr x))
(define (reduce f l i)
(cond ((null? l) i)
((null? (rest l)) (first l))
(else (let loop ((l (rest l)) (c (first l)))
(if (null? l) c (loop (rest l) (f c (first l))))))))
(define (slashify string)
(let loop ((input (string->list string)) (output '()))
(cond ((null? input) (list->string (reverse output)))
((and (not (null? input))
(not (null? (rest input)))
(or (char=? (first input) #\+) (char=? (first input) #\-))
(char=? (second input) #\.))
(loop (rest (rest input))
(cons (second input) (cons (first input) (cons #\\ output)))))
(else (loop (rest input) (cons (first input) output))))))
(define (main arguments)
(set-write-pretty! #t)
(let ((string (reduce string-append (rest arguments) "")))
(if (< (string-length string) 80)
(display string)
(write (read (open-input-string (slashify string)))))))
;;; Tam V'Nishlam Shevah L'El Borei Olam
|
