@@ -81,14 +81,18 @@ importToJs mt opts mn = JSVariableIntroduction (moduleNameToJs mn) (Just moduleB
8181 Globals -> JSAccessor (moduleNameToJs mn) (JSVar (fromJust (optionsBrowserNamespace opts)))
8282
8383imports :: Declaration -> [ModuleName]
84−imports =
85− let (f, _, _, _, _) = everythingOnValues (++) (const []) collect (const []) (const []) (const [])
86− in f
84+imports (ImportDeclaration mn _ _) = [mn]
85+imports other =
86+ let (f, _, _, _, _) = everythingOnValues (++) (const []) collectV collectB (const []) (const [])
87+ in f other
8788 where
88− collect :: Value -> [ModuleName]
89− collect (Var (Qualified (Just mn) _)) = [mn]
90− collect (Constructor (Qualified (Just mn) _)) = [mn]
91− collect _ = []
89+ collectV :: Value -> [ModuleName]
90+ collectV (Var (Qualified (Just mn) _)) = [mn]
91+ collectV (Constructor (Qualified (Just mn) _)) = [mn]
92+ collectV _ = []
93+ collectB :: Binder -> [ModuleName]
94+ collectB (ConstructorBinder (Qualified (Just mn) _) _) = [mn]
95+ collectB _ = []
9296
9397-- |
9498-- Generate code in the simplified Javascript intermediate representation for a declaration
@@ -102,16 +106,24 @@ declToJs opts mp (BindingGroupDeclaration vals) e = do
102106 js <- valueToJs opts mp e val
103107 return $ JSVariableIntroduction (identToJs ident) (Just js)
104108 return $ Just jss
105−declToJs _ mp (DataDeclaration _ _ ctors) _ = do
109+declToJs _ _ (DataDeclaration _ _ ctors) _ = do
106110 return $ Just $ flip concatMap ctors $ \(pn@(ProperName ctor), tys) ->
107− [JSVariableIntroduction ctor (Just (go pn 0 tys []))]
111+ let _ctor = '_' : ctor
112+ in [ JSVariableIntroduction _ctor (Just (makeConstructor (length tys)))
113+ , JSVariableIntroduction ctor (Just (go pn 0 (length tys) []))
114+ ]
108115 where
109− go :: ProperName -> Integer -> [Type] -> [JS] -> JS
110− go pn _ [] values =
111− JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn))), ("values", JSArrayLiteral $ reverse values) ]
112− go pn index (_ : tys') values =
116+ makeConstructor :: Int -> JS
117+ makeConstructor n =
118+ let
119+ args = [ "value" ++ show index | index <- [0..n-1] ]
120+ body = [ JSAssignment (JSAccessor arg (JSVar "this")) (JSVar arg) | arg <- args ]
121+ in JSFunction Nothing args (JSBlock body)
122+ go :: ProperName -> Int -> Int -> [JS] -> JS
123+ go pn _ 0 values = JSApp (JSNew (JSVar ('_' : runProperName pn))) (reverse values)
124+ go pn index n values =
113125 JSFunction Nothing ["value" ++ show index]
114− (JSBlock [JSReturn (go pn (index + 1) tys' (JSVar ("value" ++ show index) : values))])
126+ (JSBlock [JSReturn (go pn (index + 1) (n - 1) (JSVar ("value" ++ show index) : values))])
115127declToJs opts mp (DataBindingGroupDeclaration ds) e = do
116128 jss <- mapM (\decl -> declToJs opts mp decl e) ds
117129 return $ Just $ concat $ catMaybes jss
@@ -123,7 +135,7 @@ declToJs _ _ _ _ = return Nothing
123135-- Generate key//value pairs for an object literal exporting values from a module.
124136--
125137exportToJs :: DeclarationRef -> [(String, JS)]
126−exportToJs (TypeRef _ (Just dctors)) = map ((\n -> (n, var (Ident n))) . runProperName) dctors
138+exportToJs (TypeRef _ (Just dctors)) = concatMap ((\n -> [('_' : n, var (Ident ('_' : n))), (n, var (Ident n))]) . runProperName) dctors
127139exportToJs (ValueRef name) = [(runIdent name, var name)]
128140exportToJs (TypeInstanceRef name) = [(runIdent name, var name)]
129141exportToJs _ = []
@@ -291,23 +303,25 @@ binderToJs _ _ varName done (BooleanBinder False) =
291303 return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
292304binderToJs _ _ varName done (VarBinder ident) =
293305 return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
294−binderToJs m e varName done (ConstructorBinder ctor bs) = do
306+binderToJs m e varName done (ConstructorBinder ctor@(Qualified ctorModule (ProperName ctorName)) bs) = do
295307 js <- go 0 done bs
296308 if isOnlyConstructor e ctor
297309 then
298310 return js
299311 else
300− return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar varName)) (JSStringLiteral (show ctor)))
312+ return [JSIfElse (JSInstanceOf (JSVar varName) (qualifiedToJS m (Ident . runProperName) _ctor))
301313 (JSBlock js)
302314 Nothing]
303315 where
316+ _ctor :: Qualified ProperName
317+ _ctor = Qualified ctorModule (ProperName ('_' : ctorName))
304318 go :: (Functor m, Applicative m, Monad m) => Integer -> [JS] -> [Binder] -> SupplyT m [JS]
305319 go _ done' [] = return done'
306320 go index done' (binder:bs') = do
307321 argVar <- freshName
308322 done'' <- go (index + 1) done' bs'
309323 js <- binderToJs m e argVar done'' binder
310− return (JSVariableIntroduction argVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSAccessor "values" (JSVar varName)))) : js)
324+ return (JSVariableIntroduction argVar (Just (JSAccessor ("value" ++ show index) (JSVar varName))) : js)
311325binderToJs m e varName done (ObjectBinder bs) = go done bs
312326 where
313327 go :: (Functor m, Applicative m, Monad m) => [JS] -> [(String, Binder)] -> SupplyT m [JS]