1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-12 14:28:08 +03:00
juvix/app/CommonOptions.hs
Jonathan Cubides 9a4da4cab8
Add Geb Backend Evaluator with some extra subcommands (#1808)
This PR introduces an evaluator for the Geb STLC interface/fragment and
other related commands, including a REPL to interact with his backend.

-
https://github.com/anoma/geb/blob/mariari/binaries/src/specs/lambda.lisp

We have included a REPL and support for commands such as read and eval
here. Check out:

```
juvix dev geb --help
```

- [x] Add Geb evaluator with the two basic eval strategies.
- [x] Add quasi quoter: return morphisms from typed geb values.
- [x] Add type/object inference for morphisms.
- [x] All combined: morphisms-eval-to-morphisms
- [x] Parse and pretty printer Geb values (without quoting them)
- [x] Parse files containing Geb terms:
- [x] Saved in a .lisp file according to anoma/geb example (typed
object).
  - [x] Store in a .geb file simple as simple lisp expression.
- [x] Add related commands to the CLI for `dev geb`:
  - [x] Subcommand: eval
  - [x] Subcommand: read
  - [x] Subcommand: infer
  - [x] Subcommand: repl
  - [x] Subcommand: check 
- [x] Minor changes `hom` by `!->` in the Geb prettyprinter
- [x] Add tests for:
   - [x] New subcommand (smoke tests)
   - [x] Eval

Issues to solve after merging this PR: 

- Add location to Geb ast for proper error location.
- Add tests for all related subcommands, e.g. check, and infer.
- Check compilation from Core to Geb: (run inferObject with the type
provided by the core node).
- [x] Update the vs code-plugin to load Geb repl and eval.
(31994c8684)
2023-02-22 15:27:40 +01:00

251 lines
6.9 KiB
Haskell

-- | Contains common options reused in several commands.
module CommonOptions
( module CommonOptions,
module Juvix.Prelude,
module Options.Applicative,
)
where
import Control.Exception qualified as GHC
import Juvix.Compiler.Core.Data.TransformationId.Parser
import Juvix.Prelude
import Options.Applicative
import System.Process
import Prelude (show)
-- | Paths that are input are used to detect the root of the project.
data AppPath f = AppPath
{ _pathPath :: SomeBase f,
_pathIsInput :: Bool
}
deriving stock (Data, Eq)
makeLenses ''AppPath
instance Show (AppPath f) where
show = Prelude.show . (^. pathPath)
parseInputJuvixFile :: Parser (AppPath File)
parseInputJuvixFile = do
_pathPath <-
argument
someFileOpt
( metavar "JUVIX_FILE"
<> help "Path to a .juvix file"
<> completer juvixCompleter
)
pure AppPath {_pathIsInput = True, ..}
parseInputJuvixCoreFile :: Parser (AppPath File)
parseInputJuvixCoreFile = do
_pathPath <-
argument
someFileOpt
( metavar "JUVIX_CORE_FILE"
<> help "Path to a .jvc file"
<> completer juvixCoreCompleter
)
pure AppPath {_pathIsInput = True, ..}
parseInputJuvixGebFile :: Parser (AppPath File)
parseInputJuvixGebFile = do
_pathPath <-
argument
someFileOpt
( metavar "JUVIX_GEB_FILE"
<> help "Path to a .geb or custom .lisp file"
<> completer juvixGebCompleter
<> completer juvixGebLispCompleter
)
pure AppPath {_pathIsInput = True, ..}
parseInputJuvixAsmFile :: Parser (AppPath File)
parseInputJuvixAsmFile = do
_pathPath <-
argument
someFileOpt
( metavar "JUVIX_ASM_FILE"
<> help "Path to a .jva file"
<> completer juvixAsmCompleter
)
pure AppPath {_pathIsInput = True, ..}
parseInputCFile :: Parser (AppPath File)
parseInputCFile = do
_pathPath <-
argument
someFileOpt
( metavar "C_FILE"
<> help "Path to a .c file"
<> completer juvixCCompleter
)
pure AppPath {_pathIsInput = True, ..}
parseGenericInputFile :: Parser (AppPath File)
parseGenericInputFile = do
_pathPath <-
argument
someFileOpt
( metavar "INPUT_FILE"
<> help "Path to input file"
<> action "file"
)
pure AppPath {_pathIsInput = True, ..}
parseGenericOutputFile :: Parser (AppPath File)
parseGenericOutputFile = do
_pathPath <-
option
someFileOpt
( long "output"
<> short 'o'
<> metavar "OUTPUT_FILE"
<> help "Path to output file"
<> action "file"
)
pure AppPath {_pathIsInput = False, ..}
parseGenericOutputDir :: Mod OptionFields (SomeBase Dir) -> Parser (AppPath Dir)
parseGenericOutputDir m = do
_pathPath <-
option
someDirOpt
( long "output-dir"
<> metavar "OUTPUT_DIR"
<> help "Path to output directory"
<> action "directory"
<> m
)
pure AppPath {_pathIsInput = False, ..}
someFileOpt :: ReadM (SomeBase File)
someFileOpt = eitherReader aux
where
aux :: String -> Either String (SomeBase File)
aux s = maybe (Left $ s <> " is not a file path") Right (parseSomeFile s)
someDirOpt :: ReadM (SomeBase Dir)
someDirOpt = eitherReader aux
where
aux :: String -> Either String (SomeBase Dir)
aux s = maybe (Left $ s <> " is not a directory path") Right (parseSomeDir s)
extCompleter :: String -> Completer
extCompleter ext = mkCompleter $ \word -> do
let cmd = unwords ["compgen", "-o", "plusdirs", "-f", "-X", "!*." <> ext, "--", requote word]
result <- GHC.try @GHC.SomeException $ readProcess "bash" ["-c", cmd] ""
return . lines . fromRight [] $ result
juvixCompleter :: Completer
juvixCompleter = extCompleter "juvix"
juvixCoreCompleter :: Completer
juvixCoreCompleter = extCompleter "jvc"
juvixGebLispCompleter :: Completer
juvixGebLispCompleter = extCompleter "lisp"
juvixGebCompleter :: Completer
juvixGebCompleter = extCompleter "geb"
juvixAsmCompleter :: Completer
juvixAsmCompleter = extCompleter "jva"
juvixCCompleter :: Completer
juvixCCompleter = extCompleter "c"
requote :: String -> String
requote s =
let -- Bash doesn't appear to allow "mixed" escaping
-- in bash completions. So we don't have to really
-- worry about people swapping between strong and
-- weak quotes.
unescaped =
case s of
-- It's already strongly quoted, so we
-- can use it mostly as is, but we must
-- ensure it's closed off at the end and
-- there's no single quotes in the
-- middle which might confuse bash.
('\'' : rs) -> unescapeN rs
-- We're weakly quoted.
('"' : rs) -> unescapeD rs
-- We're not quoted at all.
-- We need to unescape some characters like
-- spaces and quotation marks.
elsewise -> unescapeU elsewise
in strong unescaped
where
strong :: String -> String
strong ss = '\'' : foldr go "'" ss
where
-- If there's a single quote inside the
-- command: exit from the strong quote and
-- emit it the quote escaped, then resume.
go '\'' t = "'\\''" ++ t
go h t = h : t
-- Unescape a strongly quoted string
-- We have two recursive functions, as we
-- can enter and exit the strong escaping.
unescapeN = goX
where
goX ('\'' : xs) = goN xs
goX (x : xs) = x : goX xs
goX [] = []
goN ('\\' : '\'' : xs) = '\'' : goN xs
goN ('\'' : xs) = goX xs
goN (x : xs) = x : goN xs
goN [] = []
-- Unescape an unquoted string
unescapeU = goX
where
goX [] = []
goX ('\\' : x : xs) = x : goX xs
goX (x : xs) = x : goX xs
-- Unescape a weakly quoted string
unescapeD = goX
where
-- Reached an escape character
goX ('\\' : x : xs)
-- If it's true escapable, strip the
-- slashes, as we're going to strong
-- escape instead.
| x `elem` ("$`\"\\\n" :: String) = x : goX xs
| otherwise = '\\' : x : goX xs
-- We've ended quoted section, so we
-- don't recurse on goX, it's done.
goX ('"' : xs) =
xs
-- Not done, but not a special character
-- just continue the fold.
goX (x : xs) =
x : goX xs
goX [] =
[]
optDeBruijn :: Parser Bool
optDeBruijn =
switch
( long "show-de-bruijn"
<> help "Show variable de Bruijn indices"
)
optTransformationIds :: Parser [TransformationId]
optTransformationIds =
option
(eitherReader parseTransf)
( long "transforms"
<> short 't'
<> value mempty
<> metavar "[Transform]"
<> completer (mkCompleter (return . completionsString))
<> help "hint: use autocomplete"
)
where
parseTransf :: String -> Either String [TransformationId]
parseTransf = mapLeft unpack . parseTransformations . pack