From: Mart Lubbers Date: Tue, 10 Jul 2018 05:48:42 +0000 (+0200) Subject: bork X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=acf65f233c22c3eb03ff43805d8065f5ad5a5b53;p=clean-tests.git bork --- diff --git a/alacarte/calc.icl b/alacarte/calc.icl new file mode 100644 index 0000000..7c802d5 --- /dev/null +++ b/alacarte/calc.icl @@ -0,0 +1,56 @@ +module calc + +import StdEnv +import Data.Tuple +import Data.Either + +:: Calculator = Calculator +instance zero Calculator where zero = Calculator +:: Memory =: Memory Int +instance zero Memory where zero = Memory 0 +:: SquareRoot = SquareRoot +instance zero SquareRoot where zero = SquareRoot + +:: Instructions = Push Int | Add | Sub | Mul | Div +:: MemInstructions = MC | MR | MP +:: SqrtInstructions = Sqrt + +class calculator i c :: i [Int] c -> ([Int], c) | zero c + +instance calculator Instructions Calculator +where + calculator (Push i) stack c = ([i:stack], c) + calculator Add stack c = (binop (+) stack, c) + calculator Sub stack c = (binop (-) stack, c) + calculator Mul stack c = (binop (*) stack, c) + calculator Div stack c = (binop (/) stack, c) + +instance calculator MemInstructions Memory +where + calculator MC stack _ = (stack, Memory 0) + calculator MR stack (Memory i) = ([i:stack], Memory i) + calculator MP [i:stack] _ = (stack, Memory i) + calculator MP _ _ = abort "Not enough elements on the stack" + +instance calculator SqrtInstructions SquareRoot +where + calculator Sqrt [i:stack] c = ([toInt (sqrt (toReal i)):stack], c) + calculator Sqrt _ _ = abort "Not enough elements on the stack" + +instance calculator (Either i1 i2) (c1, c2) | calculator i1 c1 & calculator i2 c2 & zero c1 & zero c2 +where + calculator (Left a) stack (c1, c2) = appSnd (flip tuple c2) (calculator a stack c1) + calculator (Right b) stack (c1, c2) = appSnd (tuple c1) (calculator b stack c2) + +instance zero (a, b) | zero a & zero b where zero = (zero, zero) + +binop op [l,r:stack] = [op l r:stack] +binop _ _ = abort "Not enough elements on the stack" + +Start = calculator instruction [9] state + +instruction :: (Either Instructions (Either MemInstructions SqrtInstructions)) +instruction = Right (Right Sqrt) + +state :: (Calculator, (Memory, SquareRoot)) +state = zero diff --git a/array_itasks/Mul.dcl b/array_itasks/Mul.dcl new file mode 100644 index 0000000..570cb40 --- /dev/null +++ b/array_itasks/Mul.dcl @@ -0,0 +1,8 @@ +definition module Mul + +from main import :: Expr + +:: Expr | (*.) infixl 6 Expr Expr + +evalMul :: Expr -> Int +pprintMul :: Expr -> String diff --git a/array_itasks/Sub.dcl b/array_itasks/Sub.dcl new file mode 100644 index 0000000..a35387d --- /dev/null +++ b/array_itasks/Sub.dcl @@ -0,0 +1,8 @@ +definition module Sub + +from main import :: Expr + +:: Expr | (-.) infixl 6 Expr Expr + +evalSub :: Expr -> Int +pprintSub :: Expr -> String diff --git a/array_itasks/T.dcl b/array_itasks/T.dcl new file mode 100644 index 0000000..55921c1 --- /dev/null +++ b/array_itasks/T.dcl @@ -0,0 +1,3 @@ +definition module T + +:: T = .. diff --git a/array_itasks/main.dcl b/array_itasks/main.dcl new file mode 100644 index 0000000..3d07688 --- /dev/null +++ b/array_itasks/main.dcl @@ -0,0 +1,9 @@ +definition module main + +:: Expr + = Lit Int + | (+.) infixl 6 Expr Expr + | .. + +eval :: Expr -> Int +pprint :: Expr -> String diff --git a/array_itasks/test.icl b/array_itasks/test.icl new file mode 100644 index 0000000..f44b0d8 --- /dev/null +++ b/array_itasks/test.icl @@ -0,0 +1,16 @@ +module test + +import StdEnv => qualified return +import iTasks + +gEditor{|{#Int}|} = emptyEditor +gText{|{#Int}|} = [] +JSONEncode{|{#Int}|} x = [JSONArray [JSONInt e \\ e <-: x] +JSONDecode{|{#Int}|} _ (JSONArray a) = {#i\\JSONInt<-a} +gDefault{|{#Int}|} = {} +gEq{|{#Int}|} l r = size l == size r && and [l == r\\l<-l & r<-r] + +Start w = startEngine t w + +t :: Task {#Int} +t = treturn {0,0,0} diff --git a/booking/Booking b/booking/Booking new file mode 100755 index 0000000..26039ab Binary files /dev/null and b/booking/Booking differ diff --git a/booking/Booking.icl b/booking/Booking.icl new file mode 100644 index 0000000..b4c98d8 --- /dev/null +++ b/booking/Booking.icl @@ -0,0 +1,94 @@ +module Booking + +import iTasks +import Data.List + +:: List a :== [a] + +view label value :== viewInformation label [] value +edit label value :== updateInformation label [] value +fill label :== enterInformation label [] + +share label value :== sharedStore label value +watch label store :== viewSharedInformation label [] store + +ok :== const True + +// (>>+) :: Task a -> List ( a -> Bool, a -> Task b ) -> Task b +(>>+) infixl 1 +(>>+) task options :== task >>* map trans options +where + trans ( p, t ) = OnValue (ifValue p t) + +// (>>-) :: Task a -> (a -> Task b) -> Task b +(>>-) infixl 1 +(>>-) task cont = task >>+ [ ( ok, cont ) ] + +// (>>|) :: Task a -> Task b -> Task b +(>>|) infixl 1 +(>>|) task next = task >>- \_ -> next + +// (>>?) :: Task a -> List ( String, a -> Bool, a -> Task b ) -> Task b +(>>?) infixl 1 +(>>?) task options :== task >>* map trans options +where + trans ( a, p, t ) = OnAction (Action a) (ifValue p t) + + +// Data //////////////////////////////////////////////////////////////////////// + +:: Seat = Seat Row Pos +:: Row :== Int +:: Pos :== Char + +:: Person = + { first_name :: String + , last_name :: String + , age :: Int + } + +:: Booking = + { passengers :: List Person + , flight_no :: String + , seats :: List Seat + } + + +// Stores ////////////////////////////////////////////////////////////////////// + +free_seat_store :: Shared (List Seat) +free_seat_store = share "Free seats" [ Seat r p \\ r <- [1..6], p <- ['A'..'D'] ] + + +// Checks ////////////////////////////////////////////////////////////////////// + +// Tasks /////////////////////////////////////////////////////////////////////// + +removeElems :: (List a) (List a) -> List a | iTask a +removeElems xs ys = + [] + // [ y \\ y <- ys, x <- xs | y =!= x ] + // filter (\x -> not (elem x ys)) ys + +choose_seats :: Int -> Task (List Seat) +choose_seats n = + enterMultipleChoiceWithShared "Pick a seat" [] free_seat_store >>? + [ ( "Continue" + , \seats -> True//length seats == n + , \seats -> upd (removeElems seats) free_seat_store >>| return seats + ) + ] + +main :: Task (List Seat) +main = + (forever (watch "Free seats" free_seat_store >>* [OnAction (Action "Refresh") (always (treturn ()))])) + ||- + (choose_seats 2 >>- view "Chosen seats") + + +// Boilerplate ///////////////////////////////////////////////////////////////// + +derive class iTask Seat, Person, Booking + +Start :: *World -> *World +Start world = startEngine main world diff --git a/booking/test.icl b/booking/test.icl new file mode 100644 index 0000000..03f25aa --- /dev/null +++ b/booking/test.icl @@ -0,0 +1,11 @@ +module test + +import iTasks + +Start w = startEngine main w + +sh :: Shared [Int] +sh = sharedStore "bork" [0,1,2] + +main :: Task [Int] +main = viewSharedInformation () [] sh ||- (chooseAction [(Action "Empty", ())] >>- \()->upd tl sh >>- viewInformation () []) diff --git a/dyn/test.icl b/dyn/test.icl index bddb9bd..495a59d 100644 --- a/dyn/test.icl +++ b/dyn/test.icl @@ -1,5 +1,15 @@ module test -import T +import StdEnv -Start = dynamic someT +:: Exist = E.e: Ex e & TC e & == e + +Start = Ex 42 == Ex 42 + +instance == Exist +where + (==) (Ex e1) (Ex e2) = dynEq (dynamic e1) e2 + +dynEq :: Dynamic -> (a -> Bool) | TC, == a +dynEq (a :: a^) = (==) a +dynEq _ = const False diff --git a/linker/test.icl b/linker/test.icl new file mode 100644 index 0000000..c0afd8a --- /dev/null +++ b/linker/test.icl @@ -0,0 +1,8 @@ +module test + +f :: !Int -> !Int +f _ = code { + ccall bork "I:I" +} + +Start = f diff --git a/macros/test.icl b/macros/test.icl new file mode 100644 index 0000000..b810709 --- /dev/null +++ b/macros/test.icl @@ -0,0 +1,15 @@ +module test + +:: TypeT1 m a = Ty1 (m a) +:: TypeT2 m a = Ty2 (m a) + +:: Ident a = Ident a + +:: Type2 a :== TypeT2 Ident a + +//Not allowed +:: ShortHand a :== TypeT1 Type2 a +//Allowed +//:: ShortHand a :== TypeT1 (TypeT2 Ident) a + +Start = 42 diff --git a/randdist/test.icl b/randdist/test.icl new file mode 100644 index 0000000..7acdd25 --- /dev/null +++ b/randdist/test.icl @@ -0,0 +1,14 @@ +module test + +import Data.Func, Math.Random +import StdArray, StdList, StdFunc, StdArrayExtensions + +num :== 100000000 +lim :== 100 + +Start :: {!Int} +Start + = foldl (flip (updateArrElt inc)) (createArray lim 0) + $ map (flip (rem) lim) + $ take num + $ genRandInt 42 diff --git a/sharestore/test.icl b/sharestore/test.icl new file mode 100644 index 0000000..5c6c97b --- /dev/null +++ b/sharestore/test.icl @@ -0,0 +1,12 @@ +module test + +import iTasks + +Start w = startEngine main w + +sh :: Shared [Int] +sh = sharedStore "bork" [0,1,2] + +main :: Task [Int] +main = viewSharedInformation () [] sh + -|| (chooseAction [(Action "Empty", ())] >>- \()->upd (\_->[]) sh)