765aeb4 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Add --dump-corefn command line option (#2275)

765aeb4rightfold10 years ago

CONTRIBUTORS.md+1

@@ -64,6 +64,7 @@ This file lists the contributors to the PureScript compiler project, and the ter

64- [@philopon](https://github.com/philopon) (Hirotomo Moriwaki) - My existing contributions and all future contributions until further notice are Copyright Hirotomo Moriwaki, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

65- [@pseudonom](https://github.com/pseudonom) (Eric Easley) My existing contributions and all future contributions until further notice are Copyright Eric Easley, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

66- [@puffnfresh](https://github.com/puffnfresh) (Brian McKenna) All contributions I made during June 2015 were during employment at [SlamData, Inc.](#companies) who owns the copyright. I assign copyright of all my personal contributions before June 2015 to the owners of the PureScript compiler.

67+- [@rightfold](https://github.com/rightfold) (rightfold) My existing contributions and all future contributions until further notice are Copyright rightfold, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](https://opensource.org/licenses/MIT).

67- [@robdaemon](https://github.com/robdaemon) (Robert Roland) My existing contributions and all future contributions until further notice are Copyright Robert Roland, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

68- [@robdaemon](https://github.com/robdaemon) (Robert Roland) My existing contributions and all future contributions until further notice are Copyright Robert Roland, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

68- [@RossMeikleham](https://github.com/RossMeikleham) (Ross Meikleham) My existing contributions and all future contributions until further notice are Copyright Ross Meikleham, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

69- [@RossMeikleham](https://github.com/RossMeikleham) (Ross Meikleham) My existing contributions and all future contributions until further notice are Copyright Ross Meikleham, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

69- [@rvion](https://github.com/rvion) (Rémi Vion) My existing contributions and all future contributions until further notice are Copyright Rémi Vion, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

70- [@rvion](https://github.com/rvion) (Rémi Vion) My existing contributions and all future contributions until further notice are Copyright Rémi Vion, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

psc/Main.hs+6

@@ -143,6 +143,11 @@ sourceMaps = switch $

143 long "source-maps"

144 <> help "Generate source maps"

145

146+dumpCoreFn :: Parser Bool

147+dumpCoreFn = switch $

148+ long "dump-corefn"

149+ <> help "Dump the (functional) core representation of the compiled code at output/*/corefn.json"

150+

146

151

147options :: Parser P.Options

152options :: Parser P.Options

148options = P.Options <$> noTco

153options = P.Options <$> noTco

@@ -152,6 +157,7 @@ options = P.Options <$> noTco

152 <*> verboseErrors

157 <*> verboseErrors

153 <*> (not <$> comments)

158 <*> (not <$> comments)

154 <*> sourceMaps

159 <*> sourceMaps

160+ <*> dumpCoreFn

155

161

156pscMakeOptions :: Parser PSCMakeOptions

162pscMakeOptions :: Parser PSCMakeOptions

157pscMakeOptions = PSCMakeOptions <$> many inputFile

163pscMakeOptions = PSCMakeOptions <$> many inputFile

purescript.cabal+1

@@ -180,6 +180,7 @@ library

180 Language.PureScript.CoreFn.Meta

181 Language.PureScript.CoreFn.Module

182 Language.PureScript.CoreFn.Traversals

183+ Language.PureScript.CoreFn.ToJSON

183 Language.PureScript.Comments

184 Language.PureScript.Comments

184 Language.PureScript.Environment

185 Language.PureScript.Environment

185 Language.PureScript.Errors

186 Language.PureScript.Errors

src/Language/PureScript/CoreFn/ToJSON.hsnew file+116

@@ -0,0 +1,116 @@

1+-- |

2+-- Dump the core functional representation in JSON format for consumption

3+-- by third-party code generators

4+--

5+module Language.PureScript.CoreFn.ToJSON

6+ ( moduleToJSON

7+ ) where

9+import Prelude.Compat

10+

11+import Data.Aeson

12+import Data.Version (Version, showVersion)

13+import Data.Text (pack)

14+

15+import Language.PureScript.AST.Literals

16+import Language.PureScript.CoreFn

17+import Language.PureScript.Names

18+

19+literalToJSON :: (a -> Value) -> Literal a -> Value

20+literalToJSON _ (NumericLiteral (Left n)) = toJSON ("IntLiteral", n)

21+literalToJSON _ (NumericLiteral (Right n)) = toJSON ("NumberLiteral", n)

22+literalToJSON _ (StringLiteral s) = toJSON ("StringLiteral", s)

23+literalToJSON _ (CharLiteral c) = toJSON ("CharLiteral", c)

24+literalToJSON _ (BooleanLiteral b) = toJSON ("BooleanLiteral", b)

25+literalToJSON t (ArrayLiteral xs) = toJSON ("ArrayLiteral", map t xs)

26+literalToJSON t (ObjectLiteral xs) = toJSON ("ObjectLiteral", recordToJSON t xs)

27+

28+identToJSON :: Ident -> Value

29+identToJSON = toJSON . runIdent

30+

31+properNameToJSON :: ProperName a -> Value

32+properNameToJSON = toJSON . runProperName

33+

34+qualifiedToJSON :: (a -> String) -> Qualified a -> Value

35+qualifiedToJSON f = toJSON . showQualified f

36+

37+moduleNameToJSON :: ModuleName -> Value

38+moduleNameToJSON = toJSON . runModuleName

39+

40+moduleToJSON :: Version -> Module a -> Value

41+moduleToJSON v m = object [ pack "imports" .= map (moduleNameToJSON . snd) (moduleImports m)

42+ , pack "exports" .= map identToJSON (moduleExports m)

43+ , pack "foreign" .= map (identToJSON . fst) (moduleForeign m)

44+ , pack "decls" .= map bindToJSON (moduleDecls m)

45+ , pack "builtWith" .= toJSON (showVersion v)

46+ ]

47+

48+bindToJSON :: Bind a -> Value

49+bindToJSON (NonRec _ n e) = object [ pack (runIdent n) .= exprToJSON e ]

50+bindToJSON (Rec bs) = object $ map (\((_, n), e) -> pack (runIdent n) .= exprToJSON e) bs

51+

52+recordToJSON :: (a -> Value) -> [(String, a)] -> Value

53+recordToJSON f = object . map (\(label, a) -> pack label .= f a)

54+

55+exprToJSON :: Expr a -> Value

56+exprToJSON (Var _ i) = toJSON ( "Var"

57+ , qualifiedToJSON runIdent i

58+ )

59+exprToJSON (Literal _ l) = toJSON ( "Literal"

60+ , literalToJSON (exprToJSON) l

61+ )

62+exprToJSON (Constructor _ d c is) = toJSON ( "Constructor"

63+ , properNameToJSON d

64+ , properNameToJSON c

65+ , map identToJSON is

66+ )

67+exprToJSON (Accessor _ f r) = toJSON ( "Accessor"

68+ , f

69+ , exprToJSON r

70+ )

71+exprToJSON (ObjectUpdate _ r fs) = toJSON ( "ObjectUpdate"

72+ , exprToJSON r

73+ , recordToJSON exprToJSON fs

74+ )

75+exprToJSON (Abs _ p b) = toJSON ( "Abs"

76+ , identToJSON p

77+ , exprToJSON b

78+ )

79+exprToJSON (App _ f x) = toJSON ( "App"

80+ , exprToJSON f

81+ , exprToJSON x

82+ )

83+exprToJSON (Case _ ss cs) = toJSON ( "Case"

84+ , map exprToJSON ss

85+ , map caseAlternativeToJSON cs

86+ )

87+exprToJSON (Let _ bs e) = toJSON ( "Let"

88+ , map bindToJSON bs

89+ , exprToJSON e

90+ )

91+

92+caseAlternativeToJSON :: CaseAlternative a -> Value

93+caseAlternativeToJSON (CaseAlternative bs r') =

94+ toJSON [ toJSON (map binderToJSON bs)

95+ , case r' of

96+ Left rs -> toJSON $ map (\(g, e) -> (exprToJSON g, exprToJSON e)) rs

97+ Right r -> exprToJSON r

98+ ]

99+

100+binderToJSON :: Binder a -> Value

101+binderToJSON (VarBinder _ v) = toJSON ( "VarBinder"

102+ , identToJSON v

103+ )

104+binderToJSON (NullBinder _) = toJSON "NullBinder"

105+binderToJSON (LiteralBinder _ l) = toJSON ( "LiteralBinder"

106+ , literalToJSON binderToJSON l

107+ )

108+binderToJSON (ConstructorBinder _ d c bs) = toJSON ( "ConstructorBinder"

109+ , qualifiedToJSON runProperName d

110+ , qualifiedToJSON runProperName c

111+ , map binderToJSON bs

112+ )

113+binderToJSON (NamedBinder _ n b) = toJSON ( "NamedBinder"

114+ , identToJSON n

115+ , binderToJSON b

116+ )

src/Language/PureScript/Make.hs+9

@@ -1,5 +1,6 @@

1{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-# LANGUAGE TypeFamilies #-}

3+{-# LANGUAGE OverloadedStrings #-}

4module Language.PureScript.Make

5module Language.PureScript.Make

5 (

6 (

@@ -36,6 +37,7 @@ import Control.Monad.Trans.Except

36import Control.Monad.Writer.Class (MonadWriter(..))

37import Control.Monad.Writer.Class (MonadWriter(..))

38import Data.Aeson (encode, decode)

39import Data.Aeson (encode, decode)

40+import qualified Data.Aeson as Aeson

39import Data.ByteString.Builder (toLazyByteString, stringUtf8)

41import Data.ByteString.Builder (toLazyByteString, stringUtf8)

40import Data.Either (partitionEithers)

42import Data.Either (partitionEithers)

41import Data.Foldable (for_)

43import Data.Foldable (for_)

@@ -69,6 +71,7 @@ import qualified Language.PureScript.Bundle as Bundle

69import qualified Language.PureScript.CodeGen.JS as J

71import qualified Language.PureScript.CodeGen.JS as J

70import qualified Language.PureScript.Constants as C

72import qualified Language.PureScript.Constants as C

71import qualified Language.PureScript.CoreFn as CF

73import qualified Language.PureScript.CoreFn as CF

74+import qualified Language.PureScript.CoreFn.ToJSON as CFJ

72import qualified Language.PureScript.Parser as PSParser

75import qualified Language.PureScript.Parser as PSParser

74import qualified Paths_purescript as Paths

77import qualified Paths_purescript as Paths

@@ -369,6 +372,12 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

369 for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile)

372 for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile)

370 writeTextFile externsFile exts

373 writeTextFile externsFile exts

371 lift $ when sourceMaps $ genSourceMap dir mapFile (length prefix) mappings

374 lift $ when sourceMaps $ genSourceMap dir mapFile (length prefix) mappings

375+ dumpCoreFn <- lift $ asks optionsDumpCoreFn

376+ when dumpCoreFn $ do

377+ let coreFnFile = outputDir </> filePath </> "corefn.json"

378+ let jsonPayload = CFJ.moduleToJSON Paths.version m

379+ let json = Aeson.object [ (fromString (runModuleName mn), jsonPayload) ]

380+ lift $ writeTextFile coreFnFile (BU8.toString . B.toStrict . encode $ json)

372

381

373 genSourceMap :: String -> String -> Int -> [SMap] -> Make ()

382 genSourceMap :: String -> String -> Int -> [SMap] -> Make ()

374 genSourceMap dir mapFile extraLines mappings = do

383 genSourceMap dir mapFile extraLines mappings = do

src/Language/PureScript/Options.hs+4−1

@@ -31,9 +31,12 @@ data Options = Options {

31 -- |

32 -- Generate soure maps

33 , optionsSourceMaps :: Bool

34+ -- |

35+ -- Dump CoreFn

36+ , optionsDumpCoreFn :: Bool

34 } deriving Show

37 } deriving Show

36-- |

39-- |

37-- Default make options

40-- Default make options

38defaultOptions :: Options

41defaultOptions :: Options

39−defaultOptions = Options False False Nothing False False False False

42+defaultOptions = Options False False Nothing False False False False False