pi-calculus 0.0.3 → 0.0.4

raw patch · 11 files changed

+60/−15 lines, 11 files

Files

• PatternMatching.hs +15/−8
• PiCalculus.hs +9/−4
• TypDefs.hs +1/−1
• pi-calculus.cabal +3/−2
• pilude.pi +5/−0
• testing/client.pi +6/−0
• testing/follow.pi +5/−0
• testing/hanshake.pi +5/−0
• testing/index.pi +4/−0
• testing/server.pi +3/−0
• testing/test.pi +4/−0

@@ -1,19 +1,26 @@-module PatternMatching (match) where            +module PatternMatching (match, matchTest) where                          import Control.Arrow (second) -import Control.Monad (liftM,liftM2,zipWithM)+import Control.Monad (liftM,liftM2) import Control.Monad.Error (throwError) import TypDefs-import Parser ()+import Parser (readTerm) import Network.HTTP.Base   match :: Term -> Term -> ThrowsError [(String,Value)] match a b = liftM (map (second Term)) $ match' a b  match' :: Term -> Term -> ThrowsError [(String,Term)]-match' (TVar name _) term = return [(name,term)]+match' (TVar name _) term = case name of+                                '_':_ -> return []+                                _     -> return [(name,term)] match' (TPair (m1, m2)) (TPair (t1,t2)) = liftM2 (++) (match' m1 t1)  (match' m2 t2)-match' (TList ms) (TList ts) = liftM concat $ zipWithM match' ms ts+match' (TList (m:ms)) (TList (t:ts)) = do+                bind <- match' m t+                rest <- case ms of+                    [v] -> match' v $ TList ts+                    _   -> match' (TList ms) (TList ts)+                return $ bind ++ rest match' l@(TList _) (TData d) = match' l $ dataToList d match' t1 t2 = throwError $ PatternMatch t1 t2 @@ -34,9 +41,9 @@         headers = map (TStr . show) $ rspHeaders r         bdy = rspBody r -{-testMatch :: String -> String -> ThrowsError [(String,Term)]-testMatch s1 s2 = do+matchTest :: String -> String -> ThrowsError [(String,Value)]+matchTest s1 s2 = do     t1 <- readTerm s1     t2 <- readTerm s2-    match' t1 t2-}+    match t1 t2     

@@ -17,9 +17,10 @@  import Channel import Parser+import Paths_pi_calculus+import PatternMatching import Primitives import TypDefs-import PatternMatching  nullEnv :: IO Env nullEnv = newIORef Map.empty@@ -79,11 +80,12 @@  main :: IO () main = do-        name <- getProgName-        args <- getArgs+        name   <- getProgName+        args   <- getArgs+        pilude <- getDataFileName "pilude.pi"         case args of             []  -> runRepl coreBindings-            [x] -> readFile x >>= runProcess coreBindings +            [x] -> liftM (("&load("++pilude++");")++) (readFile x) >>= runProcess coreBindings              _   -> do                     putStrLn           "Use:"                     putStrLn $ name ++ " -- Enter the REPL"@@ -275,6 +277,9 @@                         bindings <- liftThrows $ match t1 term                         mapM_ (uncurry (defineVar env)) bindings                     _         -> throwE $ Default "Can only pattern match against Terms"+eval env (Atom (TFun "load" [TStr "pilude.pi"])) = do+            pilude <- liftIO $ getDataFileName "pilude.pi"+            eval env (Atom (TFun "load" [TStr pilude])) eval env (Atom (TFun "load" [TStr file])) = do             procs <- load file               eval env $ foldl Seq Null procs

@@ -160,7 +160,7 @@ showTerm (TVar x t) = x ++ (case t of                                  Nothing -> ""                                 Just ty -> ": " ++ show ty)-showTerm (TStr str) = str+showTerm (TStr str) = show str showTerm (TNum num) = show num showTerm (TBool b ) = map toLower $ show b showTerm (TList ls) = "list(" ++ intercalate "," (map show ls) ++ ")"

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                pi-calculus-version:             0.0.3+version:             0.0.4 synopsis:            Applied pi-calculus compiler description:         Phi - A compiler for the applied pi-calculus. Very rough around the edges. license:             GPL-3@@ -14,8 +14,9 @@ category:            Web build-type:          Simple cabal-version:       >=1.8+data-files:          testing/*.pi, pilude.pi  executable phi   main-is:           PiCalculus.hs-  other-modules:     Channel, Parser, PatternMatching, Primitives, TypDefs+  other-modules:     Channel, Parser, PatternMatching, Primitives, TypDefs, Paths_pi_calculus   build-depends:       base >=4.5 && <=4.8, mtl ==2.2.*, parsec ==3.1.*, containers ==0.5.*, transformers ==0.4.*, network ==2.5.*, HTTP >=2.15, bytestring >= 0.10, io-streams ==1.1.*

@@ -0,0 +1,5 @@+let triple(a,b,c) = pair(a,pair(b,c))+let print(msg) = out(stdout,msg)+let error(msg) = out(stderr,msg)+let dbgOut(c, msg) = out(c,msg);out(stdout,msg)+let forever(process) = &process;&forever(process)

@@ -0,0 +1,6 @@+out(stdout,"Enter host:"); in(stdin,host);+out(stdout,"Enter port:"); in(stdin,port);+let ch = chan(host,port) in+    let sch = {} in+        out(stdout,sch);out(ch,sch);in(sch,msg);out(stdout,msg)+

@@ -0,0 +1,5 @@+let follow(ch,r) = (out(ch,r);in(ch,resp:HttpResponse);+    let list(c,_,h,_) = resp in+        if c = 302 +            then let req = httpReq(getHeader("location",resp),headers(),httpGet()) in &follow(ch,req) +            else out(stdout,h)) 

@@ -0,0 +1,5 @@+new sks; new skc; new s; let pks = pk(sks) in let pkc = pk(skc) in (out(c,pks);0) | (out(c,pkc);0)|!(0)|!(0)++in(c,xpk);new k ; out(c, aenc(xpk, sign(sks,k))); in(c,z); if fst(sdec(k, z)) == tag then 0 else 0++in(c,y);let y' = adec(skc,y) in let yk = getmsg(y') in if checksign(pks, y') == true then out(c, senc( yk , pair( tag, s))) ; 0 else 0

@@ -0,0 +1,4 @@+&load("follow.pi");+out(stdout,"Host:");in(stdin,site);+let siteChan = httpChan(site) in+let req = httpReq(uri(site,"index.html"),headers(),httpGet()) in &follow(siteChan,req)

@@ -0,0 +1,3 @@+out(stdout,"Enter port:"); in(stdin,port);+let ch = {port} in +    in(ch,sch);out(stdout,sch);in(stdin,msg);out(sch,msg)

@@ -0,0 +1,4 @@+let google = "www.google.com" in +let chan = httpChan(google) in+let req  = httpReq(google, headers(), httpGet()) in+out(chan,req);in(chan,httpResp(_,_,_,body));out(stdout,body)