release

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

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

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

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'

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

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

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 }

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)