Commits

Michele Bini  committed 3975d08

MIT style licensing terms; add test script

  • Participants
  • Parent commits df4ea28

Comments (0)

Files changed (6)

+Copyright (c) 2012 Michele Bini
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is furnished
+to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
 # Copyright (c) 2012 Michele Bini
 
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the version 3 of the GNU General Public License
-# as published by the Free Software Foundation.
-
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is furnished
+# to do so, subject to the following conditions:
+
+# The above copyright notice and this permission notice shall be included in all
+# copies or substantial portions of the Software.
+
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
 
 ALL=test
 all: $(ALL)
 
 This code was written in Mythryl: http://www.mythryl.org
 
-Licensing:
-
-Please consult the individual files for the copyright notices.   I
-(Michele) will release them with a BSD-style or the MIT license given
-a small compensation for the ~5 hours work (at least 90 EUR or 15
-BTC).
+The code is released with a MIT-style license (see the LICENSE file)
 
 Performance:
 

File real-time-queue--complexity.pkg

 # Copyright (c) 2012 Michele Bini
 
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is furnished
+# to do so, subject to the following conditions:
 
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
+# The above copyright notice and this permission notice shall be included in all
+# copies or substantial portions of the Software.
 
-# You should have received a copy of the GNU General Public License
-# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
 
 # This is an adaptation to Mythryl of an implementation of purely
 # functional, hard real-time queues, based on lazy lists and

File real-time-queue.pkg

 # Copyright (c) 2012 Michele Bini
 
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is furnished
+# to do so, subject to the following conditions:
 
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
+# The above copyright notice and this permission notice shall be included in all
+# copies or substantial portions of the Software.
 
-# You should have received a copy of the GNU General Public License
-# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
 
 # This is an adaptation to Mythryl of an implementation of purely
 # functional, hard real-time queues, based on lazy lists and

File test/real-time-queues

+#!/usr/bin/mythryl
+
+load "../fingerdeque/finger-deque.lib";
+
+# Requires: standard
+
+# A first, near-verbatim implementation of Real-Time Queues from:
+
+# Purely Functional Data Structures
+
+#          Chris Okasaki
+#         September 1996
+#         CMU-CS-96-177
+
+# page 43
+
+package real_time_queue__verbatim {
+    stipulate
+	include lazy;
+	package stream {
+	    stipulate
+		package data {
+		    Stream(X) = NIL | CONS(X, Suspension(Stream(X)));
+		};
+	    herein
+		fun from_list(NIL) => data::NIL;
+		    from_list(x!r) => data::CONS(x, delay(fn () = from_list(r)));
+		end;
+		
+		include data;
+	    end;
+	};
+	package stm = stream;
+    herein
+	
+	Queue(X) = QUEUE { f: stm::Stream(X), r: List(X), s: stm::Stream(X) };
+	
+	empty = QUEUE { f => stm::NIL, r => [], s => stm::NIL };
+	
+	fun isempty(QUEUE { f => stm::NIL, ... }) => TRUE;
+	    isempty _ => FALSE;
+	end;
+	
+	exception INTERNAL_ERROR;
+	
+	fun rotate(f, r, a) = delay(fn () = case (f, r)
+	     (stm::NIL,     stm::CONS(y, _))   => stm::CONS(y, delay(fn () = a));
+	     (stm::CONS(x, f'),  stm::CONS(y, r'))  => stm::CONS(x, rotate(force(f'), force(r'), stm::CONS(y, delay(fn () = a))));
+	     _ => raise exception INTERNAL_ERROR;
+	esac);
+	
+	fun queue { f, r, s } = case (s)
+	     stm::CONS(x, s)  => QUEUE { f, r, s => force(s) };
+	     stm::NIL  => {
+		 my f' = force(rotate(f, (stm::from_list r), stm::NIL));
+		 QUEUE { f => f', r => NIL, s => f' };
+	     };
+	esac;
+	
+	fun snoc( QUEUE { f, r, s }, x ) = queue { f, r => x!r, s };
+	
+	exception EMPTY;
+	
+	fun head( QUEUE { f => stm::NIL, ... } )    => raise exception EMPTY;
+	    head( QUEUE { f => stm::CONS(x, _), ... } )  => x;
+	end;
+	
+	fun tail( QUEUE { f => stm::NIL, ... } )     => raise exception EMPTY;
+	    tail( QUEUE { f => stm::CONS(x, f), r, s } )  => queue { f => force(f), r, s };
+	end;
+    end;
+};
+
+package real_time_queue {
+    stipulate
+	include lazy;
+	package stream {
+	    stipulate
+		package data {
+		    Stream(X) = NIL | CONS(X, Suspension(Stream(X)));
+		};
+	    herein
+		fun from_list(NIL) => data::NIL;
+		    from_list(x!r) => data::CONS(x, delay(fn () = from_list(r)));
+		end;
+		
+		include data;
+	    end;
+	};
+	package stm = stream;
+    herein
+	
+	Queue(X) = QUEUE { f: stm::Stream(X), r: List(X), s: stm::Stream(X) };
+	
+	empty = QUEUE { f => stm::NIL, r => [], s => stm::NIL };
+	
+	# fun make_empty () = QUEUE { f => stm::NIL, r => [], s => stm::NIL };
+	
+	# empty = make_empty();
+	
+	fun isempty(QUEUE { f => stm::NIL, ... }) => TRUE;
+	    isempty _ => FALSE;
+	end;
+	
+	stipulate	
+	    exception REAL_TIME_QUEUE_INTERNAL_ERROR;
+
+	    fun rotate(f, r, a) = delay(fn () = case (f, r)
+		 (stm::NIL,     stm::CONS(y, _))   => stm::CONS(y, delay(fn () = a));
+		 (stm::CONS(x, f'),  stm::CONS(y, r'))  => stm::CONS(x, rotate(force(f'), force(r'), stm::CONS(y, delay(fn () = a))));
+		 _ => raise exception REAL_TIME_QUEUE_INTERNAL_ERROR;
+	    esac);
+
+	    fun queue { f, r, s } = case (s)
+		 stm::CONS(x, s)  => QUEUE { f, r, s => force(s) };
+		 stm::NIL  => {
+		     my f' = force(rotate(f, (stm::from_list r), stm::NIL));
+		     QUEUE { f => f', r => NIL, s => f' };
+		 };
+	    esac;	    
+	herein
+	    fun snoc( QUEUE { f, r, s }, x ) = queue { f, r => x!r, s };
+	     
+	    exception EMPTY;
+	    
+	    fun head( QUEUE { f => stm::NIL, ... } )    => raise exception EMPTY;
+		head( QUEUE { f => stm::CONS(x, _), ... } )  => x;
+	    end;
+	    
+	    fun tail( QUEUE { f => stm::NIL, ... } )     => raise exception EMPTY;
+		tail( QUEUE { f => stm::CONS(x, f), r, s } )  => queue { f => force(f), r, s };
+	    end;
+	end;
+    end;
+};
+
+# Augmentation of the former with complexity analisys
+package real_time_queue__complexity {
+    package complexity {
+	package sst = string_map;
+	recorded_complexities = REF (sst::empty : sst::Map(Int));
+	complexity_counter = REF(0);
+
+	# To evaluate complexity, annotate all recursive calls with
+	# the following operator:
+	# Example: fun loop (FOO) => loop / (BAR); ...
+	# This operator does not break tail recursion.
+	fun f / x = {
+	    complexity_counter := *complexity_counter + 1;
+	    f(x);
+	};
+
+	# Record measurement of complexity for function f
+	fun record (name, f) x = {
+	    my c = *complexity_counter;
+	    my r = f(x);
+	    my c = *complexity_counter - c;
+	    if (case (sst::get(*recorded_complexities, name))
+			NULL => TRUE;
+			THE(p) => (c > p);
+		 esac)
+		 recorded_complexities :=
+		     sst::set(*recorded_complexities, name, c);
+		 ();
+	    fi;
+	    r;
+	};
+
+	fun stats () = {
+	    # Pretty print per-function statistics:
+	    apply (fn (k, v) = printf "Recorded worst-case complexity for '%s' is %d\n" k v)
+		(sst::keyvals_list(*recorded_complexities));
+	};
+
+	# Reset statistics
+	fun reset() = {
+	    recorded_complexities  := sst::empty;
+	    complexity_counter     := 0;
+	};
+    };
+    (/) = complexity::(/);
+    
+    stipulate
+	include lazy;
+	package stream {
+	    stipulate
+		package data {
+		    Stream(X) = NIL | CONS(X, Suspension(Stream(X)));
+		};
+	    herein
+		fun from_list(NIL) => data::NIL;
+		    from_list(x!r) => data::CONS(x, delay(fn () = from_list / (r)));
+		end;
+		
+		include data;
+	    end;
+	};
+	package stm = stream;
+    herein
+	
+	Queue(X) = QUEUE { f: stm::Stream(X), r: List(X), s: stm::Stream(X) };
+	
+	empty = QUEUE { f => stm::NIL, r => [], s => stm::NIL };
+	
+	# fun make_empty () = QUEUE { f => stm::NIL, r => [], s => stm::NIL };
+	
+	# empty = make_empty();
+	
+	fun isempty(QUEUE { f => stm::NIL, ... }) => TRUE;
+	    isempty _ => FALSE;
+	end;
+	
+	exception INTERNAL;
+	
+	stipulate	
+	    exception INTERNAL;
+
+	    fun rotate(f, r, a) = delay(fn () = case (f, r)
+		 (stm::NIL,     stm::CONS(y, _))   => stm::CONS(y, delay(fn () = a));
+		 (stm::CONS(x, f'),  stm::CONS(y, r'))  => stm::CONS(x, rotate / (force(f'), force(r'), stm::CONS(y, delay(fn () = a))));
+		 _ => raise exception INTERNAL;
+	    esac);
+
+	    fun queue { f, r, s } = case (s)
+		 stm::CONS(x, s)  => QUEUE { f, r, s => force(s) };
+		 stm::NIL  => {
+		     my f' = force(rotate(f, (stm::from_list r), stm::NIL));
+		     QUEUE { f => f', r => NIL, s => f' };
+		 };
+	    esac;	    
+	herein
+	    fun snoc( QUEUE { f, r, s }, x ) = queue { f, r => x!r, s };
+	     
+	    exception EMPTY;
+	    
+	    fun head( QUEUE { f => stm::NIL, ... } )    => raise exception EMPTY;
+		head( QUEUE { f => stm::CONS(x, _), ... } )  => x;
+	    end;
+	    
+	    fun tail( QUEUE { f => stm::NIL, ... } )     => raise exception EMPTY;
+		tail( QUEUE { f => stm::CONS(x, f), r, s } )  => queue { f => force(f), r, s };
+	    end;
+	end;
+
+	snoc = fn x = complexity::record ("snoc", snoc) x;
+	tail = fn x = complexity::record ("tail", tail) x;
+	
+    end;
+};
+
+fun time(thunk) = {
+    a = sec();
+    thunk();
+    b = sec();
+    (b - a);
+} where
+    timer = cpu_timer::get_cpu_timer();
+    fun sec () = cpu_timer::get_elapsed_cpu_seconds(timer);
+end;
+
+package float = eight_byte_float;
+
+stipulate
+    package que = finger_deque;
+herein
+    fun block_test n = {
+	printf "\nFinger deque: inserting and removing %d elements: " n;
+	my sec = time(.{
+	      my q = { for (q = que::empty_queue, c = 0; c < n; q = que::push(q, c), ++c; q) { }; };
+	      my q = { for (q = q, c = 0; c < n; q = que::push(#1(que::pull(q)), c), ++c; q) { }; };
+	      { for (q = q; !(que::queue_is_empty(q)); q = #1(que::pull(q))) { }; };
+	});
+	printf "%f s total, %f average microsec/element\n" sec (sec * 1000000.0 // float::from_int(n));
+    };
+    block_test(30);
+    block_test(30*30);
+    block_test(30*30*30*15);
+    block_test(30*30*30*30);
+    block_test(30*30*30*30*5);
+end;
+
+stipulate
+    package que = real_time_queue;
+herein
+    fun block_test n = {
+	printf "\nReal time queue: inserting and removing %d elements: " n;
+	my sec = time(.{
+	      my q = { for (q = que::empty, c = 0; c < n; q = que::snoc(q, c), ++c; q) { }; };
+	      my q = { for (q = q, c = 0; c < n; q = que::snoc(que::tail(q), c), ++c; q) { }; };
+	      { for (q = q; !(que::isempty(q)); q = que::tail(q)) { }; };
+	});
+	printf "%f s total, %f average microsec/element\n" sec (sec * 1000000.0 // float::from_int(n));
+    };
+    block_test(30);
+    block_test(30*30);
+    block_test(30*30*30*10);
+    block_test(30*30*30*30);
+    block_test(30*30*30*30*5);
+end;
+
+stipulate
+    package que = real_time_queue__complexity;
+herein
+    fun block_test n = {
+	printf "\nReal time queue: now inserting and removing %d elements:\n" n;
+	my q = { for (q = que::empty, c = 0; c < n; q = que::snoc(q, c), ++c; q) { }; };
+	{ for (q = q; !(que::isempty(q)); q = que::tail(q)) { }; };
+	que::complexity::stats();
+	que::complexity::reset();
+    };
+    block_test(40);
+    block_test(40*40);
+    block_test(40*40*40*40);
+end;
+
+exit(0);