diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # dickinson +## 1.4.3.1 + + * `base` catch-up + ## 1.4.3.0 * REPL tab-completions no longer hang indefinitely diff --git a/doc/user-guide.pdf b/doc/user-guide.pdf Binary files a/doc/user-guide.pdf and b/doc/user-guide.pdf differ diff --git a/examples/axolotlsay.dck b/examples/axolotlsay.dck new file mode 100644 --- /dev/null +++ b/examples/axolotlsay.dck @@ -0,0 +1,10 @@ +%- + +(:def axolotlsay + (:lambda txt text + ''' + ${txt} + ---- + / + ≽(◕ ᴗ ◕)≼ + ''')) diff --git a/examples/fortune.dck b/examples/fortune.dck --- a/examples/fortune.dck +++ b/examples/fortune.dck @@ -31,6 +31,7 @@ (| "Hunger is hope.") (| "Spurn your family.") (| "Salvation is finality.") + (| "Comfort leads to complacency.") (| "If you go outside today, you will become nauseous") (| "Knowledge begets humility.") (| "Mushrooms are made of flesh.") diff --git a/examples/starwars.dck b/examples/starwars.dck --- a/examples/starwars.dck +++ b/examples/starwars.dck @@ -18,9 +18,12 @@ (:oneof (| "Yert") (| "Wam") + (| "Cass") + (| "Jetta") (| "Pommet") (| "Hodnar") (| "Po") + (| "Bik") (| "Jelk") (| "Boba") (| "Orchi") diff --git a/language-dickinson.cabal b/language-dickinson.cabal --- a/language-dickinson.cabal +++ b/language-dickinson.cabal @@ -1,14 +1,11 @@ cabal-version: 2.0 name: language-dickinson -version: 1.4.3.0 +version: 1.4.3.1 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2020, 2022 Vanessa McHale maintainer: vamchale@gmail.com author: Vanessa McHale -tested-with: - ghc ==8.0.2 ghc ==8.2.2 ghc ==8.4.4 ghc ==8.6.5 ghc ==8.8.4 - ghc ==8.10.7 ghc ==9.0.2 ghc ==9.2.2 synopsis: A language for generative literature description: Dickinson is a language for generative (random) literature @@ -56,7 +53,7 @@ default-language: Haskell2010 ghc-options: -Wall build-depends: - base >=4.9 && <5, + base >=4.19.0.0 && <5, dickinson if !flag(cross) @@ -128,6 +125,7 @@ DeriveAnyClass DeriveFunctor DeriveGeneric FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving OverloadedStrings StandaloneDeriving TupleSections DeriveDataTypeable + TransformListComp ghc-options: -Wall -O2 -fstatic-argument-transformation build-depends: @@ -150,7 +148,7 @@ split if !flag(cross) - build-tool-depends: alex:alex, happy:happy + build-tool-depends: alex:alex >=3.5.0.0, happy:happy if !impl(ghc >=8.0) build-depends: semigroups diff --git a/lib/adjectives.dck b/lib/adjectives.dck --- a/lib/adjectives.dck +++ b/lib/adjectives.dck @@ -28,6 +28,7 @@ (| "noisome") (| "baneful") (| "auxetic") + (| "fulgurant") (| "bromide") (| "bolshie") (| "murine") @@ -91,6 +92,7 @@ (| "bitter") (| "cross") (| "crapulous") + (| "etiolated") (| "confutative") (| "campy") (| "cavicorn") @@ -128,6 +130,8 @@ (| "cheerful") (| "common") (| "doxastic") + (| "refulgent") + (| "effulgent") (| "demonifugic") (| "dolorous") (| "dainty") @@ -135,6 +139,8 @@ (| "devoted") (| "dramatic") (| "demented") + (| "feculent") + (| "banausic") (| "dark") (| "drained") (| "deep") @@ -394,6 +400,7 @@ (| "lugubrious") (| "laodicean") (| "lazy") + (| "epicene") (| "quiescent") (| "quaggy") (| "queasy") @@ -497,6 +504,7 @@ (| "wroth") (| "wretched") (| "wiry") + (| "encaustic") (| "withering") (| "wizened") (| "warmhearted") @@ -514,9 +522,11 @@ (| "yonic") (| "yellow") (| "yankee") + (| "parlous") (| "young") (| "zippy") (| "zaftig") + (| "sessile") (| "zygodactyl") (| "zaddy") (| "zetetic") @@ -524,5 +534,6 @@ (| "zesty") (| "pithy") (| "diaphanous") + (| "nugatory") (| "orotund") (| "stentorian")))) diff --git a/lib/noun.dck b/lib/noun.dck --- a/lib/noun.dck +++ b/lib/noun.dck @@ -24,6 +24,7 @@ (| "scansion") (| "assonance") (| "sabbing") + (| "nixtamalization") (| "adynaton") (| "aposiopesis") (| "asyndeton") @@ -200,7 +201,9 @@ (| "catchment") (| "cacozelia") (| "codicil") + (| "peccadillo") (| "bolus") + (| "assiduity") (| "bole") (| "calomel") (| "polysemy") @@ -222,6 +225,7 @@ (| "limner") (| "kenjataimu") (| "perspicuity") + (| "boustrophedon") (| "wisteria") (| "cephalophore") (| "recalcitrant") @@ -236,7 +240,9 @@ (| "diacope") (| "philatelist") (| "panegyric") + (| "scoleciphobia") (| "nosocomial") + (| "crozier") (| "tmesis") (| "skete") (| "prig") @@ -261,6 +267,7 @@ (| "aspic") (| "cachexia") (| "thaumaturge") + (| "hoosegow") (| "epicaricacy") (| "schorl") (| "velleity") @@ -316,6 +323,7 @@ (| "baculum") (| "skeuomorphism") (| "epitaph") + (| "fiacre") (| "tensor") (| "hypotaxis") (| "parataxis") @@ -334,6 +342,7 @@ (| "murmuration") (| "Lagrangian") (| "Hamiltonian") + (| "hamartia") (| "aneurysm") (| "gleet") (| "synagogue") @@ -364,6 +373,7 @@ (| "piano") (| "roke") (| "shebang") + (| "gonif") (| "sheet") (| "cornice") (| "chancroid") @@ -373,6 +383,7 @@ (| "egregore") (| "cretin") (| "calumny") + (| "schizocarp") (| "vermeil") (| "xoanon") (| "rancor") @@ -395,9 +406,11 @@ (| "caltrop") (| "calque") (| "diet") + (| "misoneism") (| "ether") (| "xylem") (| "obreptition") + (| "caliology") (| "phlogiston") (| "poop") (| "turd") @@ -406,6 +419,7 @@ (| "salmon") (| "crappie") (| "exhibitionist") + (| "pyknosis") (| "fetish") (| "fetishist") (| "cult") @@ -420,6 +434,7 @@ (| "latex") (| "jeremiad") (| "sitiogonic") + (| "froufrou") (| "isopsephy") (| "apotheosis") (| "aphelion") @@ -427,9 +442,16 @@ (| "thurible") (| "perihelion") (| "bleb") + (| "quean") + (| "hallion") + (| "apophenia") + (| "declivity") + (| "tacenda") ; plural only (| "cabochon") + (| "panjandrum") (| "sortition") (| "stotting") + (| "stye") (| "weft") (| "tenesmus") (| "folderol")))) diff --git a/lib/profession.dck b/lib/profession.dck --- a/lib/profession.dck +++ b/lib/profession.dck @@ -4,6 +4,7 @@ (:oneof (| "professor") (| "psychiatrist") + (| "equerry") (| "physician") (| "poet") (| "psychologist") diff --git a/man/emd.1 b/man/emd.1 --- a/man/emd.1 +++ b/man/emd.1 @@ -1,137 +1,108 @@ -.\" Automatically generated by Pandoc 2.18 +.\" Automatically generated by Pandoc 3.2 .\" -.\" Define V font for inline verbatim, using C font in formats -.\" that render this, and otherwise B font. -.ie "\f[CB]x\f[]"x" \{\ -. ftr V B -. ftr VI BI -. ftr VB B -. ftr VBI BI -.\} -.el \{\ -. ftr V CR -. ftr VI CI -. ftr VB CB -. ftr VBI CBI -.\} .TH "emd (1)" "" "" "" "" -.hy .SH NAME -.PP -emd - [Emily] Dickinson +emd \- [Emily] Dickinson .SH DESCRIPTION -.PP -\f[B]Dickinson\f[R] is a text-generation language +\f[B]Dickinson\f[R] is a text\-generation language .SH SYNOPSIS -.PP emd fortune.dck .PP emd repl .PP emd run literature.dck .PP -emd run project.dck --include lib +emd run project.dck \-\-include lib .PP man $(emd man) .SS SHEBANG -.PP -Dickinson ignores lines starting with \f[V]#!\f[R] so we can put +Dickinson ignores lines starting with \f[CR]#!\f[R] so we can put .IP -.nf -\f[C] +.EX #!/usr/bin/env emd -\f[R] -.fi +.EE .PP -at the top of a file and \f[V]emd\f[R] will be used as an interpreter. +at the top of a file and \f[CR]emd\f[R] will be used as an interpreter. .SH SUBCOMMANDS -.PP -\f[B]repl\f[R] - Start a repl +\f[B]repl\f[R] \- Start a repl .PP -\f[B]run\f[R] - Run a file +\f[B]run\f[R] \- Run a file .PP -\f[B]check\f[R] - Check that a program is correct without running it +\f[B]check\f[R] \- Check that a program is correct without running it .PP -\f[B]lint\f[R] - Give suggestions for common mistakes +\f[B]lint\f[R] \- Give suggestions for common mistakes .PP -\f[B]fmt\f[R] - Format Dickinson code +\f[B]fmt\f[R] \- Format Dickinson code .PP -\f[B]man\f[R] - Point to where manpages are installed +\f[B]man\f[R] \- Point to where manpages are installed .SS REPL COMMANDS -.PP -\f[B]:save\f[R] - Save curent state in a file +\f[B]:save\f[R] \- Save curent state in a file .PP -\f[B]:l\f[R] \f[B]:load\f[R] - Load a file +\f[B]:l\f[R] \f[B]:load\f[R] \- Load a file .PP -\f[B]:r\f[R] - Restore a REPL state stored in a file +\f[B]:r\f[R] \- Restore a REPL state stored in a file .PP -\f[B]:q\f[R] \f[B]:quit\f[R] - Quit session +\f[B]:q\f[R] \f[B]:quit\f[R] \- Quit session .PP -\f[B]:list\f[R] - List all names that are in scope +\f[B]:list\f[R] \- List all names that are in scope .PP -\f[B]:t\f[R] \f[B]:type\f[R] - Display the type of an expression +\f[B]:t\f[R] \f[B]:type\f[R] \- Display the type of an expression .PP -\f[B]:v\f[R] \f[B]:view\f[R] - Show the definition of a name +\f[B]:v\f[R] \f[B]:view\f[R] \- Show the definition of a name .PP -\f[B]:h\f[R] \f[B]:help\f[R] - Display help +\f[B]:h\f[R] \f[B]:help\f[R] \- Display help .SH OPTIONS .TP -\f[B]-h\f[R] \f[B]--help\f[R] +\f[B]\-h\f[R] \f[B]\-\-help\f[R] Display help .TP -\f[B]-V\f[R] \f[B]--version\f[R] +\f[B]\-V\f[R] \f[B]\-\-version\f[R] Display version information .TP -\f[B]-I\f[R] \f[B]--include\f[R] +\f[B]\-I\f[R] \f[B]\-\-include\f[R] Directory to search for libraries .SH INFLUENTIAL ENVIRONMENT VARIABLES -.PP -\f[V]DCK_PATH\f[R] - a colon-separated list of directories to search +\f[CR]DCK_PATH\f[R] \- a colon\-separated list of directories to search .SH EDITOR INTEGRATION -.PP A vim plugin is available; see .PP https://github.com/vmchale/dickinson/tree/master/vim .SS CTAGS -.PP -To configure exuberant ctags or universal ctags, put +To configure universal ctags, put .IP -.nf -\f[C] ---langdef=DICKINSON ---langmap=DICKINSON:.dck ---regex-DICKINSON=/:def *([[:lower:]][[:alnum:]]+)/\[rs]1/f,function/ ---regex-DICKINSON=/tydecl *([[:lower:]][[:alnum:]]+) *=/\[rs]1/t,type/ -\f[R] -.fi +.EX +\-\-langdef=DICKINSON +\-\-langmap=DICKINSON:.dck +\-\-regex\-DICKINSON=/:def *([[:lower:]][[:alnum:]]+)/\[rs]1/f,function/ +\-\-regex\-DICKINSON=/tydecl *([[:lower:]][[:alnum:]]+) *=/\[rs]1/t,type/ +\-\-regex\-DICKINSON=/= *([[:upper:]][[:alnum:]_]+)/\[rs]1/t,type/ +\-\-regex\-DICKINSON=/\[ha][\[ha]\[rs][]*\[rs]| *([[:upper:]][[:alnum:]_]+)/\[rs]1/t,type/ +.EE .PP -in the project .ctags +in \[ti]/.ctags.d/dickinson.ctags .SH SHELL COMPLETIONS -.PP To get shell completions in your current session: .IP -.nf -\f[C] -eval \[dq]$(emd --bash-completion-script emd)\[dq] -\f[R] -.fi +.EX +eval \[dq]$(emd \-\-bash\-completion\-script emd)\[dq] +.EE .PP -Put this in your \f[V]\[ti]/.bashrc\f[R] or -\f[V]\[ti]/.bash_profile\f[R] to install them. +Put this in your \f[CR]\[ti]/.bashrc\f[R] or +\f[CR]\[ti]/.bash_profile\f[R] to install them. .PP Shell completions are also available for fish and zsh; to get them: .PP -\f[V]emd --fish-completion-script emd\f[R] +\f[CR]emd \-\-fish\-completion\-script emd\f[R] .PP -\f[V]emd --zsh-completion-script emd\f[R] +\f[CR]emd \-\-zsh\-completion\-script emd\f[R] .SH BUGS -.PP Please report any bugs you may come across to https://github.com/vmchale/dickinson/issues. .SH COPYRIGHT -.PP Copyright 2020. Vanessa McHale. All Rights Reserved. .SH AUTHORS -Vanessa McHale. +Vanessa McHale\c +.MT vamchale@gmail.com +.ME \c. diff --git a/src/Language/Dickinson/Check/Duplicate.hs b/src/Language/Dickinson/Check/Duplicate.hs --- a/src/Language/Dickinson/Check/Duplicate.hs +++ b/src/Language/Dickinson/Check/Duplicate.hs @@ -1,21 +1,21 @@ +{-# LANGUAGE TransformListComp #-} + module Language.Dickinson.Check.Duplicate ( checkDuplicates ) where import Control.Applicative ((<|>)) import Data.Foldable (toList) import Data.Foldable.Ext (foldMapAlternative) -import Data.Function (on) -import Data.List (groupBy, sortBy) import Data.Maybe (mapMaybe) import qualified Data.Text as T +import GHC.Exts (groupWith, sortWith) import Language.Dickinson.Error import Language.Dickinson.Type -- TODO: duplicate check better? hm --- FIXME: HashSet or whatever? checkNames :: [(a, T.Text)] -> Maybe (DickinsonWarning a) -checkNames ns = foldMapAlternative announce (groupBy ((==) `on` snd) $ sortBy (compare `on` snd) ns) +checkNames ns = foldMapAlternative announce [ zip l x | (l, x) <- ns, then sortWith by x, then group by x using groupWith ] where announce (_:(l, y):_) = Just $ DuplicateStr l y announce _ = Nothing diff --git a/src/Language/Dickinson/Eval.hs b/src/Language/Dickinson/Eval.hs --- a/src/Language/Dickinson/Eval.hs +++ b/src/Language/Dickinson/Eval.hs @@ -37,7 +37,7 @@ import Language.Dickinson.Type import Language.Dickinson.TypeCheck import Language.Dickinson.Unique -import Lens.Micro (Lens', over, set, _1) +import Lens.Micro (Lens', _1, over, set) import Lens.Micro.Mtl (modifying, use, (.=)) import Prettyprinter (Doc, Pretty (..), vsep, (<+>)) @@ -217,7 +217,7 @@ tryEvalExpressionM c@Constructor{} = pure c tryEvalExpressionM (Bind _ bs e) = do let ns = fst <$> bs - newBs <- traverse tryEvalExpressionM (snd <$> bs) + newBs <- traverse (tryEvalExpressionM.snd) bs let stMod = thread $ fmap (uncurry nameMod) (NE.zip ns newBs) withSt stMod $ tryEvalExpressionM e @@ -252,7 +252,7 @@ evalExpressionM e evalExpressionM (Bind _ bs e) = do let ns = fst <$> bs - newBs <- traverse evalExpressionM (snd <$> bs) + newBs <- traverse (evalExpressionM.snd) bs let stMod = thread $ fmap (uncurry nameMod) (NE.zip ns newBs) withSt stMod $ evalExpressionM e @@ -343,7 +343,7 @@ resolveFlattenM (Var _ n) = resolveFlattenM =<< lookupName n resolveFlattenM (Choice l pes) = do let ps = fst <$> pes -- TODO: do these need to be renamed - es <- traverse resolveFlattenM (snd <$> pes) + es <- traverse (resolveFlattenM.snd) pes pure $ Choice l (NE.zip ps es) resolveFlattenM (Interp l es) = Interp l <$> traverse resolveFlattenM es resolveFlattenM (MultiInterp l es) = MultiInterp l <$> traverse resolveFlattenM es @@ -351,7 +351,7 @@ resolveFlattenM (Tuple l es) = Tuple l <$> traverse resolveFlattenM es resolveFlattenM (Bind _ bs e) = do let ns = fst <$> bs - newBs <- traverse resolveFlattenM (snd <$> bs) + newBs <- traverse (resolveFlattenM.snd) bs let stMod = thread $ fmap (uncurry nameMod) (NE.zip ns newBs) withSt stMod $ resolveFlattenM e @@ -393,7 +393,7 @@ resolveExpressionM v@(Var _ n) = maybe (pure v) resolveExpressionM =<< tryLookupName n resolveExpressionM (Choice l pes) = do let ps = fst <$> pes - es <- traverse resolveExpressionM (snd <$> pes) + es <- traverse (resolveExpressionM.snd) pes pure $ Choice l (NE.zip ps es) resolveExpressionM (Interp l es) = Interp l <$> traverse resolveExpressionM es resolveExpressionM (MultiInterp l es) = MultiInterp l <$> traverse resolveExpressionM es @@ -401,7 +401,7 @@ resolveExpressionM (Tuple l es) = Tuple l <$> traverse resolveExpressionM es resolveExpressionM (Bind _ bs e) = do let ns = fst <$> bs - newBs <- traverse resolveExpressionM (snd <$> bs) + newBs <- traverse (resolveExpressionM.snd) bs let stMod = thread $ fmap (uncurry nameMod) (NE.zip ns newBs) withSt stMod $ resolveExpressionM e diff --git a/src/Language/Dickinson/Import.hs b/src/Language/Dickinson/Import.hs --- a/src/Language/Dickinson/Import.hs +++ b/src/Language/Dickinson/Import.hs @@ -25,4 +25,4 @@ . fmap ( getFileName n) $ incl getFileName :: Name a -> FilePath -getFileName = (<> ".dck") . foldr () mempty . fmap T.unpack . name +getFileName = (<> ".dck") . foldr (() . T.unpack) mempty . name diff --git a/src/Language/Dickinson/Lexer.x b/src/Language/Dickinson/Lexer.x --- a/src/Language/Dickinson/Lexer.x +++ b/src/Language/Dickinson/Lexer.x @@ -167,7 +167,7 @@ exitInterp :: Alex () exitInterp = do - (_,iSt:_,_,_) <- get_ust + (_,iSt:_,_,_) <- alexGetUserState case iSt of InStr -> set_scd string InMultiStr -> set_scd multiStr @@ -176,10 +176,6 @@ set_scd st = Alex (Right . (go &&& (const ()))) where go s = s { alex_scd = st } -set_ust :: AlexUserState -> Alex () -set_ust st = Alex (Right . (go &&& (const ()))) - where go s = s { alex_ust = st } - mod_ust :: (AlexUserState -> AlexUserState) -> Alex () mod_ust f = Alex (Right . (go &&& (const ()))) where go s = s { alex_ust = f (alex_ust s) } @@ -187,9 +183,6 @@ gets_alex :: (AlexState -> a) -> Alex a gets_alex f = Alex (Right . (id &&& f)) -get_ust :: Alex AlexUserState -get_ust = gets_alex alex_ust - get_pos :: Alex AlexPosn get_pos = gets_alex alex_pos @@ -218,9 +211,9 @@ newIdentAlex :: AlexPosn -> T.Text -> Alex (Name AlexPosn) newIdentAlex pos t = do - st <- get_ust + st <- alexGetUserState let (st', n) = newIdent pos t st - set_ust st' $> (n $> pos) + alexSetUserState st' $> (n $> pos) newIdent :: AlexPosn -> T.Text -> AlexUserState -> (AlexUserState, Name AlexPosn) newIdent pos t pre@(max', scd, names, uniqs) = {-# SCC "newIdent" #-} diff --git a/src/Language/Dickinson/Pattern/Useless.hs b/src/Language/Dickinson/Pattern/Useless.hs --- a/src/Language/Dickinson/Pattern/Useless.hs +++ b/src/Language/Dickinson/Pattern/Useless.hs @@ -148,7 +148,7 @@ case cont of NotComplete -> usefulMaranget env (defaultMatrix ps) qs CompleteTuple n -> usefulMaranget env (specializeTuple n ps) (specializeTupleVector n q qs) - CompleteTags ns -> or $ fmap (\n -> usefulMaranget env (specializeTag n (forget ps)) (fmap void qs)) ns + CompleteTags ns -> any (\n -> usefulMaranget env (specializeTag n (forget ps)) (fmap void qs)) ns specializeTupleVector :: Int -> Pattern a -> [Pattern a] -> [Pattern a] specializeTupleVector n p ps = {-# SCC "specializeTupleVector" #-} replicate n p ++ ps diff --git a/src/Language/Dickinson/Rename.hs b/src/Language/Dickinson/Rename.hs --- a/src/Language/Dickinson/Rename.hs +++ b/src/Language/Dickinson/Rename.hs @@ -4,7 +4,6 @@ {-# LANGUAGE TupleSections #-} module Language.Dickinson.Rename ( renameDickinson - , renameDickinsonM , renameDeclarationsM , renameDeclarationM , renameExpressionM @@ -22,6 +21,7 @@ import Control.Monad.State (MonadState, State, runState) import Data.Bifunctor (second) import Data.Binary (Binary) +import qualified Data.Functor as Fun import qualified Data.IntMap as IM import qualified Data.List.NonEmpty as NE import Data.Text.Prettyprint.Doc.Ext @@ -182,12 +182,7 @@ -> Expression a -> m (Expression a) renameLet constructor p bs e = do - newBs <- traverse withName (fst <$> bs) - let localRenames = snd <$> newBs - newBinds = thread localRenames - newNames = fst <$> newBs - preNewBound = snd <$> bs - newBound <- - traverse renameExpressionM preNewBound - withRenames newBinds $ + (newNames, localRenames) <- Fun.unzip <$> traverse (withName.fst) bs + newBound <- traverse (renameExpressionM.snd) bs + withRenames (thread localRenames) $ constructor p (NE.zip newNames newBound) <$> renameExpressionM e diff --git a/src/Language/Dickinson/TypeCheck.hs b/src/Language/Dickinson/TypeCheck.hs --- a/src/Language/Dickinson/TypeCheck.hs +++ b/src/Language/Dickinson/TypeCheck.hs @@ -128,7 +128,7 @@ forM_ (fst <$> brs) $ \p -> {-# SCC "bindPattern" #-} bindPattern p ty res <- typeOf e' - traverse_ (tyAssert res) (snd <$> brs) + traverse_ (tyAssert res.snd) brs pure res typeOf (Flatten _ e) = typeOf e typeOf (Annot _ e ty) = @@ -148,7 +148,7 @@ -> Expression a -> m (DickinsonTy a) tyLet bs e = do - es' <- traverse typeOf (snd <$> bs) + es' <- traverse (typeOf.snd) bs let ns = fst <$> bs Ext.zipWithM_ tyInsert ns es' typeOf e