1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
---------------------------------------------------------------------------
--- This program implements the `runcurry` command that allows
--- to run a Curry program without explicitly invoking the REPL.
---
--- Basically, it has three modes of operation:
--- * execute the main operation of a Curry program whose file name
---   is provided as an argument
--- * execute the main operation of a Curry program whose program text
---   comes from the standard input
--- * execute the main operation of a Curry program whose program text
---   is in a script file (starting with `#!/usr/bin/env runcurry`).
---   If the script file contains the line `#jit`, it is compiled
---   and saved as an executable so that it is faster executed
---   when called the next time.
---
--- Note that the `runcurry` command is intended to compile simple
--- Curry programs which use only base libraries but not other
--- Curry packages.
--- Otherwise, one has to adapt the constant `replOpts` below.
---
--- @author Michael Hanus
--- @version March 2024
---------------------------------------------------------------------------

import Control.Monad               ( unless )
import Curry.Compiler.Distribution ( installDir )
import Data.Char                   ( isSpace )
import Data.List                   ( partition )
import System.Environment          ( getArgs )
import System.IO                   ( getContents, hFlush, stdout )

import System.CurryPath    ( setCurryPath, stripCurrySuffix )
import System.Directory
import System.FilePath     ( (<.>), (</>), isRelative, takeExtension )
import System.Process      ( exitWith, getPID, system )

---------------------------------------------------------------------------
-- The default options for the REPL of the Curry system: quiet compilation
-- and no use of the Curry package manager.
-- If the actual Curry system has different options, this constant
-- should be adapted.
-- The option `--nocypm` is set since the CURRYPATH is explicitly set
-- (by `setCurryPath`) before the runner starts.
replOpts :: String
replOpts = "--nocypm :set v0 :set parser -Wnone :set -time"

---------------------------------------------------------------------------

main :: IO ()
main = do
  args <- getArgs
  case args of
    ("-h":_)     -> putStrLn usageMsg
    ("--help":_) -> putStrLn usageMsg
    ("-?":_)     -> putStrLn usageMsg
    _            -> do setCurryPath True ""
                       checkFirstArg [] args

-- Usage message:
usageMsg :: String
usageMsg = unlines $
  ["Usage:"
  ,""
  ,"As a shell command:"
  ,"> runcurry [Curry system options] <Curry program name> <run-time arguments>"
  ,""
  ,"As a shell script: start script with"
  ,"#!/usr/bin/env runcurry"
  ,"...your Curry program defining operation 'main'..."
  ,""
  ,"In interactive mode:"
  ,"> runcurry"
  ,"...type your Curry program until end-of-file..."
  ]

-- Check whether runcurry is called in script mode, i.e., the argument
-- is not a Curry program but an existing file:
checkFirstArg :: [String] -> [String] -> IO ()
checkFirstArg curryargs [] = do
  -- no program argument provided, use remaining input as program:
  putStrLn "Type in your program with an operation 'main':"
  hFlush stdout
  progname <- getNewProgramName
  getContents >>= writeFile progname
  execAndDeleteCurryProgram progname curryargs [] >>= exitWith
checkFirstArg curryargs (arg1:args) =
  if takeExtension arg1 `elem` [".curry",".lcurry"]
  then execCurryProgram arg1 curryargs args >>= exitWith
  else do
    isexec <- isExecutable arg1
    if isexec
     then do
       -- argument is not a Curry file but it is an executable, hence, a script:
       -- store it in a Curry program, where lines starting with '#' are removed
       progname <- getNewProgramName
       proginput <- readFile arg1
       let (proglines, hashlines) = partition noHashLine (lines proginput)
           progtext = unlines proglines
       if any isHashJITOption hashlines
        then execOrJIT arg1 progname progtext curryargs args >>= exitWith
        else do
          writeFile progname progtext
          execAndDeleteCurryProgram progname curryargs args >>= exitWith
     else checkFirstArg (curryargs ++ [arg1]) args

-- Execute an already compiled binary (if it is newer than the first file arg)
-- or compile the program and execute the binary:
execOrJIT :: String -> String -> String -> [String] -> [String] -> IO Int
execOrJIT scriptfile progname progtext curryargs rtargs = do
  let binname = if isRelative scriptfile
                  then "." </> scriptfile <.> "bin"
                  else scriptfile <.> "bin"
  binexists <- doesFileExist binname
  binok <- if binexists
             then do
               stime <- getModificationTime scriptfile
               btime <- getModificationTime binname
               return (btime>stime)
            else return False
  if binok
   then do
     ec <- system $ unwords $ binname : rtargs
     if ec==0
      then return 0
      else -- An error occurred with the old binary, hence we try to re-compile:
           compileAndExec binname
   else compileAndExec binname
 where
  compileAndExec binname = do
    writeFile progname progtext
    ec <- saveCurryProgram progname curryargs binname
    if ec==0 then system $ unwords $ binname : rtargs
             else return ec

-- Is a hash line a JIT option, i.e., of the form "#jit"?
isHashJITOption :: String -> Bool
isHashJITOption s = stripSpaces (tail s) == "jit"

noHashLine :: String -> Bool
noHashLine [] = True
noHashLine (c:_) = c /= '#'

-- Generates a new program name for temporary program:
getNewProgramName :: IO String
getNewProgramName = do
  pid <- getPID
  genNewProgName ("RUNCURRY_" ++ show pid)
 where
  genNewProgName name = do
    let progname = name ++ ".curry"
    exname <- doesFileExist progname
    if exname then genNewProgName (name ++ "_0")
              else return progname

-- Is the argument the name of an executable file?
isExecutable :: String -> IO Bool
isExecutable fname = do
  fexists <- doesFileExist fname
  if fexists
    then do ec <- system $ "test -x " ++ fname
            return (ec==0)
    else return False

-- Saves a Curry program with given Curry system arguments into a binary
-- (last argument) and delete the program after the compilation:
saveCurryProgram :: String -> [String] -> String -> IO Int
saveCurryProgram progname curryargs binname = do
  ec <- system $ installDir </> "bin" </> "curry " ++ replOpts ++ " " ++
                 unwords curryargs ++ " :load " ++ progname ++
                 " :save :quit"
  unless (ec/=0) $ renameFile (stripCurrySuffix progname) binname
  system $ installDir </> "bin" </> "cleancurry" ++ " " ++ progname
  removeFile progname
  return ec

-- Executes a Curry program with given Curry system arguments and
-- run-time arguments:
execCurryProgram :: String -> [String] -> [String] -> IO Int
execCurryProgram progname curryargs rtargs = system $
  installDir </> "bin" </> "curry " ++ replOpts ++ " " ++
  unwords curryargs ++ " :load " ++ progname ++
  " :set args " ++ unwords rtargs ++ " :eval main :quit"

-- Executes a Curry program with given Curry system arguments and
-- run-time arguments and delete the program after the execution:
execAndDeleteCurryProgram :: String -> [String] -> [String] -> IO Int
execAndDeleteCurryProgram progname curryargs rtargs = do
  ec <- execCurryProgram progname curryargs rtargs
  system $ installDir </> "bin" </> "cleancurry " ++ progname
  removeFile progname
  return ec

-- Strips leading and tailing spaces:
stripSpaces :: String -> String
stripSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace