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
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
------------------------------------------------------------------------------
--- This module contains operations to execute the front end of the
--- Curry system.
---
--- @author Bernd Brassel, Michael Hanus, Bjoern Peemoeller, Finn Teegen
--- @version December 2020
------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}

module System.FrontendExec
  (FrontendTarget(..)

  , FrontendParams(..), defaultParams, rcParams
  , setQuiet, setExtended, setCpp, addDefinition, setDefinitions
  , setOverlapWarn, setFullPath, setHtmlDir, setLogfile, addTarget, setSpecials
  , setFrontendPath

  , callFrontend, callFrontendWithParams
  ) where

import Data.Char          ( toUpper )
import Data.List          ( intercalate, nub )
import Data.PropertyFile  ( getPropertiesFromFile )
import System.FilePath    ( FilePath, (</>), takeDirectory, takeFileName )
import System.Process     ( system )
import System.CurryPath   ( curryrcFileName, currySubdir, getLoadPathForModule )
import Language.Curry.Distribution
                          ( curryCompiler, curryCompilerMajorVersion
                          , curryCompilerMinorVersion, installDir
                          )

-------------------------------------------------------------------
-- calling the front end
-------------------------------------------------------------------

--- Data type for representing the different target files that can be produced
--- by the front end of the Curry compiler.
--- @cons FCY   - FlatCurry file ending with .fcy
--- @cons TFCY  - Typed FlatCurry file ending with .tfcy
--- @cons FINT  - FlatCurry interface file ending with .fint
--- @cons ACY   - AbstractCurry file ending with .acy
--- @cons UACY  - Untyped (without type checking) AbstractCurry file ending with .uacy
--- @cons HTML  - colored HTML representation of source program
--- @cons CY    - source representation employed by the frontend
--- @cons TOKS  - token stream of source program
--- @cons AST   - abstract syntax tree ending with .sast
--- @cons SAST  - shortened abstract syntax tree ending with .sast
--- @cons COMMS - comments stream ending with .cycom
data FrontendTarget = FCY | TFCY | FINT | ACY | UACY | HTML | CY | TOKS | TAFCY
                    | AST | SAST | COMMS
  deriving (Eq, Show)

--- Abstract data type for representing parameters supported by the front end
--- of the Curry compiler.
-- The parameters are of the form
-- FrontendParams Quiet Extended Cpp NoOverlapWarn FullPath HtmlDir LogFile Specials FrontendPath
data FrontendParams =
  FrontendParams
    { quiet           :: Bool              -- work silently
    , extended        :: Bool              -- support extended Curry syntax
    , cpp             :: Bool              -- enable conditional compiling
    , definitions     :: [(String, Int)]   -- definitions for conditional compiling
    , overlapWarn     :: Bool              -- warn for overlapping rules
    , fullPath        :: Maybe [String]    -- the complete list of directory names for loading modules
    , htmldir         :: Maybe String      -- output directory (only relevant for HTML target)
    , logfile         :: Maybe String      -- store all output (including errors) of the front end in file
    , targets         :: [FrontendTarget]  -- additional targets for the front end
    , specials        :: String            -- additional special parameters (use with care!)
    , frontendPath    :: String            -- the path to the frontend executable
    }

--- The default parameters of the front end.
defaultParams :: FrontendParams
defaultParams =
  FrontendParams
    { quiet        = False
    , extended     = True
    , cpp          = False
    , definitions  = defaultDefs
    , overlapWarn  = True
    , fullPath     = Nothing
    , htmldir      = Nothing
    , logfile      = Nothing
    , targets      = []
    , specials     = ""
    , frontendPath = installDir </> "bin" </> curryCompiler ++ "-frontend"
    }
 where
  defaultDefs = [("__" ++ map toUpper curryCompiler ++ "__",
                  curryCompilerMajorVersion * 100 + curryCompilerMinorVersion)]

--- The default parameters of the front end as configured by the compiler
--- specific resource configuration file.
rcParams :: IO FrontendParams
rcParams = do
  rcfile <- curryrcFileName
  [mbExtended,mbOverlapWarn] <- getPropertiesFromFile rcfile
                                  ["curryextensions","warnoverlapping"]
  return $ setExtended    (mbExtended    /= Just "no")
         $ setOverlapWarn (mbOverlapWarn /= Just "no")
         $ defaultParams

--- Set quiet mode of the front end.
setQuiet :: Bool -> FrontendParams -> FrontendParams
setQuiet s ps = ps { quiet = s }

--- Set extended mode of the front end.
setExtended :: Bool -> FrontendParams -> FrontendParams
setExtended s ps = ps { extended = s }

--- Set cpp mode of the front end.
setCpp :: Bool -> FrontendParams -> FrontendParams
setCpp s ps = ps { cpp = s }

--- Add cpp definition of the front end.
addDefinition :: (String, Int) -> FrontendParams -> FrontendParams
addDefinition d ps = ps { definitions = definitions ps ++ [d] }

--- Set cpp definitions of the front end.
setDefinitions :: [(String, Int)] -> FrontendParams -> FrontendParams
setDefinitions s ps = ps { definitions = s }

--- Set overlap warn mode of the front end.
setOverlapWarn :: Bool -> FrontendParams -> FrontendParams
setOverlapWarn s ps = ps { overlapWarn = s }

--- Set the full path of the front end.
--- If this parameter is set, the front end searches all modules
--- in this path (instead of using the default path).
setFullPath :: [String] -> FrontendParams -> FrontendParams
setFullPath s ps = ps { fullPath = Just s }

--- Set the htmldir parameter of the front end.
--- Relevant for HTML generation.
setHtmlDir :: String -> FrontendParams -> FrontendParams
setHtmlDir s ps = ps { htmldir = Just s }

--- Set the logfile parameter of the front end.
--- If this parameter is set, all messages produced by the front end
--- are stored in this file.
setLogfile :: String -> FrontendParams -> FrontendParams
setLogfile s ps = ps { logfile = Just s }

--- Set additional specials parameters of the front end.
--- These parameters are specific for the current front end and
--- should be used with care, since their form might change in the future.
setSpecials :: String -> FrontendParams -> FrontendParams
setSpecials s ps = ps { specials = s }

--- Add an additional front end target.
addTarget :: FrontendTarget -> FrontendParams -> FrontendParams
addTarget t ps = ps { targets = t : targets ps }

--- Sets the path to the frontend executable.
setFrontendPath :: String -> FrontendParams -> FrontendParams
setFrontendPath s ps = ps { frontendPath = s }

--- In order to make sure that compiler generated files (like .fcy, .fint, .acy)
--- are up to date, one can call the front end of the Curry compiler
--- with this action.
--- If the front end returns with an error, an exception is raised.
--- @param target - the kind of target file to be generated
--- @param progname - the name of the main module of the application to be compiled
callFrontend :: FrontendTarget -> String -> IO ()
callFrontend target p = do
  params <- rcParams
  callFrontendWithParams target params p

--- In order to make sure that compiler generated files (like .fcy, .fint, .acy)
--- are up to date, one can call the front end of the Curry compiler
--- with this action where various parameters can be set.
--- If the front end returns with an error, an exception is raised.
--- @param target - the kind of target file to be generated
--- @param params - parameters for the front end
--- @param modpath - the name of the main module possibly prefixed with a
---                  directory where this module resides
callFrontendWithParams :: FrontendTarget -> FrontendParams -> String -> IO ()
callFrontendWithParams target params modpath = do
  parsecurry <- callParseCurry
  let lf      = maybe "" id (logfile params)
      tgts    = nub (target : targets params)
      syscall = unwords $ [parsecurry] ++ map showFrontendTarget tgts ++
                          [showFrontendParams, cppParams, takeFileName modpath]
  retcode <- if null lf
             then system syscall
             else system (syscall ++ " > " ++ lf ++ " 2>&1")
  if retcode == 0
   then return ()
   else ioError (userError "Illegal source program")
 where
   callParseCurry = do
     path <- maybe (getLoadPathForModule modpath)
                   (\p -> return (nub (takeDirectory modpath : p)))
                   (fullPath params)
     return (quote (frontendPath params)
             ++ concatMap ((" -i" ++) . quote) path)

   quote s = '"' : s ++ "\""

   showFrontendTarget FCY   = "--flat"
   showFrontendTarget TFCY  = "--typed-flat"
   showFrontendTarget TAFCY = "--type-annotated-flat"
   showFrontendTarget FINT  = "--flat"
   showFrontendTarget ACY   = "--acy"
   showFrontendTarget UACY  = "--uacy"
   showFrontendTarget HTML  = "--html"
   showFrontendTarget CY    = "--parse-only"
   showFrontendTarget TOKS  = "--tokens"
   showFrontendTarget AST   = "--ast"
   showFrontendTarget SAST  = "--short-ast"
   showFrontendTarget COMMS = "--comments"

   showFrontendParams = unwords
    [ "-o ", currySubdir
    , if quiet       params then runQuiet     else ""
    , if extended    params then "--extended" else ""
    , if cpp         params then "--cpp"      else ""
    , if overlapWarn params then ""           else "--no-overlap-warn"
    , maybe "" ("--htmldir="++) (htmldir params)
    , specials params

    , if target `elem` [FCY,TFCY,TAFCY,FINT]
        then "-Odesugar-newtypes" -- remove when newtypes added to FlatCurry
        else ""

    ]

   runQuiet = "--no-verb --no-warn --no-overlap-warn"

   cppParams = intercalate " " $ map showDefinition (definitions params)

   showDefinition (s, v) = "-D" ++ s ++ "=" ++ show v

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