git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Include fixities in externs files, include inline JS decls. #253
commit859fde91a8717bf780cd07d1747a202614481c75 authorPhil Freeman <paf31@cantab.net> dateSat 8 Mar 2014, 22:40 (13 years ago) parentb314ba1
3 files changed+22−6
src/Language/PureScript/CodeGen/Externs.hs+10−4 src/Language/PureScript/Declarations.hs+5−1 src/Language/PureScript/Pretty/Types.hs+7−1
src/Language/PureScript/CodeGen/Externs.hs+10−4
@@ -35,11 +35,17 @@ import Language.PureScript.Environment
3535--
3636moduleToPs :: Module -> Environment -> String
3737moduleToPs (Module _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"
38−moduleToPs (Module moduleName _ (Just exts)) env = intercalate "\n" . execWriter $ do
38+moduleToPs (Module moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do
3939 tell ["module " ++ runModuleName moduleName ++ " where"]
40+ mapM_ fixityToPs ds
4041 mapM_ exportToPs exts
4142 where
4243
44+ fixityToPs :: Declaration -> Writer [String] ()
45+ fixityToPs (FixityDeclaration (Fixity assoc prec) ident) =
46+ tell [ unwords [ show assoc, show prec, ident ] ]
47+ fixityToPs _ = return ()
48+
4349 exportToPs :: DeclarationRef -> Writer [String] ()
4450 exportToPs (TypeRef pn dctors) = do
4551 case Qualified (Just moduleName) pn `M.lookup` types env of
@@ -62,15 +68,15 @@ moduleToPs (Module moduleName _ (Just exts)) env = intercalate "\n" . execWriter
6268 exportToPs (ValueRef ident) =
6369 case (moduleName, ident) `M.lookup` names env of
6470 Nothing -> error $ show ident ++ " has no type in exportToPs"
65− Just (ty, nameKind) | nameKind == Value || nameKind == Extern ForeignImport ->
71+ Just (ty, nameKind) | nameKind == Value || nameKind == Extern ForeignImport || nameKind == Extern InlineJavascript ->
6672 tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]
6773 _ -> return ()
6874 exportToPs (TypeClassRef className) =
6975 case Qualified (Just moduleName) className `M.lookup` typeClasses env of
7076 Nothing -> error $ show className ++ " has no type class definition in exportToPs"
71− Just (args, ds) -> do
77+ Just (args, members) -> do
7278 tell ["class " ++ show className ++ " " ++ unwords args ++ " where"]
73− forM_ (filter (isValueExported . fst) ds) $ \(member ,ty) ->
79+ forM_ (filter (isValueExported . fst) members) $ \(member ,ty) ->
7480 tell [ " " ++ show member ++ " :: " ++ prettyPrintType ty ]
7581 exportToPs (TypeInstanceRef ident) = do
7682 let TypeClassDictionaryInScope { tcdClassName = className, tcdInstanceTypes = tys, tcdDependencies = deps} =
src/Language/PureScript/Declarations.hs+5−1
@@ -33,7 +33,11 @@ type Precedence = Integer
3333-- |
3434-- Associativity for infix operators
3535--
36−data Associativity = Infixl | Infixr deriving (Show, D.Data, D.Typeable)
36+data Associativity = Infixl | Infixr deriving (D.Data, D.Typeable)
37+
38+instance Show Associativity where
39+ show Infixl = "infixl"
40+ show Infixr = "infixr"
3741
3842-- |
3943-- Fixity data for infix operators
src/Language/PureScript/Pretty/Types.hs+7−1
@@ -42,7 +42,6 @@ typeLiterals = mkPattern match
4242 match (Skolem s _) = Just $ 's' : show s
4343 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate ", " (map (\(pn, ty') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom ty')) deps) ++ ") => " ++ prettyPrintType ty
4444 match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintTypeAtom args) ++ ">"
45− match (PrettyPrintForAll idents ty) = Just $ "forall " ++ unwords idents ++ ". " ++ prettyPrintType ty
4645 match REmpty = Just "()"
4746 match row@RCons{} = Just $ '(' : prettyPrintRow row ++ ")"
4847 match _ = Nothing
@@ -100,8 +99,15 @@ matchType = buildPrettyPrinter operators matchTypeAtom
10099 OperatorTable [ [ AssocL typeApp $ \f x -> f ++ " " ++ x ]
101100 , [ AssocR appliedFunction $ \arg ret -> arg ++ " -> " ++ ret
102101 ]
102+ , [ Wrap forall_ $ \idents ty -> "forall " ++ unwords idents ++ ". " ++ ty ]
103103 ]
104104
105+forall_ :: Pattern () Type ([String], Type)
106+forall_ = mkPattern match
107+ where
108+ match (PrettyPrintForAll idents ty) = Just (idents, ty)
109+ match _ = Nothing
110+
105111-- |
106112-- Generate a pretty-printed string representing a Type, as it should appear inside parentheses
107113--