implementation module LazyLinker import StdEnv, Maybe, Map, Text import SaplTokenizer, SaplLinkerShared, StringAppender from FastString import charIndexBackwards from Set import newSet import FilePath, File, Directory, Error from OSError import :: MaybeOSError, :: OSError, :: OSErrorMessage, :: OSErrorCode // Module name -> file name :: ModuleMap :== Map String String // (normal module map, builtin module map, ...) :: LoaderState :== (ModuleMap, ModuleMap, Warnings, IdGenerator) :: LoaderStateExt :== (LoaderState, FuncTypeMap, SkipSet) handlerr (Error (c, str)) = abort ("LazyLinker.icl: ERROR: " +++ str +++ "\n") handlerr (Ok a) = a print str world # (con, world) = stdio world # con = fwrites str con = snd (fclose con world) warning path (Error (c, str)) world = print ("LazyLinker.icl: WARNING: " +++ path +++ ": " +++ str +++ "\n") world warning _ _ world = world isDirectory :: !String !*World -> *(!Bool, !*World) isDirectory path world = case getFileInfo path world of (Ok fi, world) = (fi.FileInfo.directory, world) (Error _, world) = (False, world) fileList :: !FilePath (FilePath -> Bool) !*World -> *(![FilePath], ![FilePath], !*World) fileList path ffilter world # (fs, world) = readDirectory path world | isOk fs = perFile path (fromOk fs) [] [] world // skip the error if the directory is not exists = ([],[], warning path fs world) where // basePath, dirlist to process, module list, override module list, world perFile _ [] ms os world = (ms, os, world) perFile basePath [f:fs] ms os world | f == "." || f == ".." = perFile path fs ms os world | f == "_override_" # (res, world) = readDirectory fullPath world # os2 = filter ffilter (handlerr res) # os2 = map (\m = fullPath </> (dropDirectory m)) os2 = perFile path fs ms (os++os2) world | otherwise = case isDirectory fullPath world of (True, world) # (ms2, os2, world) = fileList fullPath ffilter world = perFile path fs (ms++ms2) (os++os2) world (False, world) | ffilter f = perFile path fs (ms++[fullPath]) os world = perFile path fs ms os world where fullPath = basePath </> f generateLoaderState :: ![String] ![String] ![String] !*World -> *(LoaderStateExt, !*World) generateLoaderState dirs mods exclude world # (ms, os, world) = foldl (\(ms,os,w) module_directory -> let (ms2,os2,w2) = findModules module_directory w in (ms++ms2,os++os2,w2)) ([],[],world) dirs // Add individual modules (extension doesn't matter in this case) # ms = toPairTopLevel "" mods ++ ms # omap = fromList os # mmap = fromList ms # mmap = delList exclude mmap // If an override doesn't actually override anything, move it to normal modules # onlyoverride = toList (delList (map fst (toList mmap)) omap) # omap = delList (map fst onlyoverride) omap # mmap = putList onlyoverride mmap = (((mmap, omap, [], 0), newMap, newSet), world) where findModules module_directory world # (ms, os, world) = fileList module_directory (\f -> endsWith ".sapl" f) world = (toPair module_directory ms, toPair module_directory os, world) // -I toPair module_directory ms = zip2 (map ((toModuleName module_directory) o dropExtension) ms) ms // -i toPairTopLevel module_directory ms = zip2 (map ((toModuleName module_directory) o dropExtension o dropDirectory) ms) ms toModuleName module_directory path = join "." moduleDirs` where relativeDir = if(module_directory == "") path (subString (size module_directory + 1) (size path) path) dirs = split (toString pathSeparator) relativeDir moduleDirs = filter (not o (==) "_override_") dirs // drop filename from module name: Adjoxo;Main moduleDirs` = (init moduleDirs) ++ [last (split ";" (last moduleDirs))] getWarnings :: !LoaderStateExt -> [String] getWarnings ((_, _, ws, _), _, _) = ws linkByExpr :: !LoaderStateExt !StringAppender !String !*World -> *(!LoaderStateExt, !StringAppender, !String, !*World) linkByExpr (ls,lmap,ss) a expr world # maindeps = generate_dependencies (tokens expr) [] # (lmap, (_, ls), expra, world) = substitute_macros lmap maindeps (lazy_loader, ls) expr newAppender world # (lmap, ss, (_, ls), a, world) = foldl (\(lmap, ss, loader, a, world) d = generate_source lmap ss loader d a world) (lmap, ss, (lazy_loader, ls), a, world) maindeps = ((ls,lmap,ss), a, toString expra, world) where getModuleName name # (ok, pos) = charIndexBackwards name (size name - 1) '.' | ok = name % (0,pos-1) = "" /* Load a given function (LoaderFunction LoaderState, see SaplLinkerShared) * * @param ls loader state (module map, built-in module map, warning messages, id generator) * @param fn function name to be loaded * @param lmap line map */ lazy_loader :: LoaderState String FuncTypeMap *World -> *(Maybe LineType, FuncTypeMap, LoaderState, *World) lazy_loader ls=:(mmap, bmmap, messages, id) fn lmap world # line = get fn lmap | isJust line = (line, lmap, ls, world) // try to load the module # m = getModuleName fn | size m == 0 // the function name doesn't contain module name = (Nothing, lmap, ls, world) // is it already loaded? # (mpath, mmap) = delU m mmap | isNothing mpath = (Nothing, lmap, ls, world) # (lmap, id, messages, world) = read_module (fromJust mpath) lmap messages id world // read built-in module if avalaible # (bmpath, bmmap) = delU m bmmap # (lmap, id, messages, world) = if (isJust bmpath) (read_module (fromJust bmpath) lmap messages id world) (lmap, id, messages, world) // try to get the line information again = (get fn lmap, lmap, (mmap,bmmap,messages,id), world)