1;;;; -*-Mode:LISP; Package:LISP; Base:10; Syntax:ISLISP -*- 2;;;; Title: fprint.lsp 3;;;; Author: Richard Gabriel 4;;;; License: New BSD license 5;;;; ISLISP: Yes 6;;;; CVS: $Id: fprint.lsp,v 1.8 2013/06/18 05:21:53 jullien Exp $ 7 8;;; (19) FPRINT -- Benchmark to print to a file. 9 10;; NOTE, *test-atoms* has been modified to match ISLISP syntax 11;; reader for symbols and numbers. 12 13(defglobal *test-atoms* 14 '(abcdef12 cdefgh23 efghij34 ghijkl45 ijklmn56 klmnop67 15 mnopqr78 opqrst89 qrstuv90 stuvwx01 uvwxyz12 16 wxyzab23 xyzabc34 _23456ab [34567bc {45678cd 17 <56789de >67890xf ]78901fg }89012gh *90123hi)) 18 19(defun init-aux (m n atoms) 20 (cond ((= m 0) 21 (car atoms)) 22 (t (for ((i n (- i 2)) 23 (a ())) 24 ((< i 1) a) 25 (setf a (cons (car atoms) a)) 26 (setf atoms (cdr atoms)) 27 (setf a (cons (init-aux (- m 1) n atoms) a)))))) 28 29(defun init (m n atoms) 30 (let ((at (mapcar #'identity atoms))) ;; (copy-list atoms) 31 (for ((a at (cdr a))) 32 ((null (cdr a)) (set-cdr at a))) 33 (init-aux m n at))) 34 35(defglobal test-pattern (init 6 6 *test-atoms*)) 36 37(defun fprint () 38 (let ((stream (open-output-file "fprint.tst"))) 39 (format stream "~S~%" test-pattern) 40 (close stream) 41 t)) 42 43;;; call: (fprint) 44