language-dickinson 1.0.0.1 → 1.1.0.0

raw patch · 25 files changed

+226/−38 lines, 25 filesdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +8/−2
• bench/Bench.hs +12/−6
• examples/fionaBot.dck +9/−0
• examples/shakespeare.dck +1/−0
• language-dickinson.cabal +3/−3
• public/Language/Dickinson.hs +1/−0
• run/REPL.hs +31/−22
• src/Language/Dickinson/Check.hs +1/−0
• src/Language/Dickinson/Check/Duplicate.hs +1/−0
• src/Language/Dickinson/Check/Internal.hs +1/−0
• src/Language/Dickinson/Check/Pattern.hs +1/−0
• src/Language/Dickinson/Check/Scope.hs +1/−0
• src/Language/Dickinson/Eval.hs +32/−1
• src/Language/Dickinson/Lexer.x +27/−4
• src/Language/Dickinson/Parser.y +3/−0
• src/Language/Dickinson/Rename.hs +1/−0
• src/Language/Dickinson/Type.hs +4/−0
• src/Language/Dickinson/TypeCheck.hs +2/−0
• test/Eval.hs +3/−0
• test/Golden.hs +1/−0
• test/data/refractory.dck +30/−0
• test/data/refractory.pretty +28/−0
• test/examples/lambda.dck +13/−0
• test/examples/library.dck +6/−0

@@ -1,5 +1,11 @@ # dickinson +# 1.1.0.0++  * Fix bug in `:type`+  * Add builtins `oulipo`, `allCaps`, `capitalize`, and `titlecase`+  * Fix bug with nested `:flatten`s+ # 1.0.0.1    * Fix bug when calling `:flatten` on tuples.

@@ -4,6 +4,13 @@  ## Installation +### Binaries++Binaries for some platforms are available on the [releases+page](https://github.com/vmchale/dickinson/releases).++### Source+ To install, first download [cabal-install](https://www.haskell.org/cabal/) and [GHC](https://www.haskell.org/ghc/download.html). Then: @@ -34,8 +41,7 @@ A user guide is available in [markdown](https://github.com/vmchale/dickinson/blob/master/doc/user-guide.md) and as-a [pdf](https://github.com/vmchale/dickinson/blob/master/doc/user-guide.pdf). It-is hosted on [github pages](https://vmchale.github.io/dickinson/) in HTML form.+a [pdf](https://github.com/vmchale/dickinson/blob/master/doc/user-guide.pdf).  See `man/emd.1` for man pages. 

@@ -66,18 +66,21 @@                 , bgroup "fileValidate"                     [ benchValidate "test/examples/declension.dck"                     ]-                , env amalDecline $ \d ->+                , env amalComplex $ \ ~(d, r) ->                   bgroup "validate"-                    [ bench "test/examples/declension.dck" $ nf validateRun d ]+                    [ bench "test/examples/declension.dck" $ nf validateRun d+                    , bench "test/data/refractory.dck" $ nf validateRun r+                    ]                 , env amalFortune $ \f ->                   bgroup "typecheck"                     [ bench "examples/fortune.dck" $ nf tyRun f ]-                , env amalgamated $ \ ~(s, c) ->+                , env amalgamated $ \ ~(s, c, r) ->                   bgroup "check + eval"                     [ bench "examples/shakespeare.dck" $ nfIO (txtIO s)                     , bench "examples/catherineOfSienaBot.dck" $ nfIO (txtIO c)+                    , bench "test/data/refractory" $ nfIO (txtIO r)                     ]-                , env amalgamated $ \ ~(s, c) ->+                , env amalgamated $ \ ~(s, c, _) ->                   bgroup "eval"                     [ bench "examples/shakespeare.dck" $ nfIO (evalIO $ evalDickinsonAsMain s)                     , bench "examples/catherineOfSienaBot.dck" $ nfIO (evalIO $ evalDickinsonAsMain c)@@ -96,10 +99,13 @@           encodeShakespeare = encode . void . either throw id . parse <$> shakespeare           encodeEnv = (,) <$> encoded <*> encodeShakespeare           amalFortune = amalgamateRename [] "examples/fortune.dck"-          amalgamated = (,)+          amalgamated = (,,)             <$> amalgamateRename [] "examples/shakespeare.dck"             <*> amalgamateRename [] "examples/catherineOfSienaBot.dck"-          amalDecline = amalgamateRename [] "test/examples/declension.dck"+            <*> amalgamateRename [] "test/data/refractory.dck"+          amalComplex = (,)+            <$> amalgamateRename [] "test/examples/declension.dck"+            <*> amalgamateRename [] "test/data/refractory.dck"  plainExpr :: (UniqueCtx, Dickinson a) -> Dickinson a plainExpr = fst . uncurry renameDickinson

@@ -20,6 +20,15 @@     (| "Run, free yourself of me.")     (|       '''+      I lay awake nights and ponder the world+      ''')+    (|+      '''+      Just because I'm in misery+      I don't beg for no sympathy+      ''')+    (|+      '''       Oh darling, it's so sweet       You think you know how crazy, how crazy I am.       ''')

@@ -1,4 +1,5 @@ ; ported from madlang+; originally from http://web.mit.edu/dryfoo/Funny-pages/shakespeare-insult-kit.html I think %-  (:def adjective

@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               language-dickinson-version:            1.0.0.1+version:            1.1.0.0 license:            BSD3 license-file:       LICENSE copyright:          Copyright: (c) 2020 Vanessa McHale@@ -12,7 +12,7 @@  synopsis:           A language for generative literature description:        Dickinson is a language for generative (random) literature-category:           Language, Text+category:           Language, Text, Compilers/Interpreters build-type:         Simple data-files:     man/emd.1@@ -126,7 +126,7 @@         base >=4.9 && <5,         array -any,         bytestring -any,-        text -any,+        text >=1.0.0.0,         mtl -any,         transformers -any,         containers -any,

@@ -10,6 +10,7 @@                           , Dickinson                           , Declaration (..)                           , Expression (..)+                          , Builtin (..)                           , Pattern (..)                           , DickinsonTy (..)                           , Name

@@ -66,28 +66,32 @@ loop = do     inp <- getInputLine "emd> "     case words <$> inp of-        Just []             -> loop-        Just (":h":_)       -> showHelp *> loop-        Just (":help":_)    -> showHelp *> loop-        Just (":save":[fp]) -> saveReplSt fp *> loop-        Just (":save":_)    -> liftIO (putStrLn ":save takes one argument") *> loop-        Just (":l":fs)      -> traverse loadFile fs *> loop-        Just (":load":fs)   -> traverse loadFile fs *> loop-        Just (":r":[fp])    -> loadReplSt fp *> loop-        Just (":r":_)       -> liftIO (putStrLn ":r takes one argument") *> loop-        Just (":type":e:_)  -> typeExpr e *> loop-        Just (":t":e:_)     -> typeExpr e *> loop-        Just (":view":n:_)  -> bindDisplay (T.pack n) *> loop-        Just (":view":_)    -> liftIO (putStrLn ":view takes a name as an argument") *> loop-        Just [":q"]         -> pure ()-        Just [":quit"]      -> pure ()-        Just [":list"]      -> listNames *> loop-        Just (":list":_)    -> liftIO (putStrLn ":list takes no arguments") *> loop-        Just [":dump"]      -> dumpSt *> loop-        Just (":dump":_)    -> liftIO (putStrLn ":dump takes no arguments") *> loop+        Just []                       -> loop+        Just (":h":_)                 -> showHelp *> loop+        Just (":help":_)              -> showHelp *> loop+        Just (":save":[fp])           -> saveReplSt fp *> loop+        Just (":save":_)              -> liftIO (putStrLn ":save takes one argument") *> loop+        Just (":l":fs)                -> traverse loadFile fs *> loop+        Just (":load":fs)             -> traverse loadFile fs *> loop+        Just (":r":[fp])              -> loadReplSt fp *> loop+        Just (":r":_)                 -> liftIO (putStrLn ":r takes one argument") *> loop+        Just (":type":e)              -> typeExpr (unwords e) *> loop+        Just (":t":e)                 -> typeExpr (unwords e) *> loop+        Just (":view":["oulipo"])     -> liftIO (putStrLn "(internal)") *> loop+        Just (":view":["allCaps"])    -> liftIO (putStrLn "(internal)") *> loop+        Just (":view":["capitalize"]) -> liftIO (putStrLn "(internal)") *> loop+        Just (":view":["titleCase"])  -> liftIO (putStrLn "(internal)") *> loop+        Just (":view":n:_)            -> bindDisplay (T.pack n) *> loop+        Just (":view":_)              -> liftIO (putStrLn ":view takes a name as an argument") *> loop+        Just [":q"]                   -> pure ()+        Just [":quit"]                -> pure ()+        Just [":list"]                -> listNames *> loop+        Just (":list":_)              -> liftIO (putStrLn ":list takes no arguments") *> loop+        Just [":dump"]                -> dumpSt *> loop+        Just (":dump":_)              -> liftIO (putStrLn ":dump takes no arguments") *> loop         -- TODO: erase/delete names?-        Just{}              -> printExpr (fromJust inp) *> loop-        Nothing             -> pure ()+        Just{}                        -> printExpr (fromJust inp) *> loop+        Nothing                       -> pure ()  rightPad :: Int -> String -> String rightPad n str = take n $ str ++ repeat ' '@@ -128,7 +132,12 @@ listNames = liftIO . traverse_ TIO.putStrLn =<< names  names :: Repl AlexPosn [T.Text]-names = lift namesState+names = appendBuiltins <$> lift namesState+    where appendBuiltins =+              ("oulipo":)+            . ("allCaps":)+            . ("capitalize":)+            . ("titleCase":)  bindDisplay :: T.Text -> Repl AlexPosn () bindDisplay t = do

@@ -37,6 +37,7 @@ checkMultipleExpr Var{}              = Nothing checkMultipleExpr Literal{}          = Nothing checkMultipleExpr StrChunk{}         = Nothing+checkMultipleExpr BuiltinFn{}        = Nothing checkMultipleExpr (Interp _ es)      = foldMapAlternative checkMultipleExpr es checkMultipleExpr (MultiInterp _ es) = foldMapAlternative checkMultipleExpr es checkMultipleExpr (Apply _ e e')     = checkMultipleExpr e <|> checkMultipleExpr e'

@@ -47,3 +47,4 @@ checkExprDuplicates (Flatten _ e)      = checkExprDuplicates e checkExprDuplicates (Annot _ e _)      = checkExprDuplicates e checkExprDuplicates Constructor{}      = Nothing+checkExprDuplicates BuiltinFn{}        = Nothing

@@ -43,6 +43,7 @@ maxUniqueType (TyNamed _ (Name _ (Unique k) _)) = k  maxUniqueExpression :: Expression a -> Int+maxUniqueExpression BuiltinFn{}                           = 0 maxUniqueExpression Literal{}                             = 0 maxUniqueExpression (Constructor _ (Name _ (Unique k) _)) = k maxUniqueExpression StrChunk{}                            = 0

@@ -49,6 +49,7 @@ checkPatternExpr Var{}              = Nothing checkPatternExpr Literal{}          = Nothing checkPatternExpr StrChunk{}         = Nothing+checkPatternExpr BuiltinFn{}        = Nothing checkPatternExpr (Interp _ es)      = foldMapAlternative checkPatternExpr es checkPatternExpr (MultiInterp _ es) = foldMapAlternative checkPatternExpr es checkPatternExpr (Apply _ e e')     = checkPatternExpr e <|> checkPatternExpr e'

@@ -60,6 +60,7 @@         else pure $ Just (UnfoundType l n)  checkExpr :: Expression a -> CheckM (Maybe (DickinsonError a))+checkExpr BuiltinFn{}    = pure Nothing checkExpr Literal{}      = pure Nothing checkExpr StrChunk{}     = pure Nothing checkExpr (Apply _ e e') = (<|>) <$> checkExpr e <*> checkExpr e'

@@ -20,6 +20,7 @@ import           Control.Monad.Except          (MonadError, throwError) import qualified Control.Monad.Ext             as Ext import           Control.Monad.State.Lazy      (MonadState, get, gets, modify, put)+import           Data.Char                     (toUpper) import           Data.Foldable                 (toList, traverse_) import qualified Data.IntMap                   as IM import           Data.List.NonEmpty            (NonEmpty, (<|))@@ -53,7 +54,6 @@     , tyEnv         :: TyEnv a     } - instance HasLexerState (EvalSt a) where     lexerStateLens f s = fmap (\x -> s { lexerState = x }) (f (lexerState s)) @@ -191,6 +191,7 @@ tryEvalExpressionM :: (MonadState (EvalSt a) m, MonadError (DickinsonError a) m) => Expression a -> m (Expression a) tryEvalExpressionM e@Literal{}    = pure e tryEvalExpressionM e@StrChunk{}   = pure e+tryEvalExpressionM e@BuiltinFn{}  = pure e tryEvalExpressionM v@(Var _ n)    = maybe (pure v) tryEvalExpressionM =<< tryLookupName n tryEvalExpressionM (Choice _ pes) = tryEvalExpressionM =<< pick pes tryEvalExpressionM (Tuple l es)   = Tuple l <$> traverse tryEvalExpressionM es@@ -203,6 +204,8 @@         Lambda _ n _ e''' ->             withSt (nameMod n e') $                 tryEvalExpressionM e'''+        BuiltinFn l' b ->+            Apply l (BuiltinFn l' b) <$> tryEvalExpressionM e'         _ -> pure $ Apply l e'' e tryEvalExpressionM (Interp l es)      = Interp l <$> traverse tryEvalExpressionM es tryEvalExpressionM (MultiInterp l es) = MultiInterp l <$> traverse tryEvalExpressionM es@@ -220,6 +223,7 @@ evalExpressionM :: (MonadState (EvalSt a) m, MonadError (DickinsonError a) m) => Expression a -> m (Expression a) evalExpressionM e@Literal{}     = pure e evalExpressionM e@StrChunk{}    = pure e+evalExpressionM e@BuiltinFn{}   = pure e evalExpressionM e@Constructor{} = pure e evalExpressionM (Var _ n)       = evalExpressionM =<< lookupName n evalExpressionM (Choice _ pes)  = evalExpressionM =<< pick pes@@ -237,6 +241,8 @@         Lambda _ n _ e''' ->             withSt (nameMod n e') $                 evalExpressionM =<< tryEvalExpressionM e''' -- tryEvalExpressionM is a special function to "pull" eval through lambdas...+        BuiltinFn _ b ->+            mapText (applyBuiltin b) <$> evalExpressionM e'         _ -> error "Ill-typed expression" evalExpressionM e@Lambda{} = pure e evalExpressionM (Match l e brs) = do@@ -261,6 +267,16 @@ mapChoice f (Tuple l es)       = Tuple l (mapChoice f <$> es) mapChoice _ _                  = error "Internal error in function mapChoice." +mapText :: (T.Text -> T.Text) -> Expression a -> Expression a+mapText f (Literal l t)      = Literal l (f t)+mapText f (StrChunk l t)     = StrChunk l (f t)+mapText f (Choice l brs)     = let ps = fst <$> brs in Choice l (NE.zip ps (fmap (mapText f . snd) brs))+mapText f (Interp l es)      = Interp l (mapText f <$> es)+mapText f (MultiInterp l es) = MultiInterp l (mapText f <$> es)+mapText f (Annot l e ty)     = Annot l (mapText f e) ty+mapText f (Concat l es)      = Concat l (mapText f <$> es)+mapText _ _                  = error "Internal error in function mapText."+ setFrequency :: NonEmpty (Double, Expression a) -> NonEmpty (Double, Expression a) setFrequency = fmap (\(_, e) -> (fromIntegral $ {-# SCC "countNodes" #-} countNodes e, e)) @@ -272,6 +288,9 @@ countNodes (MultiInterp _ es) = product (fmap countNodes es) countNodes (Concat _ es)      = product (fmap countNodes es) countNodes (Annot _ e _)      = countNodes e+countNodes (Flatten _ e)      = countNodes e+countNodes BuiltinFn{}        = 1+countNodes Constructor{}      = 1 -- TODO: lambdas too maybe? -> unclear countNodes _                  = error "Internal error in function countNodes"  concatOrFail :: (MonadState (EvalSt a) m, MonadError (DickinsonError a) m) => (T.Text -> T.Text) -> a -> [Expression a] -> m (Expression a)@@ -291,6 +310,7 @@ resolveFlattenM e@Literal{}     = pure e resolveFlattenM e@StrChunk{}    = pure e resolveFlattenM e@Constructor{} = pure e+resolveFlattenM e@BuiltinFn{}   = pure e resolveFlattenM (Var _ n)       = resolveFlattenM =<< lookupName n resolveFlattenM (Choice l pes) = do     let ps = fst <$> pes -- TODO: do these need to be renamed@@ -310,6 +330,8 @@         Lambda _ n _ e''' ->             withSt (nameMod n e') $                 resolveFlattenM e'''+        BuiltinFn _ b ->+            mapText (applyBuiltin b) <$> resolveFlattenM e'         _ -> error "Ill-typed expression" resolveFlattenM e@Lambda{} = pure e resolveFlattenM (Match l e brs) = do@@ -325,6 +347,7 @@ -- | Resolve let bindings and such; do not perform choices or concatenations. resolveExpressionM :: (MonadState (EvalSt a) m, MonadError (DickinsonError a) m) => Expression a -> m (Expression a) resolveExpressionM e@Literal{}     = pure e+resolveExpressionM e@BuiltinFn{}   = pure e resolveExpressionM e@StrChunk{}    = pure e resolveExpressionM e@Constructor{} = pure e resolveExpressionM v@(Var _ n)     = maybe (pure v) resolveExpressionM =<< tryLookupName n@@ -355,3 +378,11 @@ resolveExpressionM (Flatten l e) =     Flatten l <$> resolveExpressionM e resolveExpressionM (Annot _ e _) = resolveExpressionM e++applyBuiltin :: Builtin -> T.Text -> T.Text+applyBuiltin AllCaps    = T.toUpper+applyBuiltin Capitalize = \t -> case T.uncons t of+    Nothing      -> ""+    Just (c, t') -> T.cons (toUpper c) t'+applyBuiltin Oulipo     = T.filter (/= 'e')+applyBuiltin Titlecase  = T.toTitle -- TODO: better

@@ -17,6 +17,7 @@                                     , Token (..)                                     , Keyword (..)                                     , Sym (..)+                                    , Builtin (..)                                     , HasLexerState (..)                                     ) where @@ -35,7 +36,7 @@ import Data.Semigroup ((<>)) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8)-import Data.Text.Prettyprint.Doc (Pretty (pretty), pipe, lparen, rparen, rbrace, rbracket, lbracket, colon, dquotes, dquote, rangle, comma)+import Data.Text.Prettyprint.Doc (Pretty (pretty), pipe, lparen, rparen, rbrace, rbracket, lbracket, colon, squotes, dquotes, dquote, rangle, comma, (<+>)) import GHC.Generics (Generic) import Language.Dickinson.Name import Language.Dickinson.Unique@@ -107,6 +108,12 @@         ":flatten"                 { mkKeyword KwFlatten }         "tydecl"                   { mkKeyword KwTyDecl } +        -- builtins+        capitalize                 { mkBuiltin Capitalize }+        allCaps                    { mkBuiltin AllCaps }+        titlecase                  { mkBuiltin Titlecase }+        oulipo                     { mkBuiltin Oulipo }+         -- identifiers         @name                      { tok (\p s -> TokIdent p <$> newIdentAlex p (mkText s)) }         @tyname                    { tok (\p s -> TokTyCons p <$> newIdentAlex p (mkText s)) }@@ -192,6 +199,8 @@  mkKeyword = constructor TokKeyword +mkBuiltin = constructor TokBuiltin+ mkSym = constructor TokSym  doSym t act = tok (\p _ -> TokSym p t <$ act)@@ -267,6 +276,12 @@     pretty DeclBreak     = "%-"     pretty Eq            = "=" +data Builtin = Capitalize+             | AllCaps+             | Titlecase+             | Oulipo -- ^ Filter all @e@s from text.+             deriving (Eq, Show, Generic, NFData, Binary, Data)+ data Keyword = KwDef              | KwLet              | KwBranch@@ -279,6 +294,12 @@              | KwTyDecl              deriving (Eq, Generic, NFData) +instance Pretty Builtin where+    pretty Capitalize = "capitalize"+    pretty AllCaps    = "allCaps"+    pretty Titlecase  = "titlecase"+    pretty Oulipo     = "oulipo"+ instance Pretty Keyword where     pretty KwDef     = ":def"     pretty KwLet     = ":let"@@ -311,17 +332,19 @@              | TokString { loc :: a, str :: T.Text }              | TokKeyword { loc :: a, kw :: Keyword }              | TokSym { loc :: a, sym :: Sym }+             | TokBuiltin { loc :: a, builtin :: Builtin }              deriving (Eq, Generic, NFData)  instance Pretty (Token a) where     pretty EOF{}                = mempty-    pretty (TokIdent _ n)       = pretty n-    pretty (TokTyCons _ tn)     = pretty tn+    pretty (TokIdent _ n)       = "identifier" <+> squotes (pretty n)+    pretty (TokTyCons _ tn)     = "constructor" <+> squotes (pretty tn)     pretty (TokDouble _ d)      = pretty d     pretty (TokString _ str')   = dquotes (pretty str')     pretty (TokStrChunk _ str') = pretty str'-    pretty (TokKeyword _ kw')   = pretty kw'+    pretty (TokKeyword _ kw')   = "keyword" <+> squotes (pretty kw')     pretty (TokSym _ sym')      = pretty sym'+    pretty (TokBuiltin _ b)     = "builtin" <+> squotes (pretty b)  loop :: Alex [Token AlexPosn] loop = do

@@ -78,6 +78,8 @@     flatten { TokKeyword $$ KwFlatten }     tydecl { TokKeyword $$ KwTyDecl } +    builtin { $$@(TokBuiltin _ _) }+     text { TokKeyword $$ KwText }      ident { $$@(TokIdent _ _) }@@ -153,6 +155,7 @@            | let some(brackets(Bind)) Expression { Let $1 (NE.reverse $2) $3 }            | lambda Name Type Expression { Lambda $1 $2 $3 $4 }            | ident { Var (loc $1) (ident $1) }+           | builtin { BuiltinFn (loc $1) (builtin $1) }            | stringLiteral { Literal (loc $1) (str $1) }            | strBegin some(Interp) strEnd { Interp $1 (toList $ NE.reverse $2) }            | multiStrBegin some(Interp) multiStrEnd { MultiInterp $1 (processMultiChunks $ toList $ NE.reverse $2) }

@@ -188,3 +188,4 @@ renameExpressionM (Annot l e ty) =     Annot l <$> renameExpressionM e <*> pure ty renameExpressionM c@Constructor{} = pure c+renameExpressionM c@BuiltinFn{} = pure c

@@ -28,6 +28,7 @@ import           Data.Text.Prettyprint.Doc.Ext      (hardSep, (<#*>), (<#>), (<^>)) import           Data.Text.Prettyprint.Doc.Internal (unsafeTextWithoutNewlines) import           GHC.Generics                       (Generic)+import           Language.Dickinson.Lexer import           Language.Dickinson.Name  data Dickinson a = Dickinson { modImports :: [Import a]@@ -89,6 +90,7 @@                           , exprTy  :: DickinsonTy a                           }                   | Constructor { exprAnn :: a, constructorName :: TyName a }+                  | BuiltinFn { exprAnn :: a, exprBuiltin :: Builtin }                   deriving (Generic, NFData, Binary, Functor, Show, Data)                   -- TODO: builtins? @@ -164,6 +166,7 @@         | allEq (fst <$> brs) = parens (":oneof" <#> indent 2 (hardSep (toList $ fmap prettyChoiceOneof (snd <$> brs))))         | otherwise           = parens (":branch" <#> indent 2 (hardSep (toList $ fmap prettyChoiceBranch brs)))     pretty (Lambda _ n ty e)  = parens (":lambda" <+> pretty n <+> pretty ty <#*> pretty e)+    pretty (Apply _ e e'@Choice{}) = parens ("$" <+> pretty e <^> pretty e')     pretty (Apply _ e e')     = parens ("$" <+> pretty e <+> pretty e')     pretty (Interp _ es)      = group (dquotes (foldMap prettyInterp es))     pretty (MultiInterp _ es) = group (align ("'''" <> prettyMultiInterp es <> "'''"))@@ -174,6 +177,7 @@     pretty (Flatten _ e)      = group (parens (":flatten" <^> pretty e))     pretty (Annot _ e ty)     = pretty e <+> colon <+> pretty ty     pretty (Constructor _ tn) = pretty tn+    pretty (BuiltinFn _ b)    = pretty b  instance Pretty (DickinsonTy a) where     pretty TyText{}       = "text"

@@ -141,3 +141,5 @@     case IM.lookup k tyEnv of         Just ty -> pure ty         Nothing -> throwError $ UnfoundConstructor l tn+typeOf (BuiltinFn l _) = pure $ -- all builtins have type (-> text text)+    TyFun l (TyText l) (TyText l)

@@ -27,6 +27,9 @@     , testCase "Match on ADT constructors" matchAdtEval     , testCase "Work with or-patterns" orPatternEval     , resultCase "test/examples/quote.dck"+    , resultCase "test/data/refractory.dck"+    , resultCase "test/examples/lambda.dck"+    , resultCase "test/examples/library.dck"     ]  forceResult :: a -> Assertion

@@ -38,6 +38,7 @@         , withDckFile "test/eval/matchSex.dck"         , withDckFile "test/examples/quote.dck"         , withDckFile "test/examples/declension.dck"+        , withDckFile "test/data/refractory.dck"         ]  prettyBSL :: Dickinson a -> BSL.ByteString

@@ -0,0 +1,30 @@+%-++(:def fionaAppleQuote+  $ oulipo+  (:oneof+    (| +      '''+      "You're more likely to get cut with a dull tool than a sharp one."+      ''')+    (|+      '''+      "You forgot the difference between equanimity and passivity."+      ''')))++(:def quote+  (:oneof+    (| ("« Le beau est ce qu'on désire sans vouloir le manger. »", "Simone Weil"))+    (| (fionaAppleQuote, "Fiona Apple"))))++(:def formatQuote+  (:lambda q (text, text)+    (:match q+      [(quote, name)+        '''+        ${quote}+            — ${$titlecase name}+        '''])))++(:def main+  $ formatQuote (:flatten quote))

@@ -0,0 +1,28 @@+%-++(:def fionaAppleQuote+  ($ oulipo+    (:oneof+      (| '''+         "You're more likely to get cut with a dull tool than a sharp one."+         ''')+      (| '''+         "You forgot the difference between equanimity and passivity."+         '''))))++(:def quote+  (:oneof+    (| ("« Le beau est ce qu'on désire sans vouloir le manger. »", "Simone Weil"))+    (| (fionaAppleQuote, "Fiona Apple"))))++(:def formatQuote+  (:lambda q (text, text)+    (:match q+      [(quote, name)+        '''+        ${quote}+            — ${($ titlecase name)}+        '''])))++(:def main+  ($ formatQuote (:flatten quote)))

@@ -0,0 +1,13 @@+%-++(:def sayHello+  (:lambda name text+    "Hello, ${name}."))++(:def name+  (:oneof+    (| "Alice")+    (| "Bob")))++(:def main+  ($ sayHello name))

@@ -0,0 +1,6 @@+(:include color)++%-++(:def main+  "Today's mood is ${color}")