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
---------------------------------------------------------------------------
--- 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.
---
--- @author Michael Hanus
--- @version December 2018
---------------------------------------------------------------------------

import Char         ( isSpace )
import Directory
import Distribution ( installDir )
import FileGoodies  ( fileSuffix )
import FilePath     ( (<.>), (</>), isRelative )
import IO           ( getContents, hFlush, stdout )
import List         ( partition )
import System       ( exitWith, getArgs, getPID, system )

import System.CurryPath ( stripCurrySuffix )

main :: IO ()
main = do
  args <- getArgs
  case args of
    ("-h":_)     -> putStrLn usageMsg
    ("--help":_) -> putStrLn usageMsg
    ("-?":_)     -> putStrLn usageMsg
    _            -> 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 fileSuffix 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

-- Our default options for the REPL:
replOpts :: String
replOpts = ":set v0 :set parser -Wnone :set -time"

-- 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