git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Very basic version of GHCJS-style imports, no parsing of JS, yet.
commitc17fbe37772ac82ae243f980e0409354c4ff07e9 authorPhil Freeman <paf31@cantab.net> dateFri 10 Jan 2014, 13:00 (13 years ago) parentd32d9eb
10 files changed+27−52
compare with golang
unifiedsplit
examples/passing/ExternMember.purs−5 examples/passing/ExternRaw.purs+7 libraries/prelude/prelude.purs+6−2 src/Language/PureScript/CodeGen/Externs.hs−2 src/Language/PureScript/CodeGen/JS.hs+7−18 src/Language/PureScript/CodeGen/JS/AST.hs+2−1 src/Language/PureScript/Declarations.hs+1−2 src/Language/PureScript/Parser/Declarations.hs+2−4 src/Language/PureScript/Pretty/JS.hs+1 src/Language/PureScript/TypeChecker.hs+1−18
examples/passing/ExternMember.pursdeleted−5
@@ -1,5 +0,0 @@
1−module ExternMember where
2−
3−foreign import member "length" length :: String -> Number
4−
5−foreign import member "concat" concat :: forall a. [a] -> [a] -> [a]
examples/passing/ExternRaw.pursnew file+7
@@ -0,0 +1,7 @@
1+module ExternRaw where
2+
3+foreign import concat "function concat(xs) { \
4+ \ return function(ys) { \
5+ \ return xs.concat(ys); \
6+ \ };\
7+ \}" :: forall a. [a] -> [a] -> [a]
libraries/prelude/prelude.purs+6−2
@@ -79,7 +79,9 @@ module Arrays where
7979 foldl _ b [] = b
8080 foldl f b (a:as) = foldl f (f a b) as
8181
82− foreign import member "length" length :: forall a. [a] -> Number
82+ foreign import length "function length(xs) { \
83+ \ return xs.length; \
84+ \}" :: forall a. [a] -> Number
8385
8486 foreign import indexOf :: forall a. [a] -> a -> Number
8587
@@ -167,7 +169,9 @@ module Tuple where
167169
168170module String where
169171
170− foreign import member "length" lengthS :: String -> Number
172+ foreign import lengthS "function lengthS(s) {\
173+ \ return s.length;\
174+ \}" :: String -> Number
171175
172176 foreign import charAt :: Number -> String -> String
173177
src/Language/PureScript/CodeGen/Externs.hs−2
@@ -40,8 +40,6 @@ declToPs path env (BindingGroupDeclaration vals) = do
4040declToPs path env (DataDeclaration name _ _) = maybeToList $ do
4141 (kind, _) <- M.lookup (path, name) $ types env
4242 return $ "foreign import data " ++ show name ++ " :: " ++ prettyPrintKind kind
43−declToPs _ _ (ExternMemberDeclaration member name ty) =
44− return $ "foreign import member " ++ show member ++ " " ++ show name ++ " :: " ++ prettyPrintType ty
4543declToPs _ _ (ExternDataDeclaration name kind) =
4644 return $ "foreign import data " ++ show name ++ " :: " ++ prettyPrintKind kind
4745declToPs _ _ (TypeSynonymDeclaration name args ty) =
src/Language/PureScript/CodeGen/JS.hs+7−18
@@ -36,12 +36,19 @@ import Language.PureScript.Types
3636
3737moduleToJs :: Options -> Module -> Environment -> [JS]
3838moduleToJs opts (Module pname@(ProperName name) decls) env =
39+ let
40+ rawDecls = mapMaybe filterRawDecls decls
41+ in
42+ map JSRaw rawDecls ++
3943 [ JSVariableIntroduction (Ident name) Nothing
4044 , JSApp (JSFunction Nothing [Ident name]
4145 (JSBlock (concat $ mapMaybe (\decl -> declToJs opts (ModuleName pname) decl env) decls)))
4246 [JSAssignment (JSAssignVariable (Ident name))
4347 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]
4448 ]
49+ where
50+ filterRawDecls (ExternDeclaration _ (Just js) _) = Just js
51+ filterRawDecls _ = Nothing
4552
4653declToJs :: Options -> ModuleName -> Declaration -> Environment -> Maybe [JS]
4754declToJs opts mp (ValueDeclaration ident _ _ val) e =
@@ -52,24 +59,6 @@ declToJs opts mp (BindingGroupDeclaration vals) e =
5259 [ JSVariableIntroduction ident (Just (valueToJs opts mp e val)),
5360 setProperty (identToJs ident) (JSVar ident) mp ]
5461 ) vals
55−declToJs _ mp (ExternMemberDeclaration member ident ty) _
56− | returnsFunction ty =
57− Just [ JSFunction (Just ident) [Ident "value"] (JSBlock
58− [ JSReturn $ JSApp (JSAccessor "bind" (JSAccessor member (JSVar (Ident "value")))) [JSVar (Ident "value")]
59− ]),
60− setProperty (show ident) (JSVar ident) mp ]
61− | otherwise =
62− Just [ JSFunction (Just ident) [Ident "value"] (JSBlock
63− [ JSReturn $ JSAccessor member (JSVar (Ident "value"))
64− ]),
65− setProperty (show ident) (JSVar ident) mp ]
66− where
67− returnsFunction (Function _ ret) = isFunction ret
68− returnsFunction (ForAll _ ty') = returnsFunction ty'
69− returnsFunction _ = error "Expected function type in declToJs"
70− isFunction (Function _ _) = True
71− isFunction (ForAll _ ty') = isFunction ty'
72− isFunction _ = False
7362declToJs _ mp (DataDeclaration _ _ ctors) _ =
7463 Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->
7564 let
src/Language/PureScript/CodeGen/JS/AST.hs+2−1
@@ -46,7 +46,8 @@ data JS
4646 | JSTypeOf JS
4747 | JSLabel String JS
4848 | JSBreak String
49− | JSContinue String deriving (Show, Data, Typeable)
49+ | JSContinue String
50+ | JSRaw String deriving (Show, Data, Typeable)
5051
5152data JSAssignment
5253 = JSAssignVariable Ident
src/Language/PureScript/Declarations.hs+1−2
@@ -38,8 +38,7 @@ data Declaration
3838 | TypeDeclaration Ident Type
3939 | ValueDeclaration Ident [[Binder]] (Maybe Guard) Value
4040 | BindingGroupDeclaration [(Ident, Value)]
41− | ExternDeclaration Ident Type
42− | ExternMemberDeclaration String Ident Type
41+ | ExternDeclaration Ident (Maybe String) Type
4342 | ExternDataDeclaration ProperName Kind
4443 | FixityDeclaration Fixity String
4544 | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])
src/Language/PureScript/Parser/Declarations.hs+2−4
@@ -65,10 +65,8 @@ parseExternDeclaration = P.try (reserved "foreign") *> indented *> (reserved "im
6565 (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)
6666 <*> (lexeme (indented *> P.string "::") *> parseKind)
6767 <|> ExternDeclaration <$> parseIdent
68− <*> (lexeme (indented *> P.string "::") *> parsePolyType)
69− <|> ExternMemberDeclaration <$> (P.try (reserved "member") *> indented *> stringLiteral)
70− <*> (indented *> parseIdent)
71− <*> (lexeme (indented *> P.string "::") *> parsePolyType))
68+ <*> P.optionMaybe stringLiteral
69+ <*> (lexeme (indented *> P.string "::") *> parsePolyType))
7270
7371parseAssociativity :: P.Parsec String ParseState Associativity
7472parseAssociativity =
src/Language/PureScript/Pretty/JS.hs+1
@@ -124,6 +124,7 @@ literals = mkPattern' match
124124 [ return $ lbl ++ ": "
125125 , prettyPrintJS' js
126126 ]
127+ match (JSRaw js) = return js
127128 match _ = mzero
128129
129130targetToJs :: JSAssignment -> String
src/Language/PureScript/TypeChecker.hs+1−18
@@ -125,24 +125,7 @@ typeCheckAll moduleName (ExternDataDeclaration name kind : rest) = do
125125 guardWith (show name ++ " is already defined") $ not $ M.member (moduleName, name) (types env)
126126 putEnv $ env { types = M.insert (moduleName, name) (kind, TypeSynonym) (types env) }
127127 typeCheckAll moduleName rest
128−typeCheckAll moduleName (ExternMemberDeclaration member name ty : rest) = do
129− rethrow (("Error in foreign import member declaration " ++ show name ++ ":\n") ++) $ do
130− env <- getEnv
131− kind <- kindOf moduleName ty
132− guardWith "Expected kind *" $ kind == Star
133− case M.lookup (moduleName, name) (names env) of
134− Just _ -> throwError $ show name ++ " is already defined"
135− Nothing -> case ty of
136− _ | isSingleArgumentFunction ty -> do
137− putEnv (env { names = M.insert (moduleName, name) (ty, Extern) (names env)
138− , members = M.insert (moduleName, name) member (members env) })
139− | otherwise -> throwError "Foreign member declarations must have function types, with an single argument."
140− typeCheckAll moduleName rest
141− where
142− isSingleArgumentFunction (Function [_] _) = True
143− isSingleArgumentFunction (ForAll _ t) = isSingleArgumentFunction t
144− isSingleArgumentFunction _ = False
145−typeCheckAll moduleName (ExternDeclaration name ty : rest) = do
128+typeCheckAll moduleName (ExternDeclaration name _ ty : rest) = do
146129 rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do
147130 env <- getEnv
148131 kind <- kindOf moduleName ty