summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--assignment-12/cashModel.dcl26
-rw-r--r--assignment-12/cashModel.icl48
-rw-r--r--assignment-12/gastje.icl88
3 files changed, 162 insertions, 0 deletions
diff --git a/assignment-12/cashModel.dcl b/assignment-12/cashModel.dcl
new file mode 100644
index 0000000..6d1b452
--- /dev/null
+++ b/assignment-12/cashModel.dcl
@@ -0,0 +1,26 @@
+definition module cashModel
+/*
+ Pieter Koopman, Radboud University, 2017
+ pieter@cs.ru.nl
+ Advanced programming
+
+ A simple state model for an automated cash register
+*/
+
+import StdEnv, GenEq
+
+:: Euro = {euro :: Int, cent :: Int}
+:: Product = Pizza | Beer | Cola
+:: Action = Add Product | Rem Product | Pay
+
+class euro a :: a -> Euro
+instance euro Product, Euro
+instance euro Int, (Int, Int), [e] | euro e
+instance + Euro
+instance - Euro
+instance zero Euro
+derive gEq Euro
+instance ~ Euro
+instance == Euro, Product
+
+model :: [Product] Action -> ([Product],[Euro])
diff --git a/assignment-12/cashModel.icl b/assignment-12/cashModel.icl
new file mode 100644
index 0000000..ed0174a
--- /dev/null
+++ b/assignment-12/cashModel.icl
@@ -0,0 +1,48 @@
+implementation module cashModel
+/*
+ Pieter Koopman, Radboud University, 2017
+ pieter@cs.ru.nl
+ Advanced programming
+
+ A simple state model for an automated cash register
+*/
+
+import StdEnv, GenEq
+
+class euro a :: a -> Euro
+instance euro Product
+where
+ euro Pizza = euro (4,99)
+ euro Beer = euro (0,65)
+ euro _ = euro 1
+
+instance euro Int where euro e = {euro = e, cent = 0}
+instance euro (Int, Int) where euro (e,c) = {euro = e, cent = c}
+instance euro [e] | euro e where euro l = sum (map euro l)
+instance euro Euro where euro e = e
+
+instance + Euro
+where
+ + x y = {euro = c / 100, cent = (abs c) rem 100}
+ where
+ c = (x.euro + y.euro) * 100 + sign x.euro * x.cent + sign y.euro * y.cent
+
+instance - Euro
+where
+ - x y = {euro = c / 100, cent = (abs c) rem 100}
+ where
+ c = (x.euro - y.euro) * 100 + sign x.euro * x.cent - sign y.euro * y.cent
+
+instance zero Euro where zero = {euro = 0, cent = 0}
+derive gEq Euro, Product
+instance == Product where (==) p q = p === q
+instance == Euro where (==) p q = p === q
+
+instance ~ Euro where ~ e = {e & euro = ~e.euro}
+
+model :: [Product] Action -> ([Product],[Euro])
+model list (Add p) = ([p:list],[euro p])
+model list (Rem p)
+| isMember p list = (removeMember p list,[~ (euro p)])
+| otherwise = (list,[])
+model list Pay = ([],[euro list])
diff --git a/assignment-12/gastje.icl b/assignment-12/gastje.icl
new file mode 100644
index 0000000..6ad6d68
--- /dev/null
+++ b/assignment-12/gastje.icl
@@ -0,0 +1,88 @@
+module gastje
+
+/*
+ Pieter Koopman, Radboud University, 2016, 2017
+ pieter@cs.ru.nl
+ Advanced programming
+ A simplified MBT tool based on logical properties
+*/
+
+import StdEnv, StdGeneric, GenEq
+
+test :: p -> [String] | prop p
+test p = check 1000 (holds p prop0)
+
+check :: Int [Prop] -> [String]
+check n [] = ["Proof\n"]
+check 0 l = ["Passed\n"]
+check n [p:x] | p.bool
+ = check (n-1) x
+ = ["Fail for: ":reverse ["\n":p.info]]
+
+class prop a where holds :: a Prop -> [Prop]
+
+instance prop Bool where holds b p = [{p & bool = b}]
+
+instance prop (a->b) | prop b & testArg a
+where
+ holds f p = diagonal [holds (f a) {p & info = [" ",string{|*|} a:p.info]} \\ a <- gen{|*|}]
+
+class testArg a | gen{|*|}, string{|*|}, gEq{|*|} a
+
+:: Prop =
+ { bool :: Bool
+ , info :: [String]
+ }
+prop0 = {bool = True, info = []}
+
+generic gen a :: [ a ]
+gen{|Int|} = [0,1,-1,maxint,minint,maxint-1,minint+1:[j\\i<-[2..], j<-[i,~i]]]
+gen{|Bool|} = [True,False]
+gen{|Char|} = [' '..'~'] ++ ['\t\n\b']
+gen{|UNIT|} = [UNIT]
+gen{|PAIR|} f g = map (uncurry PAIR) (diag2 f g)
+gen{|EITHER|} f g = merge (map RIGHT g) (map LEFT f)
+where
+ merge [a:x] ys = [a: merge ys x]
+ merge [] ys = ys
+gen{|CONS|} f = map CONS f
+gen{|OBJECT|} f = map OBJECT f
+gen{|RECORD|} f = map RECORD f
+gen{|FIELD|} f = map FIELD f
+
+generic string a :: a -> String
+string{|Int|} i = toString i
+string{|Bool|} b = toString b
+string{|Char|} c = toString ['\'',c,'\'']
+string{|UNIT|} _ = ""
+string{|PAIR|} f g (PAIR x y) = f x + " " + g y
+string{|EITHER|} f g (LEFT x) = f x
+string{|EITHER|} f g (RIGHT y) = g y
+string{|CONS of gcd|} f (CONS x)
+| gcd.gcd_arity > 0 = "(" + gcd.gcd_name + " " + f x + ")"
+| otherwise = gcd.gcd_name
+string{|OBJECT|} f (OBJECT x) = f x
+string{|RECORD of grd|} f (RECORD x) = "{" + grd.grd_name + "|" + f x + "}"
+string{|FIELD of gfd|} f (FIELD x) = gfd.gfd_name + " = " + f x + " "
+
+maxint :: Int
+maxint =: IF_INT_64_OR_32 (2^63-1) (2^31-1) //2147483647
+
+minint :: Int
+minint =: IF_INT_64_OR_32 (2^63) (2^31) //-2147483648
+
+instance + String where + s t = s +++ t
+
+diagonal :: [[a]] -> [a]
+diagonal list = f 1 2 list []
+where
+ f n m [] [] = []
+ f 0 m xs ys = f m (m+1) (rev ys xs) []
+ f n m [] ys = f m (m+1) (rev ys []) []
+ f n m [[x:r]:xs] ys = [x: f (n-1) m xs [r:ys]]
+ f n m [[]:xs] ys = f (n-1) m xs ys
+
+ rev [] accu = accu
+ rev [x:r] accu = rev r [x:accu]
+
+Start = ()