c17fbe3 · rowtype-yoga/purescript-native

examples/passing/ExternMember.pursdeleted−5

compare with golang

unifiedsplit

@@ -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

79 foldl _ b [] = b

80 foldl f b (a:as) = foldl f (f a b) as

81

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

83

85

84 foreign import indexOf :: forall a. [a] -> a -> Number

86 foreign import indexOf :: forall a. [a] -> a -> Number

85

87

@@ -167,7 +169,9 @@ module Tuple where

167

169

168module String where

170module String where

169

171

172+ foreign import lengthS "function lengthS(s) {\

173+ \ return s.length;\

170− foreign import member "length" lengthS :: String -> Number

174+ \}" :: String -> Number

171

175

172 foreign import charAt :: Number -> String -> String

176 foreign import charAt :: Number -> String -> String

173

177

src/Language/PureScript/CodeGen/Externs.hs−2

@@ -40,8 +40,6 @@ declToPs path env (BindingGroupDeclaration vals) = do

40declToPs path env (DataDeclaration name _ _) = maybeToList $ do

41 (kind, _) <- M.lookup (path, name) $ types env

42 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

45declToPs _ _ (ExternDataDeclaration name kind) =

43declToPs _ _ (ExternDataDeclaration name kind) =

46 return $ "foreign import data " ++ show name ++ " :: " ++ prettyPrintKind kind

44 return $ "foreign import data " ++ show name ++ " :: " ++ prettyPrintKind kind

47declToPs _ _ (TypeSynonymDeclaration name args ty) =

45declToPs _ _ (TypeSynonymDeclaration name args ty) =

src/Language/PureScript/CodeGen/JS.hs+7−18

@@ -36,12 +36,19 @@ import Language.PureScript.Types

36

37moduleToJs :: Options -> Module -> Environment -> [JS]

38moduleToJs opts (Module pname@(ProperName name) decls) env =

39+ let

40+ rawDecls = mapMaybe filterRawDecls decls

41+ in

42+ map JSRaw rawDecls ++

39 [ JSVariableIntroduction (Ident name) Nothing

43 [ JSVariableIntroduction (Ident name) Nothing

40 , JSApp (JSFunction Nothing [Ident name]

44 , JSApp (JSFunction Nothing [Ident name]

41 (JSBlock (concat $ mapMaybe (\decl -> declToJs opts (ModuleName pname) decl env) decls)))

45 (JSBlock (concat $ mapMaybe (\decl -> declToJs opts (ModuleName pname) decl env) decls)))

42 [JSAssignment (JSAssignVariable (Ident name))

46 [JSAssignment (JSAssignVariable (Ident name))

43 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]

47 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]

44 ]

48 ]

49+ where

50+ filterRawDecls (ExternDeclaration _ (Just js) _) = Just js

51+ filterRawDecls _ = Nothing

45

52

46declToJs :: Options -> ModuleName -> Declaration -> Environment -> Maybe [JS]

53declToJs :: Options -> ModuleName -> Declaration -> Environment -> Maybe [JS]

47declToJs opts mp (ValueDeclaration ident _ _ val) e =

54declToJs opts mp (ValueDeclaration ident _ _ val) e =

@@ -52,24 +59,6 @@ declToJs opts mp (BindingGroupDeclaration vals) e =

52 [ JSVariableIntroduction ident (Just (valueToJs opts mp e val)),

59 [ JSVariableIntroduction ident (Just (valueToJs opts mp e val)),

53 setProperty (identToJs ident) (JSVar ident) mp ]

60 setProperty (identToJs ident) (JSVar ident) mp ]

54 ) vals

61 ) 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

73declToJs _ mp (DataDeclaration _ _ ctors) _ =

62declToJs _ mp (DataDeclaration _ _ ctors) _ =

74 Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->

63 Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->

75 let

64 let

src/Language/PureScript/CodeGen/JS/AST.hs+2−1

@@ -46,7 +46,8 @@ data JS

46 | JSTypeOf JS

47 | JSLabel String JS

48 | JSBreak String

49+ | JSContinue String

49− | JSContinue String deriving (Show, Data, Typeable)

50+ | JSRaw String deriving (Show, Data, Typeable)

50

51

51data JSAssignment

52data JSAssignment

52 = JSAssignVariable Ident

53 = JSAssignVariable Ident

src/Language/PureScript/Declarations.hs+1−2

@@ -38,8 +38,7 @@ data Declaration

38 | TypeDeclaration Ident Type

39 | ValueDeclaration Ident [[Binder]] (Maybe Guard) Value

40 | BindingGroupDeclaration [(Ident, Value)]

41− | ExternDeclaration Ident Type

41+ | ExternDeclaration Ident (Maybe String) Type

42− | ExternMemberDeclaration String Ident Type

43 | ExternDataDeclaration ProperName Kind

42 | ExternDataDeclaration ProperName Kind

44 | FixityDeclaration Fixity String

43 | FixityDeclaration Fixity String

45 | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])

44 | 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

65 (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)

66 <*> (lexeme (indented *> P.string "::") *> parseKind)

67 <|> ExternDeclaration <$> parseIdent

68− <*> (lexeme (indented *> P.string "::") *> parsePolyType)

68+ <*> P.optionMaybe stringLiteral

69− <|> ExternMemberDeclaration <$> (P.try (reserved "member") *> indented *> stringLiteral)

70− <*> (indented *> parseIdent)

71− <*> (lexeme (indented *> P.string "::") *> parsePolyType))

69+ <*> (lexeme (indented *> P.string "::") *> parsePolyType))

72

70

73parseAssociativity :: P.Parsec String ParseState Associativity

71parseAssociativity :: P.Parsec String ParseState Associativity

74parseAssociativity =

72parseAssociativity =

src/Language/PureScript/Pretty/JS.hs+1

@@ -124,6 +124,7 @@ literals = mkPattern' match

124 [ return $ lbl ++ ": "

125 , prettyPrintJS' js

126 ]

127+ match (JSRaw js) = return js

127 match _ = mzero

128 match _ = mzero

128

129

129targetToJs :: JSAssignment -> String

130targetToJs :: JSAssignment -> String

src/Language/PureScript/TypeChecker.hs+1−18

@@ -125,24 +125,7 @@ typeCheckAll moduleName (ExternDataDeclaration name kind : rest) = do

125 guardWith (show name ++ " is already defined") $ not $ M.member (moduleName, name) (types env)

126 putEnv $ env { types = M.insert (moduleName, name) (kind, TypeSynonym) (types env) }

127 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

146 rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do

129 rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do

147 env <- getEnv

130 env <- getEnv

148 kind <- kindOf moduleName ty

131 kind <- kindOf moduleName ty