-
Notifications
You must be signed in to change notification settings - Fork 113
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
7 changed files
with
197 additions
and
73 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,127 @@ | ||
| {-# LANGUAGE CPP #-} | ||
| {-# LANGUAGE RecordWildCards #-} | ||
|
|
||
| module HIndent.Ast.Declaration.Foreign | ||
| ( ForeignDeclaration | ||
| , mkForeignDeclaration | ||
| ) where | ||
|
|
||
| import Data.Maybe | ||
| import qualified GHC.Types.ForeignCall as GHC | ||
| import qualified GHC.Types.SourceText as GHC | ||
| import qualified GHC.Types.SrcLoc as GHC | ||
| import HIndent.Ast.Declaration.Foreign.CallingConvention | ||
| import HIndent.Ast.Declaration.Foreign.Safety | ||
| import HIndent.Ast.NodeComments | ||
| import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC | ||
| import {-# SOURCE #-} HIndent.Pretty | ||
| import HIndent.Pretty.Combinators | ||
| import HIndent.Pretty.NodeComments | ||
| #if MIN_VERSION_ghc_lib_parser(9, 8, 0) | ||
| import qualified GHC.Data.FastString as GHC | ||
| #endif | ||
| data ForeignDeclaration | ||
| = ForeignImport | ||
| { convention :: CallingConvention | ||
| , safety :: Safety | ||
| , srcIdent :: Maybe String | ||
| , dstIdent :: GHC.LIdP GHC.GhcPs | ||
| , signature :: GHC.LHsSigType GHC.GhcPs | ||
| } | ||
| | ForeignExport | ||
| { convention :: CallingConvention | ||
| , srcIdent :: Maybe String | ||
| , dstIdent :: GHC.LIdP GHC.GhcPs | ||
| , signature :: GHC.LHsSigType GHC.GhcPs | ||
| } | ||
|
|
||
| instance CommentExtraction ForeignDeclaration where | ||
| nodeComments ForeignImport {} = NodeComments [] [] [] | ||
| nodeComments ForeignExport {} = NodeComments [] [] [] | ||
|
|
||
| instance Pretty ForeignDeclaration where | ||
| pretty' ForeignImport {..} = | ||
| spaced | ||
| $ [string "foreign import", pretty convention, pretty safety] | ||
| ++ maybeToList (fmap string srcIdent) | ||
| ++ [pretty dstIdent, string "::", pretty signature] | ||
| pretty' ForeignExport {..} = | ||
| spaced | ||
| $ [string "foreign export", pretty convention] | ||
| ++ maybeToList (fmap string srcIdent) | ||
| ++ [pretty dstIdent, string "::", pretty signature] | ||
|
|
||
| mkForeignDeclaration :: GHC.ForeignDecl GHC.GhcPs -> ForeignDeclaration | ||
| #if MIN_VERSION_ghc_lib_parser(9, 8, 0) | ||
| mkForeignDeclaration GHC.ForeignImport { fd_fi = (GHC.CImport (GHC.L _ src) (GHC.L _ conv) (GHC.L _ sfty) _ _) | ||
| , .. | ||
| } = ForeignImport {..} | ||
| where | ||
| convention = mkCallingConvention conv | ||
| safety = mkSafety sfty | ||
| srcIdent = | ||
| case src of | ||
| GHC.SourceText s -> Just $ GHC.unpackFS s | ||
| _ -> Nothing | ||
| dstIdent = fd_name | ||
| signature = fd_sig_ty | ||
| mkForeignDeclaration GHC.ForeignExport { fd_fe = (GHC.CExport (GHC.L _ src) (GHC.L _ (GHC.CExportStatic _ _ conv))) | ||
| , .. | ||
| } = ForeignExport {..} | ||
| where | ||
| convention = mkCallingConvention conv | ||
| srcIdent = | ||
| case src of | ||
| GHC.SourceText s -> Just $ GHC.unpackFS s | ||
| _ -> Nothing | ||
| dstIdent = fd_name | ||
| signature = fd_sig_ty | ||
| #elif MIN_VERSION_ghc_lib_parser(9, 6, 0) | ||
| mkForeignDeclaration GHC.ForeignImport { fd_fi = (GHC.CImport (GHC.L _ src) (GHC.L _ conv) (GHC.L _ sfty) _ _) | ||
| , .. | ||
| } = ForeignImport {..} | ||
| where | ||
| convention = mkCallingConvention conv | ||
| safety = mkSafety sfty | ||
| srcIdent = | ||
| case src of | ||
| GHC.SourceText s -> Just s | ||
| _ -> Nothing | ||
| dstIdent = fd_name | ||
| signature = fd_sig_ty | ||
| mkForeignDeclaration GHC.ForeignExport { fd_fe = (GHC.CExport (GHC.L _ src) (GHC.L _ (GHC.CExportStatic _ _ conv))) | ||
| , .. | ||
| } = ForeignExport {..} | ||
| where | ||
| convention = mkCallingConvention conv | ||
| srcIdent = | ||
| case src of | ||
| GHC.SourceText s -> Just s | ||
| _ -> Nothing | ||
| dstIdent = fd_name | ||
| signature = fd_sig_ty | ||
| #else | ||
| mkForeignDeclaration GHC.ForeignImport { fd_fi = (GHC.CImport (GHC.L _ conv) (GHC.L _ sfty) _ _ (GHC.L _ src)) | ||
| , .. | ||
| } = ForeignImport {..} | ||
| where | ||
| convention = mkCallingConvention conv | ||
| safety = mkSafety sfty | ||
| srcIdent = | ||
| case src of | ||
| GHC.SourceText s -> Just s | ||
| _ -> Nothing | ||
| dstIdent = fd_name | ||
| signature = fd_sig_ty | ||
| mkForeignDeclaration GHC.ForeignExport { fd_fe = (GHC.CExport (GHC.L _ (GHC.CExportStatic _ _ conv)) (GHC.L _ src)) | ||
| , .. | ||
| } = ForeignExport {..} | ||
| where | ||
| convention = mkCallingConvention conv | ||
| srcIdent = | ||
| case src of | ||
| GHC.SourceText s -> Just s | ||
| _ -> Nothing | ||
| dstIdent = fd_name | ||
| signature = fd_sig_ty | ||
| #endif |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,34 @@ | ||
| module HIndent.Ast.Declaration.Foreign.CallingConvention | ||
| ( CallingConvention | ||
| , mkCallingConvention | ||
| ) where | ||
|
|
||
| import qualified GHC.Types.ForeignCall as GHC | ||
| import HIndent.Ast.NodeComments | ||
| import {-# SOURCE #-} HIndent.Pretty | ||
| import HIndent.Pretty.Combinators | ||
| import HIndent.Pretty.NodeComments | ||
|
|
||
| data CallingConvention | ||
| = CCall | ||
| | CApi | ||
| | StdCall | ||
| | Prim | ||
| | JavaScript | ||
|
|
||
| instance CommentExtraction CallingConvention where | ||
| nodeComments _ = NodeComments [] [] [] | ||
|
|
||
| instance Pretty CallingConvention where | ||
| pretty' CCall = string "ccall" | ||
| pretty' CApi = string "capi" | ||
| pretty' StdCall = string "stdcall" | ||
| pretty' Prim = string "prim" | ||
| pretty' JavaScript = string "javascript" | ||
|
|
||
| mkCallingConvention :: GHC.CCallConv -> CallingConvention | ||
| mkCallingConvention GHC.CCallConv = CCall | ||
| mkCallingConvention GHC.StdCallConv = StdCall | ||
| mkCallingConvention GHC.CApiConv = CApi | ||
| mkCallingConvention GHC.PrimCallConv = Prim | ||
| mkCallingConvention GHC.JavaScriptCallConv = JavaScript |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,28 @@ | ||
| module HIndent.Ast.Declaration.Foreign.Safety | ||
| ( Safety | ||
| , mkSafety | ||
| ) where | ||
|
|
||
| import qualified GHC.Types.ForeignCall as GHC | ||
| import HIndent.Ast.NodeComments | ||
| import {-# SOURCE #-} HIndent.Pretty | ||
| import HIndent.Pretty.Combinators | ||
| import HIndent.Pretty.NodeComments | ||
|
|
||
| data Safety | ||
| = Safe | ||
| | Interruptible | ||
| | Unsafe | ||
|
|
||
| instance CommentExtraction Safety where | ||
| nodeComments _ = NodeComments [] [] [] | ||
|
|
||
| instance Pretty Safety where | ||
| pretty' Safe = string "safe" | ||
| pretty' Interruptible = string "interruptible" | ||
| pretty' Unsafe = string "unsafe" | ||
|
|
||
| mkSafety :: GHC.Safety -> Safety | ||
| mkSafety GHC.PlaySafe = Safe | ||
| mkSafety GHC.PlayInterruptible = Interruptible | ||
| mkSafety GHC.PlayRisky = Unsafe |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters