diff options
| -rw-r--r-- | Biz/Bild.hs | 64 | ||||
| -rw-r--r-- | Biz/Bild.nix | 4 | ||||
| -rw-r--r-- | Biz/Bild/Example.lisp | 3 | ||||
| -rwxr-xr-x | Biz/Ide/repl | 6 | ||||
| -rw-r--r-- | Biz/Namespace.hs | 47 |
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. |