From 05ffd999512958a5bd1a44e7bc053db5af549ca8 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 10 Feb 2015 10:07:28 +0100 Subject: [PATCH] week 2 almost finished --- week2/mart/Makefile | 21 +++++++++ week2/mart/StdT.dcl | 18 ++++++++ week2/mart/StdT.icl | 38 +++++++++++++++++ week2/mart/StdTTest.icl | 45 +++++++++++++++++++ week2/mart/TupleOverloading.dcl | 25 +++++++++++ week2/mart/TupleOverloading.icl | 49 +++++++++++++++++++++ week2/mart/TupleOverloadingTest.icl | 64 ++++++++++++++++++++++++++++ week2/mart/VectorOverloading.dcl | 14 ++++++ week2/mart/VectorOverloading.icl | 22 ++++++++++ week2/mart/VectorOverloadingTest.icl | 62 +++++++++++++++++++++++++++ 10 files changed, 358 insertions(+) create mode 100644 week2/mart/Makefile create mode 100644 week2/mart/StdT.dcl create mode 100644 week2/mart/StdT.icl create mode 100644 week2/mart/StdTTest.icl create mode 100644 week2/mart/TupleOverloading.dcl create mode 100644 week2/mart/TupleOverloading.icl create mode 100644 week2/mart/TupleOverloadingTest.icl create mode 100644 week2/mart/VectorOverloading.dcl create mode 100644 week2/mart/VectorOverloading.icl create mode 100644 week2/mart/VectorOverloadingTest.icl 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 [] -- 2.20.1