summaryrefslogtreecommitdiff
path: root/Biz
diff options
context:
space:
mode:
Diffstat (limited to 'Biz')
-rw-r--r--Biz/Bild.hs64
-rw-r--r--Biz/Bild.nix4
-rw-r--r--Biz/Bild/Example.lisp3
-rwxr-xr-xBiz/Ide/repl6
-rw-r--r--Biz/Namespace.hs47
5 files changed, 90 insertions, 34 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index 0e6daf4..dc38e39 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -210,6 +210,7 @@ data Compiler
| Guile
| NixBuild
| Rustc
+ | Sbcl
deriving (Eq, Show, Generic, Aeson.ToJSON)
data Target = Target
@@ -233,6 +234,7 @@ data Target = Target
-- | We can't build everything yet...
isBuildableNs :: Namespace -> Bool
isBuildableNs (Namespace _ Namespace.Hs) = True
+isBuildableNs (Namespace _ Namespace.Lisp) = True
isBuildableNs (Namespace _ Namespace.Scm) = False
isBuildableNs (Namespace _ Namespace.Rs) = True
isBuildableNs ns
@@ -289,6 +291,9 @@ detectImports (Namespace _ Namespace.Hs) contentLines = do
/> map langdeps
/> mconcat
pure <| pkgs <> transitivePkgs
+detectImports (Namespace _ Namespace.Lisp) contentLines = do
+ let requires = contentLines /> Text.unpack /> Regex.match lispRequires |> catMaybes
+ pure <| Set.fromList requires
detectImports _ _ = Exit.die "can only detectImports for Haskell"
-- | TODO: globally cache analyses, so I'm not re-analyzing modules all the
@@ -305,7 +310,7 @@ analyze path = do
Log.info ["bild", "analyze", str path]
let ns =
if "hs" `List.isSuffixOf` path
- then Namespace.fromContent <| Text.unpack content
+ then Namespace.fromHaskellContent <| Text.unpack content
else Namespace.fromPath root absPath
case ns of
Nothing ->
@@ -337,6 +342,21 @@ analyze path = do
|> Set.fromList,
..
}
+ Namespace.Lisp -> do
+ langdeps <- detectImports namespace contentLines
+ pure
+ Target
+ { sysdeps = Set.empty,
+ compiler = Sbcl,
+ out =
+ contentLines
+ /> Text.unpack
+ /> Regex.match (metaOut ";;")
+ |> catMaybes
+ |> head,
+ builder = user <> "@localhost",
+ ..
+ }
Namespace.Nix ->
pure
Target
@@ -586,14 +606,7 @@ build andTest loud target@Target {..} = do
Log.warn ["bild", "copy", "TODO", nschunk namespace]
pure Exit.ExitSuccess
Rustc -> do
- Log.info
- [ "bild",
- "rust",
- if Text.null builder
- then "local"
- else builder,
- nschunk namespace
- ]
+ Log.info ["bild", "dev", "rust", nschunk namespace]
proc
loud
namespace
@@ -602,6 +615,19 @@ build andTest loud target@Target {..} = do
"-o",
root </> bindir </> Maybe.fromJust out
]
+ Sbcl -> do
+ Log.info ["bild", "dev", "lisp", nschunk namespace]
+ proc
+ loud
+ namespace
+ "sbcl"
+ [ "--load",
+ path,
+ "--eval",
+ "(require :asdf)",
+ "--eval",
+ "(sb-ext:save-lisp-and-die #p\"" <> (root </> bindir </> Maybe.fromJust out) <> "\" :toplevel #'main :executable t)"
+ ]
data Proc = Proc
{ loud :: Bool,
@@ -667,6 +693,22 @@ haskellImports =
*> Regex.many (Regex.psym Char.isSpace)
*> Regex.some (Regex.psym isModuleChar)
<* Regex.many Regex.anySym
+
+isModuleChar :: Char -> Bool
+isModuleChar c =
+ elem c <| concat [['A' .. 'Z'], ['a' .. 'z'], ['.', '_'], ['0' .. '9']]
+
+-- Matches on `(require :package)` forms and returns `package`. The `require`
+-- function is technically deprecated in Common Lisp, but no new spec has been
+-- published with a replacement, and I don't wanna use asdf, so this is what we
+-- use for Lisp imports.
+lispRequires :: Regex.RE Char String
+lispRequires =
+ Regex.string "(require"
+ *> Regex.some (Regex.psym Char.isSpace)
+ *> Regex.many (Regex.psym isQuote)
+ *> Regex.many (Regex.psym isModuleChar)
+ <* Regex.many (Regex.psym (== ')'))
where
- isModuleChar c =
- elem c <| concat [['A' .. 'Z'], ['a' .. 'z'], ['.', '_'], ['0' .. '9']]
+ isQuote :: Char -> Bool
+ isQuote c = c `elem` ['\'', ':']
diff --git a/Biz/Bild.nix b/Biz/Bild.nix
index e675b68..700ea36 100644
--- a/Biz/Bild.nix
+++ b/Biz/Bild.nix
@@ -23,6 +23,8 @@ rec {
ghcWith = nixpkgs.haskell.packages.${constants.ghcCompiler}.ghcWithHoogle;
#mkGhcjsPackageSet = nixpkgs.haskell.packages.${ghcjsCompiler}.ghcWithPackages;
+ sbclWith = nixpkgs.lispPackages_new.sbclWithPackages;
+
ghcPackageSetFull = private.ghcWith private.haskellDeps;
ghcPackageSetBild = private.ghcWith (hpkgs: with hpkgs; [
aeson async base bytestring conduit conduit-extra containers directory
@@ -154,8 +156,6 @@ rec {
#python38Packages.black
#python38Packages.pylint
rustc
- sbcl
- lispPackages.swank
shellcheck
wemux
] ++ lib.optional nixpkgs.stdenv.isLinux [
diff --git a/Biz/Bild/Example.lisp b/Biz/Bild/Example.lisp
index c07fcba..2a5f908 100644
--- a/Biz/Bild/Example.lisp
+++ b/Biz/Bild/Example.lisp
@@ -1,3 +1,4 @@
-; : out helloworld.exe
+;; : out helloworld.exe
+(require 'alexandria)
(defun main (args)
(print "hello world"))
diff --git a/Biz/Ide/repl b/Biz/Ide/repl
index 0a6815f..7c2e15c 100755
--- a/Biz/Ide/repl
+++ b/Biz/Ide/repl
@@ -23,9 +23,9 @@
exit 1
;;
Lisp)
- swank-lisp-launcher.sh \
- --eval "(asdf:load-system 'swank)" \
- --eval "(swank:create-server :dont-close t)"
+ nix-shell \
+ --packages "(import $BIZ_ROOT/Biz/Bild.nix {}).private.sbclWith (p: with p; [asdf swank $langdeps])" \
+ --run "sbcl --eval '(require :asdf)' --eval '(require :swank)' --eval '(swank:create-server)' --load $targets"
;;
*)
echo "unsupported targets: ${targets[@]}"
diff --git a/Biz/Namespace.hs b/Biz/Namespace.hs
index 1365919..0fd861f 100644
--- a/Biz/Namespace.hs
+++ b/Biz/Namespace.hs
@@ -7,9 +7,9 @@ module Biz.Namespace
( Namespace (..),
Ext (..),
fromPath,
- fromContent,
- fromHaskellModule,
toPath,
+ fromHaskellContent,
+ fromHaskellModule,
toHaskellModule,
toSchemeModule,
isCab,
@@ -23,7 +23,19 @@ import qualified Data.List as List
import qualified Data.List.Split as List
import qualified Text.Regex.Applicative as Regex
-data Ext = Hs | Scm | Nix | Md | Css | Py | Sh | Keys | Json | None | Rs
+data Ext
+ = Css
+ | Hs
+ | Json
+ | Keys
+ | Lisp
+ | Md
+ | Nix
+ | None
+ | Py
+ | Rs
+ | Scm
+ | Sh
deriving (Eq, Show, Generic, Aeson.ToJSON)
data Namespace = Namespace {path :: [String], ext :: Ext}
@@ -35,8 +47,14 @@ fromPath bizRoot absPath =
+> List.stripPrefix "/"
+> Regex.match (Namespace </ rePath <* dot <*> reExt)
-fromContent :: String -> Maybe Namespace
-fromContent c = case Regex.findFirstInfix haskellModule c of
+toPath :: Namespace -> FilePath
+toPath (Namespace parts ext) =
+ joinWith "/" parts
+ <> "."
+ <> lowercase (show ext)
+
+fromHaskellContent :: String -> Maybe Namespace
+fromHaskellContent c = case Regex.findFirstInfix haskellModule c of
Nothing -> Nothing
Just (_, Namespace {..}, _) -> Just <| Namespace (filter (/= ".") path) ext
where
@@ -53,12 +71,6 @@ toHaskellModule (Namespace {..}) =
fromHaskellModule :: String -> Namespace
fromHaskellModule s = Namespace (List.splitOn "." s) Hs
-toPath :: Namespace -> FilePath
-toPath (Namespace parts ext) =
- joinWith "/" parts
- <> "."
- <> lowercase (show ext)
-
toSchemeModule :: Namespace -> String
toSchemeModule (Namespace parts Scm) = "(" ++ joinWith " " parts ++ ")"
toSchemeModule (Namespace {..}) =
@@ -77,16 +89,17 @@ rePath = Regex.many (name <* Regex.string "/" <|> name)
reExt :: Regex.RE Char Ext
reExt =
- Nix <$ Regex.string "nix"
+ Css <$ Regex.string "css"
<|> Hs <$ Regex.string "hs"
- <|> Scm <$ Regex.string "scm"
+ <|> Json <$ Regex.string "json"
+ <|> Keys <$ Regex.string "pub"
+ <|> Lisp <$ Regex.string "lisp"
<|> Md <$ Regex.string "md"
- <|> Css <$ Regex.string "css"
+ <|> Nix <$ Regex.string "nix"
<|> Py <$ Regex.string "py"
- <|> Sh <$ Regex.string "sh"
- <|> Keys <$ Regex.string "pub"
- <|> Json <$ Regex.string "json"
<|> Rs <$ Regex.string "rs"
+ <|> Scm <$ Regex.string "scm"
+ <|> Sh <$ Regex.string "sh"
-- | The cab dir is for temporary files and build outputs, not for source
-- inputs.