packages feed

Frank 0.2 → 0.3

raw patch · 6 files changed

+45/−22 lines, 6 files

Files

Elab.lhs view
@@ -86,6 +86,7 @@ > gShow g (PApp f ts)     = "(" ++ show f ++ (ts >>= ((' ' :) . show)) ++ ")" > gShow g (HAN h e)       = "(" ++ gShow g h ++ "?" ++ gShow g e ++ ")" > gShow g (E t)           = gShow g t+> gShow g (CL c)          = "'" ++ c : "'" > gShow g (CN c ts)       = tempShow c (map (gShow g) ts) > gShow g (BUNK t)        = "(" ++ gShow g t ++ " {})" > gShow g (LAM (a : as))  =@@ -114,7 +115,7 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  > checkR :: VT -> Raw -> ElabM (TM {CHK})-> --checkR v r | trace ("checkR " ++ show (v, r)) $ False = undefined+> -- checkR v r | trace ("checkR " ++ show (v, r)) $ False = undefined > checkR v r = hnf v >>= \ v -> err (Raw v r) $ case r of >   RVd      -> (|(CN [] []) (-Un =?= v-)|) >   RCh c    -> (|(CL c) (-char =?= v-)|)@@ -133,16 +134,17 @@ >         w =?= v >         canDo os >         e <- withSigs (sAct hs ss) $ do->           canDo is+>           canDo (sAct hs is) >           checkR u e >         (|(E (HAN h e))|) >       _ -> moanE $ BadHandlerType z >   r        -> synR r >>= want v  > synR :: Raw -> ElabM (TM {SYN}, VT)-> --synR r | trace ("synR " ++ show r) $ False = undefined+> -- synR r | trace ("synR " ++ show r) $ False = undefined > synR (RN n)     = synR (RA [RN n]) > synR RVd        = moanE SynCon+> synR (RCh _)    = moanE SynCon > synR RBunk      = moanE BadBunk > synR (RA rs)    = rawTree rs [] >>= \ t -> case t of >   TNode f ts -> appSyn f ts@@ -156,17 +158,18 @@ >     U (M hs is u :-> F os w) -> do >       canDo os >       e <- withSigs (sAct hs ss) $ do->         canDo is+>         canDo (sAct hs is) >         checkR u e >       (|(HAN h e, w)|) >     _ -> moanE $ BadHandlerType v+> synR RBang = moanE $ Cockup "! in synR"  > isBunk :: TTree Raw -> Bool > isBunk (TLeaf RBunk []) = True > isBunk _ = False  > ttrCh :: VT -> (TTree Raw) -> ElabM (TM {CHK})-> --ttrCh v t | trace ("ttrCh " ++ show (v, t)) $ False = undefined+> -- ttrCh v t | trace ("ttrCh " ++ show (v, t)) $ False = undefined > ttrCh v (TNode f ts) = if (not (null ts) && isBunk (last ts)) >   then (|BUNK (ttrCh Ze (TNode f (init ts)))|) else do >   info <- getInfoE@@ -194,14 +197,15 @@ > ttrCh v _ = moanE $ Cockup "oops"  > want :: VT -> (TM {SYN}, VT) -> ElabM (TM {CHK})-> want v (t, u) = (|(E t) (-u =?= v-)|)+> want v (t, u) = -- trace ("WANT " ++ show t ++ " : " ++ show u ++ " = " ++ show v) $+>   (|(E t) (-u =?= v-)|)  > getOps :: [Sig] -> ElabM [(Template, ([VT], (Sig, VT)))] > getOps [] = return [] > getOps (Pure : _) = return [] > getOps (s@(u :$ vs) : ss) = do >   info <- getInfoE->   (| ~[  (ot, xsub vs (ois, (s, oo)))+>   (| ~[  (ot, (xsub vs ois, (s, xsub vs oo))) >       |  (u', (i, os)) <- sigDecls info, u == u' >       ,  (ot, (ois, oo)) <- os >       ] ++ getOps ss |)@@ -210,7 +214,7 @@ > mkOpType ss (vs, (s, v)) = sAct (U (foldr (:->) (F [s] v) vs)) ss  > appSyn :: Template -> [TTree Raw] -> ElabM (TM {SYN}, VT)-> --appSyn f ts | trace ("appSyn " ++ show (f, ts)) $ False = undefined+> -- appSyn f ts | trace ("appSyn " ++ show (f, ts)) $ False = undefined > appSyn f ts = do >   info <- getInfoE >   sigs <- getSigsE@@ -220,12 +224,13 @@ >     Just (i, (m, v)) -> do >       ws <- fresh m >       let v' = xsub ws v->       --False <- trace ("FOUND: " ++ show f ++ " : " ++ show v') $->       --  return False+>       -- False <- trace ("FOUND: " ++ show f ++ " : " ++ show v') $+>       --   return False >       mention (H (VA i), xsub ws v) ts >     Nothing -> case [v | (f', v) <- ops, f == f'] of >       (_:_:_) -> moanE $ AmbiguousOp f sigs->       [v] -> mention (H (OP f), v) ts+>       [v] -> -- trace ("OPTYPE " ++ show f ++ " : " ++ show v) $+>                mention (H (OP f), v) ts >       [] -> case lookup f (funDecls info) of >         Just (m, vs, sa, v) -> do >           ws <- fresh m@@ -239,7 +244,7 @@ > gnom _ = []  > mention :: (TM {SYN}, VT) -> [TTree Raw] -> ElabM (TM {SYN}, VT)-> mention tv        []  = return tv+> mention tv        []  = {- trace ("MENTION " ++ show tv) $ -} return tv > mention (t, U c)  ts  = use t [] c ts > mention (t, v)    ts  = moanE $ Useless v @@ -257,6 +262,7 @@  > canDo :: [Sig] -> ElabM () > canDo [] = return ()+> canDo (Pure : _) = return () > canDo (s : ss) = do >   ss' <- getSigsE >   findSig s ss' ss'
Frank.cabal view
@@ -1,5 +1,5 @@ name:			Frank-version:		0.2+version:		0.3 synopsis:		An experimental programming language with typed algebraic effects description:	   An experimental programming language with typed algebraic effects license:		PublicDomain
Gubbins.lhs view
@@ -45,6 +45,10 @@ >    = Ret x >    | Com (forall t. (x -> Free f t) -> f (Free f t)) +< data Free f x+<    = Ret x+<    | Com (f (Free f x))+ > instance Monad (Free f) where >   return = Ret >   Ret x  >>= f = f x
Unify.lhs view
@@ -41,7 +41,7 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  > instance Unify VT where->   --s =?= t | trace (show s ++ " =?= " ++ show t) False = undefined+>   -- s =?= t | trace (show s ++ " =?= " ++ show t) False = undefined >   Ze      =?=  Ze      = return () >   Un      =?=  Un      = return () >   U b     =?=  U c     = b =?= c@@ -101,8 +101,8 @@  > solve :: Int -> [Entry] -> VT -> ElabM () > solve q es v = do->  --(g, _) <- getCxE->  --False <- trace ("SOLVE " ++ show g ++ show (q, es, v)) $ return False+>  (g, _) <- getCxE+>  -- False <- trace ("SOLVE " ++ show g ++ show (q, es, v)) $ return False >  withTopEntry $ \ e -> case e of >   q' :=? mu | q' == q -> >     if qoccur q es || qoccur q v
keylog.fk view
@@ -76,11 +76,20 @@ elem c nil = ff elem c (c' :: cs) = if (c =Char= c') then {tt} else {elem c cs} -name [ReadLine] List Char-name = if (elem (peek!) (' ' :: ('(' :: (')' :: ('.' :: nil)))))-  then {nil}-  else {(peek! << nom!) :: name!}+nameChar [ReadLine, Abort] Char+nameChar = if (elem (peek!) ('\n' :: (' ' :: ('(' :: (')' :: ('.' :: nil))))))+  then {abort!}+  else {(peek! << nom!)} +some {[ReadLine, Abort] X} [ReadLine, Abort] List X+some p = (p!) :: many p++many {[ReadLine, Abort] X} [ReadLine] List X+many p = ({some p} / {nil})!++name [ReadLine, Abort] List Char+name = some nameChar+ data Maybe X = no | yes X  let X in {X -> [] Y} [] Y@@ -97,7 +106,7 @@   | (Stk X) -nom   | root {[ReadLine, Abort] X} -withBS (Stk X) (Maybe Char) [ReadLine, Abort ? [{}] X] [Console] X+withBS (Stk X) (Maybe Char) [ReadLine, Abort, {} ? X] [Console] X withBS stk _ [x] = x withBS stk no [peek ? k] = let inch! in   { '\b' -> pop stk@@ -116,4 +125,8 @@  main [Console] SExp main = withBS (root {sexp!}) no ? sexp!++note+  main [Console, Abort] SExp+  main = noBS no ? sexp!
test.fk view
@@ -140,7 +140,7 @@  note We'll find that -    catch ? cons tt zero (abort!)  =  no+    catch ? cond tt zero (abort!)  =  no    because the (abort!) is evaluated.