bork
authorMart Lubbers <mart@martlubbers.net>
Mon, 18 Jun 2018 14:52:12 +0000 (16:52 +0200)
committerMart Lubbers <mart@martlubbers.net>
Mon, 18 Jun 2018 14:52:12 +0000 (16:52 +0200)
27 files changed:
eadt/T.dcl [new file with mode: 0644]
eadt/T.icl [new file with mode: 0644]
eadt/test.icl [new file with mode: 0644]
expr/class [new file with mode: 0755]
expr/class.dcl [new file with mode: 0644]
expr/class.icl [new file with mode: 0644]
expr/deep [new file with mode: 0755]
expr/deep.icl [new file with mode: 0644]
expr/exist/exist [new file with mode: 0755]
expr/exist/exist.dcl [new file with mode: 0644]
expr/exist/exist.icl [new file with mode: 0644]
expr/exist/existFor.dcl [new file with mode: 0644]
expr/exist/existMult.dcl [new file with mode: 0644]
expr/exist/existMult.icl [new file with mode: 0644]
expr/exist/while.dcl [new file with mode: 0644]
expr/exist/while.icl [new file with mode: 0644]
expr/exist/whileMult.dcl [new file with mode: 0644]
expr/exist/whileMult.icl [new file with mode: 0644]
expr/exist/whileRep.dcl [new file with mode: 0644]
expr/exist/whileRep.icl [new file with mode: 0644]
expr/expr.md [new file with mode: 0644]
expr/gadt [new file with mode: 0755]
expr/gadt.icl [new file with mode: 0644]
expr/shallow [new file with mode: 0755]
expr/shallow.icl [new file with mode: 0644]
jsonmap/test.icl [new file with mode: 0644]
tcp/test.icl [new file with mode: 0644]

diff --git a/eadt/T.dcl b/eadt/T.dcl
new file mode 100644 (file)
index 0000000..55921c1
--- /dev/null
@@ -0,0 +1,3 @@
+definition module T
+
+:: T = ..
diff --git a/eadt/T.icl b/eadt/T.icl
new file mode 100644 (file)
index 0000000..72acaea
--- /dev/null
@@ -0,0 +1,3 @@
+implementation module T
+
+
diff --git a/eadt/test.icl b/eadt/test.icl
new file mode 100644 (file)
index 0000000..3808a4d
--- /dev/null
@@ -0,0 +1,14 @@
+module test
+
+import StdGeneric
+import T
+
+
+:: T | T1
+
+generic gDefault a :: a
+
+gDefault{|T|} = T1
+
+Start :: T
+Start = T1
diff --git a/expr/class b/expr/class
new file mode 100755 (executable)
index 0000000..81c2912
Binary files /dev/null and b/expr/class differ
diff --git a/expr/class.dcl b/expr/class.dcl
new file mode 100644 (file)
index 0000000..a16f518
--- /dev/null
@@ -0,0 +1,15 @@
+definition module class
+
+class lit m :: Int -> m
+class var m :: String -> m
+class (+.) infixl 6 m :: m m -> m
+
+:: Eval
+instance lit Eval
+instance var Eval
+instance +. Eval
+
+:: Print
+instance lit Print
+instance var Print
+instance +. Print
diff --git a/expr/class.icl b/expr/class.icl
new file mode 100644 (file)
index 0000000..0b4622d
--- /dev/null
@@ -0,0 +1,31 @@
+implementation module class
+
+import StdEnv
+import Data.Func
+import Data.Functor
+import Data.Either
+import Data.List
+import Data.Maybe
+import Control.Applicative
+import Control.Monad
+
+//Easy to add functionality
+//Easy to add backends
+//Type safety as in GADTs
+
+class lit m :: Int -> m
+class var m :: String -> m
+class (+.) infixl 6 m :: m m -> m
+
+:: Eval :== ([(String, Int)] -> Either String Int)
+instance lit Eval where lit i = pure (pure i)
+instance var Eval where var s = maybe (Left $ "Undefined variable " +++ s) Right o lookup s
+instance +. Eval where (+.) a b = \s->liftM2 (+) (a s) (b s)
+
+:: Print :== String
+instance lit Print where lit i = toString i
+instance var Print where var s = s
+instance +. Print where (+.) a b = a +++ " + " +++ b
+
+Start :: Eval
+Start = (lit 5 +. lit 37)
diff --git a/expr/deep b/expr/deep
new file mode 100755 (executable)
index 0000000..f04ea77
Binary files /dev/null and b/expr/deep differ
diff --git a/expr/deep.icl b/expr/deep.icl
new file mode 100644 (file)
index 0000000..ad5774b
--- /dev/null
@@ -0,0 +1,27 @@
+module deep
+
+import StdEnv
+import Data.Func
+import Data.Functor
+import Data.Either
+import Data.List
+import Data.Maybe
+import Control.Applicative
+import Control.Monad
+
+:: Expr
+       = Lit Int
+       | Var String
+       | (+.) infixl 6 Expr Expr
+
+eval :: Expr -> ([(String, Int)] -> Either String Int)
+eval (Lit i) = const $ pure i
+eval (Var s) = maybe (Left $ "Undefined variable " +++ s) Right o lookup s
+eval (a +. b) = \s->liftM2 (+) (eval a s) (eval b s)
+
+print :: Expr -> String
+print (Lit i) = toString i
+print (Var s) = s
+print (a +. b) = print a +++ " + " +++ print b
+
+Start = eval (Lit 5 +. Lit 37) []
diff --git a/expr/exist/exist b/expr/exist/exist
new file mode 100755 (executable)
index 0000000..858e206
Binary files /dev/null and b/expr/exist/exist differ
diff --git a/expr/exist/exist.dcl b/expr/exist/exist.dcl
new file mode 100644 (file)
index 0000000..a221733
--- /dev/null
@@ -0,0 +1,15 @@
+definition module exist
+
+from Data.Either import :: Either
+
+:: Expr
+       = Lit Int
+       | Var String
+       | (+.) infixl 6 Expr Expr
+       | E.e: Ext e & eval e & print e
+
+class eval m :: m -> ([(String, Int)] -> Either String Int)
+class print m :: m -> String
+
+instance eval Expr
+instance print Expr
diff --git a/expr/exist/exist.icl b/expr/exist/exist.icl
new file mode 100644 (file)
index 0000000..8e6f483
--- /dev/null
@@ -0,0 +1,29 @@
+implementation module exist
+
+import StdEnv
+import Data.Func
+import Data.Functor
+import Data.Either
+import Data.List
+import Data.Maybe
+import Control.Applicative
+import Control.Monad
+
+class eval m  :: m -> ([(String, Int)] -> Either String Int)
+class print m :: m -> String
+
+instance eval Expr
+where
+       eval (Lit i) = const $ pure i
+       eval (Var s) = maybe (Left $ "Undefined variable " +++ s) Right o lookup s
+       eval (a +. b) = \s->liftM2 (+) (eval a s) (eval b s)
+       eval (Ext e) = eval e
+
+instance print Expr
+where
+       print (Lit i) = toString i
+       print (Var s) = s
+       print (a +. b) = print a +++ " + " +++ print b
+       print (Ext e) = print e
+
+Start = eval (Lit 5 +. Lit 37) []
diff --git a/expr/exist/existFor.dcl b/expr/exist/existFor.dcl
new file mode 100644 (file)
index 0000000..3369ada
--- /dev/null
@@ -0,0 +1,10 @@
+definition module whileFor
+
+import while
+
+:: WFor = WFor String Is WhileInt To WhileInt Do WhileExpr
+
+(*.) infixl 7
+(*.) a b :== WInt (WMult a b)
+
+instance evali WMult
diff --git a/expr/exist/existMult.dcl b/expr/exist/existMult.dcl
new file mode 100644 (file)
index 0000000..42130fd
--- /dev/null
@@ -0,0 +1,8 @@
+definition module Mult
+
+from exist import :: Expr
+
+:: ExprMult = (*.) infixl 7 Expr Expr
+
+instance eval ExprMult
+instance print ExprMult
diff --git a/expr/exist/existMult.icl b/expr/exist/existMult.icl
new file mode 100644 (file)
index 0000000..eba7cae
--- /dev/null
@@ -0,0 +1,8 @@
+implementation module existMult
+
+import Expr
+
+:: ExprMult = (*.) infixl 7 Expr Expr
+
+instance eval ExprMult
+instance print ExprMult
diff --git a/expr/exist/while.dcl b/expr/exist/while.dcl
new file mode 100644 (file)
index 0000000..7431e3f
--- /dev/null
@@ -0,0 +1,42 @@
+definition module while
+
+:: Then = Then
+:: Else = Else
+:: Do = Do
+:: WhileExpr
+       = (=.) infix 1 String WhileInt
+       | If WhileBool Then WhileExpr Else WhileExpr
+       | (:.) infixr 0 WhileExpr WhileExpr
+       | While WhileBool Do WhileExpr
+       | Skip
+       | E.e: WExpr e & eval e
+
+:: WhileBool
+       = Bool Bool
+       | (==.) infix 4 WhileInt WhileInt
+       | (&.) infix 3 WhileBool WhileBool
+       | Not WhileBool
+       | E.e: WBool e & evalb e
+
+:: WhileInt
+       = Int Int
+       | Var String
+       | (+.) infixl 6 WhileInt WhileInt
+       | E.e: WInt e & evali e
+
+class gamma g
+where
+       put :: g String Int -> g
+       get :: g String -> Int
+instance gamma Gamma
+
+:: Gamma
+emptyGamma :: Gamma
+
+class eval  m :: m -> (g -> g)    | gamma g
+class evali m :: m -> (g -> Int)  | gamma g
+class evalb m :: m -> (g -> Bool) | gamma g
+
+instance eval WhileExpr
+instance evali WhileInt
+instance evalb WhileBool
diff --git a/expr/exist/while.icl b/expr/exist/while.icl
new file mode 100644 (file)
index 0000000..4e23327
--- /dev/null
@@ -0,0 +1,38 @@
+implementation module while
+
+import StdEnv
+
+:: Gamma :== String -> Int
+instance gamma Gamma
+where
+       put g i v = \i`->if (i == i`) v (g i)
+       get g v = g v
+
+emptyGamma :: Gamma
+emptyGamma = abort "Undefined variable"
+
+instance eval WhileExpr
+where
+       eval (i =. v)         = \g->put g i (evali v g)
+       eval (If b _ t _ e)   = \g->if (evalb b g) (eval t g) (eval e g)
+       eval (a :. b)         = eval b o eval a
+       eval x=:(While b _ e) = \g->if (evalb b g) (eval (e :. x) g) g
+       eval Skip             = id
+       eval (WExpr e)        = eval e
+
+instance evali WhileInt
+where
+       evali (Int i)  = const i
+       evali (Var s)  = flip get s
+       evali (a +. b) = \g->evali a g + evali b g
+       evali (WInt e) = evali e
+
+instance evalb WhileBool
+where
+       evalb (Bool b)  = const b
+       evalb (a ==. b) = \g->evali a g == evali b g
+       evalb (a &. b)  = \g->evalb a g && evalb b g
+       evalb (Not a)   = not o evalb a
+       evalb (WBool e) = evalb e
+
+Start = (eval ("a" =. Int 42 :. While (Bool False) Do ("b" =. Int 4)) emptyGamma) "a"
diff --git a/expr/exist/whileMult.dcl b/expr/exist/whileMult.dcl
new file mode 100644 (file)
index 0000000..6179bf5
--- /dev/null
@@ -0,0 +1,10 @@
+definition module whileMult
+
+import while
+
+:: WMult = WMult WhileInt WhileInt
+
+(*.) infixl 7
+(*.) a b :== WInt (WMult a b)
+
+instance evali WMult
diff --git a/expr/exist/whileMult.icl b/expr/exist/whileMult.icl
new file mode 100644 (file)
index 0000000..379404e
--- /dev/null
@@ -0,0 +1,6 @@
+implementation module whileMult
+
+import StdEnv
+import while
+
+instance evali WMult where evali (WMult a b) = \g->evali a g * evali b g
diff --git a/expr/exist/whileRep.dcl b/expr/exist/whileRep.dcl
new file mode 100644 (file)
index 0000000..2fdea00
--- /dev/null
@@ -0,0 +1,10 @@
+definition module whileRep
+
+import while
+
+:: WRep = WRepeat WhileExpr Until WhileBool
+:: Until = Until
+
+Repeat e Until b :== WExpr (WRepeat e Until b)
+
+instance eval WRep
diff --git a/expr/exist/whileRep.icl b/expr/exist/whileRep.icl
new file mode 100644 (file)
index 0000000..6b5fe6f
--- /dev/null
@@ -0,0 +1,7 @@
+implementation module whileRep
+
+import while
+
+:: WRep = WRepeat WhileExpr Until WhileBool
+
+instance eval WRep where eval (WRepeat e Until b) = eval (e :. While b Do e)
diff --git a/expr/expr.md b/expr/expr.md
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/expr/gadt b/expr/gadt
new file mode 100755 (executable)
index 0000000..1947dc5
Binary files /dev/null and b/expr/gadt differ
diff --git a/expr/gadt.icl b/expr/gadt.icl
new file mode 100644 (file)
index 0000000..8d9d691
--- /dev/null
@@ -0,0 +1,29 @@
+module gadt
+
+import StdEnv
+import Data.Func
+import Data.Functor
+import Data.Either
+import Data.List
+import Data.Maybe
+import Control.Applicative
+import Control.Monad
+
+:: BM a b = {to :: a->b, fro :: b->a}
+bm = {to=id,fro=id}
+:: Expr a
+       = Lit (BM a Int) Int
+       | Var (BM a Int) String
+       | E.e: Plus (BM a e) (Expr a) (Expr a) & + e
+
+eval :: (Expr Int) -> ([(String, Int)] -> Either String Int)
+eval (Lit _ i) = const $ pure i
+eval (Var _ s) = maybe (Left $ "Undefined variable " +++ s) Right o lookup s
+eval (Plus _ a b) = \s->liftM2 (+) (eval a s) (eval b s)
+
+print :: (Expr a) -> String
+print (Lit _ i) = toString i
+print (Var _ s) = s
+print (Plus _ a b) = print a +++ " + " +++ print b
+
+Start = eval (Plus bm (Lit bm 5) (Lit bm 37)) [] 
diff --git a/expr/shallow b/expr/shallow
new file mode 100755 (executable)
index 0000000..3a961f8
Binary files /dev/null and b/expr/shallow differ
diff --git a/expr/shallow.icl b/expr/shallow.icl
new file mode 100644 (file)
index 0000000..71a3abc
--- /dev/null
@@ -0,0 +1,37 @@
+module shallow
+
+import StdEnv
+import Data.Func
+import Data.Functor
+import Data.Either
+import Data.List
+import Data.Maybe
+import Control.Applicative
+import Control.Monad
+
+:: Expr :==
+       ([(String, Int)] -> Either String Int //Evaluator
+       , String)                             //Printer
+
+lit :: Int -> Expr
+lit i = (const $ pure i, toString i)
+
+var :: String -> Expr
+var s =
+       ( maybe (Left $ "Undefined variable " +++ s) Right o lookup s
+       , s
+       )
+
+(+.) infixl 6 :: Expr Expr -> Expr
+(+.) (ea, pa) (eb, pb) =
+       ( \s->liftM2 (+) (ea s) (eb s)
+       , pa +++ " + " +++ pb
+       )
+
+print :: Expr -> String
+print (_, p) = p
+
+eval :: Expr [(String, Int)]-> Either String Int
+eval (e, _) s = e s
+
+Start = eval (lit 5 +. lit 37) []
diff --git a/jsonmap/test.icl b/jsonmap/test.icl
new file mode 100644 (file)
index 0000000..3f490de
--- /dev/null
@@ -0,0 +1,9 @@
+module test
+
+import Text.GenJSON
+from Data.Map import :: Map, newMap
+
+Start = JSONEncode{|*|} True map
+where
+    map :: Map Int Int
+    map = newMap
diff --git a/tcp/test.icl b/tcp/test.icl
new file mode 100644 (file)
index 0000000..29a4b71
--- /dev/null
@@ -0,0 +1,32 @@
+module test
+
+import iTasks
+import StdMisc,StdDebug
+import Data.Maybe
+
+Start w = startEngine t w
+
+t = withShared () \channels->
+       forever (chooseAction [(Action "Set", ())] >>- \_->set () channels)
+       ||- tcpconnect "localhost" 8123 channels
+               {ConnectionHandlers|
+                       onConnect=onConnect,
+                       onData=onData,
+                       onShareChange=onShareChange,
+                       onDisconnect=onDisconnect}
+       where
+               onConnect acc ()
+                       | not (trace_tn "onConnect") = undef
+                       = (Ok "", Nothing, [], False)
+
+               onData newdata acc ()
+                       | not (trace_tn "onData") = undef
+                       = (Ok "", Nothing, [], False)
+               
+               onShareChange acc ()
+                       | not (trace_tn "onShareChange") = undef
+                       = (Ok "", Nothing, [], False)
+
+               onDisconnect _ ()
+                       | not (trace_tn "onDisconnect") = undef
+                       = (Ok "", Nothing)