atomo 0.4.0.1 → 0.4.0.2
raw patch · 27 files changed
+824/−781 lines, 27 filesdep ~hint
Dependency ranges changed: hint
Files
- atomo.cabal +3/−3
- prelude/concurrency.atomo +23/−0
- prelude/version.atomo +1/−1
- src/Atomo/Kernel/Block.hs +20/−20
- src/Atomo/Kernel/Character.hs +28/−28
- src/Atomo/Kernel/Comparable.hs +62/−62
- src/Atomo/Kernel/Concurrency.hs +27/−8
- src/Atomo/Kernel/Continuation.hs +11/−11
- src/Atomo/Kernel/Environment.hs +6/−6
- src/Atomo/Kernel/Expression.hs +43/−43
- src/Atomo/Kernel/Format.hs +10/−10
- src/Atomo/Kernel/List.hs +85/−85
- src/Atomo/Kernel/Message.hs +6/−6
- src/Atomo/Kernel/Method.hs +4/−4
- src/Atomo/Kernel/Nucleus.hs +28/−28
- src/Atomo/Kernel/Numeric.hs +67/−67
- src/Atomo/Kernel/Particle.hs +23/−23
- src/Atomo/Kernel/Pattern.hs +12/−12
- src/Atomo/Kernel/Ports.hs +121/−121
- src/Atomo/Kernel/Pretty.hs +54/−54
- src/Atomo/Kernel/Regexp.hs +23/−23
- src/Atomo/Kernel/String.hs +157/−157
- src/Atomo/Kernel/Time.hs +4/−4
- src/Atomo/QuasiQuotes.hs +3/−3
- src/Atomo/Run.hs +1/−0
- src/Atomo/Valuable.hs +1/−1
- src/Main.hs +1/−1
atomo.cabal view
@@ -1,5 +1,5 @@ name: atomo-version: 0.4.0.1+version: 0.4.0.2 synopsis: A highly dynamic, extremely simple, very fun programming language. description:@@ -42,7 +42,7 @@ flag lib description: Install the Atomo library.- default: False+ default: True library if !flag(lib)@@ -58,7 +58,7 @@ directory, filepath, hashable == 1.0.0,- hint,+ hint >= 0.3.3.2, mtl, parsec >= 3.0.0, pretty,
+ prelude/concurrency.atomo view
@@ -0,0 +1,23 @@+macro (receive: (branches: Block))+ { bs = branches contents map:+ { `(~p -> ~e) |+ `(~p -> !cc yield: ~e)+ } \ .. [`(_ -> @ok)]++ `({ !cc |+ { receive match: ~(`Block new: bs)+ } repeat+ } call/cc)+ } call++macro (receive: (branches: Block) after: `({ ~t -> ~a }))+ { bs = branches contents map:+ { `(~p -> ~e) |+ `(@(ok: ~p) -> !cc yield: ~e)+ } \ .. [`(@none -> !cc yield: ~a), `(_ -> @ok)]++ `({ !cc |+ { (receive-timeout: ~t) match: ~(`Block new: bs)+ } repeat+ } call/cc)+ } call
prelude/version.atomo view
@@ -13,7 +13,7 @@ } (v: Version) pretty :=- v major pretty <+> text: "." <+> v minor pretty+ { v major pretty <+> text: "." <+> v minor pretty } doc (v: Version) as: String := v major show .. "." .. v minor (as: String)
src/Atomo/Kernel/Block.hs view
@@ -11,28 +11,28 @@ load :: VM () load = do- [$p|Block new: (es: List) in: t|] =:::- [$e|Block new: es arguments: [] in: t|]+ [p|Block new: (es: List) in: t|] =:::+ [e|Block new: es arguments: [] in: t|] - [$p|Block new: (es: List) arguments: (as: List) in: t|] =: do+ [p|Block new: (es: List) arguments: (as: List) in: t|] =: do t <- here "t"- es <- getList [$e|es|]- as <- getList [$e|as|]+ es <- getList [e|es|]+ as <- getList [e|as|] return (Block t (map fromPattern as) (map fromExpression es)) - [$p|(b: Block) call|] =: do+ [p|(b: Block) call|] =: do b <- here "b" >>= findBlock callBlock b [] - [$p|(b: Block) repeat|] =: do+ [p|(b: Block) repeat|] =: do Block c as es <- here "b" >>= findBlock when (length as > 0) (throwError (BlockArity 0 (length as))) withTop c (forever (evalAll es)) - [$p|(b: Block) repeat: (n: Integer)|] =: do+ [p|(b: Block) repeat: (n: Integer)|] =: do Block c as cs <- here "b" >>= findBlock when (length as > 0) (throwError (BlockArity 0 (length as)))@@ -41,48 +41,48 @@ vs <- V.replicateM (fromIntegral n) (withTop c (evalAll cs)) return $ List vs - [$p|(b: Block) call: (... args)|] =: do+ [p|(b: Block) call: (... args)|] =: do b <- here "b" >>= findBlock- vs <- getList [$e|args|]+ vs <- getList [e|args|] callBlock b vs - [$p|(b: Block) call-in: c|] =: do+ [p|(b: Block) call-in: c|] =: do Block _ _ es <- here "b" >>= findBlock c <- here "c" withTop c (evalAll es) - [$p|(b: Block) context|] =: do+ [p|(b: Block) context|] =: do Block s _ _ <- here "b" >>= findBlock return s - [$p|(b: Block) arguments|] =: do+ [p|(b: Block) arguments|] =: do Block _ as _ <- here "b" >>= findBlock return $ list (map Pattern as) - [$p|(b: Block) contents|] =: do+ [p|(b: Block) contents|] =: do Block _ _ es <- here "b" >>= findBlock return $ list (map Expression es) - [$p|v do: (b: Block)|] =: do+ [p|v do: (b: Block)|] =: do v <- here "v" b <- here "b" >>= findBlock joinWith v b [] return v- [$p|v do: (b: Block) with: (... args)|] =: do+ [p|v do: (b: Block) with: (... args)|] =: do v <- here "v" b <- here "b" >>= findBlock- as <- getList [$e|args|]+ as <- getList [e|args|] joinWith v b as return v - [$p|v join: (b: Block)|] =: do+ [p|v join: (b: Block)|] =: do v <- here "v" b <- here "b" >>= findBlock joinWith v b []- [$p|v join: (b: Block) with: (... args)|] =: do+ [p|v join: (b: Block) with: (... args)|] =: do v <- here "v" b <- here "b" >>= findBlock- as <- getList [$e|args|]+ as <- getList [e|args|] joinWith v b as
src/Atomo/Kernel/Character.hs view
@@ -8,38 +8,38 @@ load :: VM () load = do- [$p|(c: Character) control?|] =: liftM Boolean (onCharacter isControl)- [$p|(c: Character) space?|] =: liftM Boolean (onCharacter isSpace)- [$p|(c: Character) lower?|] =: liftM Boolean (onCharacter isLower)- [$p|(c: Character) upper?|] =: liftM Boolean (onCharacter isUpper)- [$p|(c: Character) alpha?|] =: liftM Boolean (onCharacter isAlpha)- [$p|(c: Character) alphanum?|] =: liftM Boolean (onCharacter isAlphaNum)- [$p|(c: Character) print?|] =: liftM Boolean (onCharacter isPrint)- [$p|(c: Character) digit?|] =: liftM Boolean (onCharacter isDigit)- [$p|(c: Character) oct-digit?|] =: liftM Boolean (onCharacter isOctDigit)- [$p|(c: Character) hex-digit?|] =: liftM Boolean (onCharacter isHexDigit)- [$p|(c: Character) letter?|] =: liftM Boolean (onCharacter isLetter)- [$p|(c: Character) mark?|] =: liftM Boolean (onCharacter isMark)- [$p|(c: Character) number?|] =: liftM Boolean (onCharacter isNumber)- [$p|(c: Character) punctuation?|] =: liftM Boolean (onCharacter isPunctuation)- [$p|(c: Character) symbol?|] =: liftM Boolean (onCharacter isSymbol)- [$p|(c: Character) separator?|] =: liftM Boolean (onCharacter isSeparator)- [$p|(c: Character) ascii?|] =: liftM Boolean (onCharacter isAscii)- [$p|(c: Character) latin1?|] =: liftM Boolean (onCharacter isLatin1)- [$p|(c: Character) ascii-upper?|] =: liftM Boolean (onCharacter isAsciiLower)- [$p|(c: Character) ascii-lower?|] =: liftM Boolean (onCharacter isAsciiUpper)+ [p|(c: Character) control?|] =: liftM Boolean (onCharacter isControl)+ [p|(c: Character) space?|] =: liftM Boolean (onCharacter isSpace)+ [p|(c: Character) lower?|] =: liftM Boolean (onCharacter isLower)+ [p|(c: Character) upper?|] =: liftM Boolean (onCharacter isUpper)+ [p|(c: Character) alpha?|] =: liftM Boolean (onCharacter isAlpha)+ [p|(c: Character) alphanum?|] =: liftM Boolean (onCharacter isAlphaNum)+ [p|(c: Character) print?|] =: liftM Boolean (onCharacter isPrint)+ [p|(c: Character) digit?|] =: liftM Boolean (onCharacter isDigit)+ [p|(c: Character) oct-digit?|] =: liftM Boolean (onCharacter isOctDigit)+ [p|(c: Character) hex-digit?|] =: liftM Boolean (onCharacter isHexDigit)+ [p|(c: Character) letter?|] =: liftM Boolean (onCharacter isLetter)+ [p|(c: Character) mark?|] =: liftM Boolean (onCharacter isMark)+ [p|(c: Character) number?|] =: liftM Boolean (onCharacter isNumber)+ [p|(c: Character) punctuation?|] =: liftM Boolean (onCharacter isPunctuation)+ [p|(c: Character) symbol?|] =: liftM Boolean (onCharacter isSymbol)+ [p|(c: Character) separator?|] =: liftM Boolean (onCharacter isSeparator)+ [p|(c: Character) ascii?|] =: liftM Boolean (onCharacter isAscii)+ [p|(c: Character) latin1?|] =: liftM Boolean (onCharacter isLatin1)+ [p|(c: Character) ascii-upper?|] =: liftM Boolean (onCharacter isAsciiLower)+ [p|(c: Character) ascii-lower?|] =: liftM Boolean (onCharacter isAsciiUpper) - [$p|(c: Character) uppercase|] =: liftM Character (onCharacter toUpper)- [$p|(c: Character) lowercase|] =: liftM Character (onCharacter toLower)- [$p|(c: Character) titlecase|] =: liftM Character (onCharacter toTitle)+ [p|(c: Character) uppercase|] =: liftM Character (onCharacter toUpper)+ [p|(c: Character) lowercase|] =: liftM Character (onCharacter toLower)+ [p|(c: Character) titlecase|] =: liftM Character (onCharacter toTitle) - [$p|(c: Character) from-digit|] =: liftM (Integer . fromIntegral) (onCharacter digitToInt)- [$p|(i: Integer) to-digit|] =: liftM Character (onInteger (intToDigit . fromIntegral))+ [p|(c: Character) from-digit|] =: liftM (Integer . fromIntegral) (onCharacter digitToInt)+ [p|(i: Integer) to-digit|] =: liftM Character (onInteger (intToDigit . fromIntegral)) - [$p|(c: Character) ord|] =: liftM (Integer . fromIntegral) (onCharacter ord)- [$p|(i: Integer) chr|] =: liftM Character (onInteger (chr . fromIntegral))+ [p|(c: Character) ord|] =: liftM (Integer . fromIntegral) (onCharacter ord)+ [p|(i: Integer) chr|] =: liftM Character (onInteger (chr . fromIntegral)) - [$p|(c: Character) category|] =: liftM c (onCharacter generalCategory)+ [p|(c: Character) category|] =: liftM c (onCharacter generalCategory) where onCharacter :: (Char -> a) -> VM a onCharacter f = here "c" >>= liftM (f . fromCharacter) . findCharacter
src/Atomo/Kernel/Comparable.hs view
@@ -9,97 +9,97 @@ load :: VM () load = do mapM_ eval- [ [$e|operator 4 == /= < <= >= >|]- , [$e|operator right 3 &&|]- , [$e|operator right 2 |||]+ [ [e|operator 4 == /= < <= >= >|]+ , [e|operator right 3 &&|]+ , [e|operator right 2 |||] ] - [$p|a equals?: b|] =: do+ [p|a equals?: b|] =: do a <- here "a" b <- here "b" return $ Boolean (a == b) - [$p|(a: Object) == (b: Object)|] =::: [$e|a equals?: b|]- [$p|(a: Object) /= (b: Object)|] =::: [$e|(a == b) not|]+ [p|(a: Object) == (b: Object)|] =::: [e|a equals?: b|]+ [p|(a: Object) /= (b: Object)|] =::: [e|(a == b) not|] - [$p|(a: Character) < (b: Character)|] =: do+ [p|(a: Character) < (b: Character)|] =: do Character a <- here "a" >>= findCharacter Character b <- here "b" >>= findCharacter return $ Boolean (a < b) - [$p|(a: Character) > (b: Character)|] =: do+ [p|(a: Character) > (b: Character)|] =: do Character a <- here "a" >>= findCharacter Character b <- here "b" >>= findCharacter return $ Boolean (a > b) - [$p|(a: Character) <= (b: Character)|] =: do+ [p|(a: Character) <= (b: Character)|] =: do Character a <- here "a" >>= findCharacter Character b <- here "b" >>= findCharacter return $ Boolean (a <= b) - [$p|(a: Character) >= (b: Character)|] =: do+ [p|(a: Character) >= (b: Character)|] =: do Character a <- here "a" >>= findCharacter Character b <- here "b" >>= findCharacter return $ Boolean (a >= b) - [$p|(a: Character) == (b: Character)|] =: do+ [p|(a: Character) == (b: Character)|] =: do Character a <- here "a" >>= findCharacter Character b <- here "b" >>= findCharacter return $ Boolean (a == b) - [$p|(a: Integer) < (b: Integer)|] =: primII (<)- [$p|(a: Double) < (b: Double)|] =: primDD (<)- [$p|(a: Rational) < (b: Rational)|] =: primRR (<)- [$p|(a: Integer) < (b: Double)|] =: primID (<)- [$p|(a: Integer) < (b: Rational)|] =: primIR (<)- [$p|(a: Double) < (b: Integer)|] =: primDI (<)- [$p|(a: Double) < (b: Rational)|] =: primDR (<)- [$p|(a: Rational) < (b: Integer)|] =: primRI (<)- [$p|(a: Rational) < (b: Double)|] =: primRD (<)+ [p|(a: Integer) < (b: Integer)|] =: primII (<)+ [p|(a: Double) < (b: Double)|] =: primDD (<)+ [p|(a: Rational) < (b: Rational)|] =: primRR (<)+ [p|(a: Integer) < (b: Double)|] =: primID (<)+ [p|(a: Integer) < (b: Rational)|] =: primIR (<)+ [p|(a: Double) < (b: Integer)|] =: primDI (<)+ [p|(a: Double) < (b: Rational)|] =: primDR (<)+ [p|(a: Rational) < (b: Integer)|] =: primRI (<)+ [p|(a: Rational) < (b: Double)|] =: primRD (<) - [$p|(a: Integer) > (b: Integer)|] =: primII (>)- [$p|(a: Double) > (b: Double)|] =: primDD (>)- [$p|(a: Rational) > (b: Rational)|] =: primRR (>)- [$p|(a: Integer) > (b: Double)|] =: primID (>)- [$p|(a: Integer) > (b: Rational)|] =: primIR (>)- [$p|(a: Double) > (b: Integer)|] =: primDI (>)- [$p|(a: Double) > (b: Rational)|] =: primDR (>)- [$p|(a: Rational) > (b: Integer)|] =: primRI (>)- [$p|(a: Rational) > (b: Double)|] =: primRD (>)+ [p|(a: Integer) > (b: Integer)|] =: primII (>)+ [p|(a: Double) > (b: Double)|] =: primDD (>)+ [p|(a: Rational) > (b: Rational)|] =: primRR (>)+ [p|(a: Integer) > (b: Double)|] =: primID (>)+ [p|(a: Integer) > (b: Rational)|] =: primIR (>)+ [p|(a: Double) > (b: Integer)|] =: primDI (>)+ [p|(a: Double) > (b: Rational)|] =: primDR (>)+ [p|(a: Rational) > (b: Integer)|] =: primRI (>)+ [p|(a: Rational) > (b: Double)|] =: primRD (>) - [$p|(a: Integer) <= (b: Integer)|] =: primII (<=)- [$p|(a: Double) <= (b: Double)|] =: primDD (<=)- [$p|(a: Rational) <= (b: Rational)|] =: primRR (<=)- [$p|(a: Integer) <= (b: Double)|] =: primID (<=)- [$p|(a: Integer) <= (b: Rational)|] =: primIR (<=)- [$p|(a: Double) <= (b: Integer)|] =: primDI (<=)- [$p|(a: Double) <= (b: Rational)|] =: primDR (<=)- [$p|(a: Rational) <= (b: Integer)|] =: primRI (<=)- [$p|(a: Rational) <= (b: Double)|] =: primRD (<=)+ [p|(a: Integer) <= (b: Integer)|] =: primII (<=)+ [p|(a: Double) <= (b: Double)|] =: primDD (<=)+ [p|(a: Rational) <= (b: Rational)|] =: primRR (<=)+ [p|(a: Integer) <= (b: Double)|] =: primID (<=)+ [p|(a: Integer) <= (b: Rational)|] =: primIR (<=)+ [p|(a: Double) <= (b: Integer)|] =: primDI (<=)+ [p|(a: Double) <= (b: Rational)|] =: primDR (<=)+ [p|(a: Rational) <= (b: Integer)|] =: primRI (<=)+ [p|(a: Rational) <= (b: Double)|] =: primRD (<=) - [$p|(a: Integer) >= (b: Integer)|] =: primII (>=)- [$p|(a: Double) >= (b: Double)|] =: primDD (>=)- [$p|(a: Rational) >= (b: Rational)|] =: primRR (>=)- [$p|(a: Integer) >= (b: Double)|] =: primID (>=)- [$p|(a: Integer) >= (b: Rational)|] =: primIR (>=)- [$p|(a: Double) >= (b: Integer)|] =: primDI (>=)- [$p|(a: Double) >= (b: Rational)|] =: primDR (>=)- [$p|(a: Rational) >= (b: Integer)|] =: primRI (>=)- [$p|(a: Rational) >= (b: Double)|] =: primRD (>=)+ [p|(a: Integer) >= (b: Integer)|] =: primII (>=)+ [p|(a: Double) >= (b: Double)|] =: primDD (>=)+ [p|(a: Rational) >= (b: Rational)|] =: primRR (>=)+ [p|(a: Integer) >= (b: Double)|] =: primID (>=)+ [p|(a: Integer) >= (b: Rational)|] =: primIR (>=)+ [p|(a: Double) >= (b: Integer)|] =: primDI (>=)+ [p|(a: Double) >= (b: Rational)|] =: primDR (>=)+ [p|(a: Rational) >= (b: Integer)|] =: primRI (>=)+ [p|(a: Rational) >= (b: Double)|] =: primRD (>=) - [$p|(a: Integer) == (b: Integer)|] =: primII (==)- [$p|(a: Double) == (b: Double)|] =: primDD (==)- [$p|(a: Rational) == (b: Rational)|] =: primRR (==)- [$p|(a: Integer) == (b: Double)|] =: primID (==)- [$p|(a: Integer) == (b: Rational)|] =: primIR (==)- [$p|(a: Double) == (b: Integer)|] =: primDI (==)- [$p|(a: Double) == (b: Rational)|] =: primDR (==)- [$p|(a: Rational) == (b: Integer)|] =: primRI (==)- [$p|(a: Rational) == (b: Double)|] =: primRD (==)+ [p|(a: Integer) == (b: Integer)|] =: primII (==)+ [p|(a: Double) == (b: Double)|] =: primDD (==)+ [p|(a: Rational) == (b: Rational)|] =: primRR (==)+ [p|(a: Integer) == (b: Double)|] =: primID (==)+ [p|(a: Integer) == (b: Rational)|] =: primIR (==)+ [p|(a: Double) == (b: Integer)|] =: primDI (==)+ [p|(a: Double) == (b: Rational)|] =: primDR (==)+ [p|(a: Rational) == (b: Integer)|] =: primRI (==)+ [p|(a: Rational) == (b: Double)|] =: primRD (==) - [$p|(a: List) == (b: List)|] =: do- as <- getVector [$e|a|]- bs <- getVector [$e|b|]+ [p|(a: List) == (b: List)|] =: do+ as <- getVector [e|a|]+ bs <- getVector [e|b|] if V.length as == V.length bs then do@@ -107,12 +107,12 @@ return $ Boolean (V.all (== Boolean True) eqs) else return $ Boolean False - [$p|(a: Process) == (b: Process)|] =: do+ [p|(a: Process) == (b: Process)|] =: do Process _ a <- here "a" >>= findProcess Process _ b <- here "b" >>= findProcess return $ Boolean (a == b) - [$p|(a: Message) == (b: Message)|] =: do+ [p|(a: Message) == (b: Message)|] =: do Message a <- here "a" >>= findMessage Message b <- here "b" >>= findMessage @@ -127,7 +127,7 @@ return $ Boolean (aos == bos && all (== Boolean True) eqs) _ -> return $ Boolean False - [$p|(a: Particle) == (b: Particle)|] =: do+ [p|(a: Particle) == (b: Particle)|] =: do Particle a <- here "a" >>= findParticle Particle b <- here "b" >>= findParticle
src/Atomo/Kernel/Concurrency.hs view
@@ -1,44 +1,63 @@ {-# LANGUAGE QuasiQuotes #-} module Atomo.Kernel.Concurrency (load) where +import System.Timeout+ import Atomo import Atomo.Method import Atomo.Spawn+import Atomo.Valuable load :: VM () load = do- [$p|self|] =: do+ [p|self|] =: do chan <- gets channel tid <- liftIO myThreadId return (Process chan tid) - [$p|receive|] =: gets channel >>= liftIO . readChan+ [p|receive|] =: gets channel >>= liftIO . readChan - [$p|halt|] =: gets halt >>= liftIO >> return (particle "ok")+ [p|receive-timeout: (n: Integer)|] =: do+ Integer t <- here "n" >>= findInteger+ c <- gets channel+ liftIO (timeout' t (readChan c)) >>= toValue - [$p|(p: Process) <- v|] =: do+ [p|halt|] =: gets halt >>= liftIO >> return (particle "ok")++ [p|(p: Process) <- v|] =: do Process chan _ <- here "p" >>= findProcess v <- here "v" liftIO (writeChan chan v) here "p" - [$p|(b: Block) spawn|] =: do+ [p|(b: Block) spawn|] =: do Block s as bes <- here "b" >>= findBlock if length as > 0 then throwError (BlockArity (length as) 0) else spawn (doBlock emptyMap s bes) - [$p|(b: Block) spawn: (... args)|] =: do+ [p|(b: Block) spawn: (... args)|] =: do b@(Block _ as _) <- here "b" >>= findBlock- vs <- getList [$e|args|]+ vs <- getList [e|args|] if length as > length vs then throwError (BlockArity (length as) (length vs)) else spawn (callBlock b vs) - [$p|(p: Process) stop|] =: do+ [p|(p: Process) stop|] =: do Process _ tid <- here "p" >>= findProcess liftIO (killThread tid) return (particle "ok")++timeout' :: Integer -> IO a -> IO (Maybe a)+timeout' n x+ | n > fromIntegral limit = do+ mr <- timeout (fromIntegral n) x+ case mr of+ Nothing -> timeout' (n - fromIntegral limit) x+ Just r -> return (Just r)+ | otherwise = timeout (fromIntegral n) x+ where+ limit = maxBound :: Int
src/Atomo/Kernel/Continuation.hs view
@@ -8,33 +8,33 @@ load :: VM () load = do- [$p|current-continuation|] =:::- [$e|{ cc | cc } call/cc|]+ [p|current-continuation|] =:::+ [e|{ cc | cc } call/cc|] -- call/cc actually makes an object delegating to Continuation -- so just add the show definiton here- [$p|Continuation show|] =:: string "<continuation>"+ [p|Continuation show|] =:: string "<continuation>" - [$p|(c: Continuation) yield: v|] =: do+ [p|(c: Continuation) yield: v|] =: do Continuation c <- here "c" >>= findContinuation v <- here "v" liftIO (readIORef c) >>= ($ v) -- this enables call/cc as well- [$p|(c: Continuation) call: (... (v . _))|] =::: [$e|c yield: v|]+ [p|(c: Continuation) call: (... (v . _))|] =::: [e|c yield: v|] -- effectively just "jumping" to a continuation- [$p|(c: Continuation) yield|] =::: [$e|c yield: @ok|]- [$p|(c: Continuation) call|] =::: [$e|c yield: @ok|]+ [p|(c: Continuation) yield|] =::: [e|c yield: @ok|]+ [p|(c: Continuation) call|] =::: [e|c yield: @ok|] - [$p|(o: Object) call/cc|] =::: [$e|o call/cc: ()|]- [$p|(o: Object) call/cc: (... args)|] =: callCC $ \c -> do+ [p|(o: Object) call/cc|] =::: [e|o call/cc: ()|]+ [p|(o: Object) call/cc: (... args)|] =: callCC $ \c -> do o <- here "o"- as <- getList [$e|args|]+ as <- getList [e|args|] cr <- mkContinuation c dispatch (keyword ["call"] [o, tuple (Continuation cr:as)]) - [$p|(v: Block) before: (b: Block) after: (a: Block)|] =: do+ [p|(v: Block) before: (b: Block) after: (a: Block)|] =: do v <- here "v" b <- here "b" a <- here "a"
src/Atomo/Kernel/Environment.hs view
@@ -8,19 +8,19 @@ load :: VM () load = do- ([$p|Environment|] =::) =<< eval [$e|Object clone|]+ ([p|Environment|] =::) =<< eval [e|Object clone|] - [$p|Environment arguments|] =:+ [p|Environment arguments|] =: liftM (list . map string) (liftIO getArgs) - [$p|Environment program-name|] =:+ [p|Environment program-name|] =: liftM string $ liftIO getProgName - [$p|Environment get: (name: String)|] =:- getString [$e|name|]+ [p|Environment get: (name: String)|] =:+ getString [e|name|] >>= liftM string . liftIO . getEnv - [$p|Environment all|] =: do+ [p|Environment all|] =: do env <- liftIO getEnvironment assocs <- forM env $ \(k, v) ->
src/Atomo/Kernel/Expression.hs view
@@ -13,24 +13,24 @@ load :: VM () load = do- [$p|`Block new: (es: List)|] =::: [$e|`Block new: es arguments: []|]- [$p|`Block new: (es: List) arguments: (as: List)|] =: do- es <- getList [$e|es|] >>= mapM findExpression- as <- getList [$e|as|] >>=+ [p|`Block new: (es: List)|] =::: [e|`Block new: es arguments: []|]+ [p|`Block new: (es: List) arguments: (as: List)|] =: do+ es <- getList [e|es|] >>= mapM findExpression+ as <- getList [e|as|] >>= mapM (\e -> findExpression e >>= toPattern' . fromExpression) return (Expression (EBlock Nothing as (map fromExpression es))) - [$p|`List new: (es: List)|] =: do- es <- getList [$e|es|] >>= mapM findExpression+ [p|`List new: (es: List)|] =: do+ es <- getList [e|es|] >>= mapM findExpression return (Expression (EList Nothing (map fromExpression es))) - [$p|`Tuple new: (es: List)|] =: do- es <- getList [$e|es|] >>= mapM findExpression+ [p|`Tuple new: (es: List)|] =: do+ es <- getList [e|es|] >>= mapM findExpression return (Expression (ETuple Nothing (map fromExpression es))) - [$p|`Match new: (branches: List) on: (value: Expression)|] =: do- bs <- getList [$e|branches|]+ [p|`Match new: (branches: List) on: (value: Expression)|] =: do+ bs <- getList [e|branches|] let pats = map (fromExpression . head . fromTuple) bs exprs = map (fromExpression . (!! 1) . fromTuple) bs@@ -39,24 +39,24 @@ Expression value <- here "value" >>= findExpression return (Expression (EMatch Nothing value (zip ps exprs))) - [$p|`Set new: (pattern: Expression) to: (value: Expression)|] =: do+ [p|`Set new: (pattern: Expression) to: (value: Expression)|] =: do Expression pat <- here "pattern" >>= findExpression Expression e <- here "value" >>= findExpression p <- toPattern' pat return (Expression $ ESet Nothing p e) - [$p|`Define new: (pattern: Expression) as: (expr: Expression)|] =: do+ [p|`Define new: (pattern: Expression) as: (expr: Expression)|] =: do Expression pat <- here "pattern" >>= findExpression Expression e <- here "expr" >>= findExpression p <- toDefinePattern' pat return (Expression $ EDefine Nothing p e) - [$p|`Dispatch new: (name: Particle) to: (targets: List) &optionals: []|] =: do+ [p|`Dispatch new: (name: Particle) to: (targets: List) &optionals: []|] =: do Particle name <- here "name" >>= findParticle- ts <- getList [$e|targets|] >>= mapM findExpression- os <- getList [$e|optionals|] >>= mapM fromValue+ ts <- getList [e|targets|] >>= mapM findExpression+ os <- getList [e|optionals|] >>= mapM fromValue let opts = map (\(Particle (Single { mName = n }), Expression e) -> option n e) os @@ -67,46 +67,46 @@ Keyword { mNames = ns } -> return $ Expression (EDispatch Nothing (keyword' ns (map fromExpression ts) opts)) - [$p|`DefineDynamic new: (name: Expression) as: (root: Expression)|] =: do+ [p|`DefineDynamic new: (name: Expression) as: (root: Expression)|] =: do n <- here "name" >>= findExpression >>= toName . fromExpression Expression r <- here "root" >>= findExpression return . Expression $ EDefineDynamic Nothing n r - [$p|`SetDynamic new: (name: Expression) to: (root: Expression)|] =: do+ [p|`SetDynamic new: (name: Expression) to: (root: Expression)|] =: do n <- here "name" >>= findExpression >>= toName . fromExpression Expression r <- here "root" >>= findExpression return . Expression $ ESetDynamic Nothing n r - [$p|`GetDynamic new: (name: Expression)|] =: do+ [p|`GetDynamic new: (name: Expression)|] =: do n <- here "name" >>= findExpression >>= toName . fromExpression return . Expression $ EGetDynamic Nothing n - [$p|`NewDynamic new: (bindings: List) do: (expr: Expression)|] =: do- ns <- getList [$e|bindings map: @from|]+ [p|`NewDynamic new: (bindings: List) do: (expr: Expression)|] =: do+ ns <- getList [e|bindings map: @from|] >>= mapM findExpression >>= mapM (toName . fromExpression)- exprs <- liftM (map fromExpression) $ getList [$e|bindings map: @to|] >>= mapM findExpression+ exprs <- liftM (map fromExpression) $ getList [e|bindings map: @to|] >>= mapM findExpression Expression e <- here "expr" >>= findExpression return . Expression $ ENewDynamic Nothing (zip ns exprs) e - [$p|(s: String) parse-expressions|] =:- getString [$e|s|] >>= liftM (list . map Expression) . parseInput+ [p|(s: String) parse-expressions|] =:+ getString [e|s|] >>= liftM (list . map Expression) . parseInput - [$p|top evaluate: (e: Expression)|] =: do+ [p|top evaluate: (e: Expression)|] =: do t <- here "top" Expression e <- here "e" >>= findExpression withTop t (eval e) - [$p|(e: Expression) expand|] =: do+ [p|(e: Expression) expand|] =: do Expression e <- here "e" >>= findExpression liftM Expression $ macroExpand e - [$p|(e: Expression) pretty-expression|] =: do+ [p|(e: Expression) pretty-expression|] =: do Expression e <- here "e" >>= findExpression toValue (pretty e) - [$p|(e: Expression) location|] =: do+ [p|(e: Expression) location|] =: do Expression e <- here "e" >>= findExpression case eLocation e of@@ -117,7 +117,7 @@ , Integer (fromIntegral (sourceColumn s)) ] - [$p|(e: Expression) type|] =: do+ [p|(e: Expression) type|] =: do Expression e <- here "e" >>= findExpression case e of EDispatch { eMessage = Keyword {} } ->@@ -151,7 +151,7 @@ EMacroQuote {} -> return (particle "macro-quote") EMatch {} -> return (particle "match") - [$p|(e: Expression) target|] =: do+ [p|(e: Expression) target|] =: do Expression e <- here "e" >>= findExpression case e of@@ -161,7 +161,7 @@ return (Expression t) _ -> raise ["no-target-for"] [Expression e] - [$p|(e: Expression) targets|] =: do+ [p|(e: Expression) targets|] =: do Expression e <- here "e" >>= findExpression case e of@@ -171,7 +171,7 @@ return $ list [Expression t] _ -> raise ["no-targets-for"] [Expression e] - [$p|(e: Expression) optionals|] =: do+ [p|(e: Expression) optionals|] =: do Expression e <- here "e" >>= findExpression case e of@@ -181,7 +181,7 @@ (mOptionals m) _ -> raise ["no-optionals-for"] [Expression e] - [$p|(e: Expression) name|] =: do+ [p|(e: Expression) name|] =: do Expression e <- here "e" >>= findExpression case e of@@ -193,7 +193,7 @@ return (string n) _ -> raise ["no-name-for"] [Expression e] - [$p|(e: Expression) names|] =: do+ [p|(e: Expression) names|] =: do Expression e <- here "e" >>= findExpression case e of@@ -203,7 +203,7 @@ return (list (map string ns)) _ -> raise ["no-names-for"] [Expression e] - [$p|(e: Expression) particle|] =: do+ [p|(e: Expression) particle|] =: do Expression e <- here "e" >>= findExpression case e of@@ -215,7 +215,7 @@ _ -> raise ["no-particle-for"] [Expression e] - [$p|(e: Expression) values|] =: do+ [p|(e: Expression) values|] =: do Expression e <- here "e" >>= findExpression case e of@@ -226,7 +226,7 @@ mes _ -> raise ["no-values-for"] [Expression e] - [$p|(e: Expression) contents|] =: do+ [p|(e: Expression) contents|] =: do Expression e <- here "e" >>= findExpression case e of@@ -242,7 +242,7 @@ liftM list (mapM toValue bs) _ -> raise ["no-contents-for"] [Expression e] - [$p|(e: Expression) flags|] =: do+ [p|(e: Expression) flags|] =: do Expression e <- here "e" >>= findExpression case e of@@ -250,7 +250,7 @@ return (list (map Character fs)) _ -> raise ["no-flags-for"] [Expression e] - [$p|(e: Expression) arguments|] =: do+ [p|(e: Expression) arguments|] =: do Expression e <- here "e" >>= findExpression case e of@@ -258,7 +258,7 @@ return (list (map Pattern as)) _ -> raise ["no-arguments-for"] [Expression e] - [$p|(e: Expression) pattern|] =: do+ [p|(e: Expression) pattern|] =: do Expression e <- here "e" >>= findExpression case e of ESet { ePattern = p } -> return (Pattern p)@@ -266,7 +266,7 @@ EMacro { emPattern = p } -> return (Pattern (PMessage p)) _ -> raise ["no-pattern-for"] [Expression e] - [$p|(e: Expression) expression|] =: do+ [p|(e: Expression) expression|] =: do Expression e <- here "e" >>= findExpression case e of ESet { eExpr = e } -> return (Expression e)@@ -277,7 +277,7 @@ EUnquote { eExpr = e } -> return (Expression e) _ -> raise ["no-expression-for"] [Expression e] - [$p|(e: Expression) associativity|] =: do+ [p|(e: Expression) associativity|] =: do Expression e <- here "e" >>= findExpression case e of EOperator { eAssoc = ALeft } ->@@ -288,7 +288,7 @@ _ -> raise ["no-associativity-for"] [Expression e] - [$p|(e: Expression) precedence|] =: do+ [p|(e: Expression) precedence|] =: do Expression e <- here "e" >>= findExpression case e of EOperator { ePrec = p } ->@@ -296,7 +296,7 @@ _ -> raise ["no-precedence-for"] [Expression e] - [$p|(e: Expression) operators|] =: do+ [p|(e: Expression) operators|] =: do Expression e <- here "e" >>= findExpression case e of EOperator { eNames = ns } ->
src/Atomo/Kernel/Format.hs view
@@ -14,26 +14,26 @@ load :: VM () load = do- ([$p|Formatter|] =::) =<< eval [$e|Object clone|]+ ([p|Formatter|] =::) =<< eval [e|Object clone|] - [$p|Formatter new: (s: String)|] =: do- s <- getString [$e|s|]+ [p|Formatter new: (s: String)|] =: do+ s <- getString [e|s|] case runParser parser (FParserState [] []) "<new:>" s of Right fs ->- [$e|Formatter|] `newWith`+ [e|Formatter|] `newWith` [ ("format", haskell fs) ] Left er -> raise ["formatting-parse"] [string (show er)] - [$p|(f: Formatter) % (... inputs)|] =: do- fs <- eval [$e|f format|] >>= fromHaskell- is <- getList [$e|inputs|]+ [p|(f: Formatter) % (... inputs)|] =: do+ fs <- eval [e|f format|] >>= fromHaskell+ is <- getList [e|inputs|] (_, f) <- evalRWST format fs (startState is) return (String f) - [$p|(f: Formatter) pretty|] =: do- fs <- eval [$e|f format|] >>= fromHaskell- [$e|Pretty|] `newWith`+ [p|(f: Formatter) pretty|] =: do+ fs <- eval [e|f format|] >>= fromHaskell+ [e|Pretty|] `newWith` [ ("doc", haskell (char 'f' <> doubleQuotes (pretty (fs :: Format)))) ]
src/Atomo/Kernel/List.hs view
@@ -9,19 +9,19 @@ load :: VM () load = do- eval [$e|operator right .|]+ eval [e|operator right .|] - [$p|List new: (... contents)|] =::: [$e|contents|]+ [p|List new: (... contents)|] =::: [e|contents|] - [$p|(l: List) length|] =:- liftM (Integer . fromIntegral . V.length) (getVector [$e|l|])+ [p|(l: List) length|] =:+ liftM (Integer . fromIntegral . V.length) (getVector [e|l|]) - [$p|(l: List) empty?|] =:- liftM (Boolean . V.null) (getVector [$e|l|])+ [p|(l: List) empty?|] =:+ liftM (Boolean . V.null) (getVector [e|l|]) - [$p|(l: List) at: (n: Integer)|] =: do+ [p|(l: List) at: (n: Integer)|] =: do Integer n <- here "n" >>= findInteger- vs <- getVector [$e|l|]+ vs <- getVector [e|l|] if fromIntegral n >= V.length vs then here "l" >>= \l -> raise@@ -31,20 +31,20 @@ ] else return (vs `V.unsafeIndex` fromIntegral n) - [$p|[] head|] =::: [$e|error: @empty-list|]- [$p|(l: List) head|] =:- liftM V.unsafeHead (getVector [$e|l|])+ [p|[] head|] =::: [e|error: @empty-list|]+ [p|(l: List) head|] =:+ liftM V.unsafeHead (getVector [e|l|]) - [$p|[] last|] =::: [$e|error: @empty-list|]- [$p|(l: List) last|] =:- liftM V.unsafeLast (getVector [$e|l|])+ [p|[] last|] =::: [e|error: @empty-list|]+ [p|(l: List) last|] =:+ liftM V.unsafeLast (getVector [e|l|]) -- TODO: handle negative ranges- [$p|(l: List) from: (s: Integer) to: (e: Integer)|] =:::- [$e|l from: s take: (e - s)|]+ [p|(l: List) from: (s: Integer) to: (e: Integer)|] =:::+ [e|l from: s take: (e - s)|] - [$p|(l: List) from: (s: Integer) take: (n: Integer)|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) from: (s: Integer) take: (n: Integer)|] =: do+ vs <- getVector [e|l|] Integer start <- here "s" >>= findInteger Integer num <- here "n" >>= findInteger @@ -59,39 +59,39 @@ (fromIntegral num) vs - [$p|[] init|] =::: [$e|error: @empty-list|]- [$p|(l: List) init|] =:- liftM (List . V.unsafeInit) (getVector [$e|l|])+ [p|[] init|] =::: [e|error: @empty-list|]+ [p|(l: List) init|] =:+ liftM (List . V.unsafeInit) (getVector [e|l|]) - [$p|[] tail|] =::: [$e|error: @empty-list|]- [$p|(l: List) tail|] =:- liftM (List . V.unsafeTail) (getVector [$e|l|])+ [p|[] tail|] =::: [e|error: @empty-list|]+ [p|(l: List) tail|] =:+ liftM (List . V.unsafeTail) (getVector [e|l|]) - [$p|(l: List) take: (n: Integer)|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) take: (n: Integer)|] =: do+ vs <- getVector [e|l|] Integer n <- here "n" >>= findInteger return . List $ V.take (fromIntegral n) vs - [$p|(l: List) drop: (n: Integer)|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) drop: (n: Integer)|] =: do+ vs <- getVector [e|l|] Integer n <- here "n" >>= findInteger return . List $ V.drop (fromIntegral n) vs - [$p|v replicate: (n: Integer)|] =: do+ [p|v replicate: (n: Integer)|] =: do v <- here "v" Integer n <- here "n" >>= findInteger return . List $ V.replicate (fromIntegral n) v - [$p|(a: List) .. (b: List)|] =: do- as <- getVector [$e|a|]- bs <- getVector [$e|b|]+ [p|(a: List) .. (b: List)|] =: do+ as <- getVector [e|a|]+ bs <- getVector [e|b|] return . List $ as V.++ bs - [$p|(l: List) reverse|] =:- liftM (List . V.reverse) (getVector [$e|l|])+ [p|(l: List) reverse|] =:+ liftM (List . V.reverse) (getVector [e|l|]) - [$p|(l: List) map: b|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) map: b|] =: do+ vs <- getVector [e|l|] b <- here "b" nvs <- V.mapM (\v ->@@ -99,9 +99,9 @@ return $ List nvs - [$p|(x: List) zip: (... ys) &zipper: @id|] =: do- xs <- getVector [$e|x|]- yss <- getList [$e|ys|] >>= mapM (liftM (\(List v) -> v) . findList)+ [p|(x: List) zip: (... ys) &zipper: @id|] =: do+ xs <- getVector [e|x|]+ yss <- getList [e|ys|] >>= mapM (liftM (\(List v) -> v) . findList) z <- here "zipper" let zipped = zipN (xs:yss)@@ -111,8 +111,8 @@ else liftM list $ forM zipped $ \vs -> dispatch (keyword ["call"] [z, tuple vs]) - [$p|(l: List) filter: b|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) filter: b|] =: do+ vs <- getVector [e|l|] b <- here "b" nvs <- V.filterM (\v -> do@@ -121,46 +121,46 @@ return $ List nvs - [$p|[] reduce: b|] =::: [$e|error: @empty-list|]- [$p|(l: List) reduce: b|] =: do- vs <- getVector [$e|l|]+ [p|[] reduce: b|] =::: [e|error: @empty-list|]+ [p|(l: List) reduce: b|] =: do+ vs <- getVector [e|l|] b <- here "b" V.fold1M (\x acc -> dispatch (keyword ["call"] [b, tuple [x, acc]])) vs - [$p|(l: List) reduce: b with: v|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) reduce: b with: v|] =: do+ vs <- getVector [e|l|] b <- here "b" v <- here "v" V.foldM (\x acc -> dispatch (keyword ["call"] [b, tuple [x, acc]])) v vs - [$p|[] reduce-right: b|] =::: [$e|error: @empty-list|]- [$p|(l: List) reduce-right: b|] =: do- vs <- getVector [$e|l|]+ [p|[] reduce-right: b|] =::: [e|error: @empty-list|]+ [p|(l: List) reduce-right: b|] =: do+ vs <- getVector [e|l|] b <- here "b" foldr1MV (\x acc -> dispatch (keyword ["call"] [b, tuple [x, acc]])) vs - [$p|(l: List) reduce-right: b with: v|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) reduce-right: b with: v|] =: do+ vs <- getVector [e|l|] b <- here "b" v <- here "v" foldrMV (\x acc -> dispatch (keyword ["call"] [b, tuple [x, acc]])) v vs - [$p|(l: List) concat|] =::: [$e|l reduce: @.. with: []|]- [$p|(l: List) sum|] =::: [$e|l reduce: @+ with: 0|]- [$p|(l: List) product|] =::: [$e|l reduce: @* with: 1|]- [$p|(l: List) maximum|] =::: [$e|l reduce: @max:|]- [$p|(l: List) minimum|] =::: [$e|l reduce: @min:|]+ [p|(l: List) concat|] =::: [e|l reduce: @.. with: []|]+ [p|(l: List) sum|] =::: [e|l reduce: @+ with: 0|]+ [p|(l: List) product|] =::: [e|l reduce: @* with: 1|]+ [p|(l: List) maximum|] =::: [e|l reduce: @max:|]+ [p|(l: List) minimum|] =::: [e|l reduce: @min:|] - [$p|(l: List) all?: b|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) all?: b|] =: do+ vs <- getVector [e|l|] b <- here "b" nvs <- V.mapM (\v -> do@@ -169,8 +169,8 @@ return $ Boolean (V.and nvs) - [$p|(l: List) any?: b|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) any?: b|] =: do+ vs <- getVector [e|l|] b <- here "b" nvs <- V.mapM (\v -> do@@ -179,12 +179,12 @@ return $ Boolean (V.or nvs) - [$p|(l: List) and|] =::: [$e|l all?: @(== True)|]- [$p|(l: List) or|] =::: [$e|l any?: @(== True)|]+ [p|(l: List) and|] =::: [e|l all?: @(== True)|]+ [p|(l: List) or|] =::: [e|l any?: @(== True)|] - [$p|(l: List) take-while: test|] =: do+ [p|(l: List) take-while: test|] =: do t <- here "test"- l <- getList [$e|l|]+ l <- getList [e|l|] let takeWhileM [] = return [] takeWhileM (x:xs) =@@ -194,9 +194,9 @@ liftM list $ takeWhileM l - [$p|(l: List) drop-while: test|] =: do+ [p|(l: List) drop-while: test|] =: do t <- here "test"- l <- getList [$e|l|]+ l <- getList [e|l|] let dropWhileM [] = return [] dropWhileM (x:xs) =@@ -206,13 +206,13 @@ liftM list $ dropWhileM l - [$p|v in?: (l: List)|] =::: [$e|l contains?: v|]- [$p|(l: List) contains?: v|] =::: [$e|l any?: @(== v)|]+ [p|v in?: (l: List)|] =::: [e|l contains?: v|]+ [p|(l: List) contains?: v|] =::: [e|l any?: @(== v)|] -- TODO: find - [$p|(l: List) at: (n: Integer) put: v|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) at: (n: Integer) put: v|] =: do+ vs <- getVector [e|l|] Integer n <- here "n" >>= findInteger v <- here "v"@@ -225,41 +225,41 @@ ] else return (List $ vs V.// [(fromIntegral n, v)]) - [$p|v . (l: List)|] =: do- vs <- getVector [$e|l|]+ [p|v . (l: List)|] =: do+ vs <- getVector [e|l|] v <- here "v" return (List $ V.cons v vs) - [$p|(l: List) push: v|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) push: v|] =: do+ vs <- getVector [e|l|] v <- here "v" return . List $ V.snoc vs v - [$p|(l: List) cons: v|] =: do- vs <- getVector [$e|l|]+ [p|(l: List) cons: v|] =: do+ vs <- getVector [e|l|] v <- here "v" return . List $ V.cons v vs - [$p|(l: List) split: (d: List)|] =: do- l <- getList [$e|l|]- d <- getList [$e|d|]+ [p|(l: List) split: (d: List)|] =: do+ l <- getList [e|l|]+ d <- getList [e|d|] return $ list (map list (splitOn d l)) - [$p|(l: List) split-on: d|] =: do- l <- getList [$e|l|]+ [p|(l: List) split-on: d|] =: do+ l <- getList [e|l|] d <- here "d" return $ list (map list (splitWhen (== d) l)) - [$p|(l: List) sort &comparison: @<=>|] =: do+ [p|(l: List) sort &comparison: @<=>|] =: do cmp <- here "comparison"- getList [$e|l|] >>= liftM list . sortVM cmp+ getList [e|l|] >>= liftM list . sortVM cmp - [$p|(l: List) sort-by: something &comparison: @<=>|] =: do- vs <- getList [$e|l|]+ [p|(l: List) sort-by: something &comparison: @<=>|] =: do+ vs <- getList [e|l|] something <- here "something" cmp <- here "comparison"
src/Atomo/Kernel/Message.hs view
@@ -7,30 +7,30 @@ load :: VM () load = do- [$p|(m: Message) type|] =: do+ [p|(m: Message) type|] =: do Message m <- here "m" >>= findMessage case m of Single {} -> return (particle "single") Keyword {} -> return (particle "keyword") - [$p|(m: Message) dispatch|] =:+ [p|(m: Message) dispatch|] =: here "m" >>= findMessage >>= dispatch . fromMessage - [$p|(m: Message) particle|] =: do+ [p|(m: Message) particle|] =: do Message m <- here "m" >>= findMessage case m of Single { mName = n } -> return (particle n) Keyword { mNames = ns } -> return (keyParticle ns (replicate (length ns + 1) Nothing)) - [$p|(m: Message) target|] =: do+ [p|(m: Message) target|] =: do Message (Single { mTarget = t }) <- here "m" >>= findMessage return t - [$p|(m: Message) targets|] =: do+ [p|(m: Message) targets|] =: do Message (Keyword { mTargets = ts }) <- here "m" >>= findMessage return $ list ts - [$p|(m: Message) optionals|] =: do+ [p|(m: Message) optionals|] =: do Message m <- here "m" >>= findMessage liftM list $ mapM (\(Option _ n v) -> toValue (particle n, v)) (mOptionals m)
src/Atomo/Kernel/Method.hs view
@@ -6,18 +6,18 @@ load :: VM () load = do- [$p|(m: Method) value|] =: do+ [p|(m: Method) value|] =: do Method m <- here "m" >>= findMethod' return (mValue m) - [$p|(m: Method) pattern|] =: do+ [p|(m: Method) pattern|] =: do Method m <- here "m" >>= findMethod' return (Pattern (PMessage (mPattern m))) - [$p|(m: Method) expression|] =: do+ [p|(m: Method) expression|] =: do Method m <- here "m" >>= findMethod' return (Expression (mExpr m)) - [$p|(m: Method) context|] =: do+ [p|(m: Method) context|] =: do Method m <- here "m" >>= findMethod' return (mContext m)
src/Atomo/Kernel/Nucleus.hs view
@@ -12,21 +12,21 @@ load :: VM () load = do- [$p|x id|] =::: [$e|x|]+ [p|x id|] =::: [e|x|] - [$p|(x: Object) clone|] =: do+ [p|(x: Object) clone|] =: do x <- here "x" newObject [x] noMethods - [$p|(x: Object) copy|] =: do+ [p|(x: Object) copy|] =: do x <- here "x" >>= objectFor ms <- liftIO (readIORef (oMethods x)) liftM (Object (oDelegates x)) (liftIO (newIORef ms)) - [$p|(x: Object) copy: (diff: Block)|] =:::- [$e|x copy do: diff|]+ [p|(x: Object) copy: (diff: Block)|] =:::+ [e|x copy do: diff|] - [$p|(x: Object) delegating-to: (y: Object)|] =: do+ [p|(x: Object) delegating-to: (y: Object)|] =: do f <- here "x" >>= objectFor t <- here "y" @@ -34,28 +34,28 @@ { oDelegates = oDelegates f ++ [t] } - [$p|(x: Object) delegates-to?: (y: Object)|] =: do+ [p|(x: Object) delegates-to?: (y: Object)|] =: do x <- here "x" y <- here "y" return (Boolean (delegatesTo x y)) - [$p|(x: Object) delegates|] =: do+ [p|(x: Object) delegates|] =: do o <- here "x" >>= objectFor return $ list (oDelegates o) - [$p|(x: Object) with-delegates: (ds: List)|] =: do- ds <- getList [$e|ds|]+ [p|(x: Object) with-delegates: (ds: List)|] =: do+ ds <- getList [e|ds|] x <- here "x" >>= objectFor return x { oDelegates = ds } - [$p|(x: Object) super|] =::: [$e|x delegates head|]+ [p|(x: Object) super|] =::: [e|x delegates head|] - [$p|(x: Object) is-a?: (y: Object)|] =: do+ [p|(x: Object) is-a?: (y: Object)|] =: do x <- here "x" y <- here "y" liftM Boolean (isA x y) - [$p|(x: Object) responds-to?: (p: Particle)|] =: do+ [p|(x: Object) responds-to?: (p: Particle)|] =: do x <- here "x" Particle p' <- here "p" >>= findParticle @@ -67,52 +67,52 @@ liftM (Boolean . isJust) . findMethod x $ single n x - [$p|x has-slot?: (name: String)|] =: do+ [p|x has-slot?: (name: String)|] =: do x <- here "x" >>= objectFor- n <- getString [$e|name|]+ n <- getString [e|name|] (ss, _) <- liftIO (readIORef (oMethods x)) return (Boolean (memberMap (hash n) ss)) - [$p|x set-slot: (name: String) to: v|] =: do+ [p|x set-slot: (name: String) to: v|] =: do x <- here "x"- n <- getString [$e|name|]+ n <- getString [e|name|] v <- here "v" define (single n (PMatch x)) (EPrimitive Nothing v) return v - [$p|(o: Object) methods|] =: do+ [p|(o: Object) methods|] =: do o <- here "o" >>= objectFor (ss, ks) <- liftIO (readIORef (oMethods o)) - [$e|Object|] `newWith`+ [e|Object|] `newWith` [ ("singles", list (map (list . map Method) (elemsMap ss))) , ("keywords", list (map (list . map Method) (elemsMap ks))) ] - [$p|(x: Object) dump|] =: do+ [p|(x: Object) dump|] =: do o <- here "x" liftIO (print o) return o - [$p|(x: Object) describe-error|] =::: [$e|x as: String|]+ [p|(x: Object) describe-error|] =::: [e|x as: String|] - [$p|(s: String) as: String|] =::: [$e|s|]+ [p|(s: String) as: String|] =::: [e|s|] - [$p|(x: Object) as: String|] =::: [$e|x show|]+ [p|(x: Object) as: String|] =::: [e|x show|] - [$p|(x: Object) show|] =::: [$e|x pretty render|]+ [p|(x: Object) show|] =::: [e|x pretty render|] - [$p|(t: Object) load: (fn: String)|] =: do+ [p|(t: Object) load: (fn: String)|] =: do t <- here "t"- fn <- getString [$e|fn|]+ fn <- getString [e|fn|] withTop t (loadFile fn) return (particle "ok") - [$p|(t: Object) require: (fn: String)|] =: do+ [p|(t: Object) require: (fn: String)|] =: do t <- here "t"- fn <- getString [$e|fn|]+ fn <- getString [e|fn|] withTop t (requireFile fn)
src/Atomo/Kernel/Numeric.hs view
@@ -9,125 +9,125 @@ load :: VM () load = do mapM_ eval- [ [$e|operator right 8 ^|]- , [$e|operator 7 % * /|]- , [$e|operator 6 + -|]+ [ [e|operator right 8 ^|]+ , [e|operator 7 % * /|]+ , [e|operator 6 + -|] ] - [$p|(i: Integer) sqrt|] =: do+ [p|(i: Integer) sqrt|] =: do Integer i <- here "i" >>= findInteger return (Double (sqrt (fromIntegral i))) - [$p|(d: Double) sqrt|] =: do+ [p|(d: Double) sqrt|] =: do Double d <- here "d" >>= findDouble return (Double (sqrt d)) - [$p|(d: Double) ceiling|] =: do+ [p|(d: Double) ceiling|] =: do Double d <- here "d" >>= findDouble return (Integer (ceiling d)) - [$p|(d: Double) round|] =: do+ [p|(d: Double) round|] =: do Double d <- here "d" >>= findDouble return (Integer (round d)) - [$p|(d: Double) floor|] =: do+ [p|(d: Double) floor|] =: do Double d <- here "d" >>= findDouble return (Integer (floor d)) - [$p|(i: Integer) reciprocal|] =: do+ [p|(i: Integer) reciprocal|] =: do Integer i <- here "i" >>= findInteger return (Double (recip (fromIntegral i))) - [$p|(d: Double) reciprocal|] =: do+ [p|(d: Double) reciprocal|] =: do Double d <- here "d" >>= findDouble return (Double (recip d)) - [$p|(r: Rational) reciprocal|] =: do+ [p|(r: Rational) reciprocal|] =: do Rational r <- here "r" >>= findRational return (Rational (recip r)) - [$p|(r: Rational) numerator|] =: do+ [p|(r: Rational) numerator|] =: do Rational r <- here "r" >>= findRational return (Integer (numerator r)) - [$p|(r: Rational) denominator|] =: do+ [p|(r: Rational) denominator|] =: do Rational r <- here "r" >>= findRational return (Integer (denominator r)) - [$p|(d: Double) as: Integer|] =::: [$e|d floor|]- [$p|(d: Double) as: Rational|] =::: [$e|d rationalize|]- [$p|(i: Integer) as: Double|] =: do+ [p|(d: Double) as: Integer|] =::: [e|d floor|]+ [p|(d: Double) as: Rational|] =::: [e|d rationalize|]+ [p|(i: Integer) as: Double|] =: do Integer i <- here "i" >>= findInteger return (Double (fromIntegral i))- [$p|(i: Integer) as: Rational|] =: do+ [p|(i: Integer) as: Rational|] =: do Integer i <- here "i" >>= findInteger return (Rational (i % 1))- [$p|(r: Rational) as: Double|] =::: [$e|r approximate|]- [$p|(r: Rational) as: Integer|] =::: [$e|r approximate floor|]+ [p|(r: Rational) as: Double|] =::: [e|r approximate|]+ [p|(r: Rational) as: Integer|] =::: [e|r approximate floor|] - [$p|(i: Integer) rationalize|] =::: [$e|(i as: Double) rationalize|]- [$p|(d: Double) rationalize|] =::: [$e|d rationalize: 0.001|]- [$p|(d: Double) rationalize: (e: Double)|] =: do+ [p|(i: Integer) rationalize|] =::: [e|(i as: Double) rationalize|]+ [p|(d: Double) rationalize|] =::: [e|d rationalize: 0.001|]+ [p|(d: Double) rationalize: (e: Double)|] =: do Double d <- here "d" >>= findDouble Double e' <- here "e" >>= findDouble return (Rational (approxRational d e')) - [$p|(r: Rational) approximate|] =: do+ [p|(r: Rational) approximate|] =: do Rational r <- here "r" >>= findRational return (Double (fromRational r)) - [$p|(a: Integer) + (b: Integer)|] =: primII (+)- [$p|(a: Rational) + (b: Rational)|] =: primRR (+)- [$p|(a: Double) + (b: Double)|] =: primDD (+)- [$p|(a: Integer) + (b: Double)|] =: primID (+)- [$p|(a: Integer) + (b: Rational)|] =: primIR (+)- [$p|(a: Double) + (b: Integer)|] =: primDI (+)- [$p|(a: Double) + (b: Rational)|] =: primDR (+)- [$p|(a: Rational) + (b: Integer)|] =: primRI (+)- [$p|(a: Rational) + (b: Double)|] =: primRD (+)+ [p|(a: Integer) + (b: Integer)|] =: primII (+)+ [p|(a: Rational) + (b: Rational)|] =: primRR (+)+ [p|(a: Double) + (b: Double)|] =: primDD (+)+ [p|(a: Integer) + (b: Double)|] =: primID (+)+ [p|(a: Integer) + (b: Rational)|] =: primIR (+)+ [p|(a: Double) + (b: Integer)|] =: primDI (+)+ [p|(a: Double) + (b: Rational)|] =: primDR (+)+ [p|(a: Rational) + (b: Integer)|] =: primRI (+)+ [p|(a: Rational) + (b: Double)|] =: primRD (+) - [$p|(a: Integer) - (b: Integer)|] =: primII (-)- [$p|(a: Rational) - (b: Rational)|] =: primRR (-)- [$p|(a: Double) - (b: Double)|] =: primDD (-)- [$p|(a: Integer) - (b: Double)|] =: primID (-)- [$p|(a: Integer) - (b: Rational)|] =: primIR (-)- [$p|(a: Double) - (b: Integer)|] =: primDI (-)- [$p|(a: Double) - (b: Rational)|] =: primDR (-)- [$p|(a: Rational) - (b: Integer)|] =: primRI (-)- [$p|(a: Rational) - (b: Double)|] =: primRD (-)+ [p|(a: Integer) - (b: Integer)|] =: primII (-)+ [p|(a: Rational) - (b: Rational)|] =: primRR (-)+ [p|(a: Double) - (b: Double)|] =: primDD (-)+ [p|(a: Integer) - (b: Double)|] =: primID (-)+ [p|(a: Integer) - (b: Rational)|] =: primIR (-)+ [p|(a: Double) - (b: Integer)|] =: primDI (-)+ [p|(a: Double) - (b: Rational)|] =: primDR (-)+ [p|(a: Rational) - (b: Integer)|] =: primRI (-)+ [p|(a: Rational) - (b: Double)|] =: primRD (-) - [$p|(a: Integer) * (b: Integer)|] =: primII (*)- [$p|(a: Rational) * (b: Rational)|] =: primRR (*)- [$p|(a: Double) * (b: Double)|] =: primDD (*)- [$p|(a: Integer) * (b: Double)|] =: primID (*)- [$p|(a: Integer) * (b: Rational)|] =: primIR (*)- [$p|(a: Double) * (b: Integer)|] =: primDI (*)- [$p|(a: Double) * (b: Rational)|] =: primDR (*)- [$p|(a: Rational) * (b: Integer)|] =: primRI (*)- [$p|(a: Rational) * (b: Double)|] =: primRD (*)+ [p|(a: Integer) * (b: Integer)|] =: primII (*)+ [p|(a: Rational) * (b: Rational)|] =: primRR (*)+ [p|(a: Double) * (b: Double)|] =: primDD (*)+ [p|(a: Integer) * (b: Double)|] =: primID (*)+ [p|(a: Integer) * (b: Rational)|] =: primIR (*)+ [p|(a: Double) * (b: Integer)|] =: primDI (*)+ [p|(a: Double) * (b: Rational)|] =: primDR (*)+ [p|(a: Rational) * (b: Integer)|] =: primRI (*)+ [p|(a: Rational) * (b: Double)|] =: primRD (*) - [$p|(a: Integer) / (b: Integer)|] =: primII div- [$p|(a: Rational) / (b: Rational)|] =: primRR (/)- [$p|(a: Double) / (b: Double)|] =: primDD (/)- [$p|(a: Integer) / (b: Double)|] =: primID (/)- [$p|(a: Integer) / (b: Rational)|] =: primIR (/)- [$p|(a: Double) / (b: Integer)|] =: primDI (/)- [$p|(a: Double) / (b: Rational)|] =: primDR (/)- [$p|(a: Rational) / (b: Integer)|] =: primRI (/)- [$p|(a: Rational) / (b: Double)|] =: primRD (/)+ [p|(a: Integer) / (b: Integer)|] =: primII div+ [p|(a: Rational) / (b: Rational)|] =: primRR (/)+ [p|(a: Double) / (b: Double)|] =: primDD (/)+ [p|(a: Integer) / (b: Double)|] =: primID (/)+ [p|(a: Integer) / (b: Rational)|] =: primIR (/)+ [p|(a: Double) / (b: Integer)|] =: primDI (/)+ [p|(a: Double) / (b: Rational)|] =: primDR (/)+ [p|(a: Rational) / (b: Integer)|] =: primRI (/)+ [p|(a: Rational) / (b: Double)|] =: primRD (/) - [$p|(a: Integer) ^ (b: Integer)|] =: primII (^)- [$p|(a: Double) ^ (b: Double)|] =: primDD (**)- [$p|(a: Integer) ^ (b: Double)|] =: primID (**)- [$p|(a: Double) ^ (b: Integer)|] =: primDI (**)- [$p|(a: Rational) ^ (b: Integer)|] =: do+ [p|(a: Integer) ^ (b: Integer)|] =: primII (^)+ [p|(a: Double) ^ (b: Double)|] =: primDD (**)+ [p|(a: Integer) ^ (b: Double)|] =: primID (**)+ [p|(a: Double) ^ (b: Integer)|] =: primDI (**)+ [p|(a: Rational) ^ (b: Integer)|] =: do Rational a <- here "a" >>= findRational Integer b <- here "b" >>= findInteger return (Rational (a ^ b)) - [$p|(a: Integer) % (b: Integer)|] =: primII mod- [$p|(a: Integer) quotient: (b: Integer)|] =: primII quot- [$p|(a: Integer) remainder: (b: Integer)|] =: primII rem+ [p|(a: Integer) % (b: Integer)|] =: primII mod+ [p|(a: Integer) quotient: (b: Integer)|] =: primII quot+ [p|(a: Integer) remainder: (b: Integer)|] =: primII rem where primII f = do Integer a <- here "a" >>= findInteger
src/Atomo/Kernel/Particle.hs view
@@ -8,65 +8,65 @@ load :: VM () load = do- [$p|(p: Particle) new: (name: String)|] =: do- n <- getString [$e|name|]+ [p|(p: Particle) new: (name: String)|] =: do+ n <- getString [e|name|] return (particle n) - [$p|(p: Particle) new: (names: List)|] =: do- ns <- getList [$e|names|]+ [p|(p: Particle) new: (names: List)|] =: do+ ns <- getList [e|names|] >>= mapM (liftM (fromText . fromString) . findString) return (keyParticle ns (replicate (length ns + 1) Nothing)) - [$p|(p: Particle) call|] =::: [$e|p call: ()|]- [$p|(p: Particle) call: targets|] =:::- [$e|(p complete: targets) dispatch|]+ [p|(p: Particle) call|] =::: [e|p call: ()|]+ [p|(p: Particle) call: targets|] =:::+ [e|(p complete: targets) dispatch|] - [$p|(p: Particle) name|] =: do+ [p|(p: Particle) name|] =: do Particle (Single { mName = n }) <- here "p" >>= findParticle return (string n) - [$p|(p: Particle) names|] =: do+ [p|(p: Particle) names|] =: do Particle (Keyword { mNames = ns }) <- here "p" >>= findParticle return $ list (map string ns) - [$p|(p: Particle) target|] =: do+ [p|(p: Particle) target|] =: do (Particle (Single { mTarget = mt })) <- here "p" >>= findParticle toValue mt - [$p|(p: Particle) targets|] =: do+ [p|(p: Particle) targets|] =: do (Particle (Keyword { mTargets = mts })) <- here "p" >>= findParticle liftM list (mapM toValue mts) - [$p|(p: Particle) optionals|] =: do+ [p|(p: Particle) optionals|] =: do Particle p <- here "p" >>= findParticle liftM list $ mapM (\(Option _ n mv) -> toValue (particle n, mv)) (mOptionals p) - [$p|(p: Particle) type|] =: do+ [p|(p: Particle) type|] =: do Particle p <- here "p" >>= findParticle case p of Keyword {} -> return (particle "keyword") Single {} -> return (particle "single") - [$p|(p: Particle) complete|] =::: [$e|p complete: ()|]- [$p|(p: Particle) complete: (... targets)|] =: do+ [p|(p: Particle) complete|] =::: [e|p complete: ()|]+ [p|(p: Particle) complete: (... targets)|] =: do Particle p <- here "p" >>= findParticle- vs <- getList [$e|targets|]+ vs <- getList [e|targets|] liftM Message (completeParticle p vs) - [$p|c define: (p: Particle) on: v with: (targets: List) as: e|] =: do+ [p|c define: (p: Particle) on: v with: (targets: List) as: e|] =: do Particle p <- here "p" >>= findParticle v <- here "v"- ts <- getList [$e|targets|]+ ts <- getList [e|targets|] e <- here "e" c <- here "c" let toPattern (Pattern p) = p toPattern v = PMatch v- + others = map toPattern ts- + main = toPattern v ids <- gets primitives@@ -87,12 +87,12 @@ forM_ obj $ \o -> defineOn o m- + return (particle "ok") - [$p|c define: (p: Particle) on: (targets: List) as: v|] =: do+ [p|c define: (p: Particle) on: (targets: List) as: v|] =: do Particle p <- here "p" >>= findParticle- vs <- getList [$e|targets|]+ vs <- getList [e|targets|] v <- here "v" c <- here "c"
src/Atomo/Kernel/Pattern.hs view
@@ -8,25 +8,25 @@ load :: VM () load = do- ([$p|Pattern Role|] =::) =<< eval [$e|Pattern clone|]- ([$p|Pattern Define|] =::) =<< eval [$e|Pattern clone|]+ ([p|Pattern Role|] =::) =<< eval [e|Pattern clone|]+ ([p|Pattern Define|] =::) =<< eval [e|Pattern clone|] - [$p|(e: Expression) to: Pattern|] =: do+ [p|(e: Expression) to: Pattern|] =: do Expression e <- here "e" >>= findExpression p <- toPattern' e return (Pattern p) - [$p|(e: Expression) to: Pattern Role|] =: do+ [p|(e: Expression) to: Pattern Role|] =: do Expression e <- here "e" >>= findExpression p <- toRolePattern' e return (Pattern p) - [$p|(e: Expression) to: Pattern Define|] =: do+ [p|(e: Expression) to: Pattern Define|] =: do Expression e <- here "e" >>= findExpression p <- toDefinePattern' e return (Pattern (PMessage p)) - [$p|(p: Pattern) name|] =: do+ [p|(p: Pattern) name|] =: do Pattern p <- here "p" >>= findPattern case p of@@ -34,40 +34,40 @@ PMessage (Single { mName = n }) -> return (string n) _ -> raise ["no-name-for"] [Pattern p] - [$p|(p: Pattern) names|] =: do+ [p|(p: Pattern) names|] =: do Pattern p <- here "p" >>= findPattern case p of PMessage (Keyword { mNames = ns }) -> return $ list (map string ns) _ -> raise ["no-names-for"] [Pattern p] - [$p|(p: Pattern) target|] =: do+ [p|(p: Pattern) target|] =: do Pattern p <- here "p" >>= findPattern case p of PMessage (Single { mTarget = t }) -> return (Pattern t) _ -> raise ["no-target-for"] [Pattern p] - [$p|(p: Pattern) targets|] =: do+ [p|(p: Pattern) targets|] =: do Pattern p <- here "p" >>= findPattern case p of PMessage (Keyword { mTargets = ts }) -> return $ list (map Pattern ts) _ -> raise ["no-targets-for"] [Pattern p] - [$p|(p: Pattern) match: v|] =: do+ [p|(p: Pattern) match: v|] =: do Pattern p <- here "p" >>= findPattern v <- here "v" ids <- gets primitives if match ids Nothing p v then do- bs <- eval [$e|Object clone|]+ bs <- eval [e|Object clone|] withTop bs (set p v) return (keyParticleN ["ok"] [bs]) else return (particle "none") - [$p|top match: (p: Pattern) on: v|] =: do+ [p|top match: (p: Pattern) on: v|] =: do p <- here "p" >>= findPattern >>= matchable' . fromPattern v <- here "v" t <- here "top"
src/Atomo/Kernel/Ports.hs view
@@ -17,23 +17,23 @@ load :: VM () load = do- ([$p|Port|] =::) =<< eval [$e|Object clone|]- ([$p|File|] =::) =<< eval [$e|Object clone|]- ([$p|Directory|] =::) =<< eval [$e|Object clone|]+ ([p|Port|] =::) =<< eval [e|Object clone|]+ ([p|File|] =::) =<< eval [e|Object clone|]+ ([p|Directory|] =::) =<< eval [e|Object clone|] sinp <- portObj stdin soutp <- portObj stdout serrp <- portObj stderr- [$p|Port standard-input|] =:: sinp- [$p|Port standard-output|] =:: soutp- [$p|Port standard-error|] =:: serrp+ [p|Port standard-input|] =:: sinp+ [p|Port standard-output|] =:: soutp+ [p|Port standard-error|] =:: serrp - [$p|(p: Port) show|] =: do- hdl <- getHandle [$e|p handle|] >>= liftIO . hShow+ [p|(p: Port) show|] =: do+ hdl <- getHandle [e|p handle|] >>= liftIO . hShow return (string ("<port " ++ hdl ++ ">")) - [$p|Port new: (fn: String) &mode: @read-write|] =: do- fn <- getString [$e|fn|]+ [p|Port new: (fn: String) &mode: @read-write|] =: do+ fn <- getString [e|fn|] Particle m <- here "mode" >>= findParticle hdl <- case m of@@ -51,45 +51,45 @@ portObj hdl - [$p|(p: Port) buffering|] =:- getHandle [$e|p handle|] >>= liftIO . hGetBuffering >>= toValue+ [p|(p: Port) buffering|] =:+ getHandle [e|p handle|] >>= liftIO . hGetBuffering >>= toValue - [$p|(p: Port) set-buffering: mode|] =: do- h <- getHandle [$e|p handle|]+ [p|(p: Port) set-buffering: mode|] =: do+ h <- getHandle [e|p handle|] m <- here "mode" >>= fromValue liftIO (hSetBuffering h m) return (particle "ok") - [$p|(p: Port) print: x|] =: do+ [p|(p: Port) print: x|] =: do x <- here "x" port <- here "p"- hdl <- getHandle [$e|p handle|]+ hdl <- getHandle [e|p handle|] c <- liftIO (hIsClosed hdl) when c (raise ["port-closed", "for"] [port, x]) - String s <- eval [$e|x as: String|] >>= findString+ String s <- eval [e|x as: String|] >>= findString liftIO (TIO.hPutStrLn hdl s) liftIO (hFlush hdl) return x - [$p|(p: Port) display: x|] =: do+ [p|(p: Port) display: x|] =: do x <- here "x" port <- here "p"- hdl <- getHandle [$e|p handle|]+ hdl <- getHandle [e|p handle|] c <- liftIO (hIsClosed hdl) when c (raise ["port-closed", "for"] [port, x]) - String s <- eval [$e|x as: String|] >>= findString+ String s <- eval [e|x as: String|] >>= findString liftIO (TIO.hPutStr hdl s) liftIO (hFlush hdl) return x - [$p|(p: Port) read|] =: do- h <- getHandle [$e|p handle|]+ [p|(p: Port) read|] =: do+ h <- getHandle [e|p handle|] segment <- liftIO (hGetSegment h) parsed <- continuedParse segment "<read>"@@ -106,16 +106,16 @@ is | all isPrimitive is -> evalAll is (i:_) -> return (Expression i) - [$p|(p: Port) read-line|] =: do- h <- getHandle [$e|p handle|]+ [p|(p: Port) read-line|] =: do+ h <- getHandle [e|p handle|] done <- liftIO (hIsEOF h) if done then raise' "end-of-input" else liftM String $ liftIO (TIO.hGetLine h) - [$p|(p: Port) read-char|] =: do- h <- getHandle [$e|p handle|]+ [p|(p: Port) read-char|] =: do+ h <- getHandle [e|p handle|] b <- liftIO (hGetBuffering h) liftIO (hSetBuffering h NoBuffering) c <- liftIO (hGetChar h)@@ -123,219 +123,219 @@ return (Character c) - [$p|(p: Port) contents|] =:- getHandle [$e|p handle|] >>= liftM String . liftIO . TIO.hGetContents+ [p|(p: Port) contents|] =:+ getHandle [e|p handle|] >>= liftM String . liftIO . TIO.hGetContents - [$p|(p: Port) flush|] =:- getHandle [$e|p handle|] >>= liftIO . hFlush+ [p|(p: Port) flush|] =:+ getHandle [e|p handle|] >>= liftIO . hFlush >> return (particle "ok") - [$p|(p: Port) close|] =:- getHandle [$e|p handle|] >>= liftIO . hClose+ [p|(p: Port) close|] =:+ getHandle [e|p handle|] >>= liftIO . hClose >> return (particle "ok") - [$p|(p: Port) open?|] =:- getHandle [$e|p handle|] >>= liftM Boolean . liftIO . hIsOpen+ [p|(p: Port) open?|] =:+ getHandle [e|p handle|] >>= liftM Boolean . liftIO . hIsOpen - [$p|(p: Port) closed?|] =:- getHandle [$e|p handle|] >>= liftM Boolean . liftIO . hIsClosed+ [p|(p: Port) closed?|] =:+ getHandle [e|p handle|] >>= liftM Boolean . liftIO . hIsClosed - [$p|(p: Port) readable?|] =:- getHandle [$e|p handle|] >>= liftM Boolean . liftIO . hIsReadable+ [p|(p: Port) readable?|] =:+ getHandle [e|p handle|] >>= liftM Boolean . liftIO . hIsReadable - [$p|(p: Port) writable?|] =:- getHandle [$e|p handle|] >>= liftM Boolean . liftIO . hIsWritable+ [p|(p: Port) writable?|] =:+ getHandle [e|p handle|] >>= liftM Boolean . liftIO . hIsWritable - [$p|(p: Port) seekable?|] =:- getHandle [$e|p handle|] >>= liftM Boolean . liftIO . hIsSeekable+ [p|(p: Port) seekable?|] =:+ getHandle [e|p handle|] >>= liftM Boolean . liftIO . hIsSeekable - [$p|(p: Port) ready?|] =:- getHandle [$e|p handle|] >>= liftM Boolean . liftIO . hReady+ [p|(p: Port) ready?|] =:+ getHandle [e|p handle|] >>= liftM Boolean . liftIO . hReady - [$p|(p: Port) eof?|] =:- getHandle [$e|p handle|] >>= liftM Boolean . liftIO . hIsEOF+ [p|(p: Port) eof?|] =:+ getHandle [e|p handle|] >>= liftM Boolean . liftIO . hIsEOF - [$p|File new: (fn: String)|] =::: [$e|Port new: fn|]- [$p|File open: (fn: String)|] =::: [$e|Port new: fn|]+ [p|File new: (fn: String)|] =::: [e|Port new: fn|]+ [p|File open: (fn: String)|] =::: [e|Port new: fn|] - [$p|File read: (fn: String)|] =:::- [$e|Port (new: fn &mode: @read) ensuring: @close do: @contents|]+ [p|File read: (fn: String)|] =:::+ [e|Port (new: fn &mode: @read) ensuring: @close do: @contents|] - [$p|File delete: (fn: String)|] =: do- fn <- getString [$e|fn|]+ [p|File delete: (fn: String)|] =: do+ fn <- getString [e|fn|] checkExists fn liftIO (removeFile fn) return (particle "ok") - [$p|File move: (from: String) to: (to: String)|] =:::- [$e|File rename: from to: to|]- [$p|File rename: (from: String) to: (to: String)|] =: do- from <- getString [$e|from|]- to <- getString [$e|to|]+ [p|File move: (from: String) to: (to: String)|] =:::+ [e|File rename: from to: to|]+ [p|File rename: (from: String) to: (to: String)|] =: do+ from <- getString [e|from|]+ to <- getString [e|to|] checkExists from liftIO (renameFile from to) return (particle "ok") - [$p|File copy: (from: String) to: (to: String)|] =: do- from <- getString [$e|from|]- to <- getString [$e|to|]+ [p|File copy: (from: String) to: (to: String)|] =: do+ from <- getString [e|from|]+ to <- getString [e|to|] checkExists from liftIO (copyFile from to) return (particle "ok") - [$p|File canonicalize-path: (fn: String)|] =: do- fn <- getString [$e|fn|]+ [p|File canonicalize-path: (fn: String)|] =: do+ fn <- getString [e|fn|] liftM string $ liftIO (canonicalizePath fn) - [$p|File make-relative: (fn: String)|] =: do- fn <- getString [$e|fn|]+ [p|File make-relative: (fn: String)|] =: do+ fn <- getString [e|fn|] liftM string $ liftIO (makeRelativeToCurrentDirectory fn) - [$p|File exists?: (fn: String)|] =: do- fn <- getString [$e|fn|]+ [p|File exists?: (fn: String)|] =: do+ fn <- getString [e|fn|] liftM Boolean $ liftIO (doesFileExist fn) - [$p|File find-executable: (name: String)|] =: do- name <- getString [$e|name|]+ [p|File find-executable: (name: String)|] =: do+ name <- getString [e|name|] find <- liftIO (findExecutable name) case find of Nothing -> return (particle "none") Just fn -> return (keyParticle ["ok"] [Nothing, Just (string fn)]) - [$p|File readable?: (fn: String)|] =: do- fn <- getString [$e|fn|]+ [p|File readable?: (fn: String)|] =: do+ fn <- getString [e|fn|] checkExists fn liftM (Boolean . readable) $ liftIO (getPermissions fn) - [$p|File writable?: (fn: String)|] =: do- fn <- getString [$e|fn|]+ [p|File writable?: (fn: String)|] =: do+ fn <- getString [e|fn|] checkExists fn liftM (Boolean . writable) $ liftIO (getPermissions fn) - [$p|File executable?: (fn: String)|] =: do- fn <- getString [$e|fn|]+ [p|File executable?: (fn: String)|] =: do+ fn <- getString [e|fn|] checkExists fn liftM (Boolean . executable) $ liftIO (getPermissions fn) - [$p|File searchable?: (fn: String)|] =: do- fn <- getString [$e|fn|]+ [p|File searchable?: (fn: String)|] =: do+ fn <- getString [e|fn|] checkExists fn liftM (Boolean . searchable) $ liftIO (getPermissions fn) - [$p|File set-readable: (fn: String) to: (b: Boolean)|] =: do+ [p|File set-readable: (fn: String) to: (b: Boolean)|] =: do Boolean r <- here "b" >>= findBoolean- fn <- getString [$e|fn|]+ fn <- getString [e|fn|] checkExists fn ps <- liftIO (getPermissions fn) liftIO (setPermissions fn (ps { readable = r })) return (particle "ok") - [$p|File set-writable: (fn: String) to: (b: Boolean)|] =: do+ [p|File set-writable: (fn: String) to: (b: Boolean)|] =: do Boolean w <- here "b" >>= findBoolean- fn <- getString [$e|fn|]+ fn <- getString [e|fn|] checkExists fn ps <- liftIO (getPermissions fn) liftIO (setPermissions fn (ps { writable = w })) return (particle "ok") - [$p|File set-executable: (fn: String) to: (b: Boolean)|] =: do+ [p|File set-executable: (fn: String) to: (b: Boolean)|] =: do Boolean x <- here "b" >>= findBoolean- fn <- getString [$e|fn|]+ fn <- getString [e|fn|] checkExists fn ps <- liftIO (getPermissions fn) liftIO (setPermissions fn (ps { executable = x })) return (particle "ok") - [$p|File set-searchable: (fn: String) to: (b: Boolean)|] =: do+ [p|File set-searchable: (fn: String) to: (b: Boolean)|] =: do Boolean s <- here "b" >>= findBoolean- fn <- getString [$e|fn|]+ fn <- getString [e|fn|] checkExists fn ps <- liftIO (getPermissions fn) liftIO (setPermissions fn (ps { searchable = s })) return (particle "ok") - [$p|Directory create: (path: String)|] =: do- path <- getString [$e|path|]+ [p|Directory create: (path: String)|] =: do+ path <- getString [e|path|] liftIO (createDirectory path) return (particle "ok") - [$p|Directory create-if-missing: (path: String)|] =: do- path <- getString [$e|path|]+ [p|Directory create-if-missing: (path: String)|] =: do+ path <- getString [e|path|] liftIO (createDirectoryIfMissing False path) return (particle "ok") - [$p|Directory create-tree-if-missing: (path: String)|] =: do- path <- getString [$e|path|]+ [p|Directory create-tree-if-missing: (path: String)|] =: do+ path <- getString [e|path|] liftIO (createDirectoryIfMissing True path) return (particle "ok") - [$p|Directory remove: (path: String)|] =: do- path <- getString [$e|path|]+ [p|Directory remove: (path: String)|] =: do+ path <- getString [e|path|] checkDirExists path liftIO (removeDirectory path) return (particle "ok") - [$p|Directory remove-recursive: (path: String)|] =: do- path <- getString [$e|path|]+ [p|Directory remove-recursive: (path: String)|] =: do+ path <- getString [e|path|] checkDirExists path liftIO (removeDirectoryRecursive path) return (particle "ok") - [$p|Directory move: (from: String) to: (to: String)|] =:::- [$e|Directory rename: from to: to|]- [$p|Directory rename: (from: String) to: (to: String)|] =: do- from <- getString [$e|from|]- to <- getString [$e|to|]+ [p|Directory move: (from: String) to: (to: String)|] =:::+ [e|Directory rename: from to: to|]+ [p|Directory rename: (from: String) to: (to: String)|] =: do+ from <- getString [e|from|]+ to <- getString [e|to|] checkDirExists from liftIO (renameDirectory from to) return (particle "ok") - [$p|Directory contents: (path: String)|] =: do- path <- getString [$e|path|]+ [p|Directory contents: (path: String)|] =: do+ path <- getString [e|path|] checkDirExists path liftM (list . map string . filter (`notElem` [".", ".."])) (liftIO (getDirectoryContents path)) - [$p|Directory current|] =:+ [p|Directory current|] =: liftM string $ liftIO getCurrentDirectory - [$p|Directory set-current: (path: String)|] =: do- path <- getString [$e|path|]+ [p|Directory set-current: (path: String)|] =: do+ path <- getString [e|path|] checkDirExists path liftIO (setCurrentDirectory path) return (particle "ok") - [$p|Directory home|] =:+ [p|Directory home|] =: liftM string $ liftIO getHomeDirectory - [$p|Directory user-data-for: (app: String)|] =: do- app <- getString [$e|app|]+ [p|Directory user-data-for: (app: String)|] =: do+ app <- getString [e|app|] liftM string $ liftIO (getAppUserDataDirectory app) - [$p|Directory user-documents|] =:+ [p|Directory user-documents|] =: liftM string $ liftIO getUserDocumentsDirectory - [$p|Directory temporary|] =:+ [p|Directory temporary|] =: liftM string $ liftIO getTemporaryDirectory - [$p|Directory exists?: (path: String)|] =: do- path <- getString [$e|path|]+ [p|Directory exists?: (path: String)|] =: do+ path <- getString [e|path|] liftM Boolean $ liftIO (doesDirectoryExist path) - [$p|(a: String) </> (b: String)|] =: do- a <- getString [$e|a|]- b <- getString [$e|b|]+ [p|(a: String) </> (b: String)|] =: do+ a <- getString [e|a|]+ b <- getString [e|b|] return (string (a </> b)) - [$p|(a: String) <.> (b: String)|] =: do- a <- getString [$e|a|]- b <- getString [$e|b|]+ [p|(a: String) <.> (b: String)|] =: do+ a <- getString [e|a|]+ b <- getString [e|b|] return (string (a <.> b)) - [$p|interaction: (prompt: String)|] =: do- prompt <- getString [$e|prompt|]- history <- getString [$e|current-history-file|]+ [p|interaction: (prompt: String)|] =: do+ prompt <- getString [e|prompt|]+ history <- getString [e|current-history-file|] line <- liftIO $ Haskeline.catch (liftM Just $ runInput history (getInputLine prompt))@@ -366,7 +366,7 @@ . withInterrupt portObj hdl = newScope $ do- port <- eval [$e|Port clone|]+ port <- eval [e|Port clone|] define (single "handle" (PMatch port)) (EPrimitive Nothing $ haskell hdl)
src/Atomo/Kernel/Pretty.hs view
@@ -10,130 +10,130 @@ load :: VM () load = do- ([$p|Pretty|] =::) =<< eval [$e|Object clone|]+ ([p|Pretty|] =::) =<< eval [e|Object clone|] - [$p|(o: Object) pretty|] =:+ [p|(o: Object) pretty|] =: here "o" >>= toValue . pretty - [$p|(p: -> Pretty) pretty|] =::: [$e|p|]+ [p|(p: -> Pretty) pretty|] =::: [e|p|] -- Converting values to documents- [$p|Pretty char: (c: Character)|] =:+ [p|Pretty char: (c: Character)|] =: here "c" >>= findCharacter >>= toValue . char . fromCharacter - [$p|Pretty text: (s: String)|] =:- getString [$e|s|] >>= toValue . text+ [p|Pretty text: (s: String)|] =:+ getString [e|s|] >>= toValue . text - [$p|Pretty zero-width-text: (s: String)|] =:- getString [$e|s|] >>= toValue . zeroWidthText+ [p|Pretty zero-width-text: (s: String)|] =:+ getString [e|s|] >>= toValue . zeroWidthText - [$p|Pretty int: (i: Integer)|] =:+ [p|Pretty int: (i: Integer)|] =: here "i" >>= findInteger >>= toValue . integer . A.fromInteger - [$p|Pretty integer: (i: Integer)|] =:+ [p|Pretty integer: (i: Integer)|] =: here "i" >>= findInteger >>= toValue . integer . A.fromInteger - [$p|Pretty float: (d: Double)|] =:+ [p|Pretty float: (d: Double)|] =: here "d" >>= findDouble >>= toValue . double . fromDouble - [$p|Pretty double: (d: Double)|] =:+ [p|Pretty double: (d: Double)|] =: here "d" >>= findDouble >>= toValue . double . fromDouble - [$p|Pretty rational: (r: Rational)|] =:+ [p|Pretty rational: (r: Rational)|] =: here "r" >>= findRational >>= toValue . rational . (\(Rational r) -> r) -- Simple derived documents- [$p|Pretty semi|] =: toValue semi- [$p|Pretty comma|] =: toValue comma- [$p|Pretty colon|] =: toValue colon- [$p|Pretty space|] =: toValue space- [$p|Pretty equals|] =: toValue equals- [$p|Pretty lparen|] =: toValue lparen- [$p|Pretty rparen|] =: toValue rparen- [$p|Pretty lbrack|] =: toValue lbrack- [$p|Pretty rbrack|] =: toValue rbrack- [$p|Pretty lbrace|] =: toValue lbrace- [$p|Pretty rbrace|] =: toValue rbrace+ [p|Pretty semi|] =: toValue semi+ [p|Pretty comma|] =: toValue comma+ [p|Pretty colon|] =: toValue colon+ [p|Pretty space|] =: toValue space+ [p|Pretty equals|] =: toValue equals+ [p|Pretty lparen|] =: toValue lparen+ [p|Pretty rparen|] =: toValue rparen+ [p|Pretty lbrack|] =: toValue lbrack+ [p|Pretty rbrack|] =: toValue rbrack+ [p|Pretty lbrace|] =: toValue lbrace+ [p|Pretty rbrace|] =: toValue rbrace -- Wrapping documents in delimiters- [$p|Pretty parens: (p: Pretty)|] =:+ [p|Pretty parens: (p: Pretty)|] =: here "p" >>= fromValue >>= toValue . parens - [$p|Pretty brackets: (p: Pretty)|] =:+ [p|Pretty brackets: (p: Pretty)|] =: here "p" >>= fromValue >>= toValue . brackets - [$p|Pretty braces: (p: Pretty)|] =:+ [p|Pretty braces: (p: Pretty)|] =: here "p" >>= fromValue >>= toValue . braces - [$p|Pretty quotes: (p: Pretty)|] =:+ [p|Pretty quotes: (p: Pretty)|] =: here "p" >>= fromValue >>= toValue . quotes - [$p|Pretty double-quotes: (p: Pretty)|] =:+ [p|Pretty double-quotes: (p: Pretty)|] =: here "p" >>= fromValue >>= toValue . doubleQuotes -- Combining documents- [$p|Pretty empty|] =: toValue empty+ [p|Pretty empty|] =: toValue empty - [$p|(a: Pretty) <> (b: Pretty)|] =: do+ [p|(a: Pretty) <> (b: Pretty)|] =: do liftM2 (<>) (here "a" >>= fromValue) (here "b" >>= fromValue) >>= toValue - [$p|(a: Pretty) <+> (b: Pretty)|] =: do+ [p|(a: Pretty) <+> (b: Pretty)|] =: do liftM2 (<+>) (here "a" >>= fromValue) (here "b" >>= fromValue) >>= toValue - [$p|Pretty hcat: (ps: List)|] =: do- getList [$e|ps|] >>= mapM fromValue >>= toValue . hcat+ [p|Pretty hcat: (ps: List)|] =: do+ getList [e|ps|] >>= mapM fromValue >>= toValue . hcat - [$p|Pretty hsep: (ps: List)|] =: do- getList [$e|ps|] >>= mapM fromValue >>= toValue . hsep+ [p|Pretty hsep: (ps: List)|] =: do+ getList [e|ps|] >>= mapM fromValue >>= toValue . hsep - [$p|(a: Pretty) \\ (b: Pretty)|] =: do+ [p|(a: Pretty) \\ (b: Pretty)|] =: do liftM2 ($$) (here "a" >>= fromValue) (here "b" >>= fromValue) >>= toValue - [$p|(a: Pretty) \+\ (b: Pretty)|] =: do+ [p|(a: Pretty) \+\ (b: Pretty)|] =: do liftM2 ($+$) (here "a" >>= fromValue) (here "b" >>= fromValue) >>= toValue - [$p|Pretty vcat: (ps: List)|] =: do- getList [$e|ps|] >>= mapM fromValue >>= toValue . vcat+ [p|Pretty vcat: (ps: List)|] =: do+ getList [e|ps|] >>= mapM fromValue >>= toValue . vcat - [$p|Pretty sep: (ps: List)|] =: do- getList [$e|ps|] >>= mapM fromValue >>= toValue . sep+ [p|Pretty sep: (ps: List)|] =: do+ getList [e|ps|] >>= mapM fromValue >>= toValue . sep - [$p|Pretty cat: (ps: List)|] =: do- getList [$e|ps|] >>= mapM fromValue >>= toValue . cat+ [p|Pretty cat: (ps: List)|] =: do+ getList [e|ps|] >>= mapM fromValue >>= toValue . cat - [$p|Pretty fsep: (ps: List)|] =: do- getList [$e|ps|] >>= mapM fromValue >>= toValue . fsep+ [p|Pretty fsep: (ps: List)|] =: do+ getList [e|ps|] >>= mapM fromValue >>= toValue . fsep - [$p|Pretty fcat: (ps: List)|] =: do- getList [$e|ps|] >>= mapM fromValue >>= toValue . fcat+ [p|Pretty fcat: (ps: List)|] =: do+ getList [e|ps|] >>= mapM fromValue >>= toValue . fcat - [$p|(p: Pretty) nest: (i: Integer)|] =: do+ [p|(p: Pretty) nest: (i: Integer)|] =: do d <- here "p" >>= fromValue i <- here "i" >>= liftM (fromIntegral . A.fromInteger) . findInteger toValue (nest i d) - [$p|(a: Pretty) hang: (b: Pretty) indented: (i: Integer)|] =: do+ [p|(a: Pretty) hang: (b: Pretty) indented: (i: Integer)|] =: do a <- here "a" >>= fromValue b <- here "b" >>= fromValue i <- here "i" >>= liftM (fromIntegral . A.fromInteger) . findInteger toValue (hang a i b) - [$p|(delimiter: Pretty) punctuate: (ps: List)|] =: do+ [p|(delimiter: Pretty) punctuate: (ps: List)|] =: do d <- here "delimiter" >>= fromValue- ps <- getList [$e|ps|] >>= mapM fromValue+ ps <- getList [e|ps|] >>= mapM fromValue liftM list (mapM toValue (punctuate d ps)) -- Predicates on documents- [$p|(p: Pretty) empty?|] =:+ [p|(p: Pretty) empty?|] =: liftM (Boolean . isEmpty) (here "p" >>= fromValue) -- Rendering documents- [$p|(p: -> Pretty) render &mode: @page &line-length: 100 &ribbons-per-line: 1.5|] =: do+ [p|(p: -> Pretty) render &mode: @page &line-length: 100 &ribbons-per-line: 1.5|] =: do d <- here "p" >>= fromValue m <- here "mode" >>= findParticle sl <- here "line-length" >>= liftM (fromIntegral . A.fromInteger) . findInteger
src/Atomo/Kernel/Regexp.hs view
@@ -30,12 +30,12 @@ load :: VM () load = do- ([$p|RegexpBindings|] =::) =<< eval [$e|Object clone|]- ([$p|RegexpMatch|] =::) =<< eval [$e|Object clone|]+ ([p|RegexpBindings|] =::) =<< eval [e|Object clone|]+ ([p|RegexpMatch|] =::) =<< eval [e|Object clone|] - [$p|Regexp new: (s: String) &flags: ""|] =: do- s <- getString [$e|s|]- fs <- getString [$e|flags|]+ [p|Regexp new: (s: String) &flags: ""|] =: do+ s <- getString [e|s|]+ fs <- getString [e|flags|] case regex s fs of RegexOK re ->@@ -43,24 +43,24 @@ Failed x -> raise ["regexp-failed"] [string x] - [$p|(r: Regexp) =~ (s: String)|] =::: [$e|r matches?: s|]- [$p|(s: String) =~ (r: Regexp)|] =::: [$e|r matches?: s|]+ [p|(r: Regexp) =~ (s: String)|] =::: [e|r matches?: s|]+ [p|(s: String) =~ (r: Regexp)|] =::: [e|r matches?: s|] - [$p|(r: Regexp) matches?: (s: String)|] =: do+ [p|(r: Regexp) matches?: (s: String)|] =: do Regexp { rCompiled = re } <- here "r" >>= findRegexp- t <- getText [$e|s|]+ t <- getText [e|s|] return (Boolean (match re (encodeUtf8 t))) - [$p|(r: Regexp) match: (s: String)|] =: do+ [p|(r: Regexp) match: (s: String)|] =: do Regexp { rCompiled = re, rNamed = ns } <- here "r" >>= findRegexp- t <- getText [$e|s|]+ t <- getText [e|s|] let mr = match re (encodeUtf8 t) :: MatchResult BS.ByteString if BS.null (mrMatch mr) then return (particle "none") else do bs <- mkBindings (mrMatch mr:mrSubList mr) ns - rm <- [$e|RegexpMatch|] `newWith`+ rm <- [e|RegexpMatch|] `newWith` [ ("before", byteString (mrBefore mr)) , ("match", byteString (mrMatch mr)) , ("after", byteString (mrAfter mr))@@ -70,34 +70,34 @@ return (keyParticleN ["ok"] [rm]) - [$p|(s: String) replace: (r: Regexp) with: (callback: Block)|] =: do+ [p|(s: String) replace: (r: Regexp) with: (callback: Block)|] =: do Regexp { rCompiled = re, rNamed = ns } <- here "r" >>= findRegexp callback <- here "callback"- t <- getText [$e|s|]+ t <- getText [e|s|] doReplace re t $ \cs -> do bs <- mkBindings cs ns dispatch (keyword ["join"] [bs, callback]) >>= liftM fromString . findString - [$p|(s: String) replace: (r: Regexp) with: (format: String)|] =: do+ [p|(s: String) replace: (r: Regexp) with: (format: String)|] =: do Regexp { rCompiled = re, rNamed = ns } <- here "r" >>= findRegexp- format <- getText [$e|format|]- t <- getText [$e|s|]+ format <- getText [e|format|]+ t <- getText [e|s|] doReplace re t (reReplace (replacements format) ns) - [$p|(s: String) replace-all: (r: Regexp) with: (callback: Block)|] =: do+ [p|(s: String) replace-all: (r: Regexp) with: (callback: Block)|] =: do Regexp { rCompiled = re, rNamed = ns } <- here "r" >>= findRegexp callback <- here "callback"- t <- getText [$e|s|]+ t <- getText [e|s|] doReplaceAll re t $ \cs -> do bs <- mkBindings cs ns dispatch (keyword ["join"] [bs, callback]) >>= liftM fromString . findString - [$p|(s: String) replace-all: (r: Regexp) with: (format: String)|] =: do+ [p|(s: String) replace-all: (r: Regexp) with: (format: String)|] =: do Regexp { rCompiled = re, rNamed = ns } <- here "r" >>= findRegexp- format <- getText [$e|format|]- t <- getText [$e|s|]+ format <- getText [e|format|]+ t <- getText [e|s|] doReplaceAll re t (reReplace (replacements format) ns) doReplace :: Regex -> T.Text -> ([BS.ByteString] -> VM T.Text) -> VM Value@@ -171,7 +171,7 @@ mkBindings :: [BS.ByteString] -> [(String, Int)] -> VM Value mkBindings subs names =- [$e|RegexpBindings|] `newWith` concat+ [e|RegexpBindings|] `newWith` concat [ zipWith (\n m -> ("\\" ++ show n, byteString m)) [0 :: Int ..] subs
src/Atomo/Kernel/String.hs view
@@ -10,67 +10,67 @@ load :: VM () load = do- [$p|(s: String) as: List|] =:- liftM (list . map Character) (getString [$e|s|])+ [p|(s: String) as: List|] =:+ liftM (list . map Character) (getString [e|s|]) - [$p|(s: String) to: Character|] =: do- s <- getString [$e|s|]+ [p|(s: String) to: Character|] =: do+ s <- getString [e|s|] case s of "$'" -> return (Character '\'') '$':rest -> return (Character (read $ "'" ++ rest ++ "'")) _ -> raise ["invalid-string"] [string s] - [$p|(s: String) to: Integer|] =: do- s <- getString [$e|s|]+ [p|(s: String) to: Integer|] =: do+ s <- getString [e|s|] return (Integer (read s)) - [$p|(s: String) to: Double|] =: do- s <- getString [$e|s|]+ [p|(s: String) to: Double|] =: do+ s <- getString [e|s|] return (Double (read s)) - [$p|(s: String) to: Rational|] =: do- s <- getString [$e|s|]+ [p|(s: String) to: Rational|] =: do+ s <- getString [e|s|] let num = read $ takeWhile (/= '/') s denom = read . tail $ dropWhile (/= '/') s return (Rational (num % denom)) - [$p|(l: List) to: String|] =: do- vs <- getList [$e|l|]+ [p|(l: List) to: String|] =: do+ vs <- getList [e|l|] if all isCharacter vs then return $ string (map (\(Character c) -> c) vs) else raise' "list-not-homogenous" - [$p|(c: Character) singleton|] =: do+ [p|(c: Character) singleton|] =: do Character c <- here "c" >>= findCharacter return (String (T.singleton c)) - [$p|(s: String) length|] =:- liftM (Integer . fromIntegral . T.length) (getText [$e|s|])+ [p|(s: String) length|] =:+ liftM (Integer . fromIntegral . T.length) (getText [e|s|]) - [$p|(s: String) empty?|] =:- liftM (Boolean . T.null) $ getText [$e|s|]+ [p|(s: String) empty?|] =:+ liftM (Boolean . T.null) $ getText [e|s|] - [$p|(s: String) at: (n: Integer)|] =: do+ [p|(s: String) at: (n: Integer)|] =: do Integer n <- here "n" >>= findInteger- t <- getText [$e|s|]+ t <- getText [e|s|] if fromIntegral n >= T.length t then raise ["out-of-bounds", "for-string"] [Integer n, String t] else return . Character $ t `T.index` fromIntegral n - [$p|"" head|] =::: [$e|error: @empty-string|]- [$p|(s: String) head|] =:- liftM (Character . T.head) (getText [$e|s|])+ [p|"" head|] =::: [e|error: @empty-string|]+ [p|(s: String) head|] =:+ liftM (Character . T.head) (getText [e|s|]) - [$p|"" last|] =::: [$e|error: @empty-string|]- [$p|(s: String) last|] =:- liftM (Character . T.last) (getText [$e|s|])+ [p|"" last|] =::: [e|error: @empty-string|]+ [p|(s: String) last|] =:+ liftM (Character . T.last) (getText [e|s|]) - [$p|(s: String) from: (n: Integer) to: (m: Integer)|] =: do+ [p|(s: String) from: (n: Integer) to: (m: Integer)|] =: do Integer n <- here "n" >>= findInteger Integer m <- here "m" >>= findInteger- t <- getText [$e|s|]+ t <- getText [e|s|] let start = fromIntegral n count = (fromIntegral m) - start@@ -81,25 +81,25 @@ [keyParticleN ["from", "to"] [Integer n, Integer m], String t] else return (String . T.take count . T.drop start $ t) - [$p|"" init|] =::: [$e|error: @empty-string|]- [$p|(s: String) init|] =:- liftM (String . T.init) (getText [$e|s|])+ [p|"" init|] =::: [e|error: @empty-string|]+ [p|(s: String) init|] =:+ liftM (String . T.init) (getText [e|s|]) - [$p|"" tail|] =::: [$e|error: @empty-string|]- [$p|(s: String) tail|] =:- liftM (String . T.tail) (getText [$e|s|])+ [p|"" tail|] =::: [e|error: @empty-string|]+ [p|(s: String) tail|] =:+ liftM (String . T.tail) (getText [e|s|]) - [$p|(s: String) take: (n: Integer)|] =: do+ [p|(s: String) take: (n: Integer)|] =: do Integer n <- here "n" >>= findInteger- liftM (String . T.take (fromIntegral n)) (getText [$e|s|])+ liftM (String . T.take (fromIntegral n)) (getText [e|s|]) - [$p|(s: String) drop: (n: Integer)|] =: do+ [p|(s: String) drop: (n: Integer)|] =: do Integer n <- here "n" >>= findInteger- liftM (String . T.drop (fromIntegral n)) (getText [$e|s|])+ liftM (String . T.drop (fromIntegral n)) (getText [e|s|]) - [$p|(s: String) take-while: test|] =: do+ [p|(s: String) take-while: test|] =: do t <- here "test"- s <- getString [$e|s|]+ s <- getString [e|s|] let takeWhileM [] = return [] takeWhileM (x:xs) =@@ -109,9 +109,9 @@ liftM string $ takeWhileM s - [$p|(s: String) drop-while: test|] =: do+ [p|(s: String) drop-while: test|] =: do t <- here "test"- s <- getString [$e|s|]+ s <- getString [e|s|] let dropWhileM [] = return [] dropWhileM (x:xs) =@@ -121,107 +121,107 @@ liftM string $ dropWhileM s - [$p|(c: Character) repeat: (n: Integer)|] =: do+ [p|(c: Character) repeat: (n: Integer)|] =: do Character c <- here "c" >>= findCharacter Integer n <- here "n" >>= findInteger return (string (replicate (fromIntegral n) c)) - [$p|(s: String) repeat: (n: Integer)|] =: do+ [p|(s: String) repeat: (n: Integer)|] =: do Integer n <- here "n" >>= findInteger- liftM (String . T.replicate (fromIntegral n)) (getText [$e|s|])+ liftM (String . T.replicate (fromIntegral n)) (getText [e|s|]) - [$p|(a: String) .. (b: String)|] =: do- a <- getText [$e|a|]- b <- getText [$e|b|]+ [p|(a: String) .. (b: String)|] =: do+ a <- getText [e|a|]+ b <- getText [e|b|] return (String (a `T.append` b)) - [$p|(s: String) reverse|] =:- liftM (String . T.reverse) (getText [$e|s|])+ [p|(s: String) reverse|] =:+ liftM (String . T.reverse) (getText [e|s|]) - [$p|(l: List) join|] =: do- ts <- getList [$e|l|]+ [p|(l: List) join|] =: do+ ts <- getList [e|l|] >>= mapM (liftM fromString . findString) return (String (T.concat ts)) - [$p|(l: List) join: (d: String)|] =: do- ts <- getList [$e|l|]+ [p|(l: List) join: (d: String)|] =: do+ ts <- getList [e|l|] >>= mapM (liftM fromString . findString) - d <- getText [$e|d|]+ d <- getText [e|d|] return (String (T.intercalate d ts)) - [$p|(s: String) intersperse: (c: Character)|] =: do+ [p|(s: String) intersperse: (c: Character)|] =: do Character c <- here "c" >>= findCharacter- t <- getText [$e|s|]+ t <- getText [e|s|] return (String (T.intersperse c t)) - [$p|(s: String) split: (d: String)|] =: do- s <- getText [$e|s|]- d <- getText [$e|d|]+ [p|(s: String) split: (d: String)|] =: do+ s <- getText [e|s|]+ d <- getText [e|d|] return $ list (map String (T.splitOn d s)) -- TODO: split-by - [$p|(s: String) split-on: (d: Character)|] =: do- s <- getText [$e|s|]+ [p|(s: String) split-on: (d: Character)|] =: do+ s <- getText [e|s|] Character d <- here "d" >>= findCharacter return $ list (map String (T.split (== d) s)) - [$p|(s: String) split-at: (n: Integer)|] =: do+ [p|(s: String) split-at: (n: Integer)|] =: do Integer n <- here "n" >>= findInteger- s <- getText [$e|s|]+ s <- getText [e|s|] let (a, b) = T.splitAt (fromIntegral n) s return $ list [String a, String b] - [$p|(s: String) break-on: (d: String)|] =: do- s <- getText [$e|s|]- d <- getText [$e|d|]+ [p|(s: String) break-on: (d: String)|] =: do+ s <- getText [e|s|]+ d <- getText [e|d|] let (a, b) = T.breakOn d s return $ list [String a, String b] - [$p|(s: String) break-end: (d: String)|] =: do- s <- getText [$e|s|]- d <- getText [$e|d|]+ [p|(s: String) break-end: (d: String)|] =: do+ s <- getText [e|s|]+ d <- getText [e|d|] let (a, b) = T.breakOnEnd d s return $ list [String a, String b] - [$p|(s: String) group|] =: do- s <- getText [$e|s|]+ [p|(s: String) group|] =: do+ s <- getText [e|s|] return $ list (map String (T.group s)) - [$p|(s: String) inits|] =: do- s <- getText [$e|s|]+ [p|(s: String) inits|] =: do+ s <- getText [e|s|] return $ list (map String (T.inits s)) - [$p|(s: String) tails|] =: do- s <- getText [$e|s|]+ [p|(s: String) tails|] =: do+ s <- getText [e|s|] return $ list (map String (T.tails s)) - [$p|(s: String) chunks-of: (n: Integer)|] =: do+ [p|(s: String) chunks-of: (n: Integer)|] =: do Integer n <- here "n" >>= findInteger- s <- getText [$e|s|]+ s <- getText [e|s|] return $ list (map String (T.chunksOf (fromIntegral n) s)) - [$p|(s: String) lines|] =: do- s <- getText [$e|s|]+ [p|(s: String) lines|] =: do+ s <- getText [e|s|] return $ list (map String (T.lines s)) - [$p|(s: String) words|] =: do- s <- getText [$e|s|]+ [p|(s: String) words|] =: do+ s <- getText [e|s|] return $ list (map String (T.words s)) - [$p|(l: List) unlines|] =: do- l <- getList [$e|l|] >>= mapM (liftM fromString . findString)+ [p|(l: List) unlines|] =: do+ l <- getList [e|l|] >>= mapM (liftM fromString . findString) return $ String (T.unlines l) - [$p|(l: List) unwords|] =: do- l <- getList [$e|l|] >>= mapM (liftM fromString . findString)+ [p|(l: List) unwords|] =: do+ l <- getList [e|l|] >>= mapM (liftM fromString . findString) return $ String (T.unwords l) - [$p|(s: String) map: b|] =: do- s <- getString [$e|s|]+ [p|(s: String) map: b|] =: do+ s <- getString [e|s|] b <- here "b" vs <- forM s $ \c ->@@ -231,128 +231,128 @@ then return (string (map (\(Character c) -> c) vs)) else return $ list vs - [$p|(s: String) each: (b: Block)|] =::: [$e|{ s map: b in-context; s } call|]+ [p|(s: String) each: (b: Block)|] =::: [e|{ s map: b in-context; s } call|] - [$p|(c: Character) . (s: String)|] =: do+ [p|(c: Character) . (s: String)|] =: do Character c <- here "c" >>= findCharacter- s <- getText [$e|s|]+ s <- getText [e|s|] return (String (T.cons c s)) - [$p|(c: Character) >> (s: String)|] =::: [$e|c . s|]+ [p|(c: Character) >> (s: String)|] =::: [e|c . s|] - [$p|(s: String) << (c: Character)|] =: do- s <- getText [$e|s|]+ [p|(s: String) << (c: Character)|] =: do+ s <- getText [e|s|] Character c <- here "c" >>= findCharacter return (String (T.snoc s c)) - [$p|(haystack: String) replace: (needle: String) with: (new: String)|] =: do- h <- getText [$e|haystack|]- n <- getText [$e|needle|]- s <- getText [$e|new|]+ [p|(haystack: String) replace: (needle: String) with: (new: String)|] =: do+ h <- getText [e|haystack|]+ n <- getText [e|needle|]+ s <- getText [e|new|] return (String (T.replace n s h)) - [$p|(s: String) case-fold|] =:- liftM (String . T.toCaseFold) (getText [$e|s|])+ [p|(s: String) case-fold|] =:+ liftM (String . T.toCaseFold) (getText [e|s|]) - [$p|(s: String) lowercase|] =:- liftM (String . T.toLower) (getText [$e|s|])+ [p|(s: String) lowercase|] =:+ liftM (String . T.toLower) (getText [e|s|]) - [$p|(s: String) uppercase|] =:- liftM (String . T.toUpper) (getText [$e|s|])+ [p|(s: String) uppercase|] =:+ liftM (String . T.toUpper) (getText [e|s|]) - [$p|(s: String) left-justify: (length: Integer) &padding: $ |] =: do- s <- getText [$e|s|]+ [p|(s: String) left-justify: (length: Integer) &padding: $ |] =: do+ s <- getText [e|s|] Integer l <- here "length" >>= findInteger Character c <- here "c" >>= findCharacter return (String (T.justifyLeft (fromIntegral l) c s)) - [$p|(s: String) right-justify: (length: Integer) &padding: $ |] =: do- s <- getText [$e|s|]+ [p|(s: String) right-justify: (length: Integer) &padding: $ |] =: do+ s <- getText [e|s|] Integer l <- here "length" >>= findInteger Character c <- here "c" >>= findCharacter return (String (T.justifyRight (fromIntegral l) c s)) - [$p|(s: String) center: (length: Integer) &padding: $ |] =: do- s <- getText [$e|s|]+ [p|(s: String) center: (length: Integer) &padding: $ |] =: do+ s <- getText [e|s|] Integer l <- here "length" >>= findInteger Character c <- here "c" >>= findCharacter return (String (T.center (fromIntegral l) c s)) - [$p|(s: String) strip|] =:- liftM (String . T.strip) (getText [$e|s|])+ [p|(s: String) strip|] =:+ liftM (String . T.strip) (getText [e|s|]) - [$p|(s: String) strip-start|] =:- liftM (String . T.stripStart) (getText [$e|s|])+ [p|(s: String) strip-start|] =:+ liftM (String . T.stripStart) (getText [e|s|]) - [$p|(s: String) strip-end|] =:- liftM (String . T.stripEnd) (getText [$e|s|])+ [p|(s: String) strip-end|] =:+ liftM (String . T.stripEnd) (getText [e|s|]) - [$p|(s: String) strip: (c: Character)|] =: do+ [p|(s: String) strip: (c: Character)|] =: do Character c <- here "c" >>= findCharacter- liftM (String . T.dropAround (== c)) (getText [$e|s|])+ liftM (String . T.dropAround (== c)) (getText [e|s|]) - [$p|(s: String) strip-start: (c: Character)|] =: do+ [p|(s: String) strip-start: (c: Character)|] =: do Character c <- here "c" >>= findCharacter- liftM (String . T.dropWhile (== c)) (getText [$e|s|])+ liftM (String . T.dropWhile (== c)) (getText [e|s|]) - [$p|(s: String) strip-end: (c: Character)|] =: do+ [p|(s: String) strip-end: (c: Character)|] =: do Character c <- here "c" >>= findCharacter- liftM (String . T.dropWhileEnd (== c)) (getText [$e|s|])+ liftM (String . T.dropWhileEnd (== c)) (getText [e|s|]) - [$p|(s: String) all?: b|] =::: [$e|(s as: List) all?: b|]- [$p|(s: String) any?: b|] =::: [$e|(s as: List) any?: b|]+ [p|(s: String) all?: b|] =::: [e|(s as: List) all?: b|]+ [p|(s: String) any?: b|] =::: [e|(s as: List) any?: b|] - [$p|(s: String) contains?: (c: Character)|] =: do- t <- getText [$e|s|]+ [p|(s: String) contains?: (c: Character)|] =: do+ t <- getText [e|s|] Character c <- here "c" >>= findCharacter return (Boolean (T.any (== c) t)) - [$p|(c: Character) in?: (s: String)|] =::: [$e|s contains?: c|]+ [p|(c: Character) in?: (s: String)|] =::: [e|s contains?: c|] - [$p|(s: String) reduce: b|] =::: [$e|(s as: List) reduce: b|]- [$p|(s: String) reduce: b with: v|] =::: [$e|(s as: List) reduce: b with: v|]+ [p|(s: String) reduce: b|] =::: [e|(s as: List) reduce: b|]+ [p|(s: String) reduce: b with: v|] =::: [e|(s as: List) reduce: b with: v|] - [$p|(s: String) reduce-right: b|] =::: [$e|(s as: List) reduce-right: b|]- [$p|(s: String) reduce-right: b with: v|] =::: [$e|(s as: List) reduce-right: b with: v|]+ [p|(s: String) reduce-right: b|] =::: [e|(s as: List) reduce-right: b|]+ [p|(s: String) reduce-right: b with: v|] =::: [e|(s as: List) reduce-right: b with: v|] - [$p|(s: String) maximum|] =:- liftM (Character . T.maximum) (getText [$e|s|])+ [p|(s: String) maximum|] =:+ liftM (Character . T.maximum) (getText [e|s|]) - [$p|(s: String) minimum|] =:- liftM (Character . T.minimum) (getText [$e|s|])+ [p|(s: String) minimum|] =:+ liftM (Character . T.minimum) (getText [e|s|]) - [$p|(s: String) sort|] =:- liftM (string . sort) (getString [$e|s|])+ [p|(s: String) sort|] =:+ liftM (string . sort) (getString [e|s|]) - [$p|(s: String) sort-by: cmp|] =::: [$e|s (as: List) (sort-by: cmp) to: String|]+ [p|(s: String) sort-by: cmp|] =::: [e|s (as: List) (sort-by: cmp) to: String|] - [$p|(a: String) is-prefix-of?: (b: String)|] =: do- a <- getText [$e|a|]- b <- getText [$e|b|]+ [p|(a: String) is-prefix-of?: (b: String)|] =: do+ a <- getText [e|a|]+ b <- getText [e|b|] return $ Boolean (a `T.isPrefixOf` b) - [$p|(a: String) is-suffix-of?: (b: String)|] =: do- a <- getText [$e|a|]- b <- getText [$e|b|]+ [p|(a: String) is-suffix-of?: (b: String)|] =: do+ a <- getText [e|a|]+ b <- getText [e|b|] return $ Boolean (a `T.isSuffixOf` b) - [$p|(a: String) is-infix-of?: (b: String)|] =: do- a <- getText [$e|a|]- b <- getText [$e|b|]+ [p|(a: String) is-infix-of?: (b: String)|] =: do+ a <- getText [e|a|]+ b <- getText [e|b|] return $ Boolean (a `T.isInfixOf` b) - [$p|(a: String) starts-with?: (b: String)|] =::: [$e|b is-prefix-of?: a|]- [$p|(a: String) ends-with?: (b: String)|] =::: [$e|b is-suffix-of?: a|]- [$p|(a: String) includes?: (b: String)|] =::: [$e|b is-infix-of?: a|]+ [p|(a: String) starts-with?: (b: String)|] =::: [e|b is-prefix-of?: a|]+ [p|(a: String) ends-with?: (b: String)|] =::: [e|b is-suffix-of?: a|]+ [p|(a: String) includes?: (b: String)|] =::: [e|b is-infix-of?: a|] - [$p|(s: String) filter: b|] =::: [$e|s (as: List) (filter: b) to: String|]+ [p|(s: String) filter: b|] =::: [e|s (as: List) (filter: b) to: String|] - [$p|(x: String) zip: (y: String) &zipper: @->|] =: do- x <- getText [$e|x|]- y <- getText [$e|y|]+ [p|(x: String) zip: (y: String) &zipper: @->|] =: do+ x <- getText [e|x|]+ y <- getText [e|y|] z <- here "zipper" vs <- forM (T.zip x y) $ \(a, b) ->@@ -360,7 +360,7 @@ return $ list vs - [$p|(x: List) zip: (y: String) &zipper: @->|] =:::- [$e|x zip: (y as: List) &zipper: zipper|]- [$p|(x: String) zip: (y: List) &zipper: @->|] =:::- [$e|(x as: List) zip: y &zipper: zipper|]+ [p|(x: List) zip: (y: String) &zipper: @->|] =:::+ [e|x zip: (y as: List) &zipper: zipper|]+ [p|(x: String) zip: (y: List) &zipper: @->|] =:::+ [e|(x as: List) zip: y &zipper: zipper|]
src/Atomo/Kernel/Time.hs view
@@ -8,17 +8,17 @@ load :: VM () load = do- ([$p|Timer|] =::) =<< eval [$e|Object clone|]+ ([p|Timer|] =::) =<< eval [e|Object clone|] - [$p|Timer now|] =:+ [p|Timer now|] =: liftM (Double . fromRational . toRational) (liftIO getPOSIXTime) - [$p|Timer sleep: (n: Integer)|] =: do+ [p|Timer sleep: (n: Integer)|] =: do Integer n <- here "n" >>= findInteger liftIO (sleepFor n) return (particle "ok") - [$p|Timer sleep: (d: Double)|] =: do+ [p|Timer sleep: (d: Double)|] =: do Double d <- here "d" >>= findDouble liftIO (threadDelay (floor d)) return (particle "ok")
src/Atomo/QuasiQuotes.hs view
@@ -31,15 +31,15 @@ -- | Pattern quasi-quoter. p :: QuasiQuoter-p = QuasiQuoter quotePatternExp undefined+p = QuasiQuoter quotePatternExp undefined undefined undefined -- | Single expression quasi-quoter. e :: QuasiQuoter-e = QuasiQuoter quoteExprExp undefined+e = QuasiQuoter quoteExprExp undefined undefined undefined -- | Quasi-quoter for multiple expressions (a block of code). es :: QuasiQuoter-es = QuasiQuoter quoteExprsExp undefined+es = QuasiQuoter quoteExprsExp undefined undefined undefined withLocation :: (String -> (String, Int, Int) -> a) -> (a -> Q Exp) -> String -> TH.ExpQ withLocation p c s = do
src/Atomo/Run.hs view
@@ -70,6 +70,7 @@ , "set" , "block"+ , "concurrency" , "continuation" , "list" , "numeric"
src/Atomo/Valuable.hs view
@@ -127,6 +127,6 @@ instance Valuable Prettied where toValue d =- [$e|Pretty|] `newWith` [("doc", haskell d)]+ [e|Pretty|] `newWith` [("doc", haskell d)] fromValue v = dispatch (single "doc" v) >>= fromHaskell
src/Main.hs view
@@ -56,7 +56,7 @@ return () repl :: VM Value-repl = eval [$e|Lobby clone repl|]+repl = eval [e|Lobby clone repl|] primRepl :: VM Value primRepl = do