diff options
| author | Mart Lubbers | 2015-04-16 21:22:20 +0200 | 
|---|---|---|
| committer | Mart Lubbers | 2015-04-16 21:22:20 +0200 | 
| commit | 6f604b19d3f5966e5c1d7c4fdf3703bd6ff0861c (patch) | |
| tree | 96d580507249f7f58368476d9113007d4afcd748 /fp1/week2 | |
| parent | Added student numbers (diff) | |
update to fp2 yay, public and licence
Diffstat (limited to 'fp1/week2')
| -rw-r--r-- | fp1/week2/camil/Makefile | 4 | ||||
| -rw-r--r-- | fp1/week2/camil/StdT.dcl | 18 | ||||
| -rw-r--r-- | fp1/week2/camil/StdT.icl | 37 | ||||
| -rw-r--r-- | fp1/week2/camil/TupleOverloading.dcl | 25 | ||||
| -rw-r--r-- | fp1/week2/camil/TupleOverloading.icl | 53 | ||||
| -rw-r--r-- | fp1/week2/camil/VectorOverloading.dcl | 14 | ||||
| -rw-r--r-- | fp1/week2/camil/VectorOverloading.icl | 37 | ||||
| -rw-r--r-- | fp1/week2/mart/Makefile | 21 | ||||
| -rw-r--r-- | fp1/week2/mart/StdT.dcl | 18 | ||||
| -rw-r--r-- | fp1/week2/mart/StdT.icl | 35 | ||||
| -rw-r--r-- | fp1/week2/mart/StdTTest.icl | 45 | ||||
| -rw-r--r-- | fp1/week2/mart/TupleOverloading.dcl | 25 | ||||
| -rw-r--r-- | fp1/week2/mart/TupleOverloading.icl | 49 | ||||
| -rw-r--r-- | fp1/week2/mart/TupleOverloadingTest.icl | 64 | ||||
| -rw-r--r-- | fp1/week2/mart/VectorOverloading.dcl | 14 | ||||
| -rw-r--r-- | fp1/week2/mart/VectorOverloading.icl | 22 | ||||
| -rw-r--r-- | fp1/week2/mart/VectorOverloadingTest.icl | 62 | ||||
| -rw-r--r-- | fp1/week2/week2.tar.gz | bin | 0 -> 1623 bytes | 
18 files changed, 543 insertions, 0 deletions
| diff --git a/fp1/week2/camil/Makefile b/fp1/week2/camil/Makefile new file mode 100644 index 0000000..9095df9 --- /dev/null +++ b/fp1/week2/camil/Makefile @@ -0,0 +1,4 @@ +all: +	clm StdT -o StdT +	clm TupleOverloading -o TupleOverloading +	clm VectorOverloading -o VectorOverloading diff --git a/fp1/week2/camil/StdT.dcl b/fp1/week2/camil/StdT.dcl new file mode 100644 index 0000000..ca97fdc --- /dev/null +++ b/fp1/week2/camil/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/fp1/week2/camil/StdT.icl b/fp1/week2/camil/StdT.icl new file mode 100644 index 0000000..03c8645 --- /dev/null +++ b/fp1/week2/camil/StdT.icl @@ -0,0 +1,37 @@ +/**
 + * Mart Lubbers, s4109503
 + * Camil Staps, s4498062
 + */
 +
 +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.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 = if (a < b) zero (fromInt (toInt a - toInt b))
 +
 +instance toInt		T where toInt a = a.m * 60 + a.s
 +instance fromInt	T where fromInt	n = if (n < 0) zero {m = n/60, s = n rem 60}
 +
 +instance toString	T where 
 +	toString {m = x, s = 0} = toString x +++ ":00"
 +	toString a = toString a.m +++ ":" +++ (if (a.s < 10) "0" "") +++ toString a.s
 +instance fromString	T where 
 +	fromString s = if (s.[size s - 3] == ':') 
 +		{m = toInt (s % (0, size s - 4)), s = toInt (s % (size s - 2, size s - 1))} 
 +		zero
 +
 +Start :: (Bool, Bool, T, T, T, Int, String, T, T)
 +Start = (LOTR == Tea, Tea < LOTR, 
 +	zero + LOTR, LOTR + Tea, Tea - LOTR, 
 +	toInt LOTR, toString Tea, 
 +	fromString "5:40", fromString "foo")
 +
 +LOTR = {m=178, s=0}
 +Tea = {m=0,s=41}
 diff --git a/fp1/week2/camil/TupleOverloading.dcl b/fp1/week2/camil/TupleOverloading.dcl new file mode 100644 index 0000000..6831948 --- /dev/null +++ b/fp1/week2/camil/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/fp1/week2/camil/TupleOverloading.icl b/fp1/week2/camil/TupleOverloading.icl new file mode 100644 index 0000000..0ea437d --- /dev/null +++ b/fp1/week2/camil/TupleOverloading.icl @@ -0,0 +1,53 @@ +/**
 + * Mart Lubbers, s4109503
 + * Camil Staps, s4498062
 + */
 +
 +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/fp1/week2/camil/VectorOverloading.dcl b/fp1/week2/camil/VectorOverloading.dcl new file mode 100644 index 0000000..76f8520 --- /dev/null +++ b/fp1/week2/camil/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/fp1/week2/camil/VectorOverloading.icl b/fp1/week2/camil/VectorOverloading.icl new file mode 100644 index 0000000..4c9c84a --- /dev/null +++ b/fp1/week2/camil/VectorOverloading.icl @@ -0,0 +1,37 @@ +/**
 + * Mart Lubbers, s4109503
 + * Camil Staps, s4498062
 + */
 +
 +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}
 +
 +Start  = test {x0=1,x1=2}
 +
 +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/fp1/week2/mart/Makefile b/fp1/week2/mart/Makefile new file mode 100644 index 0000000..a35595b --- /dev/null +++ b/fp1/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/fp1/week2/mart/StdT.dcl b/fp1/week2/mart/StdT.dcl new file mode 100644 index 0000000..f4f0d75 --- /dev/null +++ b/fp1/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/fp1/week2/mart/StdT.icl b/fp1/week2/mart/StdT.icl new file mode 100644 index 0000000..01bee7d --- /dev/null +++ b/fp1/week2/mart/StdT.icl @@ -0,0 +1,35 @@ +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 && 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) - 2, size a))}
 +	| otherwise = zero
 diff --git a/fp1/week2/mart/StdTTest.icl b/fp1/week2/mart/StdTTest.icl new file mode 100644 index 0000000..6af64fc --- /dev/null +++ b/fp1/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/fp1/week2/mart/TupleOverloading.dcl b/fp1/week2/mart/TupleOverloading.dcl new file mode 100644 index 0000000..6831948 --- /dev/null +++ b/fp1/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/fp1/week2/mart/TupleOverloading.icl b/fp1/week2/mart/TupleOverloading.icl new file mode 100644 index 0000000..2995fbd --- /dev/null +++ b/fp1/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/fp1/week2/mart/TupleOverloadingTest.icl b/fp1/week2/mart/TupleOverloadingTest.icl new file mode 100644 index 0000000..91417f7 --- /dev/null +++ b/fp1/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/fp1/week2/mart/VectorOverloading.dcl b/fp1/week2/mart/VectorOverloading.dcl new file mode 100644 index 0000000..76f8520 --- /dev/null +++ b/fp1/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/fp1/week2/mart/VectorOverloading.icl b/fp1/week2/mart/VectorOverloading.icl new file mode 100644 index 0000000..74f6f69 --- /dev/null +++ b/fp1/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/fp1/week2/mart/VectorOverloadingTest.icl b/fp1/week2/mart/VectorOverloadingTest.icl new file mode 100644 index 0000000..e5571bb --- /dev/null +++ b/fp1/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   []
 diff --git a/fp1/week2/week2.tar.gz b/fp1/week2/week2.tar.gzBinary files differ new file mode 100644 index 0000000..93c0467 --- /dev/null +++ b/fp1/week2/week2.tar.gz | 
