week 2 almost finished

10 files changed, 358 insertions, 0 deletions

diff --git a/week2/mart/Makefile b/week2/mart/Makefile
new file mode 100644
index 0000000..a35595b
--- /dev/null
+++ b/week2/mart/Makefile
@@ -0,0 +1,21 @@
+PATHS=-I ~/downloads/clean/lib/StdLib -I ~/downloads/clean/lib/MersenneTwister/ -I ~/downloads/usr/lib64/clean/Gast/ -I ~/downloads/clean/lib/Generics/
+FLAGS=-v
+
+all: tuple vector stdtime
+
+tuple: TupleOverloading.icl TupleOverloading.dcl
+	clm $(FLAGS) $(PATHS) TupleOverloadingTest -o TupleOverloadingTest
+
+vector: VectorOverloading.icl VectorOverloading.dcl
+	clm $(FLAGS) $(PATHS) VectorOverloadingTest -o VectorOverloadingTest
+
+stdtime: StdT.icl StdT.dcl
+	clm $(FLAGS) $(PATHS) StdTTest -o StdTTest
+
+testall:
+	./StdTTest
+	./TupleOverloadingTest
+	./VectorOverloadingTest
+
+clean:
+	$(RM) -r Clean\ System\ Files a.out TupleOverloadingTest VectorOverloadingTest StdTTest
diff --git a/week2/mart/StdT.dcl b/week2/mart/StdT.dcl
new file mode 100644
index 0000000..f4f0d75
--- /dev/null
+++ b/week2/mart/StdT.dcl
@@ -0,0 +1,18 @@
+definition module StdT

+

+import StdOverloaded

+

+:: T

+

+instance ==			T

+instance <			T

+

+instance zero		T

+instance +			T

+instance -			T

+

+instance toInt		T

+instance fromInt	T

+

+instance toString	T

+instance fromString	T

diff --git a/week2/mart/StdT.icl b/week2/mart/StdT.icl
new file mode 100644
index 0000000..e49da8a
--- /dev/null
+++ b/week2/mart/StdT.icl
@@ -0,0 +1,38 @@
+implementation module StdT

+

+import StdEnv

+

+::	T = {m :: Int, s :: Int}

+

+instance ==	T where

+	== a b = a.m == b.m && a.s == b.s

+instance <	T where

+	< a b = a.m < b.m || a.s < b.s

+

+instance zero	T where

+	zero = {m=zero, s=zero}

+instance +	T where

+	+ a b = fromInt (toInt a + toInt b)

+instance -	T where

+	- a b = fromInt (toInt a - toInt b)

+

+instance toInt	T where

+	toInt a = a.m*60 + a.s

+instance fromInt	T where

+	fromInt a

+	| a<0 = zero

+	| otherwise = {m=a/60, s=a rem 60}

+

+instance toString	T where

+	toString {m=ms, s=0} = toString ms +++ ":00"

+	toString {m=ms, s=ss}

+	| ss < 10 = toString ms +++ ":0" +++ toString ss

+	| otherwise = toString ms +++ ":" +++ toString ss

+

+instance fromString	T where

+	fromString a

+	| a.[size a - 3] == ':' = {m = toInt (a % (0, (size a) - 4)), s = toInt (a % ((size a) - 3, size a))}

+	| otherwise = zero

+

+Start :: T

+Start = fromString "12:34"

diff --git a/week2/mart/StdTTest.icl b/week2/mart/StdTTest.icl
new file mode 100644
index 0000000..6af64fc
--- /dev/null
+++ b/week2/mart/StdTTest.icl
@@ -0,0 +1,45 @@
+module StdTTest

+

+/*	Test module StdTTest

+	Voor werken met Gast: 

+		(*) gebruik Environment 'Gast'

+		(*) zet Project Options op 'Basic Values Only'

+*/

+

+import StdT

+import StdEnv

+import gast

+

+Start

+			= testn 1000

+				(\ i -> 

+				    gelijkheid_is_symmetrisch       i /\

+				    ordening_is_monotoon            i /\

+				    negatieve_tijd_bestaat_niet     i /\

+				    omzetten_naar_Int_is_consistent i /\ 

+				    parse_print_is_consistent       i /\

+				    True

+				)

+

+t :: Int -> T

+t x = fromInt x

+

+gelijkheid_is_symmetrisch			:: Int -> Property

+gelijkheid_is_symmetrisch i			= name "gelijkheid_is_symmetrisch"

+									       (t i == t i)

+

+ordening_is_monotoon				:: Int -> Property

+ordening_is_monotoon i				= name "ordening_is_monotoon"

+									       ((i <= i+1) ==> t i <= t (i+1))

+

+negatieve_tijd_bestaat_niet			:: Int -> Property

+negatieve_tijd_bestaat_niet i		= name "negatieve_tijd_bestaat_niet"

+									       ((i + 1 >= i) ==> t i - t (i+1) == zero)

+

+omzetten_naar_Int_is_consistent		:: Int -> Property

+omzetten_naar_Int_is_consistent i	= name "omzetten_naar_Int_is_consistent"

+									       ((abs i >= 0) ==> toInt (t (abs i)) == abs i)

+

+parse_print_is_consistent			:: Int -> Property

+parse_print_is_consistent i			= name "parse_print_is_consistent"

+									       (fromString (toString (t i)) == t i)

diff --git a/week2/mart/TupleOverloading.dcl b/week2/mart/TupleOverloading.dcl
new file mode 100644
index 0000000..6831948
--- /dev/null
+++ b/week2/mart/TupleOverloading.dcl
@@ -0,0 +1,25 @@
+definition module TupleOverloading

+

+import StdEnv

+

+instance +    (a,b)   | + a & + b

+instance +    (a,b,c) | + a & + b & + c

+

+

+instance -    (a,b)   | - a & - b

+instance -    (a,b,c) | - a & - b & - c

+

+instance *    (a,b)   | * a & * b

+instance *    (a,b,c) | * a & * b & * c

+

+instance /    (a,b)   | / a & / b

+instance /    (a,b,c) | / a & / b & / c

+

+instance zero (a,b)   | zero a & zero b

+instance zero (a,b,c) | zero a & zero b & zero c

+

+instance one  (a,b)   | one a & one b

+instance one  (a,b,c) | one a & one b & one c

+

+instance ~    (a,b)   | ~ a & ~ b

+instance ~    (a,b,c) | ~ a & ~ b & ~ c

diff --git a/week2/mart/TupleOverloading.icl b/week2/mart/TupleOverloading.icl
new file mode 100644
index 0000000..2995fbd
--- /dev/null
+++ b/week2/mart/TupleOverloading.icl
@@ -0,0 +1,49 @@
+implementation module TupleOverloading

+

+import StdEnv

+

+instance +    (a,b)   | + a & + b                where

+	+ (a,b) (c,d) = (a+c,b+d)

+instance +    (a,b,c) | + a & + b & + c          where

+	+ (a,b,c) (d,e,f) = (a+d,b+e,c+f)

+

+

+instance -    (a,b)   | - a & - b                where

+	- (a,b) (c,d) = (a-c,b-d)

+instance -    (a,b,c) | - a & - b & - c          where

+	- (a,b,c) (d,e,f) = (a-d,b-e,c-f)

+

+instance *    (a,b)   | * a & * b                where

+	* (a,b) (c,d) = (a*c,b*d)

+instance *    (a,b,c) | * a & * b & * c          where

+	* (a,b,c) (d,e,f) = (a*d,b*e,c*f)

+

+instance /    (a,b)   | / a & / b                where

+	/ (a,b) (c,d) = (a/c,b/d)

+instance /    (a,b,c) | / a & / b & / c          where

+	/ (a,b,c) (d,e,f) = (a/d,b/e,c/f)

+

+instance zero (a,b)   | zero a & zero b          where

+	zero = (zero,zero)

+instance zero (a,b,c) | zero a & zero b & zero c where

+	zero = (zero,zero,zero)

+

+instance one  (a,b)   | one a & one b            where

+	one = (one,one)

+instance one  (a,b,c) | one a & one b & one c    where

+	one = (one,one,one)

+

+instance ~    (a,b)   | ~ a & ~ b                where

+	~ (a,b) = (~a,~b)

+instance ~    (a,b,c) | ~ a & ~ b & ~ c          where

+	~ (a,b,c) = (~a,~b,~c)

+

+Start  = (test (1,2), test (1,2,3))

+

+test a = ( zero + a == a    && a    == a + zero

+         , a - zero == a    && a    == ~ (zero - a)

+         ,  one * a == a    && a    == a * one

+         , zero * a == zero && zero == a * zero

+         ,  a / one == a

+         ,  ~ (~ a) == a

+         )

diff --git a/week2/mart/TupleOverloadingTest.icl b/week2/mart/TupleOverloadingTest.icl
new file mode 100644
index 0000000..91417f7
--- /dev/null
+++ b/week2/mart/TupleOverloadingTest.icl
@@ -0,0 +1,64 @@
+module TupleOverloadingTest
+
+/*	Test module VectorOverloading
+	Voor werken met Gast: 
+		(*) gebruik Environment 'Gast'
+		(*) zet Project Options op 'Basic Values Only'
+*/
+
+import TupleOverloading
+import StdEnv
+import gast
+
+Start
+		= testn 1000
+			(\v -> 
+		       zero_is_neutral_for_addition      v /\
+		       zero_is_neutral_for_subtraction   v /\
+		       one_is_neutral_for_multiplication v /\
+		       one_is_neutral_for_division       v /\
+		       negation_is_idempotent            v /\
+		       add_then_subtract_yields_identity v /\
+		       subtract_then_add_yields_identity v /\
+		       True
+		    )
+
+:: Vector2 a :== (a,a)
+:: BaseType
+		:== Int
+//		:== Real
+
+zero_is_neutral_for_addition		:: (Vector2 BaseType) -> Property
+zero_is_neutral_for_addition a		= name "zero_is_neutral_for_addition"
+									       (zero + a == a && a == a + zero)
+
+zero_is_neutral_for_subtraction		:: (Vector2 BaseType) -> Property
+zero_is_neutral_for_subtraction a	= name "zero_is_neutral_for_subtraction"
+									       (a - zero == a && a == ~ (zero - a))
+
+one_is_neutral_for_multiplication	:: (Vector2 BaseType) -> Property
+one_is_neutral_for_multiplication a	= name "one_is_neutral_for_multiplication" 
+									       (one * a == a && a == a * one)
+
+zero_is_zero_for_multiplication		:: (Vector2 BaseType) -> Property
+zero_is_zero_for_multiplication a	= name "zero_is_zero_for_multiplication"
+									       (zero * a == zero && zero == a * zero)
+
+one_is_neutral_for_division			:: (Vector2 BaseType) -> Property
+one_is_neutral_for_division a		= name "one_is_neutral_for_division"
+									       (a / one == a)
+
+negation_is_idempotent				:: (Vector2 BaseType) -> Property
+negation_is_idempotent a			= name "negation_is_idempotent" 
+									       (~ (~ a) == a)
+
+
+add_then_subtract_yields_identity	:: (Vector2 BaseType) -> Property
+add_then_subtract_yields_identity a	= name "add then subtract" ((a + a) - a == a)
+
+subtract_then_add_yields_identity	:: (Vector2 BaseType) -> Property
+subtract_then_add_yields_identity a	= name "subtract then add" ((zero - a - a) + a + a == zero)
+
+//derive genShow (,)
+//derive ggen    (,)
+derive bimap   []
diff --git a/week2/mart/VectorOverloading.dcl b/week2/mart/VectorOverloading.dcl
new file mode 100644
index 0000000..76f8520
--- /dev/null
+++ b/week2/mart/VectorOverloading.dcl
@@ -0,0 +1,14 @@
+definition module VectorOverloading

+

+import StdEnv

+

+:: Vector2 a = {x0 :: a, x1 :: a}

+

+instance ==   (Vector2 a) | == a

+instance zero (Vector2 a) | zero a

+instance one  (Vector2 a) | one a

+instance ~    (Vector2 a) | ~ a

+instance +    (Vector2 a) | + a

+instance -    (Vector2 a) | - a

+instance *    (Vector2 a) | * a

+instance /    (Vector2 a) | / a

diff --git a/week2/mart/VectorOverloading.icl b/week2/mart/VectorOverloading.icl
new file mode 100644
index 0000000..74f6f69
--- /dev/null
+++ b/week2/mart/VectorOverloading.icl
@@ -0,0 +1,22 @@
+implementation module VectorOverloading

+

+import StdEnv

+

+:: Vector2 a = {x0 :: a, x1 :: a}

+

+instance ==   (Vector2 a) | == a   where

+	== a b = a.x0 == b.x0 && a.x1 == b.x1

+instance zero (Vector2 a) | zero a where

+	zero = {x0=zero, x1=zero}

+instance one  (Vector2 a) | one a  where

+	one = {x0=one, x1=one}

+instance ~    (Vector2 a) | ~ a    where

+	~ a = {x0= ~a.x0, x1= ~a.x1}

+instance +    (Vector2 a) | + a    where

+	+ a b = {x0=a.x0+b.x0, x1=a.x1+b.x1}

+instance -    (Vector2 a) | - a    where

+	- a b = {x0=a.x0-b.x0, x1=a.x1-b.x1}

+instance *    (Vector2 a) | * a    where

+	* a b = {x0=a.x0*b.x0, x1=a.x1*b.x1}

+instance /    (Vector2 a) | / a    where

+	/ a b = {x0=a.x0/b.x0, x1=a.x1/b.x1}

diff --git a/week2/mart/VectorOverloadingTest.icl b/week2/mart/VectorOverloadingTest.icl
new file mode 100644
index 0000000..e5571bb
--- /dev/null
+++ b/week2/mart/VectorOverloadingTest.icl
@@ -0,0 +1,62 @@
+module VectorOverloadingTest

+

+/*	Test module VectorOverloading

+	Voor werken met Gast: 

+		(*) gebruik Environment 'Gast'

+		(*) zet Project Options op 'Basic Values Only'

+*/

+

+import VectorOverloading

+import StdEnv

+import gast

+

+Start

+		= testn 1000

+			(\v -> 

+		       zero_is_neutral_for_addition      v /\

+		       zero_is_neutral_for_subtraction   v /\

+		       one_is_neutral_for_multiplication v /\

+		       one_is_neutral_for_division       v /\

+		       negation_is_idempotent            v /\

+		       add_then_subtract_yields_identity v /\

+		       subtract_then_add_yields_identity v /\

+		       True

+		    )

+

+:: BaseType

+		:== Int

+//		:== Real

+

+zero_is_neutral_for_addition		:: (Vector2 BaseType) -> Property

+zero_is_neutral_for_addition a		= name "zero_is_neutral_for_addition"

+									       (zero + a == a && a == a + zero)

+

+zero_is_neutral_for_subtraction		:: (Vector2 BaseType) -> Property

+zero_is_neutral_for_subtraction a	= name "zero_is_neutral_for_subtraction"

+									       (a - zero == a && a == ~ (zero - a))

+

+one_is_neutral_for_multiplication	:: (Vector2 BaseType) -> Property

+one_is_neutral_for_multiplication a	= name "one_is_neutral_for_multiplication" 

+									       (one * a == a && a == a * one)

+

+zero_is_zero_for_multiplication		:: (Vector2 BaseType) -> Property

+zero_is_zero_for_multiplication a	= name "zero_is_zero_for_multiplication"

+									       (zero * a == zero && zero == a * zero)

+

+one_is_neutral_for_division			:: (Vector2 BaseType) -> Property

+one_is_neutral_for_division a		= name "one_is_neutral_for_division"

+									       (a / one == a)

+

+negation_is_idempotent				:: (Vector2 BaseType) -> Property

+negation_is_idempotent a			= name "negation_is_idempotent" 

+									       (~ (~ a) == a)

+

+add_then_subtract_yields_identity	:: (Vector2 BaseType) -> Property

+add_then_subtract_yields_identity a	= name "add then subtract" ((a + a) - a == a)

+

+subtract_then_add_yields_identity	:: (Vector2 BaseType) -> Property

+subtract_then_add_yields_identity a	= name "subtract then add" ((zero - a - a) + a + a == zero)

+

+derive genShow Vector2

+derive ggen    Vector2

+derive bimap   []