add Adam's name to copyright of serialisation code

contrib/serialize/serialize.factor

@@ -1,5 +1,11 @@
-! Copyright (C) 2006 Chris Double.
+! Copyright (C) 2006 Adam Langley and Chris Double.
+! Adam Langley was the original author of this work.
+!
+! Chris Double modified it to fix bugs and get it working
+! correctly under the latest versions of Factor.
+!
 ! See http://factorcode.org/license.txt for BSD license.
+!
 IN: serialize
 USING: kernel  math hashtables namespaces io strings sequences generic words errors arrays vectors ;
 
@@ -21,119 +27,119 @@ USE: prettyprint
 GENERIC: (serialize)  ( obj -- )
 
 M: f (serialize) ( obj -- )
-	drop "n" write ;
+  drop "n" write ;
 
 M: fixnum (serialize) ( obj -- )
-	! Factor may use 64 bit fixnums on such systems
+  ! Factor may use 64 bit fixnums on such systems
-	"f" write
+  "f" write
-	4 >be write ;
+  4 >be write ;
 
 : bytes-needed ( bignum -- int )
-	log2 8 + 8 / floor ;
+  log2 8 + 8 / floor ;
 
 M: bignum (serialize) ( obj -- )
-	"b" write
+  "b" write
-	dup bytes-needed (serialize)
+  dup bytes-needed (serialize)
-	dup bytes-needed >be write ;
+  dup bytes-needed >be write ;
 
 M: float (serialize) ( obj -- )
-	"F" write
+  "F" write
-	float>bits (serialize) ;
+  float>bits (serialize) ;
 
 M: complex (serialize) ( obj -- )
-	"c" write
+  "c" write
-	dup real (serialize)
+  dup real (serialize)
-	imaginary (serialize) ;
+  imaginary (serialize) ;
 
 M: ratio (serialize) ( obj -- )
-	"r" write
+  "r" write
-	dup numerator (serialize)
+  dup numerator (serialize)
-	denominator (serialize) ;
+  denominator (serialize) ;
 
 M: string (serialize) ( obj -- )
-	"s" write
+  "s" write
-	dup length (serialize)
+  dup length (serialize)
-	write ;
+  write ;
 
 M: object (serialize) ( obj -- )
-	class word-name "Don't know to serialize a " swap append throw ;
+  class word-name "Don't know to serialize a " swap append throw ;
 
 M: sbuf (serialize) ( obj -- )
-	"S" write 
+  "S" write 
-	dup length (serialize)
+  dup length (serialize)
-	[ (serialize) ] each ;
+  [ (serialize) ] each ;
 
 : (serialize-seq) ( seq code -- )
-	over object-id [
+  over object-id [
-          "o" write (serialize) 2drop
+    "o" write (serialize) 2drop
-        ] [ 
+  ] [ 
-	  write
+    write
-	  dup add-object (serialize)
+    dup add-object (serialize)
-	  dup length (serialize)
+    dup length (serialize)
-	  [ (serialize) ] each
+    [ (serialize) ] each
-        ] if* ;
+  ] if* ;
 
-M: tuple (serialize)
+M: tuple (serialize) ( obj -- )
-	dup object-id [
+  dup object-id [
-	  "o" write (serialize) 2drop
+    "o" write (serialize) 2drop
-        ] [
+  ] [
-	  "t" write 
+    "t" write 
-	  dup add-object (serialize)
+    dup add-object (serialize)
-	  tuple>array (serialize) 
+    tuple>array (serialize) 
-	] if* ;
+  ] if* ;
 
-M: array (serialize)
+M: array (serialize) ( obj -- )
-	"a" (serialize-seq) ;
+  "a" (serialize-seq) ;
 
-M: vector (serialize)
+M: vector (serialize) ( obj -- )
-	"v" (serialize-seq) ;
+  "v" (serialize-seq) ;
 
-M: quotation (serialize)
+M: quotation (serialize) ( obj -- )
-	"q" (serialize-seq) ;
+  "q" (serialize-seq) ;
 
-M: hashtable (serialize)
+M: hashtable (serialize) ( obj -- )
-	dup object-id [
+  dup object-id [
-	  "o" write (serialize) 2drop
+    "o" write (serialize) 2drop
-        ] [
+  ] [
-	  "h" write
+    "h" write
-	  dup add-object (serialize)
+    dup add-object (serialize)
-	  hash>alist (serialize)
+    hash>alist (serialize)
-	] if* ;
+  ] if* ;
 
-M: word (serialize)
+M: word (serialize) ( obj -- )
-	"w" write
+  "w" write
-	dup word-name (serialize)
+  dup word-name (serialize)
-	word-vocabulary (serialize) ;
+  word-vocabulary (serialize) ;
 
-M: wrapper (serialize)
+M: wrapper (serialize) ( obj -- )
-	"W" write
+  "W" write
-	wrapped (serialize) ;
+  wrapped (serialize) ;
 
-DEFER: (deserialize)
+DEFER: (deserialize) ( -- obj )
 
 : deserialize-false ( -- f )
-	f ;
+  f ;
 
-: deserialize-fixnum
+: deserialize-fixnum ( -- fixnum )
-	4 read be> ;
+  4 read be> ;
 
-: deserialize-string
+: deserialize-string ( -- string )
-	(deserialize) read ;
+  (deserialize) read ;
 
-: deserialize-ratio
+: deserialize-ratio ( -- ratio )
-	(deserialize) (deserialize) / ;
+  (deserialize) (deserialize) / ;
 
-: deserialize-complex
+: deserialize-complex ( -- complex )
-	(deserialize) (deserialize) rect> ;
+  (deserialize) (deserialize) rect> ;
 
-: deserialize-bignum
+: deserialize-bignum ( -- bignum )
-	(deserialize) read be> ;
+  (deserialize) read be> ;
 
-: deserialize-word
+: deserialize-word ( -- word )
-	(deserialize) dup (deserialize) lookup dup [ nip ] [ "Unknown word" throw ] if ;
+  (deserialize) dup (deserialize) lookup dup [ nip ] [ "Unknown word" throw ] if ;
 
-: deserialize-wrapper
+: deserialize-wrapper ( -- wrapper )
-	(deserialize) <wrapper> ;
+  (deserialize) <wrapper> ;
 
 : deserialize-array ( -- array )
   (deserialize)     
@@ -167,23 +173,23 @@ DEFER: (deserialize)
 : deserialize-unknown ( -- object )
   (deserialize) serialized get nth ;
 
-: (deserialize)
+: (deserialize) ( -- object )
-	read1 ch>string dup
+  read1 ch>string dup
-	H{ { "f" deserialize-fixnum }
+  H{ { "f" deserialize-fixnum }
-           { "s" deserialize-string }
+     { "s" deserialize-string }
-	   { "r" deserialize-ratio }
+     { "r" deserialize-ratio }
-	   { "c" deserialize-complex }
+     { "c" deserialize-complex }
-	   { "b" deserialize-bignum }
+     { "b" deserialize-bignum }
-	   { "w" deserialize-word }
+     { "w" deserialize-word }
-	   { "W" deserialize-wrapper }
+     { "W" deserialize-wrapper }
-	   { "n" deserialize-false }
+     { "n" deserialize-false }
-	   { "a" deserialize-array }
+     { "a" deserialize-array }
-	   { "v" deserialize-vector }
+     { "v" deserialize-vector }
-	   { "q" deserialize-quotation }
+     { "q" deserialize-quotation }
-	   { "h" deserialize-hashtable }
+     { "h" deserialize-hashtable }
-	   { "o" deserialize-unknown }
+     { "o" deserialize-unknown }
-	 }
+  }
-	hash dup [ "Unknown typecode" throw ] unless nip execute ;
+  hash dup [ "Unknown typecode" throw ] unless nip execute ;
 
 : serialize ( obj -- )
   [