--- /dev/null
+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
--- /dev/null
+definition module StdT\r
+\r
+import StdOverloaded\r
+\r
+:: T\r
+\r
+instance == T\r
+instance < T\r
+\r
+instance zero T\r
+instance + T\r
+instance - T\r
+\r
+instance toInt T\r
+instance fromInt T\r
+\r
+instance toString T\r
+instance fromString T\r
--- /dev/null
+implementation module StdT\r
+\r
+import StdEnv\r
+\r
+:: T = {m :: Int, s :: Int}\r
+\r
+instance == T where\r
+ == a b = a.m == b.m && a.s == b.s\r
+instance < T where\r
+ < a b = a.m < b.m || a.s < b.s\r
+\r
+instance zero T where\r
+ zero = {m=zero, s=zero}\r
+instance + T where\r
+ + a b = fromInt (toInt a + toInt b)\r
+instance - T where\r
+ - a b = fromInt (toInt a - toInt b)\r
+\r
+instance toInt T where\r
+ toInt a = a.m*60 + a.s\r
+instance fromInt T where\r
+ fromInt a\r
+ | a<0 = zero\r
+ | otherwise = {m=a/60, s=a rem 60}\r
+\r
+instance toString T where\r
+ toString {m=ms, s=0} = toString ms +++ ":00"\r
+ toString {m=ms, s=ss}\r
+ | ss < 10 = toString ms +++ ":0" +++ toString ss\r
+ | otherwise = toString ms +++ ":" +++ toString ss\r
+\r
+instance fromString T where\r
+ fromString a\r
+ | a.[size a - 3] == ':' = {m = toInt (a % (0, (size a) - 4)), s = toInt (a % ((size a) - 3, size a))}\r
+ | otherwise = zero\r
+\r
+Start :: T\r
+Start = fromString "12:34"\r
--- /dev/null
+module StdTTest\r
+\r
+/* Test module StdTTest\r
+ Voor werken met Gast: \r
+ (*) gebruik Environment 'Gast'\r
+ (*) zet Project Options op 'Basic Values Only'\r
+*/\r
+\r
+import StdT\r
+import StdEnv\r
+import gast\r
+\r
+Start\r
+ = testn 1000\r
+ (\ i -> \r
+ gelijkheid_is_symmetrisch i /\\r
+ ordening_is_monotoon i /\\r
+ negatieve_tijd_bestaat_niet i /\\r
+ omzetten_naar_Int_is_consistent i /\ \r
+ parse_print_is_consistent i /\\r
+ True\r
+ )\r
+\r
+t :: Int -> T\r
+t x = fromInt x\r
+\r
+gelijkheid_is_symmetrisch :: Int -> Property\r
+gelijkheid_is_symmetrisch i = name "gelijkheid_is_symmetrisch"\r
+ (t i == t i)\r
+\r
+ordening_is_monotoon :: Int -> Property\r
+ordening_is_monotoon i = name "ordening_is_monotoon"\r
+ ((i <= i+1) ==> t i <= t (i+1))\r
+\r
+negatieve_tijd_bestaat_niet :: Int -> Property\r
+negatieve_tijd_bestaat_niet i = name "negatieve_tijd_bestaat_niet"\r
+ ((i + 1 >= i) ==> t i - t (i+1) == zero)\r
+\r
+omzetten_naar_Int_is_consistent :: Int -> Property\r
+omzetten_naar_Int_is_consistent i = name "omzetten_naar_Int_is_consistent"\r
+ ((abs i >= 0) ==> toInt (t (abs i)) == abs i)\r
+\r
+parse_print_is_consistent :: Int -> Property\r
+parse_print_is_consistent i = name "parse_print_is_consistent"\r
+ (fromString (toString (t i)) == t i)\r
--- /dev/null
+definition module TupleOverloading\r
+\r
+import StdEnv\r
+\r
+instance + (a,b) | + a & + b\r
+instance + (a,b,c) | + a & + b & + c\r
+\r
+\r
+instance - (a,b) | - a & - b\r
+instance - (a,b,c) | - a & - b & - c\r
+\r
+instance * (a,b) | * a & * b\r
+instance * (a,b,c) | * a & * b & * c\r
+\r
+instance / (a,b) | / a & / b\r
+instance / (a,b,c) | / a & / b & / c\r
+\r
+instance zero (a,b) | zero a & zero b\r
+instance zero (a,b,c) | zero a & zero b & zero c\r
+\r
+instance one (a,b) | one a & one b\r
+instance one (a,b,c) | one a & one b & one c\r
+\r
+instance ~ (a,b) | ~ a & ~ b\r
+instance ~ (a,b,c) | ~ a & ~ b & ~ c\r
--- /dev/null
+implementation module TupleOverloading\r
+\r
+import StdEnv\r
+\r
+instance + (a,b) | + a & + b where\r
+ + (a,b) (c,d) = (a+c,b+d)\r
+instance + (a,b,c) | + a & + b & + c where\r
+ + (a,b,c) (d,e,f) = (a+d,b+e,c+f)\r
+\r
+\r
+instance - (a,b) | - a & - b where\r
+ - (a,b) (c,d) = (a-c,b-d)\r
+instance - (a,b,c) | - a & - b & - c where\r
+ - (a,b,c) (d,e,f) = (a-d,b-e,c-f)\r
+\r
+instance * (a,b) | * a & * b where\r
+ * (a,b) (c,d) = (a*c,b*d)\r
+instance * (a,b,c) | * a & * b & * c where\r
+ * (a,b,c) (d,e,f) = (a*d,b*e,c*f)\r
+\r
+instance / (a,b) | / a & / b where\r
+ / (a,b) (c,d) = (a/c,b/d)\r
+instance / (a,b,c) | / a & / b & / c where\r
+ / (a,b,c) (d,e,f) = (a/d,b/e,c/f)\r
+\r
+instance zero (a,b) | zero a & zero b where\r
+ zero = (zero,zero)\r
+instance zero (a,b,c) | zero a & zero b & zero c where\r
+ zero = (zero,zero,zero)\r
+\r
+instance one (a,b) | one a & one b where\r
+ one = (one,one)\r
+instance one (a,b,c) | one a & one b & one c where\r
+ one = (one,one,one)\r
+\r
+instance ~ (a,b) | ~ a & ~ b where\r
+ ~ (a,b) = (~a,~b)\r
+instance ~ (a,b,c) | ~ a & ~ b & ~ c where\r
+ ~ (a,b,c) = (~a,~b,~c)\r
+\r
+Start = (test (1,2), test (1,2,3))\r
+\r
+test a = ( zero + a == a && a == a + zero\r
+ , a - zero == a && a == ~ (zero - a)\r
+ , one * a == a && a == a * one\r
+ , zero * a == zero && zero == a * zero\r
+ , a / one == a\r
+ , ~ (~ a) == a\r
+ )\r
--- /dev/null
+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 []
--- /dev/null
+definition module VectorOverloading\r
+\r
+import StdEnv\r
+\r
+:: Vector2 a = {x0 :: a, x1 :: a}\r
+\r
+instance == (Vector2 a) | == a\r
+instance zero (Vector2 a) | zero a\r
+instance one (Vector2 a) | one a\r
+instance ~ (Vector2 a) | ~ a\r
+instance + (Vector2 a) | + a\r
+instance - (Vector2 a) | - a\r
+instance * (Vector2 a) | * a\r
+instance / (Vector2 a) | / a\r
--- /dev/null
+implementation module VectorOverloading\r
+\r
+import StdEnv\r
+\r
+:: Vector2 a = {x0 :: a, x1 :: a}\r
+\r
+instance == (Vector2 a) | == a where\r
+ == a b = a.x0 == b.x0 && a.x1 == b.x1\r
+instance zero (Vector2 a) | zero a where\r
+ zero = {x0=zero, x1=zero}\r
+instance one (Vector2 a) | one a where\r
+ one = {x0=one, x1=one}\r
+instance ~ (Vector2 a) | ~ a where\r
+ ~ a = {x0= ~a.x0, x1= ~a.x1}\r
+instance + (Vector2 a) | + a where\r
+ + a b = {x0=a.x0+b.x0, x1=a.x1+b.x1}\r
+instance - (Vector2 a) | - a where\r
+ - a b = {x0=a.x0-b.x0, x1=a.x1-b.x1}\r
+instance * (Vector2 a) | * a where\r
+ * a b = {x0=a.x0*b.x0, x1=a.x1*b.x1}\r
+instance / (Vector2 a) | / a where\r
+ / a b = {x0=a.x0/b.x0, x1=a.x1/b.x1}\r
--- /dev/null
+module VectorOverloadingTest\r
+\r
+/* Test module VectorOverloading\r
+ Voor werken met Gast: \r
+ (*) gebruik Environment 'Gast'\r
+ (*) zet Project Options op 'Basic Values Only'\r
+*/\r
+\r
+import VectorOverloading\r
+import StdEnv\r
+import gast\r
+\r
+Start\r
+ = testn 1000\r
+ (\v -> \r
+ zero_is_neutral_for_addition v /\\r
+ zero_is_neutral_for_subtraction v /\\r
+ one_is_neutral_for_multiplication v /\\r
+ one_is_neutral_for_division v /\\r
+ negation_is_idempotent v /\\r
+ add_then_subtract_yields_identity v /\\r
+ subtract_then_add_yields_identity v /\\r
+ True\r
+ )\r
+\r
+:: BaseType\r
+ :== Int\r
+// :== Real\r
+\r
+zero_is_neutral_for_addition :: (Vector2 BaseType) -> Property\r
+zero_is_neutral_for_addition a = name "zero_is_neutral_for_addition"\r
+ (zero + a == a && a == a + zero)\r
+\r
+zero_is_neutral_for_subtraction :: (Vector2 BaseType) -> Property\r
+zero_is_neutral_for_subtraction a = name "zero_is_neutral_for_subtraction"\r
+ (a - zero == a && a == ~ (zero - a))\r
+\r
+one_is_neutral_for_multiplication :: (Vector2 BaseType) -> Property\r
+one_is_neutral_for_multiplication a = name "one_is_neutral_for_multiplication" \r
+ (one * a == a && a == a * one)\r
+\r
+zero_is_zero_for_multiplication :: (Vector2 BaseType) -> Property\r
+zero_is_zero_for_multiplication a = name "zero_is_zero_for_multiplication"\r
+ (zero * a == zero && zero == a * zero)\r
+\r
+one_is_neutral_for_division :: (Vector2 BaseType) -> Property\r
+one_is_neutral_for_division a = name "one_is_neutral_for_division"\r
+ (a / one == a)\r
+\r
+negation_is_idempotent :: (Vector2 BaseType) -> Property\r
+negation_is_idempotent a = name "negation_is_idempotent" \r
+ (~ (~ a) == a)\r
+\r
+add_then_subtract_yields_identity :: (Vector2 BaseType) -> Property\r
+add_then_subtract_yields_identity a = name "add then subtract" ((a + a) - a == a)\r
+\r
+subtract_then_add_yields_identity :: (Vector2 BaseType) -> Property\r
+subtract_then_add_yields_identity a = name "subtract then add" ((zero - a - a) + a + a == zero)\r
+\r
+derive genShow Vector2\r
+derive ggen Vector2\r
+derive bimap []\r
repositories / fp1415.git / commitdiff