Add 'libs' directory to paths

This is for finding support libraries for code generators, e.g. the
shared objects that chez will load for glue code for foreign libraries.
It'll be used more shortly...

Makefile

@@ -46,6 +46,7 @@ install: all install-exec install-libs
 
 install-exec: idris2
 	mkdir -p ${PREFIX}/bin
+	mkdir -p ${PREFIX}/idris2/lib
 	mkdir -p ${PREFIX}/idris2/support/chez
 	mkdir -p ${PREFIX}/idris2/support/chicken
 	mkdir -p ${PREFIX}/idris2/support/racket

src/Compiler/Common.idr

@@ -63,6 +63,14 @@ mkNameTags defs tags t (n :: ns)
               => mkNameTags defs (insert n t tags) (t + 1) ns
            _ => mkNameTags defs tags t ns
 
+natHackNames : List Name
+natHackNames
+    = [UN "prim__add_Integer",
+       UN "prim__sub_Integer",
+       UN "prim__mul_Integer",
+       NS ["Prelude"] (UN "natToInteger"),
+       NS ["Prelude"] (UN "integerToNat")]
+
 -- Find all the names which need compiling, from a given expression, and compile
 -- them to CExp form (and update that in the Defs)
 export
@@ -71,7 +79,8 @@ findUsedNames : {auto c : Ref Ctxt Defs} -> Term vars ->
 findUsedNames tm
     = do defs <- get Ctxt
          let ns = getRefs (Resolved (-1)) tm
-         allNs <- getAllDesc (keys ns) empty defs
+         natHackNames' <- traverse toResolvedNames natHackNames
+         allNs <- getAllDesc (natHackNames' ++ keys ns) empty defs
          cns <- traverse toFullNames (keys allNs)
          -- Initialise the type constructor list with explicit names for
          -- the primitives (this is how we look up the tags)

src/Compiler/CompileExpr.idr

@@ -75,6 +75,9 @@ expandToArity num fn [] = etaExpand 0 num fn []
 
 -- None of these should be hard coded, but we'll do it this way until we
 -- have a more general approach to optimising data types!
+-- NOTE: Make sure that names mentioned here are listed in 'natHackNames' in
+-- Common.idr, so that they get compiled, as they won't be spotted by the
+-- usual calls to 'getRefs'.
 natHack : CExp vars -> CExp vars
 natHack (CCon fc (NS ["Prelude"] (UN "Z")) _ []) = CPrimVal fc (BI 0)
 natHack (CCon fc (NS ["Prelude"] (UN "S")) _ [k])

src/Compiler/Scheme/Chez.idr

@@ -31,9 +31,26 @@ findChez
                                     x <- ["scheme", "chez", "chezscheme9.5"]]
                           maybe (pure "/usr/bin/env scheme") pure e
 
-findLibs : List String -> List String
+-- Given the chez compiler directives, return a list of pairs of:
-findLibs = mapMaybe (isLib . trim)
+--   - the library file name
+--   - the full absolute path of the library file name, if it's in one
+--     of the library paths managed by Idris
+-- If it can't be found, we'll assume it's a system library and that chez
+-- will thus be able to find it.
+findLibs : {auto c : Ref Ctxt Defs} ->
+           List String -> Core (List (String, String))
+findLibs ds
+    = do let libs = mapMaybe (isLib . trim) ds
+         traverse locate (nub libs)
   where
+    locate : String -> Core (String, String)
+    locate fname
+        = do fullname <- catch (findLibraryFile fname)
+                               (\err => -- assume a system library so not
+                                        -- in our library path
+                                        pure fname)
+             pure (fname, fullname)
+
     isLib : String -> Maybe String
     isLib d
         = if isPrefixOf "lib" d
@@ -107,7 +124,7 @@ compileToSS : Ref Ctxt Defs ->
               ClosedTerm -> (outfile : String) -> Core ()
 compileToSS c tm outfile
     = do ds <- getDirectives Chez
-         let libs = findLibs ds
+         libs <- findLibs ds
          (ns, tags) <- findUsedNames tm
          defs <- get Ctxt
          compdefs <- traverse (getScheme chezExtPrim defs) ns
@@ -115,7 +132,8 @@ compileToSS c tm outfile
          main <- schExp chezExtPrim 0 [] !(compileExp tags tm)
          chez <- coreLift findChez
          support <- readDataFile "chez/support.ss"
-         let scm = schHeader chez libs ++ support ++ code ++ main ++ schFooter
+         let scm = schHeader chez (map snd libs) ++ 
+                   support ++ code ++ main ++ schFooter
          Right () <- coreLift $ writeFile outfile scm
             | Left err => throw (FileErr outfile err)
          coreLift $ chmod outfile 0o755

src/Core/Context.idr

@@ -1569,6 +1569,12 @@ addDataDir dir
     = do defs <- get Ctxt
          put Ctxt (record { options->dirs->data_dirs $= (++ [dir]) } defs)
 
+export
+addLibDir : {auto c : Ref Ctxt Defs} -> String -> Core ()
+addLibDir dir
+    = do defs <- get Ctxt
+         put Ctxt (record { options->dirs->lib_dirs $= (++ [dir]) } defs)
+
 export
 setBuildDir : {auto c : Ref Ctxt Defs} -> String -> Core ()
 setBuildDir dir

src/Core/Directory.idr

@@ -36,7 +36,7 @@ dropExtension fname
                -- assert that root can't be empty
                reverse (assert_total (strTail root))
     
--- Return the contents of the first file available in the list
+-- Return the name of the first file available in the list
 firstAvailable : List String -> Core (Maybe String)
 firstAvailable [] = pure Nothing
 firstAvailable (f :: fs)
@@ -57,6 +57,21 @@ readDataFile fname
             | Left err => throw (FileErr f err)
          pure d
 
+-- Look for a library file required by a code generator. Look in the
+-- library directories, and in the lib/ subdirectoriy of all the 'extra import' 
+-- directories
+export
+findLibraryFile : {auto c : Ref Ctxt Defs} ->
+                  String -> Core String
+findLibraryFile fname
+    = do d <- getDirs
+         let fs = map (\p => p ++ cast sep ++ fname) 
+                      (lib_dirs d ++ map (\x => x ++ cast sep ++ "lib")
+                                         (extra_dirs d))
+         Just f <- firstAvailable fs
+            | Nothing => throw (InternalError ("Can't find library " ++ fname))
+         pure f
+
 -- Given a namespace, return the full path to the checked module, 
 -- looking first in the build directory then in the extra_dirs
 export

src/Core/Options.idr

@@ -11,15 +11,17 @@ record Dirs where
   build_dir : String -- build directory, relative to working directory
   dir_prefix : String -- installation prefix, for finding data files (e.g. run time support)
   extra_dirs : List String -- places to look for import files
+  lib_dirs : List String -- places to look for libraries (for code generation)
   data_dirs : List String -- places to look for data file
 
 public export
 toString : Dirs -> String
-toString (MkDirs wdir bdir dfix edirs ddirs) =
+toString (MkDirs wdir bdir dfix edirs ldirs ddirs) =
   unlines [ "+ Working Directory   :: " ++ show wdir
           , "+ Build Directory     :: " ++ show bdir
           , "+ Installation Prefix :: " ++ show dfix
           , "+ Extra Directories :: " ++ show edirs
+          , "+ CG Library Directories :: " ++ show ldirs
           , "+ Data Directories :: " ++ show ddirs]
 
 public export
@@ -105,7 +107,7 @@ record Options where
   extensions : List LangExt
 
 defaultDirs : Dirs
-defaultDirs = MkDirs "." "build" "/usr/local" ["."] []
+defaultDirs = MkDirs "." "build" "/usr/local" ["."] ["."] []
 
 defaultPPrint : PPrinter
 defaultPPrint = MkPPOpts False True False

src/Idris/Main.idr

@@ -53,6 +53,11 @@ updatePaths
               Just path => do traverse addDataDir (map trim (split (==pathSep) path))
                               pure ()
               Nothing => pure ()
+         blibs <- coreLift $ getEnv "IDRIS2_LIBS"
+         case blibs of
+              Just path => do traverse addLibDir (map trim (split (==pathSep) path))
+                              pure ()
+              Nothing => pure ()
          -- BLODWEN_PATH goes first so that it overrides this if there's
          -- any conflicts. In particular, that means that setting BLODWEN_PATH
          -- for the tests means they test the local version not the installed
@@ -61,6 +66,8 @@ updatePaths
          addPkgDir "base"
          addDataDir (dir_prefix (dirs (options defs)) ++ dirSep ++
                         "idris2" ++ dirSep ++ "support")
+         addLibDir (dir_prefix (dirs (options defs)) ++ dirSep ++
+                        "idris2" ++ dirSep ++ "lib")
 
 updateREPLOpts : {auto o : Ref ROpts REPLOpts} ->
                  Core ()