week 2 camil
authorCamil Staps <info@camilstaps.nl>
Mon, 9 Feb 2015 19:22:32 +0000 (20:22 +0100)
committerCamil Staps <info@camilstaps.nl>
Mon, 9 Feb 2015 19:22:32 +0000 (20:22 +0100)
week2/camil/StdT.dcl [new file with mode: 0644]
week2/camil/StdT.icl [new file with mode: 0644]
week2/camil/TupleOverloading.dcl [new file with mode: 0644]
week2/camil/TupleOverloading.icl [new file with mode: 0644]
week2/camil/VectorOverloading.dcl [new file with mode: 0644]
week2/camil/VectorOverloading.icl [new file with mode: 0644]

diff --git a/week2/camil/StdT.dcl b/week2/camil/StdT.dcl
new file mode 100644 (file)
index 0000000..ca97fdc
--- /dev/null
@@ -0,0 +1,18 @@
+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
diff --git a/week2/camil/StdT.icl b/week2/camil/StdT.icl
new file mode 100644 (file)
index 0000000..1534c83
--- /dev/null
@@ -0,0 +1,38 @@
+/**\r
+ * Er is nog een probleem met fromString: deze geeft een onduidelijke warning bij het compileren (toInt geeft geen inline code).\r
+ * Verder wordt 5:a0 vrolijk gelezen als 5 minuten, 0 seconden, terwijl dit 0 minuten, 0 seconden zou moeten geven volgens de opgave.\r
+ * Ik weet niet zeker of dit een randgeval is waar de opgavemaker geen rekening mee heeft gehouden, of dat de code aangepast kan worden.\r
+ */\r
+\r
+implementation module StdT\r
+\r
+import StdEnv\r
+\r
+::     T = {m :: Int, s :: Int} \r
+\r
+instance ==            T where == a b = a.m == b.m && a.s == b.s\r
+instance <             T where < a b = a.m < b.m || a.m == b.m && a.s < b.s\r
+\r
+instance zero          T where zero = {m = zero, s = zero}\r
+instance +             T where + a b = fromInt (toInt a + toInt b) \r
+instance -             T where - a b = if (a < b) zero (fromInt (toInt a - toInt b))\r
+\r
+instance toInt         T where toInt a = a.m * 60 + a.s\r
+instance fromInt       T where fromInt n = if (n < 0) zero {m = n/60, s = n rem 60}\r
+\r
+instance toString      T where \r
+       toString {m = x, s = 0} = toString x +++ ":00"\r
+       toString a = toString a.m +++ ":" +++ (if (a.s < 10) "0" "") +++ toString a.s\r
+instance fromString    T where \r
+       fromString s = if (s.[size s - 3] == ':') \r
+               {m = toInt (s % (0, size s - 4)), s = toInt (s % (size s - 2, size s - 1))} \r
+               zero\r
+\r
+Start :: (Bool, Bool, T, T, T, Int, String, T, T)\r
+Start = (LOTR == Tea, Tea < LOTR, \r
+       zero + LOTR, LOTR + Tea, Tea - LOTR, \r
+       toInt LOTR, toString Tea, \r
+       fromString "5:40", fromString "foo")\r
+\r
+LOTR = {m=178, s=0}\r
+Tea = {m=0,s=41}\r
diff --git a/week2/camil/TupleOverloading.dcl b/week2/camil/TupleOverloading.dcl
new file mode 100644 (file)
index 0000000..6831948
--- /dev/null
@@ -0,0 +1,25 @@
+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
diff --git a/week2/camil/TupleOverloading.icl b/week2/camil/TupleOverloading.icl
new file mode 100644 (file)
index 0000000..bdc8c18
--- /dev/null
@@ -0,0 +1,48 @@
+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
+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
diff --git a/week2/camil/VectorOverloading.dcl b/week2/camil/VectorOverloading.dcl
new file mode 100644 (file)
index 0000000..76f8520
--- /dev/null
@@ -0,0 +1,14 @@
+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
diff --git a/week2/camil/VectorOverloading.icl b/week2/camil/VectorOverloading.icl
new file mode 100644 (file)
index 0000000..794cfb2
--- /dev/null
@@ -0,0 +1,32 @@
+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
+\r
+Start  = test {x0=1,x1=2}\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