Commit 4b0271bd authored by Michael Hanus's avatar Michael Hanus
Browse files

Initial version of the universal Curry REPL

parents
*~
.cpm
.curry
Copyright (c) 2021, Michael Hanus
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the names of the copyright holders nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
curry-repl
==========
This package contains the implementation of a
universal REPL (Read-Eval-Print-Loop) which can be used
on top of a Curry compiler. Thus, if the Curry compiler
supports some standard options (see below), it can
be extended to a simple interactive programming environment.
The specification of the concrete compiler is provided
as an element of type `REPL.Compiler.CCDescription`.
The entry point of the REPL is the operation `mainREPL`
defined in module `REPL.Main`.
The directory `examples` contains example specifications.
Requirements for a Curry Compiler used by a REPL
------------------------------------------------
Basically, the REPL translates each expression to be evaluated
into a program with a `main` operation. This program is
compiled and then executed. In order to implement this
kind of REPL, it should be possible to invoke the Curry compiler `cc`
as follows:
cc [-vn] [-iDIR] ... [-iDIR] [--parse-options="PO"] [-c|--compile] MOD
* `-vn`: verbosity with 0<=n<=4
* `-iDIR`: use `DIR` to search for imported modules
* `-c`: compile only
* `PO`: options passed to the Curry front end
* `MOD`: the module to be compiled containing an operation `main`
This command should compile module `MOD` (and, if necessary,
all imported modules) and create an executable `MOD` which
executes the operation `main` in this module. `MOD` might
be a hierarchical module name, e.g., `Dir.Mod`. In this case,
the executable `Dir.Mod` is generated where the source code
of the module is stored in `Dir/Mod.curry`.
If the option `-c` or `--compile` is provided,
the executable is not generated.
This might be reasonable to compile all modules in order
to check for errors and speed up later compilations
without re-compiling all imports.
If the module name is prefixed by a path, e.g., `dir1/dir2/Mod`,
then we change into the directory of the path (`dir1/dir2`)
and compile the main module there.
Further options:
----------------
Options beyond this general usage might depend on the compiler.
For instance, each compiler might implement a different set
of search strategies.
Here are some examples of options and their values:
* interactive (yes/no): should the user be asked to print the next result?
* first (yes/no): print only one result and stop?
* results (int n): number of results to be printed (n=0: infinite)
* time (yes/no): print execution time?
* strategy: search strategy to be used, e.g., dfs/bfs/ids/fs
* debug (yes/no): interactive debugging
* trace (yes/no): trace evaluation
* printdepth (int d): print resulting terms up to depth d (d=0: no limit)
The actual options are specified by data of type `CCOption`
(see module `REPL.Compiler`).
------------------------------------------------------------------------------
--- A REPL for the Curry->Go compiler.
--- The REPL can be compiled into an executable by
---
--- > cypm curry :l C2GoREPL.curry :save :q
---
--- @author Michael Hanus
--- @version February 2021
------------------------------------------------------------------------------
module C2GoREPL where
import Data.List ( intercalate )
import System.CurryPath ( sysLibPath )
import REPL.Compiler
import REPL.Main ( mainREPL )
main :: IO ()
main = mainREPL c2go
--- Specification of the Curry->Go compiler:
-- Adapt this definition to the actual location of the compiler:
c2goHome :: String
c2goHome = "/usr/local/curry2go"
c2go :: CCDescription
c2go = CCDescription
"curry2go"
c2goBanner
c2goHome
"info@curry-lang.org"
"curry2go"
(c2goHome ++ "/lib") -- base library path
False -- parser should read untyped FlatCurry
True -- use CURRYPATH variable
[stratOpt, intOpt, firstOpt]
c2goBanner :: String
c2goBanner = unlines [bannerLine, bannerText, bannerLine]
where
bannerText = "Curry2Go Interactive Environment"
bannerLine = take (length bannerText) (repeat '-')
stratOpt :: CCOption
stratOpt = CCOption
"fs/dfs/bfs "
"search strategy (fair / depth-first / breadth-first)"
[ ("fs" ,"--fs")
, ("dfs","--dfs")
, ("bfs","--bfs")
]
intOpt :: CCOption
intOpt = CCOption
"+/-interactive "
"turn on/off interactive evaluation of main expression"
[ ("-interactive","")
, ("+interactive","--interactive")
]
firstOpt :: CCOption
firstOpt = CCOption
"+/-first "
"turn on/off printing only first value/solution"
[ ("-first","")
, ("+first","--first")
]
------------------------------------------------------------------------------
{
"name": "curry-repl",
"version": "0.0.1",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "A universal REPL which can be used on top of a Curry compiler",
"category": [ "Programming" ],
"license": "BSD-3-Clause",
"licenseFile": "LICENSE",
"dependencies": {
"base" : ">=3.0.0, <4.0.0",
"abstract-curry" : ">=3.0.0, <4.0.0",
"currypath" : ">=3.0.0, <4.0.0",
"directory" : ">=3.0.0, <4.0.0",
"filepath" : ">=3.0.0, <4.0.0",
"frontend-exec" : ">=3.0.0, <4.0.0",
"io-extra" : ">=3.0.0, <4.0.0",
"process" : ">=3.0.0, <4.0.0",
"propertyfile" : ">=3.0.0, <4.0.0"
},
"exportedModules": [ "REPL.Main", "REPL.Compiler" ]
}
------------------------------------------------------------------------------
--- Definition of the parameters which must be defined to
--- implement a REPL for a given Curry compiler.
---
--- These parameters might be read at startup time (e.g., from
--- a JSON file) or statically defined in some module.
---
--- @author Michael Hanus
--- @version February 2021
------------------------------------------------------------------------------
module REPL.Compiler where
--- The description of a Curry compiler.
--- The name should be a sequence of alphanumeric characeters and
--- is used for naming resource files, main modules etc.
--- The title is shown in the banner.
--- The directory `ccHome` should contain a template `<ccName>rc.default`
--- with the a template for a resource configuration file.
data CCDescription = CCDescription
{ ccName :: String -- the name of the compiler
, ccBanner :: String -- the banner shown for the compiler
, ccHome :: String -- home directory of the compiler
, ccEmail :: String -- contact email (shown at startup)
, ccExec :: String -- the executable of the compiler
, ccLibPath :: String -- the path of the standard libraries
, ccTypedFC :: Bool -- should the parser read typed FlatCurry?
, ccCurryPath :: Bool -- use CURRYPATH instead of '-i' to set
-- import dirs for the compiler?
, ccOpts :: [CCOption] -- list of options for the compiler
}
--- An option implemented by a Curry compiler.
--- It consists a short and long description and a list of selections,
--- where each selection consists of a tag and the option passed
--- to the compiler if this value is selected.
--- All tags of an option are exclusive, i.e., at most one of them
--- can be set.
data CCOption = CCOption String String [(String,String)]
showCompilerOptions :: [CCOption] -> String
showCompilerOptions = unlines . map showOpt
where
showOpt (CCOption s1 s2 _) = s1 ++ " - " ++ s2
------------------------------------------------------------------------------
This diff is collapsed.
------------------------------------------------------------------------------
--- Some operations to handle the REPL resource configuration file
--- that is stored in $HOME/.<compiler-name>rc
---
--- @author Michael Hanus
--- @version February 2021
------------------------------------------------------------------------------
module REPL.RCFile -- (readRC, rcValue, setRCProperty, extractRCArgs, updateRCDefs)
where
import Control.Monad ( unless )
import Data.Char ( toLower, isSpace )
import Data.List ( sort )
import Data.PropertyFile
import System.FilePath ( FilePath, (</>), (<.>) )
import System.Directory ( getHomeDirectory, doesFileExist, copyFile
, renameFile )
import REPL.Compiler
import REPL.Utils ( strip )
--- The location of the default rc template.
defaultRC :: CCDescription -> FilePath
defaultRC cd = ccHome cd </> ccName cd ++ "rc.default"
--- Location of the rc file of a user.
--- After bootstrapping, one can also use Distribution.rcFileName
--- The name of the file specifying configuration parameters of the
--- current distribution. This file must have the usual format of
--- property files (see description in module PropertyFile).
rcFileName :: CCDescription -> IO FilePath
rcFileName cd = (</> "." ++ ccName cd ++ "rc") `fmap` getHomeDirectory
--- Reads the rc file. If it is not present, the standard file
--- from the distribution will be copied.
readRC :: CCDescription -> IO [(String, String)]
readRC cd = do
let rcdefname = defaultRC cd
rcdexists <- doesFileExist rcdefname
unless rcdexists $
error $ "Critical error: file '" ++ rcdefname ++ "' not found!"
rcname <- rcFileName cd
rcexists <- doesFileExist rcname
catch (if rcexists then updateRC cd else copyFile rcdefname rcname)
(const $ return ())
-- check again existence of user rc file:
newrcexists <- doesFileExist rcname
readPropertyFile (if newrcexists then rcname else rcdefname)
rcKeys :: [(String, String)] -> [String]
rcKeys = sort . map fst
--- Reads the rc file (which must be present) and compares the definitions
--- with the distribution rc file. If the set of variables is different,
--- update the rc file with the distribution but keep the user's definitions.
updateRC :: CCDescription -> IO ()
updateRC cd = do
rcname <- rcFileName cd
userprops <- readPropertyFile rcname
distprops <- readPropertyFile (defaultRC cd)
unless (rcKeys userprops == rcKeys distprops) $ do
putStrLn $ "Updating \"" ++ rcname ++ "\"..."
renameFile rcname $ rcname <.> "bak"
copyFile (defaultRC cd) rcname
mapM_ (\ (n, v) -> maybe (return ())
(\uv -> unless (uv == v) $ updatePropertyFile rcname n uv)
(lookup n userprops))
distprops
--- Sets a property in the rc file.
setRCProperty :: CCDescription -> String -> String -> IO ()
setRCProperty cd pname pval = do
readRC cd -- just be to sure that rc file exists and is up-to-date
rcname <- rcFileName cd
updatePropertyFile rcname pname pval
--- Look up a configuration variable in the list of variables from the rc file.
--- Uppercase/lowercase is ignored for the variable names and the empty
--- string is returned for an undefined variable.
rcValue :: [(String, String)] -> String -> String
rcValue rcdefs var = strip $ maybe "" id $
lookup (map toLower var) (map (first (map toLower)) rcdefs)
where
first f (x, y) = (f x, y)
--- Extract from a list of command-line arguments rc properties
--- of the from "-Dprop=val", which must be the first arguments,
--- and return the remaining arguments and the extracted properties.
extractRCArgs :: [String] -> ([String],[(String,String)])
extractRCArgs args =
let (dargs,otherargs) = break (\s -> take 2 s /= "-D") args
in (otherargs, map splitDefs (map (drop 2) dargs))
where
splitDefs darg = case break (=='=') darg of
(var,_:val) -> (var,val)
_ -> (darg,"")
--- Update list of rc properties w.r.t. a list new properties.
updateRCDefs :: [(String,String)] -> [(String,String)] -> [(String,String)]
updateRCDefs orgdefs newdefs =
map (\ (name,val) -> (name, maybe val id (lookup name newdefs))) orgdefs
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--- The state of the REPL.
---
--- @author Michael Hanus
--- @version February 2021
------------------------------------------------------------------------------
module REPL.State where
import Control.Monad ( unless )
import Curry.Compiler.Distribution ( installDir )
import System.Environment ( getArgs )
import System.IO ( Handle, hFlush, stdout )
import System.Directory ( doesFileExist )
import System.FilePath ( (</>), splitSearchPath )
import System.Process ( getPID )
import REPL.Compiler
data ReplState = ReplState
{ compiler :: CCDescription
, rcvars :: [(String, String)] -- content of rc file
, verbose :: Int -- verbosity level:
-- 0 = errors and warnings
-- 1 = show frontend compilation status
-- 2 = show also kics2c compilation status
-- 3 = show also ghc compilation status
-- 4 = show analysis information
, libPaths :: [String] -- directories containg the standard libraries
, importPaths :: [String] -- additional directories to search for imports
, preludeName :: String -- the name of the standard prelude
, currMod :: String -- name of current main module
, addMods :: [String] -- names of additionally added modules
, mainExpMod :: String -- name of module to store main expressions
, prompt :: String -- repl prompt shown in front of user input
, showTime :: Bool -- show execution of main goal?
, withShow :: Bool -- use class `Show` to show results
, showBindings :: Bool -- show free variables in main goal in output?
, safeExec :: Bool -- safe execution mode without I/O actions
, parseOpts :: String -- additional options for the front end
, rtsArgs :: String -- run-time arguments passed to main application
, cmpOpts :: [(String,String)] -- compiler-specific options
, quit :: Bool -- terminate the REPL?
, exitStatus :: Int -- exit status (set in case of REPL errors)
, sourceguis :: [(String,(String,Handle))] -- handles to SourceProgGUIs
}
--- Initial state of REPL w.r.t. a compiler description
initReplState :: CCDescription -> IO ReplState
initReplState cd = do
pid <- getPID
let compilerid = filter isAlphaNum (ccName cd)
mainmod <- getUnusedMod ("Main" ++ compilerid ++ show pid)
return $ ReplState
{ compiler = cd
, rcvars = []
, verbose = 1
, libPaths = splitSearchPath (ccLibPath cd)
, importPaths = []
, preludeName = "Prelude"
, currMod = "Prelude"
, addMods = []
, mainExpMod = mainmod
, prompt = "%s> "
, showTime = False
, withShow = False
, showBindings = False
, safeExec = False
, parseOpts = ""
, rtsArgs = ""
, cmpOpts = map (\ (CCOption _ _ tags) -> head tags) (ccOpts cd)
, quit = False
, exitStatus = 0
, sourceguis = []
}
where
getUnusedMod f = do
ex <- doesFileExist (f ++ ".curry")
if ex then getUnusedMod (f ++ "X")
else return f
mainExpFile :: ReplState -> String
mainExpFile rst = mainExpMod rst ++ ".curry"
loadPaths :: ReplState -> [String]
loadPaths rst = "." : importPaths rst ++ libPaths rst
--- Show an info message for a given verbosity level
writeVerboseInfo :: ReplState -> Int -> String -> IO ()
writeVerboseInfo rst lvl msg =
unless (verbose rst < lvl) (putStrLn msg >> hFlush stdout)
------------------------------------------------------------------------------
--- --------------------------------------------------------------------------
--- Some auxiliary operations for the REPL
--- --------------------------------------------------------------------------
module REPL.Utils
( showMonoTypeExpr, showMonoQualTypeExpr
, moduleNameToPath, validModuleName
, getTimeCmd, removeFileIfExists
, notNull, strip, lpad, rpad, writeErrorMsg
) where
import Control.Monad ( when )
import Data.Char ( isSpace )
import Data.List ( intercalate )
import AbstractCurry.Types
import System.Directory ( doesFileExist, removeFile )
import System.FilePath ( FilePath, (</>) )
import REPL.State
--------------------------------------------------------------------------
--- Shows an AbstractCurry type expression in standard Curry syntax.
--- If the first argument is True, all occurrences of type variables
--- are replaced by "()".
showMonoQualTypeExpr :: Bool -> CQualTypeExpr -> String
showMonoQualTypeExpr mono (CQualType cx ty) =
showContext mono cx ++ showMonoTypeExpr mono ty
--- Shows an AbstractCurry context in standard Curry syntax.
--- If the first argument is True, no context is shown.
showContext :: Bool -> CContext -> String
showContext False (CContext cs)
| null cs
= ""
| otherwise
= parens (length cs > 1) (intercalate ", " (map showConstraint cs)) ++ " => "
showContext True _ = ""
--- Shows an AbstractCurry constraint in standard Curry syntax.
showConstraint :: CConstraint -> String
showConstraint ((_, name), ty) =
showIdentifier name ++ " " ++ showMonoTypeExpr False ty
--- Shows an AbstractCurry type expression in standard Curry syntax.
--- If the first argument is True, all occurrences of type variables
--- are replaced by "()".
showMonoTypeExpr :: Bool -> CTypeExpr -> String
showMonoTypeExpr mono ty = showMonoTypeExpr' mono 0 ty
showMonoTypeExpr' :: Bool -> Int -> CTypeExpr -> String
showMonoTypeExpr' mono _ (CTVar (_,name)) =
if mono then "()" else showIdentifier name
showMonoTypeExpr' mono p (CFuncType domain range) = parens (p > 0) $
showMonoTypeExpr' mono 1 domain ++ " -> " ++ showMonoTypeExpr' mono 0 range
showMonoTypeExpr' _ _ (CTCons (_,name)) = name
showMonoTypeExpr' mono p texp@(CTApply tcon targ) = maybe
(parens (p > 1) $ showMonoTypeExpr' mono 2 tcon ++ " " ++
showMonoTypeExpr' mono 2 targ)
(\(mod,name) -> showTypeCons mono mod name (argsOfApply texp))
(funOfApply texp)
where
funOfApply te = case te of CTApply (CTCons qn) _ -> Just qn
CTApply tc _ -> funOfApply tc
_ -> Nothing
argsOfApply te = case te of
CTApply (CTCons _) ta -> [ta]
CTApply tc ta -> argsOfApply tc ++ [ta]
_ -> []
showTypeCons :: Bool -> String -> String -> [CTypeExpr] -> String
showTypeCons _ _ name [] = name
showTypeCons mono mod name ts@(_:_)
| mod == "Prelude" = showPreludeTypeCons mono name ts
| otherwise = name ++ prefixMap (showMonoTypeExpr' mono 2) ts " "
showPreludeTypeCons :: Bool -> String -> [CTypeExpr] -> String
showPreludeTypeCons mono name typelist
| name == "[]" && head typelist == CTCons (pre "Char")
= "String"
| name == "[]"
= "[" ++ showMonoTypeExpr' mono 0 (head typelist) ++ "]"
| isTuple name
= "(" ++ combineMap (showMonoTypeExpr' mono 0) typelist "," ++ ")"
| otherwise
= name ++ prefixMap (showMonoTypeExpr' mono 2) typelist " "
-- Remove characters '<' and '>' from identifiers since these characters
-- are sometimes introduced in new identifiers generated by the front end
-- (for sections)
showIdentifier :: String -> String
showIdentifier = filter (`notElem` "<>")
-- enclose string with parentheses if required by first argument
parens :: Bool -> String -> String
parens True s = '(' : s ++ ")"
parens False s = s
prefixMap :: (a -> [b]) -> [a] -> [b] -> [b]
prefixMap f xs s = concatMap (s ++) (map f xs)
combineMap :: (a -> [b]) -> [a] -> [b] -> [b]
combineMap _ [] _ = []
combineMap f (x:xs) s = f x ++ prefixMap f xs s
isTuple :: String -> Bool
isTuple [] = False
isTuple (x:xs) = x == '(' && p1_isTuple xs
where
p1_isTuple [] = False
p1_isTuple (z:[]) = z == ')'
p1_isTuple (z1:z2:zs) = z1 == ',' && p1_isTuple (z2:zs)
---------------------------------------------------------------------------
--- Transforms a hierarchical module identifier into a file path.
--- `moduleNameToPath "Data.Set"` evaluates to `"Data/Set"`.
moduleNameToPath :: String -> FilePath
moduleNameToPath = foldr1 (</>) . splitModuleIdentifiers
--- Split up the components of a module identifier. For instance,
--- `splitModuleIdentifiers "Data.Set"` evaluates to `["Data", "Set"]`.
splitModuleIdentifiers :: String -> [String]
splitModuleIdentifiers s = let (pref, rest) = break (== '.') s in
pref : case rest of
[] -> []
_ : s' -> splitModuleIdentifiers s'
--- Is a string a valid module name?
validModuleName :: String -> Bool
validModuleName = all (\c -> isAlphaNum c || c == '_' || c == '.')
---------------------------------------------------------------------------
-- Decorates a shell command so that timing information is shown if
-- the corresponding option is set.
getTimeCmd :: ReplState -> String -> String -> IO String
getTimeCmd rst timename cmd
| showTime rst = return $ timeCmd ++ cmd
| otherwise = return cmd
where
timeCmd = "time --format=\"" ++ timename ++ " time: %Us / elapsed: %E\" "
--- Removes the specified file only if it exists.
removeFileIfExists :: FilePath -> IO ()
removeFileIfExists file = do
exists <- doesFileExist file
when exists $ removeFile file
---------------------------------------------------------------------------
notNull :: [a] -> Bool
notNull = not . null
--- Remove leading and trailing whitespace
strip :: String -> String
strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace
--- Extend a String to a given minimal length by adding *leading* spaces.
lpad :: Int -> String -> String
lpad n s = replicate (n - length s) ' ' ++ s
--- Extend a String to a given minimal length by adding *trailing* spaces.
rpad :: Int -> String -> String
rpad n s = s ++ replicate (n - length s) ' '
---------------------------------------------------------------------------
--- Shows an error message.
writeErrorMsg :: String -> IO ()
writeErrorMsg msg = putStrLn $ "ERROR: " ++ msg
---------------------------------------------------------------------------
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment