git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Update externs codegen for newtypes
commit169e4ad438aea88607501661009d245578b23311 authorGary Burgess <gary.burgess@gmail.com> dateSat 26 Jul 2014, 18:44 (12 years ago) parent5a61b93
3 files changed+59−50
compare with golang
unifiedsplit
src/Language/PureScript/CodeGen/Common.hs+53 src/Language/PureScript/CodeGen/Externs.hs+5−1 src/Language/PureScript/CodeGen/JS.hs+1−49
src/Language/PureScript/CodeGen/Common.hs+53
@@ -17,7 +17,14 @@ module Language.PureScript.CodeGen.Common where
1717
1818import Data.Char
1919import Data.List (intercalate)
20+import Data.Maybe (fromMaybe)
21+import Data.Function (on)
22+
23+import qualified Data.Map as M
24+
2025import Language.PureScript.Names
26+import Language.PureScript.Environment
27+import Language.PureScript.Types
2128
2229-- |
2330-- Convert an Ident into a valid Javascript identifier:
@@ -138,3 +145,49 @@ nameIsJsReserved name =
138145
139146moduleNameToJs :: ModuleName -> String
140147moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)
148+
149+-- |
150+-- Finds the value stored for a data constructor in the current environment.
151+-- This is a partial function, but if an invalid type has reached this far then
152+-- something has gone wrong in typechecking.
153+--
154+lookupConstructor :: Environment -> Qualified ProperName -> (DataDeclType, ProperName, Type)
155+lookupConstructor e ctor = fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e
156+
157+-- |
158+-- Checks whether a data constructor is the only constructor for that type, used
159+-- to simplify the check when generating code for binders.
160+--
161+isOnlyConstructor :: Environment -> Qualified ProperName -> Bool
162+isOnlyConstructor e ctor = numConstructors (ctor, lookupConstructor e ctor) == 1
163+ where
164+ numConstructors :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> Int
165+ numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e
166+ typeConstructor :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> (ModuleName, ProperName)
167+ typeConstructor (Qualified (Just moduleName) _, (_, tyCtor, _)) = (moduleName, tyCtor)
168+ typeConstructor _ = error "Invalid argument to isOnlyConstructor"
169+
170+-- |
171+-- Checks whether a data constructor is for a newtype.
172+--
173+isNewtypeConstructor :: Environment -> Qualified ProperName -> Bool
174+isNewtypeConstructor e ctor = case lookupConstructor e ctor of
175+ (Newtype, _, _) -> True
176+ (Data, _, _) -> False
177+
178+-- |
179+-- Checks the number of arguments a data constructor accepts.
180+--
181+getConstructorArity :: Environment -> Qualified ProperName -> Int
182+getConstructorArity e = go . (\(_, _, ctors) -> ctors) . lookupConstructor e
183+ where
184+ go :: Type -> Int
185+ go (TypeApp (TypeApp f _) t) | f == tyFunction = go t + 1
186+ go (ForAll _ ty _) = go ty
187+ go _ = 0
188+
189+-- |
190+-- Checks whether a data constructor has no arguments, for example, `Nothing`.
191+--
192+isNullaryConstructor :: Environment -> Qualified ProperName -> Bool
193+isNullaryConstructor e = (== 0) . getConstructorArity e
src/Language/PureScript/CodeGen/Externs.hs+5−1
@@ -24,6 +24,7 @@ import qualified Data.Map as M
2424
2525import Control.Monad.Writer
2626
27+import Language.PureScript.CodeGen.Common
2728import Language.PureScript.TypeClassDictionaries
2829import Language.PureScript.Declarations
2930import Language.PureScript.Pretty
@@ -60,7 +61,10 @@ moduleToPs (Module moduleName ds (Just exts)) env = intercalate "\n" . execWrite
6061 printDctor dctor = case dctor `lookup` tys of
6162 Nothing -> Nothing
6263 Just tyArgs -> Just $ show dctor ++ " " ++ unwords (map prettyPrintTypeAtom tyArgs)
63− tell ["data " ++ show pn ++ " " ++ unwords args ++ (if null dctors' then "" else " = " ++ intercalate " | " (mapMaybe printDctor dctors'))]
64+ let dtype = if length dctors' == 1 && isNewtypeConstructor env (Qualified (Just moduleName) $ head dctors')
65+ then "newtype"
66+ else "data"
67+ tell [dtype ++ " " ++ show pn ++ " " ++ unwords args ++ (if null dctors' then "" else " = " ++ intercalate " | " (mapMaybe printDctor dctors'))]
6468 Just (_, TypeSynonym) ->
6569 case Qualified (Just moduleName) pn `M.lookup` typeSynonyms env of
6670 Nothing -> error $ show pn ++ " has no type synonym info in exportToPs"
src/Language/PureScript/CodeGen/JS.hs+1−49
@@ -23,15 +23,13 @@ module Language.PureScript.CodeGen.JS (
2323 identNeedsEscaping
2424) where
2525
26−import Data.Maybe (catMaybes, fromJust, fromMaybe)
26+import Data.Maybe (catMaybes, fromJust)
2727import Data.Function (on)
2828import Data.List (nub, (\\), delete, sortBy)
2929
3030import Control.Monad (replicateM, forM)
3131import Control.Applicative
3232
33−import qualified Data.Map as M
34−
3533import Language.PureScript.Names
3634import Language.PureScript.Declarations
3735import Language.PureScript.Options
@@ -407,49 +405,3 @@ binderToJs m e varName done (NamedBinder ident binder) = do
407405 return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
408406binderToJs m e varName done (PositionedBinder _ binder) =
409407 binderToJs m e varName done binder
410−
411−-- |
412−-- Finds the value stored for a data constructor in the current environment.
413−-- This is a partial function, but if an invalid type has reached this far then
414−-- something has gone wrong in typechecking.
415−--
416−lookupConstructor :: Environment -> Qualified ProperName -> (DataDeclType, ProperName, Type)
417−lookupConstructor e ctor = fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e
418−
419−-- |
420−-- Checks whether a data constructor is the only constructor for that type, used
421−-- to simplify the check when generating code for binders.
422−--
423−isOnlyConstructor :: Environment -> Qualified ProperName -> Bool
424−isOnlyConstructor e ctor = numConstructors (ctor, lookupConstructor e ctor) == 1
425− where
426− numConstructors :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> Int
427− numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e
428− typeConstructor :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> (ModuleName, ProperName)
429− typeConstructor (Qualified (Just moduleName) _, (_, tyCtor, _)) = (moduleName, tyCtor)
430− typeConstructor _ = error "Invalid argument to isOnlyConstructor"
431−
432−-- |
433−-- Checks whether a data constructor is for a newtype.
434−--
435−isNewtypeConstructor :: Environment -> Qualified ProperName -> Bool
436−isNewtypeConstructor e ctor = case lookupConstructor e ctor of
437− (Newtype, _, _) -> True
438− (Data, _, _) -> False
439−
440−-- |
441−-- Checks the number of arguments a data constructor accepts.
442−--
443−getConstructorArity :: Environment -> Qualified ProperName -> Int
444−getConstructorArity e = go . (\(_, _, ctors) -> ctors) . lookupConstructor e
445− where
446− go :: Type -> Int
447− go (TypeApp (TypeApp f _) t) | f == tyFunction = go t + 1
448− go (ForAll _ ty _) = go ty
449− go _ = 0
450−
451−-- |
452−-- Checks whether a data constructor has no arguments, for example, `Nothing`.
453−--
454−isNullaryConstructor :: Environment -> Qualified ProperName -> Bool
455−isNullaryConstructor e = (== 0) . getConstructorArity e