futhark 0.21.9 → 0.21.10

raw patch · 26 files changed

+356/−128 lines, 26 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• docs/man/futhark.rst +7/−0
• futhark.cabal +1/−1
• prelude/math.fut +33/−5
• rts/c/scalar.h +36/−0
• rts/c/scalar_f16.h +36/−0
• rts/python/scalar.py +27/−0
• src/Futhark/Builder.hs +19/−0
• src/Futhark/CLI/Autotune.hs +12/−1
• src/Futhark/CLI/Bench.hs +3/−11
• src/Futhark/CLI/Doc.hs +1/−1
• src/Futhark/Construct.hs +2/−1
• src/Futhark/Doc/Generator.hs +11/−8
• src/Futhark/IR/Primitive.hs +20/−1
• src/Futhark/IR/TypeCheck.hs +15/−27
• src/Futhark/LSP/Handlers.hs +1/−7
• src/Futhark/LSP/Tool.hs +16/−26
• src/Futhark/Optimise/InPlaceLowering/SubstituteIndices.hs +3/−0
• src/Futhark/Optimise/Simplify/Rep.hs +30/−10
• src/Futhark/Pass/ExtractKernels/DistributeNests.hs +2/−2
• src/Futhark/Pass/ExtractKernels/Interchange.hs +19/−16
• src/Futhark/Util.hs +42/−0
• src/Language/Futhark/Parser/Lexer.x +1/−1
• src/Language/Futhark/Parser/Lexer/Wrapper.hs +4/−5
• src/Language/Futhark/Parser/Monad.hs +6/−0
• src/Language/Futhark/Parser/Parser.y +8/−4
• src/Language/Futhark/Query.hs +1/−1

@@ -77,6 +77,13 @@  Print all non-builtin imported Futhark files to stdout, one per line. +futhark lsp+-----------++Run an LSP (Language Server Protocol) server for Futhark that+communicates on standard input.  There is no reason to run this by+hand.  It is used by LSP clients to provide editor features.+ futhark query PROGRAM LINE COL ------------------------------ 

@@ -1,6 +1,6 @@ cabal-version: 2.4 name:           futhark-version:        0.21.9+version:        0.21.10 synopsis:       An optimising compiler for a functional, array-oriented language.  description:    Futhark is a small programming language designed to be compiled to

@@ -135,7 +135,10 @@   val to_i64: t -> i64   val to_f64: t -> f64 +  -- | Square root.   val sqrt: t -> t+  -- | Cube root.+  val cbrt: t -> t   val exp: t -> t    val sin: t -> t@@ -156,10 +159,24 @@    val atan2: t -> t -> t +  -- | Compute the length of the hypotenuse of a right-angled+  -- triangle.  That is, `hypot x y` computes *√(x²+y²)*.  Put another+  -- way, the distance of *(x,y)* from origin in an Euclidean space.+  -- The calculation is performed without undue overflow or underflow+  -- during intermediate steps (specific accuracy depends on the+  -- backend).   val hypot: t -> t -> t +  -- | The true Gamma function.   val gamma: t -> t+  -- | The natural logarithm of the absolute value of `gamma`@term.   val lgamma: t -> t++  -- | The error function.+  val erf : t -> t+  -- | The complementary error function.+  val erfc : t -> t+   -- | Linear interpolation.  The third argument must be in the range   -- `[0,1]` or the results are unspecified.   val lerp: t -> t -> t -> t@@ -171,9 +188,16 @@   -- | Base-10 logarithm.   val log10: t -> t +  -- | Round towards infinity.   val ceil : t -> t+  -- | Round towards negative infinity.   val floor : t -> t+  -- | Round towards zero.   val trunc : t -> t+  -- | Round to the nearest integer, with halfway cases rounded to the+  -- nearest even integer.  Note that this differs from `round()` in+  -- C, but matches more modern languages.+  val round : t -> t    -- | Computes `a*b+c`.  Depending on the compiler backend, this may   -- be fused into a single operation that is faster but less@@ -185,11 +209,6 @@   -- occur. Edge case behavior is per the IEEE 754-2008 standard.   val fma : (a: t) -> (b: t) -> (c: t) -> t -  -- | Round to the nearest integer, with alfway cases rounded to the-  -- nearest even integer.  Note that this differs from `round()` in-  -- C, but matches more modern languages.-  val round : t -> t-   val isinf: t -> bool   val isnan: t -> bool @@ -899,6 +918,7 @@   def abs (x: f64) = intrinsics.fabs64 x    def sqrt (x: f64) = intrinsics.sqrt64 x+  def cbrt (x: f64) = intrinsics.cbrt64 x    def log (x: f64) = intrinsics.log64 x   def log2 (x: f64) = intrinsics.log2_64 x@@ -920,6 +940,8 @@   def hypot (x: f64) (y: f64) = intrinsics.hypot64 (x, y)   def gamma = intrinsics.gamma64   def lgamma = intrinsics.lgamma64+  def erf = intrinsics.erf64+  def erfc = intrinsics.erfc64    def lerp v0 v1 t = intrinsics.lerp64 (v0,v1,t)   def fma a b c = intrinsics.fma64 (a,b,c)@@ -1008,6 +1030,7 @@   def abs (x: f32) = intrinsics.fabs32 x    def sqrt (x: f32) = intrinsics.sqrt32 x+  def cbrt (x: f32) = intrinsics.cbrt32 x    def log (x: f32) = intrinsics.log32 x   def log2 (x: f32) = intrinsics.log2_32 x@@ -1029,6 +1052,8 @@   def hypot (x: f32) (y: f32) = intrinsics.hypot32 (x, y)   def gamma = intrinsics.gamma32   def lgamma = intrinsics.lgamma32+  def erf = intrinsics.erf32+  def erfc = intrinsics.erfc32    def lerp v0 v1 t = intrinsics.lerp32 (v0,v1,t)   def fma a b c = intrinsics.fma32 (a,b,c)@@ -1121,6 +1146,7 @@   def abs (x: f16) = intrinsics.fabs16 x    def sqrt (x: f16) = intrinsics.sqrt16 x+  def cbrt (x: f16) = intrinsics.cbrt16 x    def log (x: f16) = intrinsics.log16 x   def log2 (x: f16) = intrinsics.log2_16 x@@ -1142,6 +1168,8 @@   def hypot (x: f16) (y: f16) = intrinsics.hypot16 (x, y)   def gamma = intrinsics.gamma16   def lgamma = intrinsics.lgamma16+  def erf = intrinsics.erf16+  def erfc = intrinsics.erfc16    def lerp v0 v1 t = intrinsics.lerp16 (v0,v1,t)   def fma a b c = intrinsics.fma16 (a,b,c)

@@ -1180,6 +1180,10 @@   return sqrt(x); } +static inline float futrts_cbrt32(float x) {+  return cbrt(x);+}+ static inline float futrts_exp32(float x) {   return exp(x); }@@ -1248,6 +1252,14 @@   return lgamma(x); } +static inline float futrts_erf32(float x) {+  return erf(x);+}++static inline float futrts_erfc32(float x) {+  return erfc(x);+}+ static inline float fmod32(float x, float y) {   return fmod(x, y); }@@ -1294,6 +1306,10 @@   return sqrtf(x); } +static inline float futrts_cbrt32(float x) {+  return cbrtf(x);+}+ static inline float futrts_exp32(float x) {   return expf(x); }@@ -1362,6 +1378,14 @@   return lgammaf(x); } +static inline float futrts_erf32(float x) {+  return erff(x);+}++static inline float futrts_erfc32(float x) {+  return erfcf(x);+}+ static inline float fmod32(float x, float y) {   return fmodf(x, y); }@@ -1505,6 +1529,10 @@   return sqrt(x); } +static inline double futrts_cbrt64(double x) {+  return cbrt(x);+}+ static inline double futrts_exp64(double x) {   return exp(x); }@@ -1571,6 +1599,14 @@  static inline double futrts_lgamma64(double x) {   return lgamma(x);+}++static inline double futrts_erf64(double x) {+  return erf(x);+}++static inline double futrts_erfc64(double x) {+  return erfc(x); }  static inline double futrts_fma64(double a, double b, double c) {

@@ -191,6 +191,10 @@   return sqrt(x); } +static inline f16 futrts_cbrt16(f16 x) {+  return cbrt(x);+}+ static inline f16 futrts_exp16(f16 x) {   return exp(x); }@@ -259,6 +263,14 @@   return lgamma(x); } +static inline f16 futrts_erf16(f16 x) {+  return erf(x);+}++static inline f16 futrts_erfc16(f16 x) {+  return erfc(x);+}+ static inline f16 fmod16(f16 x, f16 y) {   return fmod(x, y); }@@ -305,6 +317,10 @@   return hsqrt(x); } +static inline f16 futrts_cbrt16(f16 x) {+  return cbrtf(x);+}+ static inline f16 futrts_exp16(f16 x) {   return hexp(x); }@@ -373,6 +389,14 @@   return lgammaf(x); } +static inline f16 futrts_erf16(f16 x) {+  return erff(x);+}++static inline f16 futrts_erfc16(f16 x) {+  return erfcf(x);+}+ static inline f16 fmod16(f16 x, f16 y) {   return fmodf(x, y); }@@ -476,6 +500,10 @@   return futrts_sqrt32(x); } +static inline f16 futrts_cbrt16(f16 x) {+  return futrts_cbrt32(x);+}+ static inline f16 futrts_exp16(f16 x) {   return futrts_exp32(x); }@@ -542,6 +570,14 @@  static inline f16 futrts_lgamma16(f16 x) {   return futrts_lgamma32(x);+}++static inline f16 futrts_erf16(f16 x) {+  return futrts_erf32(x);+}++static inline f16 futrts_erfc16(f16 x) {+  return futrts_erfc32(x); }  static inline f16 fmod16(f16 x, f16 y) {

@@ -439,6 +439,9 @@ def futhark_sqrt64(x):   return np.sqrt(x) +def futhark_cbrt64(x):+  return np.cbrt(x)+ def futhark_exp64(x):   return np.exp(x) @@ -490,6 +493,12 @@ def futhark_lgamma64(x):   return np.float64(math.lgamma(x)) +def futhark_erf64(x):+  return np.float64(math.erf(x))++def futhark_erfc64(x):+  return np.float64(math.erfc(x))+ def futhark_round64(x):   return np.round(x) @@ -525,6 +534,9 @@ def futhark_sqrt32(x):   return np.float32(np.sqrt(x)) +def futhark_cbrt32(x):+  return np.float32(np.cbrt(x))+ def futhark_exp32(x):   return np.exp(x) @@ -576,6 +588,12 @@ def futhark_lgamma32(x):   return np.float32(math.lgamma(x)) +def futhark_erf32(x):+  return np.float32(math.erf(x))++def futhark_erfc32(x):+  return np.float32(math.erfc(x))+ def futhark_round32(x):   return np.round(x) @@ -611,6 +629,9 @@ def futhark_sqrt16(x):   return np.float16(np.sqrt(x)) +def futhark_cbrt16(x):+  return np.float16(np.cbrt(x))+ def futhark_exp16(x):   return np.exp(x) @@ -661,6 +682,12 @@  def futhark_lgamma16(x):   return np.float16(math.lgamma(x))++def futhark_erf16(x):+  return np.float16(math.erf(x))++def futhark_erfc16(x):+  return np.float16(math.erfc(x))  def futhark_round16(x):   return np.round(x)

@@ -25,6 +25,7 @@     runBuilder,     runBuilder_,     runBodyBuilder,+    runLambdaBuilder,      -- * The 'MonadBuilder' typeclass     module Futhark.Builder.Class,@@ -204,6 +205,24 @@   Builder rep (Body rep) ->   m (Body rep) runBodyBuilder = fmap (uncurry $ flip insertStms) . runBuilder++-- | Given lambda parameters, Run a builder action that produces the+-- statements and returns the 'Result' of the lambda body.+runLambdaBuilder ::+  ( Buildable rep,+    MonadFreshNames m,+    HasScope somerep m,+    SameScope somerep rep+  ) =>+  [LParam rep] ->+  Builder rep Result ->+  m (Lambda rep)+runLambdaBuilder params m = do+  ((res, ret), stms) <- runBuilder . localScope (scopeOfLParams params) $ do+    res <- m+    ret <- mapM subExpResType res+    pure (res, ret)+  pure $ Lambda params (mkBody stms res) ret  -- Utility instance defintions for MTL classes.  These require -- UndecidableInstances, but save on typing elsewhere.

@@ -41,7 +41,18 @@  initialAutotuneOptions :: AutotuneOptions initialAutotuneOptions =-  AutotuneOptions "opencl" Nothing 10 (Just "tuning") [] 0 60 False thresholdMax Nothing+  AutotuneOptions+    { optBackend = "opencl",+      optFuthark = Nothing,+      optMinRuns = 10,+      optTuning = Just "tuning",+      optExtraOptions = [],+      optVerbose = 0,+      optTimeout = 600,+      optSkipCompilation = False,+      optDefaultThreshold = thresholdMax,+      optTestSpec = Nothing+    }  compileOptions :: AutotuneOptions -> IO CompileOptions compileOptions opts = do

@@ -23,7 +23,7 @@ import Futhark.Bench import Futhark.Server import Futhark.Test-import Futhark.Util (atMostChars, fancyTerminal, maxinum, maybeNth, pmapIO)+import Futhark.Util (atMostChars, fancyTerminal, maybeNth, pmapIO) import Futhark.Util.Console import Futhark.Util.Options import Statistics.Resampling (Estimator (..), resample)@@ -355,18 +355,10 @@     toDouble = fromRational . toRational  reportResult :: [RunResult] -> (Double, Double) -> IO ()-reportResult results bootstrapCI = do+reportResult results (ci_lower, ci_upper) = do   let runtimes = map (fromIntegral . runMicroseconds) results       avg = sum runtimes / fromIntegral (length runtimes) :: Double-  putStrLn $-    uncurry-      ( printf-          "%10.0fμs (95%%-CI: [%10.1f, %10.1f]; min: %3.0f%%; max: %+3.0f%%)"-          avg-      )-      bootstrapCI-      ((minimum runtimes / avg - 1) * 100)-      ((maxinum runtimes / avg - 1) * 100)+  putStrLn $ printf "%10.0fμs (95%% CI: [%10.1f, %10.1f])" avg ci_lower ci_upper  runBenchmarkCase ::   Server ->

@@ -68,7 +68,7 @@   mapM_ (write . fmap renderHtml) file_htmls   write ("style.css", cssFile)   where-    write :: (String, T.Text) -> IO ()+    write :: (FilePath, T.Text) -> IO ()     write (name, content) = do       let file = dir </> makeRelative "/" name       when (docVerbose cfg) $

@@ -486,7 +486,8 @@         lambdaBody = body       } --- | Easily construct a t'Lambda' within a 'MonadBuilder'.+-- | Easily construct a t'Lambda' within a 'MonadBuilder'.  See also+-- 'runLambdaBuilder'. mkLambda ::   MonadBuilder m =>   [LParam (Rep m)] ->

@@ -76,7 +76,7 @@     ctxVisibleMTys :: S.Set VName   } -type FileMap = M.Map VName (String, Namespace)+type FileMap = M.Map VName (FilePath, Namespace)  type DocM = ReaderT Context (WriterT Documented (Writer Warnings)) @@ -119,7 +119,8 @@       mconcat (map (vname Type) (M.keys abs))         <> forEnv file_env       where-        vname ns v = M.singleton (qualLeaf v) (file, ns)+        file' = makeRelative "/" file+        vname ns v = M.singleton (qualLeaf v) (file', ns)         vname' ((ns, _), v) = vname ns v          forEnv env =@@ -175,7 +176,7 @@       ++ map (importHtml *** fst) import_pages   where     file_map = vnameToFileMap imports-    importHtml import_name = "doc" </> import_name <.> "html"+    importHtml import_name = "doc" </> makeRelative "/" import_name <.> "html"  -- | The header documentation (which need not be present) can contain -- an abstract and further sections.@@ -228,7 +229,7 @@  importLink :: FilePath -> String -> Html importLink current name =-  let file = relativise (makeRelative "/" $ "doc" </> name -<.> "html") current+  let file = relativise ("doc" </> makeRelative "/" name -<.> "html") current    in (H.a ! A.href (fromString file) $ fromString name)  indexPage :: [FilePath] -> Imports -> Documented -> FileMap -> Html@@ -288,8 +289,9 @@       H.li $ H.a ! A.href (fromString $ '#' : initial) $ fromString initial      linkTo (name, (file, what)) =-      let link =-            (H.a ! A.href (fromString (makeRelative "/" $ "doc" </> vnameLink' name "" file))) $+      let file' = makeRelative "/" file+          link =+            (H.a ! A.href (fromString (makeRelative "/" $ "doc" </> vnameLink' name "" file'))) $               fromString $ baseString name           what' = case what of             IndexValue -> "value"@@ -297,7 +299,7 @@             IndexType -> "type"             IndexModuleType -> "module type"             IndexModule -> "module"-          html_file = makeRelative "/" $ "doc" </> file -<.> "html"+          html_file = "doc" </> file' -<.> "html"        in H.tr $             (H.td ! A.class_ "doc_index_name" $ link)               <> (H.td ! A.class_ "doc_index_namespace" $ what')@@ -661,12 +663,13 @@         then pure Nothing         else Just <$> vnameLink vname -vnameLink' :: VName -> String -> String -> String vnameLink :: VName -> DocM String vnameLink vname = do   current <- asks ctxCurrent   file <- asks $ maybe current fst . M.lookup vname . ctxFileMap   pure $ vnameLink' vname current file++vnameLink' :: VName -> String -> String -> String vnameLink' (VName _ tag) current file =   if file == current     then "#" ++ show tag

@@ -130,9 +130,15 @@ import Data.Word import Foreign.C.Types (CUShort (..)) import Futhark.Util-  ( ceilDouble,+  ( cbrt,+    cbrtf,+    ceilDouble,     ceilFloat,     convFloat,+    erf,+    erfc,+    erfcf,+    erff,     floorDouble,     floorFloat,     hypot,@@ -1182,6 +1188,10 @@       f32 "sqrt32" sqrt,       f64 "sqrt64" sqrt,       --+      f16 "cbrt16" $ convFloat . cbrtf . convFloat,+      f32 "cbrt32" cbrtf,+      f64 "cbrt64" cbrt,+      --       f16 "log16" log,       f32 "log32" log,       f64 "log64" log,@@ -1265,6 +1275,15 @@       f16 "lgamma16" $ convFloat . lgammaf . convFloat,       f32 "lgamma32" lgammaf,       f64 "lgamma64" lgamma,+      --+      --+      f16 "erf16" $ convFloat . erff . convFloat,+      f32 "erf32" erff,+      f64 "erf64" erf,+      --+      f16 "erfc16" $ convFloat . erfcf . convFloat,+      f32 "erfc32" erfcf,+      f64 "erfc64" erfc,       --       i8 "clz8" $ IntValue . Int32Value . fromIntegral . countLeadingZeros,       i16 "clz16" $ IntValue . Int32Value . fromIntegral . countLeadingZeros,

@@ -533,11 +533,11 @@ checkArrIdent ::   Checkable rep =>   VName ->-  TypeM rep Type+  TypeM rep (Shape, PrimType) checkArrIdent v = do   t <- lookupType v   case t of-    Array {} -> pure t+    Array pt shape _ -> pure (shape, pt)     _ -> bad $ NotAnArray v t  checkAccIdent ::@@ -836,16 +836,16 @@     bad $ SlicingError (arrayRank vt) (length idxes)   mapM_ checkDimIndex idxes checkBasicOp (Update _ src (Slice idxes) se) = do-  src_t <- checkArrIdent src-  when (arrayRank src_t /= length idxes) $-    bad $ SlicingError (arrayRank src_t) (length idxes)+  (src_shape, src_pt) <- checkArrIdent src+  when (shapeRank src_shape /= length idxes) $+    bad $ SlicingError (shapeRank src_shape) (length idxes)    se_aliases <- subExpAliasesM se   when (src `nameIn` se_aliases) $     bad $ TypeError "The target of an Update must not alias the value to be written."    mapM_ checkDimIndex idxes-  require [arrayOf (Prim (elemType src_t)) (Shape (sliceDims (Slice idxes))) NoUniqueness] se+  require [arrayOf (Prim src_pt) (Shape (sliceDims (Slice idxes))) NoUniqueness] se   consume =<< lookupAliases src checkBasicOp (FlatIndex ident slice) = do   vt <- lookupType ident@@ -854,16 +854,16 @@     bad $ SlicingError (arrayRank vt) 1   checkFlatSlice slice checkBasicOp (FlatUpdate src slice v) = do-  src_t <- checkArrIdent src-  when (arrayRank src_t /= 1) $-    bad $ SlicingError (arrayRank src_t) 1+  (src_shape, src_pt) <- checkArrIdent src+  when (shapeRank src_shape /= 1) $+    bad $ SlicingError (shapeRank src_shape) 1    v_aliases <- lookupAliases v   when (src `nameIn` v_aliases) $     bad $ TypeError "The target of an Update must not alias the value to be written."    checkFlatSlice slice-  requireI [arrayOf (Prim (elemType src_t)) (Shape (flatSliceDims slice)) NoUniqueness] v+  requireI [arrayOf (Prim src_pt) (Shape (flatSliceDims slice)) NoUniqueness] v   consume =<< lookupAliases src checkBasicOp (Iota e x s et) = do   require [Prim int64] e@@ -875,7 +875,7 @@ checkBasicOp (Scratch _ shape) =   mapM_ checkSubExp shape checkBasicOp (Reshape newshape arrexp) = do-  rank <- arrayRank <$> checkArrIdent arrexp+  rank <- shapeRank . fst <$> checkArrIdent arrexp   mapM_ (require [Prim int64] . newDim) newshape   zipWithM_ (checkDimChange rank) newshape [0 ..]   where@@ -910,22 +910,10 @@           ++ show rank           ++ "-dimensional array." checkBasicOp (Concat i (arr1exp :| arr2exps) ressize) = do-  arr1t <- checkArrIdent arr1exp-  arr2ts <- mapM checkArrIdent arr2exps-  let success =-        all-          ( (== dropAt i 1 (arrayDims arr1t))-              . dropAt i 1-              . arrayDims-          )-          arr2ts-  unless success $-    bad $-      TypeError $-        "Types of arguments to concat do not match.  Got "-          ++ pretty arr1t-          ++ " and "-          ++ intercalate ", " (map pretty arr2ts)+  arr1_dims <- shapeDims . fst <$> checkArrIdent arr1exp+  arr2s_dims <- map (shapeDims . fst) <$> mapM checkArrIdent arr2exps+  unless (all ((== dropAt i 1 arr1_dims) . dropAt i 1) arr2s_dims) $+    bad $ TypeError "Types of arguments to concat do not match."   require [Prim int64] ressize checkBasicOp (Copy e) =   void $ checkArrIdent e

@@ -40,15 +40,9 @@   debug "Got hover request"   let RequestMessage _ _ _ (HoverParams doc pos _workDone) = req       Position l c = pos-      range = Range pos pos       file_path = uriToFilePath $ doc ^. uri   state <- tryTakeStateFromMVar state_mvar file_path-  case getHoverInfoFromState state file_path (fromEnum l + 1) (fromEnum c + 1) of-    Just msg -> do-      let ms = HoverContents $ MarkupContent MkMarkdown msg-          rsp = Hover ms (Just range)-      responder (Right $ Just rsp)-    Nothing -> responder (Right Nothing)+  responder $ Right $ getHoverInfoFromState state file_path (fromEnum l + 1) (fromEnum c + 1)  onDocumentFocusHandler :: MVar State -> Handlers (LspM ()) onDocumentFocusHandler state_mvar = notificationHandler (SCustomMethod "custom/onFocusTextDocument") $ \msg -> do

@@ -11,42 +11,32 @@   ) where -import qualified Data.Text as T import Futhark.Compiler.Program (lpImports) import Futhark.LSP.State (State (..))-import Futhark.Util.Loc (Loc (Loc, NoLoc), Pos (Pos), SrcLoc, locOf, srclocOf)+import Futhark.Util.Loc (Loc (Loc, NoLoc), Pos (Pos), SrcLoc, locOf) import Futhark.Util.Pretty (prettyText)-import Language.Futhark.Core (locStr) import Language.Futhark.Prop (isBuiltinLoc) import Language.Futhark.Query   ( AtPos (AtName),-    BoundTo (BoundTerm),+    BoundTo (..),     atPos,     boundLoc,   ) import Language.LSP.Types-  ( Location (..),-    Position (..),-    Range (..),-    Uri,-    filePathToUri,-  )  -- | Retrieve hover info for the definition referenced at the given -- file at the given line and column number (the two 'Int's).-getHoverInfoFromState :: State -> Maybe FilePath -> Int -> Int -> Maybe T.Text+getHoverInfoFromState :: State -> Maybe FilePath -> Int -> Int -> Maybe Hover getHoverInfoFromState state (Just path) l c = do-  AtName qn (Just def) _loc <- queryAtPos state $ Pos path l c 0-  case def of-    BoundTerm t defloc -> do-      Just $-        (prettyText qn <> " : " <> prettyText t)-          <> if isBuiltinLoc defloc-            then mempty-            else "\n\n**Definition: " <> T.pack (locStr (srclocOf defloc)) <> "**"-    bound-      | isBuiltinLoc (boundLoc bound) -> Just "Builtin definition."-      | otherwise -> Just $ "Definition: " <> T.pack (locStr (boundLoc bound))+  AtName _ (Just def) loc <- queryAtPos state $ Pos path l c 0+  let msg =+        case def of+          BoundTerm t _ -> prettyText t+          BoundModule {} -> "module"+          BoundModuleType {} -> "module type"+          BoundType {} -> "type"+      ms = HoverContents $ MarkupContent MkPlainText msg+  Just $ Hover ms (Just (rangeFromLoc loc)) getHoverInfoFromState _ _ _ _ = Nothing  -- | Find the location of the definition referenced at the given file@@ -76,12 +66,12 @@ -- Futhark's parser has a slightly different notion of locations than -- LSP; so we tweak the positions here. getStartPos :: Pos -> Position-getStartPos (Pos _ line col _) =-  Position (toEnum line - 1) (toEnum col - 1)+getStartPos (Pos _ l c _) =+  Position (toEnum l - 1) (toEnum c - 1)  getEndPos :: Pos -> Position-getEndPos (Pos _ line col _) =-  Position (toEnum line - 1) (toEnum col)+getEndPos (Pos _ l c _) =+  Position (toEnum l - 1) (toEnum c)  -- | Create an LSP 'Range' from a Futhark 'Loc'. rangeFromLoc :: Loc -> Range

@@ -19,8 +19,11 @@ import Futhark.IR.Prop.Aliases import Futhark.Transform.Substitute +-- | Essentially the components of an 'Index' expression. type IndexSubstitution = (Certs, VName, Type, Slice SubExp) +-- | A mapping from variable names to the indexing operation they+-- should be replaced with. type IndexSubstitutions = [(VName, IndexSubstitution)]  typeEnvFromSubstitutions :: LParamInfo rep ~ Type => IndexSubstitutions -> Scope rep

@@ -4,7 +4,10 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} --- | Representation used by the simplification engine.+-- | Representation used by the simplification engine.  It contains+-- aliasing information and a bit of caching for various information+-- that is looked up frequently.  The name is an old relic; feel free+-- to suggest a better one. module Futhark.Optimise.Simplify.Rep   ( Wise,     VarWisdom (..),@@ -52,9 +55,10 @@ import Futhark.Util.Pretty import Prelude hiding (id, (.)) +-- | Representative phantom type for the simplifier representation. data Wise rep --- | The wisdom of the let-bound variable.+-- | The information associated with a let-bound variable. newtype VarWisdom = VarWisdom {varWisdomAliases :: VarAliases}   deriving (Eq, Ord, Show) @@ -68,9 +72,10 @@ instance FreeIn VarWisdom where   freeIn' (VarWisdom als) = freeIn' als --- | Wisdom about an expression.+-- | Simplifier information about an expression. data ExpWisdom = ExpWisdom   { _expWisdomConsumed :: ConsumedInExp,+    -- | The free variables in the expression.     expWisdomFree :: AliasDec   }   deriving (Eq, Ord, Show)@@ -90,7 +95,7 @@ instance Rename ExpWisdom where   rename = substituteRename --- | Wisdom about a body.+-- | Simplifier information about a body. data BodyWisdom = BodyWisdom   { bodyWisdomAliases :: [VarAliases],     bodyWisdomConsumed :: ConsumedInExp,@@ -163,6 +168,7 @@       rephraseOp = pure . removeOpWisdom     } +-- | Remove simplifier information from scope. removeScopeWisdom :: Scope (Wise rep) -> Scope rep removeScopeWisdom = M.map unAlias   where@@ -171,6 +177,8 @@     unAlias (LParamName dec) = LParamName dec     unAlias (IndexName it) = IndexName it +-- | Add simplifier information to scope.  All the aliasing+-- information will be vacuous, however. addScopeWisdom :: Scope rep -> Scope (Wise rep) addScopeWisdom = M.map alias   where@@ -179,24 +187,31 @@     alias (LParamName dec) = LParamName dec     alias (IndexName it) = IndexName it +-- | Remove simplifier information from function. removeFunDefWisdom :: CanBeWise (Op rep) => FunDef (Wise rep) -> FunDef rep removeFunDefWisdom = runIdentity . rephraseFunDef removeWisdom +-- | Remove simplifier information from statement. removeStmWisdom :: CanBeWise (Op rep) => Stm (Wise rep) -> Stm rep removeStmWisdom = runIdentity . rephraseStm removeWisdom +-- | Remove simplifier information from lambda. removeLambdaWisdom :: CanBeWise (Op rep) => Lambda (Wise rep) -> Lambda rep removeLambdaWisdom = runIdentity . rephraseLambda removeWisdom +-- | Remove simplifier information from body. removeBodyWisdom :: CanBeWise (Op rep) => Body (Wise rep) -> Body rep removeBodyWisdom = runIdentity . rephraseBody removeWisdom +-- | Remove simplifier information from expression. removeExpWisdom :: CanBeWise (Op rep) => Exp (Wise rep) -> Exp rep removeExpWisdom = runIdentity . rephraseExp removeWisdom +-- | Remove simplifier information from pattern. removePatWisdom :: Pat (VarWisdom, a) -> Pat a removePatWisdom = runIdentity . rephrasePat (pure . snd) +-- | Add simplifier information to pattern. addWisdomToPat ::   (ASTRep rep, CanBeWise (Op rep)) =>   Pat (LetDec rep) ->@@ -207,6 +222,7 @@   where     f (als, dec) = (VarWisdom als, dec) +-- | Produce a body with simplifier information. mkWiseBody ::   (ASTRep rep, CanBeWise (Op rep)) =>   BodyDec rep ->@@ -223,6 +239,7 @@   where     (aliases, consumed) = Aliases.mkBodyAliasing stms res +-- | Produce a statement with simplifier information. mkWiseLetStm ::   (ASTRep rep, CanBeWise (Op rep)) =>   Pat (LetDec rep) ->@@ -233,6 +250,7 @@   let pat' = addWisdomToPat pat e    in Let pat' (StmAux cs attrs $ mkWiseExpDec pat' dec e) e +-- | Produce simplifier information for an expression. mkWiseExpDec ::   (ASTRep rep, CanBeWise (Op rep)) =>   Pat (LetDec (Wise rep)) ->@@ -267,12 +285,8 @@ -- representation. type Informing rep = (ASTRep rep, CanBeWise (Op rep)) -class-  ( AliasedOp (OpWithWisdom op),-    IsOp (OpWithWisdom op)-  ) =>-  CanBeWise op-  where+-- | A type class for indicating that this operation can be lifted into the simplifier representation.+class (AliasedOp (OpWithWisdom op), IsOp (OpWithWisdom op)) => CanBeWise op where   type OpWithWisdom op :: Data.Kind.Type   removeOpWisdom :: OpWithWisdom op -> op   addOpWisdom :: op -> OpWithWisdom op@@ -282,18 +296,23 @@   removeOpWisdom () = ()   addOpWisdom () = () +-- | Construct a 'Wise' statement. informStm :: Informing rep => Stm rep -> Stm (Wise rep) informStm (Let pat aux e) = mkWiseLetStm pat aux $ informExp e +-- | Construct 'Wise' statements. informStms :: Informing rep => Stms rep -> Stms (Wise rep) informStms = fmap informStm +-- | Construct a 'Wise' body. informBody :: Informing rep => Body rep -> Body (Wise rep) informBody (Body dec stms res) = mkWiseBody dec (informStms stms) res +-- | Construct a 'Wise' lambda. informLambda :: Informing rep => Lambda rep -> Lambda (Wise rep) informLambda (Lambda ps body ret) = Lambda ps (informBody body) ret +-- | Construct a 'Wise' expression. informExp :: Informing rep => Exp rep -> Exp (Wise rep) informExp (If cond tbranch fbranch (IfDec ts ifsort)) =   If cond (informBody tbranch) (informBody fbranch) (IfDec ts ifsort)@@ -316,6 +335,7 @@           mapOnOp = pure . addOpWisdom         } +-- | Construct a 'Wise' function definition. informFunDef :: Informing rep => FunDef rep -> FunDef (Wise rep) informFunDef (FunDef entry attrs fname rettype params body) =   FunDef entry attrs fname rettype params $ informBody body

@@ -430,7 +430,7 @@                 let branch = Branch perm pat cond tbranch fbranch ret                 stms <-                   (`runReaderT` types) $-                    simplifyStms =<< interchangeBranch nest' branch+                    simplifyStms . oneStm =<< interchangeBranch nest' branch                 onTopLevelStms stms                 pure acc'         _ ->@@ -452,7 +452,7 @@                 let withacc = WithAccStm perm pat inputs lam                 stms <-                   (`runReaderT` types) $-                    simplifyStms =<< interchangeWithAcc nest' withacc+                    simplifyStms . oneStm =<< interchangeWithAcc nest' withacc                 onTopLevelStms stms                 pure acc'         _ ->

@@ -193,7 +193,7 @@   Let pat (defAux ()) $ If cond tbranch fbranch ret  interchangeBranch1 ::-  (MonadBuilder m) =>+  (MonadFreshNames m, HasScope SOACS m) =>   Branch ->   LoopNesting ->   m Branch@@ -215,21 +215,22 @@               map_stm = Let branch_pat' aux $ Op $ Screma w arrs $ mapSOAC lam           pure $ mkBody (oneStm map_stm) res -    tbranch' <- mkBranch tbranch-    fbranch' <- mkBranch fbranch+    tbranch' <- runBodyBuilder $ mkBranch tbranch+    fbranch' <- runBodyBuilder $ mkBranch fbranch     pure $       Branch [0 .. patSize pat - 1] pat' cond tbranch' fbranch' $         IfDec ret' if_sort +-- | Given a (parallel) map nesting and an inner branch, move the maps+-- inside the branch.  The result is the resulting branch expression,+-- which will then contain statements with @map@ expressions. interchangeBranch ::   (MonadFreshNames m, HasScope SOACS m) =>   KernelNest ->   Branch ->-  m (Stms SOACS)-interchangeBranch nest loop = do-  (loop', stms) <--    runBuilder $ foldM interchangeBranch1 loop $ reverse $ kernelNestLoops nest-  pure $ stms <> oneStm (branchStm loop')+  m (Stm SOACS)+interchangeBranch nest loop =+  branchStm <$> foldM interchangeBranch1 loop (reverse $ kernelNestLoops nest)  -- | An encoding of a WithAcc with alongside its result pattern. data WithAccStm@@ -240,7 +241,7 @@   Let pat (defAux ()) $ WithAcc inputs lam  interchangeWithAcc1 ::-  (MonadBuilder m, Rep m ~ SOACS) =>+  (MonadFreshNames m, LocalScope SOACS m) =>   WithAccStm ->   LoopNesting ->   m WithAccStm@@ -250,7 +251,7 @@     inputs' <- mapM onInput inputs     lam_params' <- newAccLamParams $ lambdaParams acc_lam     iota_p <- newParam "iota_p" $ Prim int64-    acc_lam' <- trLam (Var (paramName iota_p)) <=< mkLambda lam_params' $ do+    acc_lam' <- trLam (Var (paramName iota_p)) <=< runLambdaBuilder lam_params' $ do       let acc_params = drop (length inputs) lam_params'           orig_acc_params = drop (length inputs) $ lambdaParams acc_lam       iota_w <-@@ -331,12 +332,14 @@                 mapOnOp = trSOAC i               } +-- | Given a (parallel) map nesting and an inner withacc, move the+-- maps inside the branch.  The result is the resulting withacc+-- expression, which will then contain statements with @map@+-- expressions. interchangeWithAcc ::-  (MonadFreshNames m, HasScope SOACS m) =>+  (MonadFreshNames m, LocalScope SOACS m) =>   KernelNest ->   WithAccStm ->-  m (Stms SOACS)-interchangeWithAcc nest withacc = do-  (withacc', stms) <--    runBuilder $ foldM interchangeWithAcc1 withacc $ reverse $ kernelNestLoops nest-  pure $ stms <> oneStm (withAccStm withacc')+  m (Stm SOACS)+interchangeWithAcc nest withacc =+  withAccStm <$> foldM interchangeWithAcc1 withacc (reverse $ kernelNestLoops nest)

@@ -42,6 +42,12 @@     lgammaf,     tgamma,     tgammaf,+    erf,+    erff,+    erfc,+    erfcf,+    cbrt,+    cbrtf,     hypot,     hypotf,     fromPOSIX,@@ -321,6 +327,42 @@ -- | The system-level @hypotf@ function. hypotf :: Float -> Float -> Float hypotf = c_hypotf++foreign import ccall "erf" c_erf :: Double -> Double++foreign import ccall "erff" c_erff :: Float -> Float++foreign import ccall "erfc" c_erfc :: Double -> Double++foreign import ccall "erfcf" c_erfcf :: Float -> Float++-- | The system-level @erf()@ function.+erf :: Double -> Double+erf = c_erf++-- | The system-level @erff()@ function.+erff :: Float -> Float+erff = c_erff++-- | The system-level @erfc()@ function.+erfc :: Double -> Double+erfc = c_erfc++-- | The system-level @erfcf()@ function.+erfcf :: Float -> Float+erfcf = c_erfcf++foreign import ccall "cbrt" c_cbrt :: Double -> Double++foreign import ccall "cbrtf" c_cbrtf :: Float -> Float++-- | The system-level @cbrt@ function.+cbrt :: Double -> Double+cbrt = c_cbrt++-- | The system-level @cbrtf@ function.+cbrtf :: Float -> Float+cbrtf = c_cbrtf  -- | Turn a POSIX filepath into a filepath for the native system. toPOSIX :: Native.FilePath -> Posix.FilePath

@@ -150,7 +150,7 @@  scanTokens :: Pos -> BS.ByteString -> Either LexerError ([L Token], Pos) scanTokens pos str =-  runAlex' pos str $ do+  runAlex pos str $ do   fix $ \loop -> do     tok <- getToken     case tok of

@@ -7,7 +7,7 @@ -- Futhark-agnostic, and perhaps it can even serve as inspiration for -- other Alex lexer wrappers. module Language.Futhark.Parser.Lexer.Wrapper-  ( runAlex',+  ( runAlex,     Alex,     AlexInput,     Byte,@@ -16,7 +16,6 @@     alexGetInput,     alexGetByte,     alexGetStartCode,-    alexMove,     alexError,     alexGetPos,   )@@ -75,13 +74,13 @@     alex_scd :: !Int -- the current startcode   } -runAlex' :: Pos -> BS.ByteString -> Alex a -> Either LexerError a-runAlex' start_pos input__ (Alex f) =+runAlex :: Pos -> BS.ByteString -> Alex a -> Either LexerError a+runAlex start_pos input (Alex f) =   case f     ( AlexState         { alex_pos = start_pos,           alex_bpos = 0,-          alex_inp = input__,+          alex_inp = input,           alex_chr = '\n',           alex_scd = 0         }

@@ -35,6 +35,7 @@     emptyArrayError,     parseError,     parseErrorAt,+    backOneCol,      -- * Reexports     L,@@ -275,6 +276,11 @@  twoDotsRange :: Loc -> ParserMonad a twoDotsRange loc = parseErrorAt loc $ Just "use '...' for ranges, not '..'.\n"++-- | Move the end position back one column.+backOneCol :: Loc -> Loc+backOneCol (Loc start (Pos f l c o)) = Loc start $ Pos f l (c - 1) (o - 1)+backOneCol NoLoc = NoLoc  --- Now for the parser interface. 

@@ -492,10 +492,14 @@                 { TEApply $1 $2 (srcspan $1 $>) }               | 'id[' DimExp ']'                 { let L loc (INDEXING v) = $1-                  in TEApply (TEVar (qualName v) (srclocOf loc)) (TypeArgExpDim $2 (srclocOf loc)) (srcspan $1 $>) }+                  in TEApply (TEVar (qualName v) (srclocOf (backOneCol loc)))+                             (TypeArgExpDim $2 (srclocOf loc))+                             (srcspan $1 $>) }               | 'qid[' DimExp ']'                 { let L loc (QUALINDEXING qs v) = $1-                  in TEApply (TEVar (QualName qs v) (srclocOf loc)) (TypeArgExpDim $2 (srclocOf loc)) (srcspan $1 $>) }+                  in TEApply (TEVar (QualName qs v) (srclocOf (backOneCol loc)))+                             (TypeArgExpDim $2 (srclocOf loc))+                             (srcspan $1 $>) }               | TypeExpAtom                 { $1 } @@ -849,14 +853,14 @@ VarSlice :: { ((Name, Loc), UncheckedSlice, Loc) }           : 'id[' DimIndices ']'             { let L vloc (INDEXING v) = $1-              in ((v, vloc), $2, locOf (srcspan $1 $>)) }+              in ((v, backOneCol vloc), $2, locOf (srcspan $1 $>)) }  QualVarSlice :: { ((QualName Name, Loc), UncheckedSlice, Loc) }               : VarSlice                 { let ((v, vloc), y, loc) = $1 in ((qualName v, vloc), y, loc) }               | 'qid[' DimIndices ']'                 { let L vloc (QUALINDEXING qs v) = $1-                  in ((QualName qs v, vloc), $2, locOf (srcspan $1 $>)) }+                  in ((QualName qs v, backOneCol vloc), $2, locOf (srcspan $1 $>)) }  DimIndex :: { UncheckedDimIndex }          : Exp2                   { DimFix $1 }

@@ -66,7 +66,7 @@  typeParamDefs :: TypeParamBase VName -> Defs typeParamDefs (TypeParamDim vn loc) =-  M.singleton vn $ DefBound $ BoundTerm (Scalar $ Prim $ Signed Int32) (locOf loc)+  M.singleton vn $ DefBound $ BoundTerm (Scalar $ Prim $ Signed Int64) (locOf loc) typeParamDefs (TypeParamType _ vn loc) =   M.singleton vn $ DefBound $ BoundType $ locOf loc