From 6511fc0e97cd96f87be9e3daab60bfb5492ef153 Mon Sep 17 00:00:00 2001 From: Max New Date: Mon, 30 Dec 2013 12:01:45 -0600 Subject: [PATCH 1/3] Refactor Build.File using monad transformers --- compiler/Build/File.hs | 125 ++++++++++++++++++++++++----------------- compiler/Compiler.hs | 3 +- 2 files changed, 73 insertions(+), 55 deletions(-) diff --git a/compiler/Build/File.hs b/compiler/Build/File.hs index 371aa6d..cf9c000 100644 --- a/compiler/Build/File.hs +++ b/compiler/Build/File.hs @@ -1,8 +1,12 @@ module Build.File (build) where +import Control.Applicative ((<$>)) import Control.Monad (when) +import Control.Monad.RWS.Strict import qualified Data.Binary as Binary import qualified Data.List as List +import qualified Data.Maybe as Maybe +import Data.Monoid (Last(..)) import qualified Data.Map as Map import System.Directory import System.Exit @@ -10,7 +14,6 @@ import System.FilePath import System.IO import qualified Transform.Canonicalize as Canonical - import qualified Data.ByteString.Lazy as L import qualified Build.Utils as Utils @@ -22,72 +25,82 @@ import qualified InterfaceSerialization as IS import qualified Parse.Module as Parser import qualified SourceSyntax.Module as M -build :: Flag.Flags -> Int -> M.Interfaces -> String -> [FilePath] - -> IO (String, M.Interfaces) -build _ _ interfaces moduleName [] = - return (moduleName, interfaces) -build flags numModules interfaces _ (filePath:rest) = - do (name,interface) <- - build1 flags (numModules - length rest) numModules interfaces filePath - let interfaces' = Map.insert name interface interfaces - build flags numModules interfaces' name rest +-- Reader: Runtime flags, always accessible +-- Writer: Remember the last module to be accessed +-- State: Build up a map of the module interfaces +type BuildT m a = RWST Flag.Flags (Last String) M.Interfaces m a +type Build a = BuildT IO a +evalBuild :: Flag.Flags -> M.Interfaces -> Build () -> IO (Maybe String) +evalBuild fs is b = do + (_, s) <- evalRWST b fs is + return . getLast $ s -build1 :: Flag.Flags -> Int -> Int -> M.Interfaces -> FilePath - -> IO (String, M.ModuleInterface) -build1 flags moduleNum numModules interfaces filePath = - do compiled <- alreadyCompiled flags filePath - case compiled of - False -> compile flags number interfaces filePath - True -> retrieve flags interfaces filePath - where - number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]" +-- Builds a list of files, returning the moduleName of the last one. +-- Returns "" if the list is empty +build :: Flag.Flags -> M.Interfaces -> [FilePath] -> IO String +build flags is = fmap (Maybe.fromMaybe "") . evalBuild flags is . buildAll +buildAll :: [FilePath] -> Build () +buildAll fs = mapM_ build1 (zip [1..] fs) + where build1 (num, fname) = do + compiled <- alreadyCompiled filePath + case compiled of + False -> + let number = join ["[", show num, " of ", show total, "]"] + compile number filePath + True -> retrieve filePath + total = length fs -alreadyCompiled :: Flag.Flags -> FilePath -> IO Bool -alreadyCompiled flags filePath = do - existsi <- doesFileExist (Utils.elmi flags filePath) - existso <- doesFileExist (Utils.elmo flags filePath) - if not existsi || not existso - then return False - else do tsrc <- getModificationTime filePath - tint <- getModificationTime (Utils.elmo flags filePath) - return (tsrc <= tint) +alreadyCompiled :: FilePath -> Build Bool +alreadyCompiled filePath = do + flags <- ask + liftIO $ do + existsi <- doesFileExist (Utils.elmi flags filePath) + existso <- doesFileExist (Utils.elmo flags filePath) + if not existsi || not existso + then return False + else do tsrc <- getModificationTime filePath + tint <- getModificationTime (Utils.elmo flags filePath) + return (tsrc <= tint) -retrieve :: Flag.Flags -> Map.Map String M.ModuleInterface -> FilePath - -> IO (String, M.ModuleInterface) -retrieve flags interfaces filePath = do - bytes <- IS.loadInterface (Utils.elmi flags filePath) - let binary = IS.interfaceDecode (Utils.elmi flags filePath) =<< bytes +retrieve :: FilePath -> Build () +retrieve filePath = do + flags <- ask + let elmi = Utils.elmi flags filePath + bytes <- liftIO $ IS.loadInterface elmi + let binary = IS.interfaceDecode elmi =<< bytes case IS.validVersion filePath =<< binary of Right (name, interface) -> - do when (Flag.print_types flags) (Print.interfaceTypes interfaces interface) - return (name, interface) + do interfaces <- get + liftIO $ when (Flag.print_types flags) (Print.interfaceTypes interfaces interface) + update name interface + Left err -> - do hPutStrLn stderr err - exitFailure + liftIO $ hPutStrLn stderr err >> exitFailure -compile :: Flag.Flags -> String -> M.Interfaces -> FilePath - -> IO (String, M.ModuleInterface) -compile flags number interfaces filePath = - do source <- readFile filePath +compile :: String -> FilePath -> Build () +compile number filePath = + do flags <- ask + interfaces <- get + source <- liftIO $ readFile filePath let name = getName source - printStatus name + liftIO $ do + printStatus name + createDirectoryIfMissing True (Flag.cache_dir flags) + createDirectoryIfMissing True (Flag.build_dir flags) - createDirectoryIfMissing True (Flag.cache_dir flags) - createDirectoryIfMissing True (Flag.build_dir flags) - - metaModule <- - case Source.build (Flag.no_prelude flags) interfaces source of + metaModule <- + liftIO $ case Source.build (Flag.no_prelude flags) interfaces source of Right modul -> return modul Left errors -> do Print.errors errors exitFailure - when (Flag.print_types flags) $ Print.metaTypes interfaces metaModule - + liftIO $ when (Flag.print_types flags) $ Print.metaTypes interfaces metaModule + let intermediate = (name, Canonical.interface name $ M.metaToInterface metaModule) generateCache intermediate metaModule - return intermediate + uncurry update intermediate where getName source = case Parser.getModuleName source of @@ -100,7 +113,13 @@ compile flags number interfaces filePath = , "( " ++ filePath ++ " )" ] generateCache intermediate metaModule = do - createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath - writeFile (Utils.elmo flags filePath) (JS.generate metaModule) - withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle -> + flags <- ask + liftIO $ do + createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath + writeFile (Utils.elmo flags filePath) (JS.generate metaModule) + withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle -> L.hPut handle (Binary.encode intermediate) + +update :: String -> M.ModuleInterface -> Build () +update name inter = modify (Map.insert name inter) + >> tell (Last . Just $ name) diff --git a/compiler/Compiler.hs b/compiler/Compiler.hs index 6674dc3..6bd15ec 100644 --- a/compiler/Compiler.hs +++ b/compiler/Compiler.hs @@ -37,8 +37,7 @@ build flags rootFile = then getSortedDependencies (Flag.src_dir flags) builtIns rootFile else return [rootFile] - (moduleName, interfaces) <- - File.build flags (length files) builtIns "" files + moduleName <- File.build flags builtIns files js <- foldM appendToOutput BS.empty files From cf9d21b0c8c658885f9c2fbc4403c8cd400c514b Mon Sep 17 00:00:00 2001 From: Max New Date: Mon, 30 Dec 2013 16:03:46 -0600 Subject: [PATCH 2/3] Recompile modules when their dependencies have changed. --- compiler/Build/Dependencies.hs | 60 +++++++++------ compiler/Build/File.hs | 137 ++++++++++++++++++++------------- compiler/Build/Print.hs | 8 +- 3 files changed, 127 insertions(+), 78 deletions(-) diff --git a/compiler/Build/Dependencies.hs b/compiler/Build/Dependencies.hs index 4ebdcb0..f69a65e 100644 --- a/compiler/Build/Dependencies.hs +++ b/compiler/Build/Dependencies.hs @@ -1,4 +1,4 @@ -module Build.Dependencies (getSortedDependencies) where +module Build.Dependencies (getSortedDependencies, readDeps) where import Data.Data import Control.Applicative @@ -18,6 +18,8 @@ import System.FilePath as FP import System.IO import Text.PrettyPrint (Doc) +import Build.Print (failure) + import qualified SourceSyntax.Module as Module import qualified SourceSyntax.Type as Type import qualified Parse.Parse as Parse @@ -36,7 +38,7 @@ getSortedDependencies :: [FilePath] -> Module.Interfaces -> FilePath -> IO [Stri getSortedDependencies srcDirs builtIns root = do extras <- extraDependencies let allSrcDirs = srcDirs ++ Maybe.fromMaybe [] extras - result <- runErrorT $ readDeps allSrcDirs builtIns root + result <- runErrorT $ readAllDeps allSrcDirs builtIns root case result of Right deps -> sortDeps deps Left err -> failure $ err ++ if Maybe.isJust extras then "" else msg @@ -44,8 +46,6 @@ getSortedDependencies srcDirs builtIns root = Path.dependencyFile ++ " file if you\nare trying to use a 3rd party library." -failure msg = hPutStrLn stderr msg >> exitFailure - extraDependencies :: IO (Maybe [FilePath]) extraDependencies = do exists <- doesFileExist Path.dependencyFile @@ -86,34 +86,44 @@ sortDeps depends = mistakes = filter (\scc -> length scc > 1) sccs msg = "A cyclical module dependency or was detected in:\n" -readDeps :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO [Deps] -readDeps srcDirs builtIns root = do +readAllDeps :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO [Deps] +readAllDeps srcDirs builtIns root = do let ifaces = (Set.fromList . Map.keys) builtIns State.evalStateT (go ifaces root) Set.empty where go :: Set.Set String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [Deps] go builtIns root = do - (root', txt) <- lift $ getFile srcDirs root - case Parse.dependencies txt of - Left err -> throwError $ msg ++ show err - where msg = "Error resolving dependencies in " ++ root' ++ ":\n" + root' <- lift $ findSrcFile srcDirs root + (name, deps) <- lift $ readDeps root' + seen <- State.get + let realDeps = Set.difference (Set.fromList deps) builtIns + newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen + State.put (Set.insert name (Set.union newDeps seen)) + rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps) + return ((makeRelative "." root', name, Set.toList realDeps) : concat rest) - Right (name,deps) -> - do seen <- State.get - let realDeps = Set.difference (Set.fromList deps) builtIns - newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen - State.put (Set.insert name (Set.union newDeps seen)) - rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps) - return ((makeRelative "." root', name, Set.toList realDeps) : concat rest) +readDeps :: FilePath -> ErrorT String IO (String, [String]) +readDeps path = do + txt <- lift $ readFile path + case Parse.dependencies txt of + Left err -> throwError $ msg ++ show err + where msg = "Error resolving dependencies in " ++ path ++ ":\n" + Right o -> return o -getFile :: [FilePath] -> FilePath -> ErrorT String IO (FilePath,String) -getFile [] path = - throwError $ unlines - [ "Could not find file: " ++ path - , " If it is not in the root directory of your project, use" - , " --src-dir to declare additional locations for source files." - , " If it is part of a 3rd party library, it needs to be declared" - , " as a dependency in the " ++ Path.dependencyFile ++ " file." ] +findSrcFile :: [FilePath] -> FilePath -> ErrorT String IO FilePath +findSrcFile dirs path = foldr tryDir notFound dirs + where notFound = throwError $ unlines + [ "Could not find file: " ++ path + , " If it is not in the root directory of your project, use" + , " --src-dir to declare additional locations for source files." + , " If it is part of a 3rd party library, it needs to be declared" + , " as a dependency in the " ++ Path.dependencyFile ++ " file." ] + tryDir dir next = do + let path' = dir path + exists <- liftIO $ doesFileExist path' + if exists + then return path' + else next getFile (dir:dirs) path = do let path' = dir path diff --git a/compiler/Build/File.hs b/compiler/Build/File.hs index cf9c000..6c1e5da 100644 --- a/compiler/Build/File.hs +++ b/compiler/Build/File.hs @@ -1,68 +1,100 @@ module Build.File (build) where -import Control.Applicative ((<$>)) -import Control.Monad (when) +import Control.Applicative ((<$>), (<*>), pure) +import Control.Monad (when) +import Control.Monad.Error (runErrorT) import Control.Monad.RWS.Strict -import qualified Data.Binary as Binary -import qualified Data.List as List -import qualified Data.Maybe as Maybe -import Data.Monoid (Last(..)) -import qualified Data.Map as Map +import Data.Monoid (Last(..)) import System.Directory import System.Exit import System.FilePath import System.IO -import qualified Transform.Canonicalize as Canonical -import qualified Data.ByteString.Lazy as L +import qualified Data.Binary as Binary +import qualified Data.List as List +import qualified Data.Maybe as Maybe +import qualified Data.Map as Map +import qualified Data.ByteString.Lazy as L -import qualified Build.Utils as Utils -import qualified Build.Flags as Flag -import qualified Build.Source as Source -import qualified Build.Print as Print -import qualified Generate.JavaScript as JS +import qualified Build.Dependencies as Deps +import qualified Build.Flags as Flag +import qualified Build.Print as Print +import qualified Build.Source as Source +import qualified Build.Utils as Utils +import qualified Generate.JavaScript as JS import qualified InterfaceSerialization as IS -import qualified Parse.Module as Parser -import qualified SourceSyntax.Module as M +import qualified Parse.Module as Parser +import qualified SourceSyntax.Module as M +import qualified Transform.Canonicalize as Canonical -- Reader: Runtime flags, always accessible -- Writer: Remember the last module to be accessed -- State: Build up a map of the module interfaces -type BuildT m a = RWST Flag.Flags (Last String) M.Interfaces m a +type BuildT m a = RWST Flag.Flags (Last String) BInterfaces m a type Build a = BuildT IO a +-- Interfaces, remembering if something was recompiled +type BInterfaces = Map.Map String (Bool, M.ModuleInterface) + evalBuild :: Flag.Flags -> M.Interfaces -> Build () -> IO (Maybe String) evalBuild fs is b = do - (_, s) <- evalRWST b fs is + (_, s) <- evalRWST b fs (fmap notUpdated is) return . getLast $ s + where notUpdated i = (False, i) --- Builds a list of files, returning the moduleName of the last one. --- Returns "" if the list is empty +-- | Builds a list of files, returning the moduleName of the last one. +-- Returns \"\" if the list is empty build :: Flag.Flags -> M.Interfaces -> [FilePath] -> IO String build flags is = fmap (Maybe.fromMaybe "") . evalBuild flags is . buildAll buildAll :: [FilePath] -> Build () -buildAll fs = mapM_ build1 (zip [1..] fs) - where build1 (num, fname) = do - compiled <- alreadyCompiled filePath - case compiled of - False -> - let number = join ["[", show num, " of ", show total, "]"] - compile number filePath - True -> retrieve filePath +buildAll fs = mapM_ (uncurry build1) (zip [1..] fs) + where build1 num fname = do + shouldCompile <- shouldBeCompiled fname + if shouldCompile + then compile number fname + else retrieve fname + + where number = join ["[", show num, " of ", show total, "]"] + total = length fs -alreadyCompiled :: FilePath -> Build Bool -alreadyCompiled filePath = do +shouldBeCompiled :: FilePath -> Build Bool +shouldBeCompiled filePath = do flags <- ask - liftIO $ do - existsi <- doesFileExist (Utils.elmi flags filePath) - existso <- doesFileExist (Utils.elmo flags filePath) - if not existsi || not existso - then return False - else do tsrc <- getModificationTime filePath - tint <- getModificationTime (Utils.elmo flags filePath) - return (tsrc <= tint) + let alreadyCompiled = liftIO $ do + existsi <- doesFileExist (Utils.elmi flags filePath) + existso <- doesFileExist (Utils.elmo flags filePath) + return $ existsi && existso + + outDated = liftIO $ do + tsrc <- getModificationTime filePath + tint <- getModificationTime (Utils.elmo flags filePath) + return (tsrc > tint) + + dependenciesUpdated = do + eDeps <- liftIO . runErrorT $ Deps.readDeps filePath + case eDeps of + -- Should never actually reach here + Left err -> liftIO $ Print.failure err + Right (_, deps) -> anyM wasCompiled deps + + + in (not <$> alreadyCompiled) `orM` outDated `orM` dependenciesUpdated + +wasCompiled :: String -> Build Bool +wasCompiled modul = maybe False fst . Map.lookup modul <$> get + +-- Short-circuiting monadic (||) +infixr 2 `orM` +orM :: (Monad m) => m Bool -> m Bool -> m Bool +orM m1 m2 = do b1 <- m1 + if b1 + then return b1 + else m2 + +anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool +anyM f = foldr (orM . f) (return False) retrieve :: FilePath -> Build () retrieve filePath = do @@ -72,19 +104,20 @@ retrieve filePath = do let binary = IS.interfaceDecode elmi =<< bytes case IS.validVersion filePath =<< binary of Right (name, interface) -> - do interfaces <- get + do binterfaces <- get + let interfaces = snd <$> binterfaces liftIO $ when (Flag.print_types flags) (Print.interfaceTypes interfaces interface) - update name interface + update name interface False - Left err -> - liftIO $ hPutStrLn stderr err >> exitFailure + Left err -> liftIO $ Print.failure err compile :: String -> FilePath -> Build () compile number filePath = do flags <- ask - interfaces <- get + binterfaces <- get source <- liftIO $ readFile filePath - let name = getName source + let interfaces = snd <$> binterfaces + name = getName source liftIO $ do printStatus name createDirectoryIfMissing True (Flag.cache_dir flags) @@ -98,9 +131,9 @@ compile number filePath = liftIO $ when (Flag.print_types flags) $ Print.metaTypes interfaces metaModule - let intermediate = (name, Canonical.interface name $ M.metaToInterface metaModule) - generateCache intermediate metaModule - uncurry update intermediate + let newInters = Canonical.interface name $ M.metaToInterface metaModule + generateCache name newInters metaModule + update name newInters True where getName source = case Parser.getModuleName source of @@ -112,14 +145,14 @@ compile number filePath = , replicate (max 1 (20 - length name)) ' ' , "( " ++ filePath ++ " )" ] - generateCache intermediate metaModule = do + generateCache name interfs metaModule = do flags <- ask liftIO $ do createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath writeFile (Utils.elmo flags filePath) (JS.generate metaModule) withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle -> - L.hPut handle (Binary.encode intermediate) + L.hPut handle (Binary.encode (name, interfs)) -update :: String -> M.ModuleInterface -> Build () -update name inter = modify (Map.insert name inter) - >> tell (Last . Just $ name) +update :: String -> M.ModuleInterface -> Bool -> Build () +update name inter wasUpdated = modify (Map.insert name (wasUpdated, inter)) + >> tell (Last . Just $ name) diff --git a/compiler/Build/Print.hs b/compiler/Build/Print.hs index abedfd8..3e0fee9 100644 --- a/compiler/Build/Print.hs +++ b/compiler/Build/Print.hs @@ -1,5 +1,8 @@ module Build.Print where +import System.IO (hPutStrLn, stderr) +import System.Exit (exitFailure) + import qualified Data.Map as Map import qualified Data.List as List import qualified SourceSyntax.Module as M @@ -29,4 +32,7 @@ types interfaces types' aliases imports = errors :: [P.Doc] -> IO () errors errs = - mapM_ print (List.intersperse (P.text " ") errs) \ No newline at end of file + mapM_ print (List.intersperse (P.text " ") errs) + +failure :: String -> IO a +failure msg = hPutStrLn stderr msg >> exitFailure From 0e40a32adc3c1e95146084c15c5ec0adda2c7332 Mon Sep 17 00:00:00 2001 From: Max New Date: Mon, 13 Jan 2014 09:21:39 -0600 Subject: [PATCH 3/3] Style fixes and -Walls for a couple files. --- compiler/Build/Dependencies.hs | 22 ++-------------------- compiler/Build/File.hs | 16 ++++++++-------- 2 files changed, 10 insertions(+), 28 deletions(-) diff --git a/compiler/Build/Dependencies.hs b/compiler/Build/Dependencies.hs index f69a65e..3ac294b 100644 --- a/compiler/Build/Dependencies.hs +++ b/compiler/Build/Dependencies.hs @@ -1,37 +1,25 @@ +{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-} module Build.Dependencies (getSortedDependencies, readDeps) where -import Data.Data import Control.Applicative import Control.Monad.Error import qualified Control.Monad.State as State import qualified Data.Aeson as Json import qualified Data.ByteString.Lazy.Char8 as BSC -import qualified Data.Char as Char import qualified Data.Graph as Graph import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Maybe as Maybe import qualified Data.Set as Set import System.Directory -import System.Exit import System.FilePath as FP -import System.IO -import Text.PrettyPrint (Doc) import Build.Print (failure) import qualified SourceSyntax.Module as Module -import qualified SourceSyntax.Type as Type import qualified Parse.Parse as Parse -import qualified Metadata.Prelude as Prelude -import qualified Transform.Check as Check -import qualified Transform.SortDefinitions as SD -import qualified Type.Inference as TI -import qualified Type.Constrain.Declaration as TcDecl -import qualified Transform.Canonicalize as Canonical import qualified Elm.Internal.Paths as Path import qualified Elm.Internal.Name as N -import qualified Elm.Internal.Version as V import qualified Elm.Internal.Dependencies as Deps getSortedDependencies :: [FilePath] -> Module.Interfaces -> FilePath -> IO [String] @@ -125,13 +113,7 @@ findSrcFile dirs path = foldr tryDir notFound dirs then return path' else next -getFile (dir:dirs) path = do - let path' = dir path - exists <- liftIO $ doesFileExist path' - case exists of - True -> (,) path' `fmap` liftIO (readFile path') - False -> getFile dirs path - +isNative :: String -> Bool isNative name = List.isPrefixOf "Native." name toFilePath :: String -> FilePath diff --git a/compiler/Build/File.hs b/compiler/Build/File.hs index 6c1e5da..5cf07db 100644 --- a/compiler/Build/File.hs +++ b/compiler/Build/File.hs @@ -1,17 +1,15 @@ +{-# OPTIONS_GHC -Wall #-} module Build.File (build) where -import Control.Applicative ((<$>), (<*>), pure) -import Control.Monad (when) +import Control.Applicative ((<$>)) import Control.Monad.Error (runErrorT) import Control.Monad.RWS.Strict -import Data.Monoid (Last(..)) import System.Directory import System.Exit import System.FilePath import System.IO import qualified Data.Binary as Binary -import qualified Data.List as List import qualified Data.Maybe as Maybe import qualified Data.Map as Map import qualified Data.ByteString.Lazy as L @@ -37,10 +35,11 @@ type Build a = BuildT IO a type BInterfaces = Map.Map String (Bool, M.ModuleInterface) evalBuild :: Flag.Flags -> M.Interfaces -> Build () -> IO (Maybe String) -evalBuild fs is b = do - (_, s) <- evalRWST b fs (fmap notUpdated is) +evalBuild flags interfaces b = do + (_, s) <- evalRWST b flags (fmap notUpdated interfaces) return . getLast $ s - where notUpdated i = (False, i) + where + notUpdated i = (False, i) -- | Builds a list of files, returning the moduleName of the last one. -- Returns \"\" if the list is empty @@ -49,7 +48,8 @@ build flags is = fmap (Maybe.fromMaybe "") . evalBuild flags is . buildAll buildAll :: [FilePath] -> Build () buildAll fs = mapM_ (uncurry build1) (zip [1..] fs) - where build1 num fname = do + where build1 :: Integer -> FilePath -> Build () + build1 num fname = do shouldCompile <- shouldBeCompiled fname if shouldCompile then compile number fname