Mercurial > repos > rhope

changeset 46:429b5f441381

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added Date Time object
author Mike Pavone <pavone@retrodev.com>
date Tue, 01 Dec 2009 03:59:31 -0500
parents 6420c35edb43
children 6202b866d72c
files date.rhope interp.c interp.h number.c
diffstat 4 files changed, 276 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/date.rhope	Tue Dec 01 03:59:31 2009 -0500
@@ -0,0 +1,241 @@
+//Note that the following code does not currently take into account leap seconds
+
+Days From Secs[secs:days,secs left]
+{
+    secs per day <- [[60]*[60]]*[24]       
+    days <- [secs]/[secs per day]
+    secs left <- [secs]%[secs per day]
+}
+
+//This doesn't take into account the mod 100 rule
+Year From Unix Days[days:year,day in year]
+{
+   block days <- [[365]*[4]]+[1]
+   base year <- [1970]+[[[days]/[block days]]*[4]]
+   after base <- [days]%[block days]
+   If[[after base] > [365]]
+   {
+      year <- [[base year]+[1]]+[ [[after base]-[366]]/[365] ]
+      day in year <- [[after base]-[366]]%[365]
+   }{
+      year <- Val[base year]
+      day in year <- Val[after base]
+   }
+}
+
+Is Leap Year[year:is,is not]
+{
+	is <-If[[[year]%[400]]=[0]] {}
+	{
+		,is not <- If[[[year]%[100]]=[0]]
+		{
+			is,is not <- If[[[year]%[4]]=[0]]
+		}	
+	}
+}
+
+_Month From Day[day,days,current:month,day in month]
+{
+	curdays <- [days]Index[current]
+	If[[day]<[curdays]]
+	{
+		month <- current
+		day in month <- day
+	}{
+		month,day in month <- _Month From Day[[day]-[curdays], days, [current]+[1]]
+	}
+}
+
+Month From Day[day,year:month,day in month]
+{
+	base <- (31,28,31,30,31,30,31,31,30,31,30,31)
+	Is Leap Year[year]
+	{
+		days <- [base]Set[1, 29]
+	}{
+		days <- Val[base]
+	}
+	month,day in month <- _Month From Day[day, days, 0]
+}
+
+Blueprint Date Time
+{
+	Long:Fifty Micros
+	Word:Year
+	Byte:Month
+	Byte:Day
+}
+
+Date Time From Unix[unix:date]
+{
+	,sec in day <- Days From Secs[unix]
+	{ year <- Year From Unix Days[~] {}
+	{ month, day <- Month From Day[~, year] }}
+	date <- [[[[Build["Date Time"]]Fifty Micros <<[[sec in day]*[20000]]]Year <<[year]]Month <<[[month]+[1]]]Day <<[[day]+[1]]
+}
+
+Now[:date]
+{
+	date <- Date Time From Unix[Unix Time[]]
+}
+
+Seconds@Date Time[date:out]
+{
+	out <- [[[date]Fifty Micros >>]/[20000]]%[60]
+}
+
+Milliseconds@Date Time[date:out]
+{
+	out <- [[[date]Fifty Micros >>]/[20]]%[60000]
+}
+
+Microseconds@Date Time[date:out]
+{
+	out <- [[[date]Fifty Micros >>]%[20]]*[50]
+}
+
+Hours@Date Time[date:out]
+{
+	out <- [[date]Fifty Micros >>]/[[[20000]*[60]]*[60]]
+}
+
+Minutes@Date Time[date:out]
+{
+	out <- [[[date]Fifty Micros >>]/[[20000]*[60]]]%[60]
+}
+
+Day in Year@Date Time[date:out]
+{
+	base day <- [(0,0,31,59,90,120,151,181,212,243,273,304,334)]Index[[date]Month >>]
+	,noleap <- If[[[date]Month >>] > [2]]
+	{
+		,noleap <- Is Leap Year[[date]Year >>]
+		{
+			out <- [base day] + [[date]Day >>]
+		}
+	}
+	Val[noleap]
+	{
+		out <- [[base day] + [[date]Day >>]]-[1]
+	}
+}
+
+//Gregorian only for the moment
+//Sunday = 0, Saturday = 6
+//Uses Zeller's algorithm
+Day of Week@Date Time[date:out]
+{
+	If[[[date]Month >>] < [3]]
+	{
+		zmonth <- [[date]Month >>]+[12]
+		zyear <- [[date]Year >>]-[1]
+	}{
+		zmonth <- [date]Month >>
+		zyear <- [date]Year >>
+	}
+	[zyear]Slice@String[2]
+	{ century <- <String@Whole Number[~] }
+	{ y <- <String@Whole Number[~] }
+	
+	a <- [[26]* [[zmonth]+[1]]]/[10]
+	b <- [[5]*[y]]/[4]
+	c <- [century]/[4]
+	d <- [2]*[century]
+
+	out <- [[-[+[+[+[[date]Day >>, a], b], c], d]] + [6]] % [7]
+}
+
+Format@Date Time[date,format:out]
+{
+	If[[format]=[""]]
+	{
+		out <- ""
+	}{
+		months <- ("", "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
+		days <- ("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
+		cur,rest format <- [format]Slice[1]
+		If[[cur] = ["Y"]]
+		{
+			piece <- [date]Year >>
+		}{ If[[cur] = ["M"]]
+		{
+			piece <- [date]Month >>
+		}{ If[[cur] = ["N"]]
+		{
+			tpiece <- [months]Index[[date]Month >>]
+		}{ If[[cur] = ["B"]]
+		{
+			tpiece <- [[months]Index[[date]Month >>]]Slice[3]
+		}{ If[[cur] = ["D"]]
+		{
+			ppiece <- [date]Day >>
+		}{ If[[cur] = ["d"]]
+		{
+			piece <- [date]Day >>
+		}{ If[[cur] = ["n"]]
+		{
+			tpiece <- [days]Index[[date]Day of Week]
+		}{ If[[cur] = ["b"]]
+		{
+			tpiece <- [[days]Index[[date]Day of Week]]Slice[3]
+		}{ If[[cur] = ["w"]]
+		{
+			piece <- Day of Week[date]
+		}{ If[[cur] = ["h"]]
+		{
+			hour <- [date]Hours
+			If[[hour] > [12]]
+			{
+				ppiece <- [hour]-[12]
+			}{
+				If[[hour] = [0]]
+				{ ppiece <- 12 }
+				{ ppiece <- Val[hour] }
+			}
+		}{ If[[cur] = ["H"]]
+		{
+			ppiece <- Hours[date]
+		}{ If[[cur] = ["m"]]
+		{
+			ppiece <- Minutes[date]
+		}{ If[[cur] = ["s"]]
+		{
+			ppiece <- Seconds[date]
+		}{ If[[cur] = ["a"]]
+		{
+			If[[[date]Hours] < [12]]
+			{ tpiece <- "AM" }
+			{ tpiece <- "PM" }
+		}{ If[[cur] = ["t"]]
+		{
+			ppiece <- Milliseconds[date]
+		}{
+			tpiece <- Val[cur]
+		}}}}}}}}}}}}}}}
+
+		sppiece <- <Whole Number@String[ppiece]
+
+		If[[[sppiece]Length] < [2]]
+		{
+			tpiece <- ["0"]Append[sppiece]
+		}{
+			tpiece <- Val[sppiece]
+		}
+		tpiece <- <Whole Number@String[piece]
+		out <- [tpiece]Append[[date]Format[rest format]]
+		
+	}
+}
+
+RFC 2822@Date Time[date:out]
+{
+	out <- [date]Format["d B Y H:m:s -0000"]
+}
+
+//Preferred format for HTTP as specified by RFC 2616
+RFC 2616@Date Time[date:out]
+{
+	out <- [[date]Format["b, D B Y H:m:s"]]Append[" GMT"]
+}
+
+
--- a/interp.c	Mon Nov 30 23:47:08 2009 -0500
+++ b/interp.c	Tue Dec 01 03:59:31 2009 -0500
@@ -1482,6 +1482,11 @@
 	aworker->input_types[0] = BUILTIN_TYPE_WHOLE;
 	aworker->input_types[1] = BUILTIN_TYPE_WHOLE;
 
+	aworker = create_worker(prog, "%@Whole Number", 2, 1, WORKER_TYPE);
+	aworker->implement_func=(custom_worker *)vis_whole_modulus;
+	aworker->input_types[0] = BUILTIN_TYPE_WHOLE;
+	aworker->input_types[1] = BUILTIN_TYPE_WHOLE;
+
 	//add_method(this_comp, aworker);
 	
 	current_method = 0;
@@ -1567,6 +1572,14 @@
 	aworker->implement_func=(custom_worker *)vis_real_sqrt;
 	aworker->input_types[0] = BUILTIN_TYPE_REAL;
 
+	aworker = create_worker(prog, "Truncate to Whole@Real Number", 1, 1, WORKER_TYPE);
+	aworker->implement_func=(custom_worker *)vis_whole_fromreal;
+	aworker->input_types[0] = BUILTIN_TYPE_REAL;
+
+	aworker = create_worker(prog, "<Whole Number@Real Number", 1, 1, WORKER_TYPE);
+	aworker->implement_func=(custom_worker *)vis_real_fromwhole;
+	aworker->input_types[0] = BUILTIN_TYPE_WHOLE;
+
 	//add_method(this_comp, aworker);
 	
 	current_method = 0;
--- a/interp.h	Mon Nov 30 23:47:08 2009 -0500
+++ b/interp.h	Tue Dec 01 03:59:31 2009 -0500
@@ -113,6 +113,7 @@
 int vis_whole_and(datum ** inputlist, queue_entry * worker_entry);
 int vis_whole_lsh(datum ** inputlist, queue_entry * worker_entry);
 int vis_whole_rsh(datum ** inputlist, queue_entry * worker_entry);
+int vis_whole_modulus(datum ** inputlist, queue_entry * worker_entry);
 int vis_inttostring(datum ** inputlist, queue_entry * worker_entry);
 int vis_stringequal(datum ** inputlist, queue_entry * worker_entry);
 int vis_string_split(datum ** inputlist, queue_entry * worker_entry);
@@ -136,6 +137,8 @@
 int vis_greaterreal(datum ** inputlist, queue_entry * worker_entry);
 int vis_lesserreal(datum ** inputlist, queue_entry * worker_entry);
 int vis_realtostring(datum ** inputlist, queue_entry * worker_entry);
+int vis_whole_fromreal(datum ** inputlist, queue_entry * worker_entry);
+int vis_real_fromwhole(datum ** inputlist, queue_entry * worker_entry);
 //Index, Append, Swap, Insert, Remove, Set, Length, New
 int vis_list_index(datum ** inputlist, queue_entry * worker_entry);
 int vis_list_append(datum ** inputlist, queue_entry * worker_entry);
--- a/number.c	Mon Nov 30 23:47:08 2009 -0500
+++ b/number.c	Tue Dec 01 03:59:31 2009 -0500
@@ -180,6 +180,14 @@
 	return 0;
 }
 
+int vis_whole_modulus(datum ** inputlist, queue_entry * worker_entry)
+{
+	inputlist[0] = copy_datum(inputlist[0], 0);
+	inputlist[0]->c.integers.num_a %= inputlist[1]->c.integers.num_a;
+	release_ref(inputlist[1]);
+	return 0;
+}
+
 
 int vis_greaterint(datum ** inputlist, queue_entry * worker_entry)
 {
@@ -424,4 +432,14 @@
 	release_ref(inputlist[0]);
 	inputlist[0] = output;
 	return 0;
-}
\ No newline at end of file
+}
+
+int vis_real_fromwhole(datum ** inputlist, queue_entry * worker_entry)
+{
+	datum * output = new_datum(BUILTIN_TYPE_REAL, 3, 0, worker_entry->instance->def->program);
+	output->c.real = inputlist[0]->c.integers.num_a;
+	release_ref(inputlist[0]);
+	inputlist[0] = output;
+	return 0;
+}
+