@@ -41,11 +41,12 @@ import Language.PureScript.Options
4141import Language.PureScript.CodeGen.JS.AST as AST
4242import Language.PureScript.Types
4343import Language.PureScript.CodeGen.Optimize
44−import Language.PureScript.CodeGen.Common (identToJs)
44+import Language.PureScript.CodeGen.Common
4545import Language.PureScript.TypeChecker.Monad (canonicalizeDataConstructor)
4646
4747-- |
48−-- Generate code in the simplified Javascript intermediate representation for all declarations in a module
48+-- Generate code in the simplified Javascript intermediate representation for all declarations in a
49+-- module.
4950--
5051moduleToJs :: Options -> Module -> Environment -> [JS]
5152moduleToJs opts (Module pname@(ProperName name) decls) env =
@@ -85,16 +86,36 @@ declToJs _ mp (ExternDeclaration importTy ident (Just js) _) _ =
8586 Just $ js : setProperty ident (var ident) mp
8687declToJs _ _ _ _ = Nothing
8788
89+-- |
90+-- Generate code in the simplified Javascript intermediate representation for setting the property
91+-- of an object.
92+--
8893setProperty :: Ident -> JS -> ModuleName -> [JS]
8994setProperty ident@(Op op) val (ModuleName (ProperName moduleName)) =
90− [ JSAssignment (JSAccessor (identToJs ident) (JSVar moduleName)) val
91− , JSAssignment (JSIndexer (JSStringLiteral op) (JSVar moduleName)) (JSAccessor (identToJs ident) (JSVar moduleName)) ]
95+ [ JSAssignment (accessor ident (JSVar moduleName)) val
96+ , JSAssignment (JSIndexer (JSStringLiteral op) (JSVar moduleName)) (accessor ident (JSVar moduleName)) ]
9297setProperty ident val (ModuleName (ProperName moduleName)) =
93− [ JSAssignment (JSAccessor (identToJs ident) (JSVar moduleName)) val ]
98+ [ JSAssignment (accessor ident (JSVar moduleName)) val ]
9499
100+-- |
101+-- Generate code in the simplified Javascript intermediate representation for a variable based on a
102+-- PureScript identifier.
103+--
95104var :: Ident -> JS
96105var = JSVar . identToJs
97106
107+-- |
108+-- Generate code in the simplified Javascript intermediate representation for an accessor based on
109+-- a PureScript identifier. If the name is not valid in Javascript (symbol based, reserved name) an
110+-- indexer is returned.
111+--
112+accessor :: Ident -> JS -> JS
113+accessor (Ident name) | nameIsJsReserved name = JSIndexer (JSStringLiteral name)
114+accessor ident = JSAccessor (identToJs ident)
115+
116+-- |
117+-- Generate code in the simplified Javascript intermediate representation for a value or expression.
118+--
98119valueToJs :: Options -> ModuleName -> Environment -> Value -> JS
99120valueToJs _ _ _ (NumericLiteral n) = JSNumericLiteral n
100121valueToJs _ _ _ (StringLiteral s) = JSStringLiteral s
@@ -104,21 +125,31 @@ valueToJs opts m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs
104125valueToJs opts m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar "Object")) [ valueToJs opts m e o, JSObjectLiteral (map (second (valueToJs opts m e)) ps)]
105126valueToJs _ m e (Constructor (Qualified Nothing name)) =
106127 case M.lookup (m, name) (dataConstructors e) of
107− Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS identToJs (Qualified (Just aliasModule) aliasIdent)
128+ Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS id (Qualified (Just aliasModule) aliasIdent)
108129 _ -> JSVar . runProperName $ name
109−valueToJs _ _ _ (Constructor name) = qualifiedToJS runProperName name
130+valueToJs _ _ _ (Constructor name) = qualifiedToJS (Ident . runProperName) name
110131valueToJs opts m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs opts m e) sts))) []
111132valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values)
112133valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)
113134valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)
114135valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]
115−valueToJs opts m e (Abs arg val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m e val)])
136+valueToJs opts m e (Abs arg val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m (bindName m arg e) val)])
116137valueToJs opts m e (TypedValue _ (Abs arg val) ty) | optionsPerformRuntimeTypeChecks opts = let arg' = identToJs arg in JSFunction Nothing [arg'] (JSBlock $ runtimeTypeChecks arg' ty ++ [JSReturn (valueToJs opts m e val)])
117138valueToJs _ m e (Var ident) = varToJs m e ident
118139valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
119140valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"
120141valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
121142
143+-- |
144+-- Temporarily extends the environment to include a local variable name introduced by a lambda
145+-- abstraction.
146+--
147+bindName :: ModuleName -> Ident -> Environment -> Environment
148+bindName m ident env = env { names = M.insert (m, ident) (error "Temporary lambda variable type was read", LocalVariable) $ names env }
149+
150+-- |
151+-- Generate code in the simplified Javascript intermediate representation for runtime type checks.
152+--
122153runtimeTypeChecks :: String -> Type -> [JS]
123154runtimeTypeChecks arg ty =
124155 let
@@ -148,6 +179,10 @@ runtimeTypeChecks arg ty =
148179 arrayCheck :: JS -> JS
149180 arrayCheck js = JSIfElse (JSUnary Not (JSApp (JSAccessor "isArray" (JSVar "Array")) [js])) (JSBlock [JSThrow (JSStringLiteral "Array expected")]) Nothing
150181
182+-- |
183+-- Generate code in the simplified Javascript intermediate representation for a reference to a
184+-- variable.
185+--
151186varToJs :: ModuleName -> Environment -> Qualified Ident -> JS
152187varToJs m e qual@(Qualified _ ident) = go qual
153188 where
@@ -156,18 +191,25 @@ varToJs m e qual@(Qualified _ ident) = go qual
156191 Just (_, Alias aliasModule aliasIdent) -> go (Qualified (Just aliasModule) aliasIdent)
157192 _ -> case qual of
158193 Qualified Nothing _ -> var ident
159− Qualified (Just (ModuleName (ProperName mn))) (Op op) -> JSIndexer (JSStringLiteral op) (JSVar mn)
160− _ -> qualifiedToJS identToJs qual
194+ _ -> qualifiedToJS id qual
161195 isExtern (Extern ForeignImport) = True
162196 isExtern (Alias m' ident') = case M.lookup (m', ident') (names e) of
163197 Just (_, ty') -> isExtern ty'
164198 Nothing -> error "Undefined alias in varToJs"
165199 isExtern _ = False
166200
167−qualifiedToJS :: (a -> String) -> Qualified a -> JS
168−qualifiedToJS f (Qualified (Just (ModuleName (ProperName m))) a) = JSAccessor (f a) (JSVar m)
169−qualifiedToJS f (Qualified Nothing a) = JSVar (f a)
201+-- |
202+-- Generate code in the simplified Javascript intermediate representation for a reference to a
203+-- variable that may have a qualified name.
204+--
205+qualifiedToJS :: (a -> Ident) -> Qualified a -> JS
206+qualifiedToJS f (Qualified (Just (ModuleName (ProperName m))) a) = accessor (f a) (JSVar m)
207+qualifiedToJS f (Qualified Nothing a) = JSVar $ identToJs (f a)
170208
209+-- |
210+-- Generate code in the simplified Javascript intermediate representation for pattern match binders
211+-- and guards.
212+--
171213bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> JS
172214bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders, vals))) $ do
173215 valNames <- replicateM (length vals) fresh
@@ -183,6 +225,10 @@ bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders,
183225 binderToJs m e v done'' b
184226 go _ _ _ _ = error "Invalid arguments to bindersToJs"
185227
228+-- |
229+-- Generate code in the simplified Javascript intermediate representation for a pattern match
230+-- binder.
231+--
186232binderToJs :: ModuleName -> Environment -> String -> [JS] -> Binder -> Gen [JS]
187233binderToJs _ _ _ done NullBinder = return done
188234binderToJs _ _ varName done (StringBinder str) =
@@ -246,6 +292,10 @@ binderToJs m e varName done (NamedBinder ident binder) = do
246292 js <- binderToJs m e varName done binder
247293 return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
248294
295+-- |
296+-- Checks whether a data constructor is the only constructor for that type, used to simplify the
297+-- check when generating code for binders.
298+--
249299isOnlyConstructor :: ModuleName -> Environment -> Qualified ProperName -> Bool
250300isOnlyConstructor m e ctor =
251301 let (ty, _) = fromMaybe (error "Data constructor not found") $ qualify m ctor `M.lookup` dataConstructors e
@@ -258,6 +308,10 @@ isOnlyConstructor m e ctor =
258308 typeConstructor (TypeApp ty _) = typeConstructor ty
259309 typeConstructor fn = error $ "Invalid arguments to typeConstructor: " ++ show fn
260310
311+-- |
312+-- Generate code in the simplified Javascript intermediate representation for a statement in a
313+-- PureScript block.
314+--
261315statementToJs :: Options -> ModuleName -> Environment -> Statement -> JS
262316statementToJs opts m e (VariableIntroduction ident value) = JSVariableIntroduction (identToJs ident) (Just (valueToJs opts m e value))
263317statementToJs opts m e (Assignment target value) = JSAssignment (JSVar (identToJs target)) (valueToJs opts m e value)