0 | ||| State used during JS code generation and when
  1 | ||| converting `NamedCExp` to imperative statements.
  2 | module Compiler.ES.State
  3 |
  4 | import Core.Context
  5 | import Compiler.ES.Ast
  6 | import Compiler.NoMangle
  7 | import Data.SortedMap
  8 |
  9 | %default total
 10 |
 11 | --------------------------------------------------------------------------------
 12 | --          Utilities
 13 | --------------------------------------------------------------------------------
 14 |
 15 | ||| Convenient alias for `throw . InternalError`
 16 | export
 17 | error : String -> Core a
 18 | error = throw . InternalError
 19 |
 20 | ||| Convenient alias for `error . fastConcat`.
 21 | export
 22 | errorConcat : List String -> Core a
 23 | errorConcat = error . fastConcat
 24 |
 25 | --------------------------------------------------------------------------------
 26 | --          CG Mode
 27 | --------------------------------------------------------------------------------
 28 |
 29 | ||| Specifies the readability of the generated code.
 30 | |||
 31 | ||| In `Pretty` mode (the default), the codegen will
 32 | ||| lift multiline lambdas from argument lists to the
 33 | ||| surrounding scope and keep user generated names.
 34 | ||| In addition, blocks of code are laid out with indentation
 35 | ||| and linebreaks for better readability.
 36 | |||
 37 | ||| In `Compact` mode, all local variables are replace with
 38 | ||| short machine generated ones, and every toplevel
 39 | ||| function is printed on a single line without
 40 | ||| line-breaks or indentation.
 41 | |||
 42 | ||| Finally, `Minimal` mode is like `Compact`, but toplevel
 43 | ||| function names will be mangled and replaced with
 44 | ||| machine generated indices.
 45 | public export
 46 | data CGMode = Pretty | Compact | Minimal
 47 |
 48 | ||| We only keep user defined local names and only so
 49 | ||| in `Pretty` mode.
 50 | export
 51 | keepLocalName : Name -> CGMode -> Bool
 52 | keepLocalName (UN n) Pretty = True
 53 | keepLocalName _      _      = False
 54 |
 55 | ||| We mangle toplevel function names only in `Minimal` mode.
 56 | export
 57 | keepRefName : Name -> CGMode -> Bool
 58 | keepRefName _ Minimal = False
 59 | keepRefName _ _       = True
 60 |
 61 | --------------------------------------------------------------------------------
 62 | --          State
 63 | --------------------------------------------------------------------------------
 64 |
 65 | public export
 66 | data ESs : Type where
 67 |
 68 | ||| Settings and state used during JS code generation.
 69 | public export
 70 | record ESSt where
 71 |   constructor MkESSt
 72 |   ||| Whether to always use minimal names
 73 |   mode     : CGMode
 74 |
 75 |   ||| Returns `True`, if the given expression can be used as an
 76 |   ||| argument in a function call. (If this returns `False`, the
 77 |   ||| given expression will be lifted to the surrounding scope
 78 |   ||| and bound to a new local variable).
 79 |   isArg    : Exp -> Bool
 80 |
 81 |   ||| Returns `True`, if the given expression can be used directly
 82 |   ||| in a function application. (If this returns `False`, the
 83 |   ||| given expression will be lifted to the surrounding scope
 84 |   ||| and bound to a variable).
 85 |   isFun    : Exp -> Bool
 86 |
 87 |   ||| Current local variable index
 88 |   loc      : Int
 89 |
 90 |   ||| Current global variable index
 91 |   ref      : Int
 92 |
 93 |   ||| Mapping from local names to minimal expressions
 94 |   locals   : SortedMap Name Minimal
 95 |
 96 |   ||| Mapping from toplevel function names to variables
 97 |   refs     : SortedMap Name Var
 98 |
 99 |   ||| Mappings from name to definitions to be added
100 |   ||| to the preamble.
101 |   preamble : SortedMap String String
102 |
103 |   ||| Accepted codegen types in foreign function definitions.
104 |   ||| For JS, this is either `["node","javascript"]` or
105 |   ||| `["browser","javascript"]`.
106 |   ccTypes  : List String
107 |
108 |   ||| %nomangle names
109 |   noMangleMap : NoMangleMap
110 |
111 | --------------------------------------------------------------------------------
112 | --          Local Variables
113 | --------------------------------------------------------------------------------
114 |
115 | ||| Map a local name to the given minimal expression
116 | export
117 | addLocal : { auto c : Ref ESs ESSt } -> Name -> Minimal -> Core ()
118 | addLocal n v = update ESs $ { locals $= insert n v }
119 |
120 | ||| Get and bump the local var index
121 | export
122 | nextLocal : { auto c : Ref ESs ESSt } -> Core Var
123 | nextLocal = do
124 |   st <- get ESs
125 |   put ESs $ { loc $= (+1) } st
126 |   pure $ VLoc st.loc
127 |
128 | ||| Register a `Name` as a local variable. The name is kept
129 | ||| unchanged if `keepLocalName` returns `True` with the
130 | ||| current name and state, otherwise it is converted to
131 | ||| a new local variable.
132 | export
133 | registerLocal : {auto c : Ref ESs ESSt} -> (name : Name) -> Core Var
134 | registerLocal n = do
135 |   st <- get ESs
136 |   if keepLocalName n st.mode
137 |      then let v = VName n in addLocal n (MVar v) >> pure v
138 |      else do v <- nextLocal
139 |              addLocal n (MVar v)
140 |              pure v
141 |
142 | ||| Look up a name and call `registerLocal` in case it has
143 | ||| not been added to the map of local names.
144 | export
145 | getOrRegisterLocal : {auto c : Ref ESs ESSt} -> Name -> Core Minimal
146 | getOrRegisterLocal n = do
147 |   Nothing <- lookup n . locals <$> get ESs
148 |     | Just v => pure v
149 |   MVar <$> registerLocal n
150 |
151 | ||| Maps the given list of names (from a pattern match
152 | ||| on a data constructor) to the corresponding
153 | ||| projections on the given scrutinee.
154 | export
155 | projections :  {auto c : Ref ESs ESSt}
156 |             -> (scrutinee : Minimal)
157 |             -> List Name
158 |             -> Core ()
159 | projections sc xs =
160 |   let ps = zip [1..length xs] xs
161 |    in traverse_ (\(i,n) => addLocal n $ MProjection i sc) ps
162 |
163 | --------------------------------------------------------------------------------
164 | --          Toplevel Names
165 | --------------------------------------------------------------------------------
166 |
167 | ||| Map a toplevel function name to the given `Var`
168 | export
169 | addRef : { auto c : Ref ESs ESSt } -> Name -> Var -> Core ()
170 | addRef n v = update ESs $ { refs $= insert n v }
171 |
172 | ||| Get and bump the local ref index
173 | export
174 | nextRef : { auto c : Ref ESs ESSt } -> Core Var
175 | nextRef = do
176 |   st <- get ESs
177 |   put ESs $ { ref $= (+1) } st
178 |   pure $ VRef st.ref
179 |
180 | registerRef :  {auto c : Ref ESs ESSt}
181 |             -> (name : Name)
182 |             -> Core Var
183 | registerRef n = do
184 |   st <- get ESs
185 |   if keepRefName n st.mode || isJust (isNoMangle st.noMangleMap n)
186 |      then let v = VName n in addRef n v >> pure v
187 |      else do v <- nextRef
188 |              addRef n v
189 |              pure v
190 |
191 | ||| Look up a name and call `registerRef` in case it has
192 | ||| not been added to the map of toplevel function names.
193 | ||| The name will be replace with an index if the current
194 | ||| `GCMode` is set to `Minimal`.
195 | export
196 | getOrRegisterRef :  {auto c : Ref ESs ESSt}
197 |                  -> Name
198 |                  -> Core Var
199 | getOrRegisterRef n = do
200 |   Nothing <- lookup n . refs <$> get ESs
201 |     | Just v => pure v
202 |   registerRef n
203 |
204 | --------------------------------------------------------------------------------
205 | --          Preamble and Foreign Definitions
206 | --------------------------------------------------------------------------------
207 |
208 | ||| Add a new set of definitions under the given name to
209 | ||| the preamble. Fails with an error if a different set
210 | ||| of definitions have already been added under the same name.
211 | export
212 | addToPreamble :  {auto c : Ref ESs ESSt}
213 |               -> (name : String)
214 |               -> (def : String) -> Core ()
215 | addToPreamble name def = do
216 |   s <- get ESs
217 |   case lookup name (preamble s) of
218 |     Nothing => put ESs $ { preamble $= insert name def } s
219 |     Just x =>
220 |       unless (x == def) $ do
221 |         errorConcat
222 |               [ "two incompatible definitions for ", name
223 |               , "<|",x ,"|> <|" , def, "|>"
224 |               ]
225 |
226 | --------------------------------------------------------------------------------
227 | --          Initialize State
228 | --------------------------------------------------------------------------------
229 |
230 | ||| Initial state of the code generator
231 | export
232 | init :  (mode  : CGMode)
233 |      -> (isArg : Exp -> Bool)
234 |      -> (isFun : Exp -> Bool)
235 |      -> (types : List String)
236 |      -> (noMangle : NoMangleMap)
237 |      -> ESSt
238 | init mode isArg isFun ccs noMangle =
239 |   MkESSt mode isArg isFun 0 0 empty empty empty ccs noMangle
240 |
241 | ||| Reset the local state before defining a new toplevel
242 | ||| function.
243 | export
244 | reset : {auto c : Ref ESs ESSt} -> Core ()
245 | reset = update ESs $ { loc := 0, locals := empty }
246 |