[Gd-chatter] r10835 - trunk/ltd/code

[housel at gwydiondylan.org]

Author: housel
Date: Wed Jul 26 07:45:40 2006
New Revision: 10835

Added:
   trunk/ltd/code/package.lisp   (contents, props changed)
Modified:
   trunk/ltd/code/dpp.lisp
   trunk/ltd/code/loop.lisp
   trunk/ltd/code/ltd-table.lisp
   trunk/ltd/code/ltd.lisp
   trunk/ltd/code/misc.lisp
   trunk/ltd/code/options.lisp
   trunk/ltd/code/read.lisp
   trunk/ltd/code/tables.lisp
Log:
Bug: 7322
- Create a package ("LTD") instead of using "CL-USER".
- Fix various style warnings found by SBCL.


Modified: trunk/ltd/code/dpp.lisp
==============================================================================
--- trunk/ltd/code/dpp.lisp	(original)
+++ trunk/ltd/code/dpp.lisp	Wed Jul 26 07:45:40 2006
@@ -1,6 +1,6 @@
 ;;; -*- Mode: lisp; Syntax: common-lisp; -*- Author: Peter Norvig
 ;;;     File: dpp.lisp; Date: 29-Aug-95 
-(in-package :cl-user)
+(in-package :ltd)
 
 ;;;; DPP: DYLAN PRETTY-PRINTER
 

Modified: trunk/ltd/code/loop.lisp
==============================================================================
--- trunk/ltd/code/loop.lisp	(original)
+++ trunk/ltd/code/loop.lisp	Wed Jul 26 07:45:40 2006
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: User; -*-
-(in-package :cl-user)
+(in-package :ltd)
 
 ;;;; CVT-LOOP and friends
 

Modified: trunk/ltd/code/ltd-table.lisp
==============================================================================
--- trunk/ltd/code/ltd-table.lisp	(original)
+++ trunk/ltd/code/ltd-table.lisp	Wed Jul 26 07:45:40 2006
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- Author: Peter Norvig
 ;;;     File: ltd-table.lisp; Date: /95
-(in-package :cl-user)
+(in-package :ltd)
 
 ;;;; Functions called from the (ltd-fn ...) table in tables.lisp
 
@@ -151,7 +151,7 @@
 	(t (cvt-exp exp))))
 
 (defun cvt-setf (exp)
-  (maybe-begin (loop for (var val) on (args exp) by 'cddr
+  (maybe-begin (loop for (var val) on (args exp) by #'cddr
 		     collect `(:= ,(cvt-exp var) ,(cvt-exp val)))))
 
 (defun binding-var (binding) (if (consp binding) (first/ binding) binding))
@@ -580,7 +580,7 @@
 (defun cvt-keys (keys)
   ;; Leave the key/value pair alone, except
   ;; replace :test-not f with :test (complement f)
-  (loop for sublist on keys by 'cddr
+  (loop for sublist on keys by #'cddr
         do (when (and (eq (first/ sublist) ':test-not) (length>1 sublist))
 	     (setf (first sublist) ':test)
              (setf (second sublist) `(complement ,(second/ sublist)))))

Modified: trunk/ltd/code/ltd.lisp
==============================================================================
--- trunk/ltd/code/ltd.lisp	(original)
+++ trunk/ltd/code/ltd.lisp	Wed Jul 26 07:45:40 2006
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- Author: Peter Norvig
 ;;;     File: convert.lisp; Date: 28-Aug-95
-(in-package :cl-user)
+(in-package :ltd)
 
 ;;;; LTD: CONVERT FROM COMMON LISP TO DYLAN - TOP-LEVEL FUNCTION
 

Modified: trunk/ltd/code/misc.lisp
==============================================================================
--- trunk/ltd/code/misc.lisp	(original)
+++ trunk/ltd/code/misc.lisp	Wed Jul 26 07:45:40 2006
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- Author: Peter Norvig
 ;;;     File: misc.lisp; Date: 8-Sep-95
-(in-package :cl-user)
+(in-package :ltd)
 
 ;;;; MISC. FUNCTIONS: UTILITY FUNCTIONS
 

Modified: trunk/ltd/code/options.lisp
==============================================================================
--- trunk/ltd/code/options.lisp	(original)
+++ trunk/ltd/code/options.lisp	Wed Jul 26 07:45:40 2006
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- Author: Peter Norvig
 ;;;     File: options.lisp; Date: 2/Feb/95
-(in-package :cl-user)
+(in-package :ltd)
 
 ;;;; OPTIONS: FACILITY FOR DEFINING, SETTING. AND QUERYING OPTIONS
 
@@ -19,8 +19,6 @@
 (defstruct (option (:type list))
   name value type doc)
 
-;(deftype boolean () '(member t nil))
-
 (defparameter *default-options*
     `(
       ;; Options for the conversion from Lisp to Dylan
@@ -91,7 +89,7 @@
   (when ?
     (dolist (option *options*)
       (setf (option-value option) :?)))
-  (loop for (key val) on inits by 'cddr do
+  (loop for (key val) on inits by #'cddr do
 	(unless (member key '(:? :default))
 	  (set-option key val)))
   *options*)

Added: trunk/ltd/code/package.lisp
==============================================================================
--- (empty file)
+++ trunk/ltd/code/package.lisp	Wed Jul 26 07:45:40 2006
@@ -0,0 +1,7 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-
+
+(defpackage :ltd
+  (:use :common-lisp)
+  (:export #:ltd-files))
+
+

Modified: trunk/ltd/code/read.lisp
==============================================================================
--- trunk/ltd/code/read.lisp	(original)
+++ trunk/ltd/code/read.lisp	Wed Jul 26 07:45:40 2006
@@ -1,5 +1,5 @@
 ;;;; LTD-READ: PRESERVES COMMENTS AND REMEMBERS FILE POSITIONS
-(in-package :cl-user)
+(in-package :ltd)
 
 (defvar *eof* "eof")
 (defvar *file-position-table* (make-hash-table :test #'eq))
@@ -49,6 +49,11 @@
   (let ((*readtable* *lisp-readtable*))
     (funcall *lisp-array* stream char arg)))
 
+(defun read-char-if (stream char)
+  (if (eql (peek-char nil stream nil nil) char)
+      (read-char stream)
+      nil))
+
 (defun collect-comments (stream char &optional arg comment-so-far)
   ;; Gather up comments, then either attach to following exp
   ;; or return no values (thus silently ignoring the comments).
@@ -121,8 +126,3 @@
   "Read a Lisp expression, preserving comments and file positions."
   (let* ((*readtable* *ltd-readtable*))
     (record-file-positions stream (read stream nil *eof*))))
-
-(defun read-char-if (stream char)
-  (if (eql (peek-char nil stream nil nil) char)
-      (read-char stream)
-      nil))

Modified: trunk/ltd/code/tables.lisp
==============================================================================
--- trunk/ltd/code/tables.lisp	(original)
+++ trunk/ltd/code/tables.lisp	Wed Jul 26 07:45:40 2006
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- Author: Peter Norvig
 ;;;     File: tables.lisp; Date: 31-Aug-95
-(in-package :cl-user)
+(in-package :ltd)
 
 ;;;; CLtL2 CONSTANTS