112 lines
5.0 KiB
Common Lisp
112 lines
5.0 KiB
Common Lisp
;;; Copyright 2013 Google Inc.
|
|
;;;
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|
;;; you may not use this file except in compliance with the License.
|
|
;;; You may obtain a copy of the License at
|
|
;;;
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
|
;;;
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
;;; See the License for the specific language governing permissions and
|
|
;;; limitations under the License.
|
|
|
|
;;; Lisp structures encapsulate data which belongs together. They are a template
|
|
;;; of sorts, providing a way to generate multiple instances of uniformly
|
|
;;; organized information
|
|
;;; Defining a structure also interns accessor functions to get and set the
|
|
;;; slots of that structure.
|
|
|
|
;;; The following form creates a new structure class named BASKETBALL-PLAYER
|
|
;;; with slots named NAME, TEAM, and NUMBER.
|
|
;;; This additionally creates functions MAKE-BASKETBALL-PLAYER,
|
|
;;; COPY-BASKETBALL-PLAYER, BASKETBALL-PLAYER-P, BASKETBALL-PLAYER-NAME,
|
|
;;; BASKETBALL-PLAYER-TEAM, and BASKETBALL-PLAYER-NUMBER.
|
|
|
|
(defstruct basketball-player
|
|
name team number)
|
|
|
|
(define-test make-struct
|
|
(let ((player (make-basketball-player :name "Larry" :team :celtics
|
|
:number 33)))
|
|
(true-or-false? t (basketball-player-p player))
|
|
(assert-equal "Larry" (basketball-player-name player))
|
|
(assert-equal :celtics (basketball-player-team player))
|
|
(assert-equal 33 (basketball-player-number player))
|
|
(setf (basketball-player-team player) :retired)
|
|
(assert-equal :retired (basketball-player-team player))))
|
|
|
|
;;; Structure fields can have default values.
|
|
|
|
(defstruct baseball-player
|
|
name (team :red-sox) (position :outfield))
|
|
|
|
(define-test struct-defaults
|
|
(let ((player (make-baseball-player)))
|
|
;; We have not specified a default value for NAME, therefore we cannot
|
|
;; read it here - it would invoke undefined behaviour.
|
|
(assert-equal :red-sox (baseball-player-team player))
|
|
(assert-equal :outfield (baseball-player-position player))))
|
|
|
|
;;; The accessor names can get pretty long. It's possible to specify a different
|
|
;;; prefix with the :CONC-NAME option.
|
|
|
|
(defstruct (american-football-player (:conc-name nfl-guy-))
|
|
name position team)
|
|
|
|
(define-test struct-access
|
|
(let ((player (make-american-football-player
|
|
:name "Drew Brees" :position :qb :team "Saints")))
|
|
(assert-equal "Drew Brees" (nfl-guy-name player))
|
|
(assert-equal "Saints" (nfl-guy-team player))
|
|
(assert-equal :qb (nfl-guy-position player))))
|
|
|
|
;;; Structs can be defined to include other structure definitions.
|
|
;;; This form of inheritance allows composition of objects.
|
|
|
|
(defstruct (nba-contract (:include basketball-player))
|
|
salary start-year end-year)
|
|
|
|
(define-test structure-inheritance
|
|
(let ((contract (make-nba-contract :salary 136000000
|
|
:start-year 2004 :end-year 2011
|
|
:name "Kobe Bryant"
|
|
:team :lakers :number 24)))
|
|
(assert-equal 2004 (nba-contract-start-year contract))
|
|
(assert-equal 'nba-contract (type-of contract))
|
|
;; Inherited structures follow the rules of type hierarchy.
|
|
(true-or-false? t (typep contract 'basketball-player))
|
|
;; One can access structure fields both with the structure's own accessors
|
|
;; and with the inherited accessors.
|
|
(assert-equal :lakers (nba-contract-team contract))
|
|
(assert-equal :lakers (basketball-player-team contract))))
|
|
|
|
;;; Copying a structure named FOO is handled with the COPY-FOO function.
|
|
;;; All such copies are shallow.
|
|
|
|
(define-test structure-equality-and-copying
|
|
(let ((manning-1 (make-american-football-player
|
|
:name "Manning" :team (list "Colts" "Broncos")))
|
|
(manning-2 (make-american-football-player
|
|
:name "Manning" :team (list "Colts" "Broncos"))))
|
|
;; MANNING-1 and MANNING-2 are different objects...
|
|
(true-or-false? nil (eq manning-1 manning-2))
|
|
;;...but they contain the same information.
|
|
(true-or-false? t (equalp manning-1 manning-2))
|
|
(let ((manning-3 (copy-american-football-player manning-1)))
|
|
(true-or-false? nil (eq manning-1 manning-3))
|
|
(true-or-false? t (equalp manning-1 manning-3))
|
|
;; Setting the slot of one instance does not modify the others...
|
|
(setf (nfl-guy-name manning-1) "Rogers")
|
|
(true-or-false? nil (string= (nfl-guy-name manning-1)
|
|
(nfl-guy-name manning-3)))
|
|
(assert-equal "Rogers" (nfl-guy-name manning-1))
|
|
(assert-equal "Manning" (nfl-guy-name manning-3))
|
|
;; ...but modifying shared structure may affect other instances.
|
|
(setf (car (nfl-guy-team manning-1)) "Giants")
|
|
(true-or-false? t (string= (car (nfl-guy-team manning-1))
|
|
(car (nfl-guy-team manning-3))))
|
|
(assert-equal "Giants" (car (nfl-guy-team manning-1)))
|
|
(assert-equal "Giants" (car (nfl-guy-team manning-3))))))
|