bork

diff --git a/alacarte/calc.icl b/alacarte/calc.icl
new file mode 100644 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (executable)
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 (file)
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 (file)
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 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
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)