Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 103 lines (84 sloc) 3.691 kb
0a90bf7 @nklein Deprecated this library in favor of ContextL
authored
1 ;; Copyright (c) 2011 nklein software
2 ;; MIT License. See included LICENSE.txt file for licensing details.
3
4 ;; load the ContextL library
5 (require 'contextl)
6
7 ;; prepare some layers for the welcom
8 (contextl:deflayer :latin)
9 (contextl:deflayer :pig-latin (:latin))
10 (contextl:deflayer :french)
11 (contextl:deflayer :spanish)
12
13 ;; declare our method
14 (contextl:define-layered-function welcome ())
15
16 ;; define a variant of our method without a version
17 (contextl:define-layered-method welcome ()
18 :welcome)
19
20 ;; set up a macro to quickly let us make some versioned about methods
21 (defmacro defwelcome ((version) &body body)
22 `(contextl:define-layered-method welcome :in ,version ()
23 ,@body))
24
25 ;; make some versioned welcome methods
26 (defwelcome (:latin) :velkominum) ;; someone fire that translator
27 (defwelcome (:pig-latin) :elcomeway)
28 (defwelcome (:french) :bonjour)
29
30 ;; define a little helper macro because the contextl:with-active-layers
31 ;; macro quotes things we don't want to have quoted
32 (defmacro with-layer ((layer) &body body)
33 `(unwind-protect
34 (progn
35 (when ,layer (contextl:ensure-active-layer ,layer))
36 ,@body)
37 (when ,layer (contextl:ensure-inactive-layer ,layer))))
38
39 ;; verify
40 (let ((greets (mapcar #'(lambda (vv)
41 (with-layer (vv)
42 (welcome)))
43 '(nil :latin :pig-latin :french :spanish))))
44 (format t "Greets: ~S~%" greets)
45 (assert (equal greets
46 '(:welcome :velkominum :elcomeway :bonjour :welcome))))
47
48 ;; prepare some versions for the serialize methods
49 (contextl:deflayer :v1)
50 (contextl:deflayer :v1.1 (:v1))
51 (contextl:deflayer :v1.2 (:v1.1))
52 (contextl:deflayer :v2 (:v1))
53
54 ;; declare the serialize method
55 (contextl:define-layered-function serialize (value))
56
57 ;; set up a function that turns an integer VALUE into a list of a
58 ;; given number of BYTES (in big-endian order).
59 (defun encode-int (value bytes)
60 (loop :for bb :from (1- bytes) :downto 0
61 :collecting (ldb (byte 8 (* bb 8)) value)))
62
63 ;; Originally, we think integers can always fit in 2 bytes and
64 ;; we can just encode strings as strings.
65 (contextl:define-layered-method serialize ((value integer))
66 (encode-int value 2))
67
68 (contextl:define-layered-method serialize ((value string))
69 value)
70
71 ;; Then, we realized that we really should have put more
72 ;; information when encoding as a string, like the fact that
73 ;; it is a string and the length of the string.
74 (contextl:define-layered-method serialize :in :v1 ((value string))
75 (list :string (serialize (length value)) value))
76
77 ;; Oops, we realized after :v1.0 that we need more than two bytes,
78 ;; so we up it to 4 bytes.
79 (contextl:define-layered-method serialize :in :v1.1 ((value integer))
80 (encode-int value 4))
81
82 ;; In :v1.2, we think we can get away without the length of the string
83 (contextl:define-layered-method serialize :in :v1.2 ((value string))
84 (list :string value))
85
86 ;; In :v1.2, we came dangerously close to overflowing 4 bytes for
87 ;; an int, so we upped it to 8 bytes for :v2.
88 (contextl:define-layered-method serialize :in :v2 ((value integer))
89 (encode-int value 8))
90
91 ;; And, now we test all of our versions
92 (let ((encoded-strings (mapcar #'(lambda (vv)
93 (with-layer (vv)
94 (serialize "foo")))
95 '(nil :v1 :v1.1 :v1.2 :v2))))
96 (format t "Encoded strings: ~S~%" encoded-strings)
97 (assert (equalp encoded-strings
98 '("foo"
99 (:string (0 3) "foo")
100 (:string (0 0 0 3) "foo")
101 (:string "foo")
102 (:string (0 0 0 0 0 0 0 3) "foo")))))
Something went wrong with that request. Please try again.