From 7a087840f738f5cdfa15970bf51359dbb917e224 Mon Sep 17 00:00:00 2001 From: Vanessa McHale Date: Sun, 29 Jul 2018 23:46:46 -0500 Subject: [PATCH] release --- ats-pkg/ats-pkg.cabal | 2 +- ats-pkg/internal/Quaalude.cpphs | 12 ++++++++- ats-pkg/src/Language/ATS/Package/Build.hs | 26 ++++++++----------- .../src/Language/ATS/Package/Dependency.hs | 9 ++++--- .../src/Language/ATS/Package/PackageSet.hs | 6 +++-- language-ats/TODO.md | 2 ++ language-ats/src/Language/ATS/Parser.y | 1 + language-ats/src/Language/ATS/PrettyPrint.hs | 4 --- 8 files changed, 35 insertions(+), 27 deletions(-) diff --git a/ats-pkg/ats-pkg.cabal b/ats-pkg/ats-pkg.cabal index ac98d990..01999b0c 100644 --- a/ats-pkg/ats-pkg.cabal +++ b/ats-pkg/ats-pkg.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: ats-pkg -version: 3.1.0.4 +version: 3.1.0.5 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale diff --git a/ats-pkg/internal/Quaalude.cpphs b/ats-pkg/internal/Quaalude.cpphs index f7045bb1..d3e1d7b3 100644 --- a/ats-pkg/internal/Quaalude.cpphs +++ b/ats-pkg/internal/Quaalude.cpphs @@ -36,6 +36,7 @@ module Quaalude ( hex , MonadIO (..) -- * Miscellaneous , makeExe + , shouldWrite -- * "System.Process.Ext" reëxports , silentCreateProcess -- * "Data.Text.Lazy" reëxports @@ -135,6 +136,7 @@ import Control.Monad.State.Lazy import Data.Binary import Data.Bool (bool) import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BSL import Data.Foldable (fold, traverse_) import Data.Functor (($>)) import Data.List @@ -144,7 +146,7 @@ import Data.Version (showVersion) #ifdef DEBUG import Debug.Trace (traceShow, traceShowId) #endif -import Development.Shake hiding (getEnv) +import Development.Shake hiding (doesFileExist, getEnv) import Development.Shake.FilePath import Dhall hiding (Text, bool) import Lens.Micro hiding (both) @@ -199,3 +201,11 @@ instance (Semigroup a, Monoid a) => Monoid (Action a) where -- prelude. (<#>) :: Doc -> Doc -> Doc (<#>) a b = a <> line <> b + +shouldWrite :: (MonadIO m, Binary a) => a -> FilePath -> m Bool +shouldWrite x fp = do + exists <- liftIO (doesFileExist fp) + contents <- if exists + then liftIO (BSL.readFile fp) + else pure mempty + pure $ BSL.length contents /= 0 && encode x /= contents diff --git a/ats-pkg/src/Language/ATS/Package/Build.hs b/ats-pkg/src/Language/ATS/Package/Build.hs index 722231b9..b9c50160 100644 --- a/ats-pkg/src/Language/ATS/Package/Build.hs +++ b/ats-pkg/src/Language/ATS/Package/Build.hs @@ -114,16 +114,20 @@ mkManpage mStr = do Just _ -> bool (pure ()) manpages b _ -> pure () +-- cfgFile :: FilePath +-- cfgFile = ".atspkg" "config" + -- FIXME this doesn't rebuild when it should; it should rebuild when -- @atspkg.dhall@ changes. getConfig :: MonadIO m => Maybe String -> Maybe FilePath -> m Pkg getConfig mStr dir' = liftIO $ do d <- fromMaybe <$> fmap ( "atspkg.dhall") getCurrentDirectory <*> pure dir' - b <- not <$> doesFileExist ".atspkg/config" - let str = fromMaybe mempty mStr - if b - then input auto (T.pack (d <> " " <> str)) - else fmap (decode . BSL.fromStrict) . BS.readFile $ ".atspkg/config" + b <- not <$> doesFileExist (".atspkg" "config") + let strMod = maybe id (\s -> (<> (" " <> s))) mStr + b' <- shouldWrite mStr (".atspkg" "args") + if b || b' + then input auto (T.pack (strMod d)) + else fmap (decode . BSL.fromStrict) . BS.readFile $ ".atspkg" "config" manTarget :: Text -> FilePath manTarget m = unpack m -<.> "1" @@ -199,14 +203,6 @@ mkPkg mStr rba lint tim setup rs tgt v = do , pkgToAction mStr setup rs tgt cfg ] -shouldWrite :: (MonadIO m, Binary a) => a -> FilePath -> m Bool -shouldWrite x fp = do - exists <- liftIO (doesFileExist fp) - contents <- if exists - then liftIO (BSL.readFile fp) - else pure mempty - pure $ BSL.length contents /= 0 && encode x /= contents - mkConfig :: Maybe String -> Rules () mkConfig mStr = do @@ -311,9 +307,9 @@ pkgToAction mStr setup rs tgt ~(Pkg bs ts lbs mt _ v v' ds cds bdeps ccLocal cf -- TODO depend on tgt somehow? specialDeps %> \out -> do (_, cfgBin') <- cfgBin - need [ cfgBin', flags, ".atspkg" "config" ] + need [ cfgBin', flags, ".atspkg" "config"] v'' <- getVerbosity - liftIO $ fetchDeps v'' (ccFromString cc') setup (first unpack <$> ds) (first unpack <$> cdps) (first unpack <$> bdeps) cfgBin' atslibSetup False *> writeFile out "" + liftIO $ fetchDeps v'' (ccFromString cc') mStr setup (first unpack <$> ds) (first unpack <$> cdps) (first unpack <$> bdeps) cfgBin' atslibSetup False *> writeFile out "" let bins = toTgt tgt . target <$> bs setTargets rs bins mt diff --git a/ats-pkg/src/Language/ATS/Package/Dependency.hs b/ats-pkg/src/Language/ATS/Package/Dependency.hs index 951b79c9..10aa4964 100644 --- a/ats-pkg/src/Language/ATS/Package/Dependency.hs +++ b/ats-pkg/src/Language/ATS/Package/Dependency.hs @@ -31,6 +31,7 @@ getTgt _ = Nothing fetchDeps :: Verbosity -- ^ Shake verbosity -> CCompiler -- ^ C compiler to use + -> Maybe String -- ^ Args -> [IO ()] -- ^ Setup steps that can be performed concurrently -> [(String, ATSConstraint)] -- ^ ATS dependencies -> [(String, ATSConstraint)] -- ^ C Dependencies @@ -39,16 +40,16 @@ fetchDeps :: Verbosity -- ^ Shake verbosity -> SetupScript -- ^ How to install an ATS library -> Bool -- ^ Whether to perform setup anyhow. -> IO () -fetchDeps v cc' setup' deps cdeps atsBld cfgPath als b' = +fetchDeps v cc' mStr setup' deps cdeps atsBld cfgPath als b' = unless (null deps && null cdeps && null atsBld && b' && False) $ do putStrLn "Resolving dependencies..." pkgSet <- unpack . defaultPkgs . decode <$> BSL.readFile cfgPath - deps' <- setBuildPlan "ats" libDeps pkgSet deps - atsDeps' <- setBuildPlan "atsbld" libBldDeps pkgSet atsBld - cdeps' <- setBuildPlan "c" libDeps pkgSet cdeps + deps' <- setBuildPlan "ats" libDeps mStr pkgSet deps + atsDeps' <- setBuildPlan "atsbld" libBldDeps mStr pkgSet atsBld + cdeps' <- setBuildPlan "c" libDeps mStr pkgSet cdeps -- Set up actions d <- ( "lib/") <$> cpkgHome cc' diff --git a/ats-pkg/src/Language/ATS/Package/PackageSet.hs b/ats-pkg/src/Language/ATS/Package/PackageSet.hs index 171ab0f1..ef54b057 100644 --- a/ats-pkg/src/Language/ATS/Package/PackageSet.hs +++ b/ats-pkg/src/Language/ATS/Package/PackageSet.hs @@ -51,12 +51,14 @@ listDeps b = fmap s . input auto . T.pack setBuildPlan :: FilePath -- ^ Filepath for cache inside @.atspkg@ -> DepSelector + -> Maybe String -- ^ Arguments -> String -- ^ URL of package set to use. -> [(String, ATSConstraint)] -- ^ Libraries we want -> IO [[ATSDependency]] -setBuildPlan p getDeps url deps = do +setBuildPlan p getDeps mStr url deps = do b <- doesFileExist depCache - bool setBuildPlan' (decode <$> BSL.readFile depCache) b + b' <- shouldWrite mStr (".atspkg" "args") + bool setBuildPlan' (decode <$> BSL.readFile depCache) (b && b') where depCache = ".atspkg/buildplan-" ++ p setBuildPlan' = do diff --git a/language-ats/TODO.md b/language-ats/TODO.md index 495df34a..31ce0007 100644 --- a/language-ats/TODO.md +++ b/language-ats/TODO.md @@ -13,6 +13,8 @@ - [ ] `stadef x: bool = z` - [ ] `language-xats` library: https://github.com/githwxi/ATS-Xanadu/tree/master/srcgen/xats/SATS - [ ] Fix problem with macro blocks being indented wrong +- [ ] handle `absprop someprop` and `absprop some_prop(prop, prop+)` +- [ ] fix for https://github.com/ats-lang/ats-lang.github.io/blob/master/DOCUMENT/INT2PROGINATS/CODE/CHAP_THMPRVING/sqrt2_irrat.dats # Deficiencies - [ ] Error messages - [ ] Add test suite for messages diff --git a/language-ats/src/Language/ATS/Parser.y b/language-ats/src/Language/ATS/Parser.y index 9b97cf96..41b0fbf8 100644 --- a/language-ats/src/Language/ATS/Parser.y +++ b/language-ats/src/Language/ATS/Parser.y @@ -454,6 +454,7 @@ StaticExpression : Name { StaticVal $1 } | StaticExpression semicolon StaticExpression { SPrecede $1 $3 } | UnOp StaticExpression { SUnary $1 $2 } | identifierSpace doubleParens { SCall (Unqualified $ to_string $1) [] } + | identifier doubleParens { SCall (Unqualified $ to_string $1) [] } | let StaticDecls comment_after(in) end { SLet $1 $2 Nothing } | let StaticDecls in StaticExpression end { SLet $1 $2 (Just $4) } | openParen StaticExpression closeParen { $2 } diff --git a/language-ats/src/Language/ATS/PrettyPrint.hs b/language-ats/src/Language/ATS/PrettyPrint.hs index 2d451896..2e0b9999 100644 --- a/language-ats/src/Language/ATS/PrettyPrint.hs +++ b/language-ats/src/Language/ATS/PrettyPrint.hs @@ -534,10 +534,6 @@ instance Eq a => Pretty (PreFunction a) where pretty (PreF i si pus [] as rt t Nothing) = fancyU pus pretty i <> prettyMTermetric t prettyArgsNil as <> prettySigNull si rt pretty (PreF i si pus us as rt t Nothing) = fancyU pus pretty i <> prettyMTermetric t fancyU us prettyArgsNil as <> prettySigNull si rt -instance Eq a => Pretty (DataPropLeaf a) where - pretty (DataPropLeaf us e Nothing) = "|" <+> foldMap pretty (reverse us) <+> pretty e - pretty (DataPropLeaf us e (Just e')) = "|" <+> foldMap pretty (reverse us) <+> pretty e <+> "of" <+> pretty e' - prettyFix :: (Pretty a) => Either a String -> Doc prettyFix (Left i) = pretty i prettyFix (Right s) = parens (text s)