From c40d834c32acdbe97fdb71bf7e971c3484579377 Mon Sep 17 00:00:00 2001 From: Unknown Date: Fri, 21 Jul 2017 01:33:12 +0200 Subject: [PATCH 1/2] Started removing Foreign --- src/Curry/Syntax/Parser.hs | 14 ++------------ src/Curry/Syntax/Pretty.hs | 5 ----- src/Curry/Syntax/ShowModule.hs | 9 --------- src/Curry/Syntax/Type.hs | 2 -- src/Curry/Syntax/Utils.hs | 7 ++----- 5 files changed, 4 insertions(+), 33 deletions(-) diff --git a/src/Curry/Syntax/Parser.hs b/src/Curry/Syntax/Parser.hs index 4a753be..cc45f6c 100644 --- a/src/Curry/Syntax/Parser.hs +++ b/src/Curry/Syntax/Parser.hs @@ -239,7 +239,7 @@ topDecls = topDecl `sepBy` semicolon topDecl :: Parser a Token (Decl ()) topDecl = choice [ dataDecl, externalDataDecl, newtypeDecl, typeDecl , classDecl, instanceDecl, defaultDecl - , foreignDecl, infixDecl, functionDecl ] + , infixDecl, functionDecl ] dataDecl :: Parser a Token (Decl ()) dataDecl = typeDeclLhs DataDecl KW_data <*> constrs <*> deriv @@ -357,7 +357,7 @@ localDecls :: Parser a Token [Decl ()] localDecls = whereClause valueDecls valueDecls :: Parser a Token [Decl ()] -valueDecls = choice [infixDecl, valueDecl, foreignDecl] `sepBy` semicolon +valueDecls = choice [infixDecl, valueDecl] `sepBy` semicolon infixDecl :: Parser a Token (Decl ()) infixDecl = infixDeclLhs InfixDecl <*> option integer <*> funop `sepBy1` comma @@ -391,16 +391,6 @@ valueDecl = position <**> decl isConstrId c = c == qConsId || isQualified c || isQTupleId c -foreignDecl :: Parser a Token (Decl ()) -foreignDecl = ForeignDecl - <$> tokenPos KW_foreign - <*> callConv <*> (option string) - <*> succeed () - <*> fun <*-> token DoubleColon <*> type0 - where callConv = CallConvPrimitive <$-> token Id_primitive - <|> CallConvCCall <$-> token Id_ccall - "Unsupported calling convention" - defaultDecl :: Parser a Token (Decl ()) defaultDecl = DefaultDecl <$> position <*-> token KW_default <*> parens (type0 `sepBy` comma) diff --git a/src/Curry/Syntax/Pretty.hs b/src/Curry/Syntax/Pretty.hs index bc0e122..6c20387 100644 --- a/src/Curry/Syntax/Pretty.hs +++ b/src/Curry/Syntax/Pretty.hs @@ -105,11 +105,6 @@ ppDecl (TypeDecl _ tc tvs ty) = ppDecl (TypeSig _ fs qty) = list (map ppIdent fs) <+> text "::" <+> ppQualTypeExpr qty ppDecl (FunctionDecl _ _ _ eqs) = vcat (map ppEquation eqs) -ppDecl (ForeignDecl p cc impent _ f ty) = - sep [text "foreign" <+> ppCallConv cc <+> maybePP (text . show) impent, - indent (ppDecl (TypeSig p [f] (QualTypeExpr [] ty)))] - where ppCallConv CallConvPrimitive = text "primitive" - ppCallConv CallConvCCall = text "ccall" ppDecl (ExternalDecl _ vs) = list (map ppVar vs) <+> text "external" ppDecl (PatternDecl _ t rhs) = ppRule (ppPattern 0 t) equals rhs ppDecl (FreeDecl _ vs) = list (map ppVar vs) <+> text "free" diff --git a/src/Curry/Syntax/ShowModule.hs b/src/Curry/Syntax/ShowModule.hs index e986dd8..cebcc6a 100644 --- a/src/Curry/Syntax/ShowModule.hs +++ b/src/Curry/Syntax/ShowModule.hs @@ -172,15 +172,6 @@ showsDecl (FunctionDecl pos a ident eqs) . showsIdent ident . space . showsList showsEquation eqs . showsString ")" -showsDecl (ForeignDecl pos cconv mstr a ident typ) - = showsString "(ForeignDecl " - . showsPosition pos . space - . shows cconv . space - . showsMaybe shows mstr . space - . showsPrec 11 a . space - . showsIdent ident . space - . showsTypeExpr typ - . showsString ")" showsDecl (ExternalDecl pos vars) = showsString "(ExternalDecl " . showsPosition pos . space diff --git a/src/Curry/Syntax/Type.hs b/src/Curry/Syntax/Type.hs index 74f9acb..a89260d 100644 --- a/src/Curry/Syntax/Type.hs +++ b/src/Curry/Syntax/Type.hs @@ -156,7 +156,6 @@ data Decl a | TypeDecl Position Ident [Ident] TypeExpr -- type C a b = D a b | TypeSig Position [Ident] QualTypeExpr -- f, g :: Bool | FunctionDecl Position a Ident [Equation a] -- f True = 1 ; f False = 0 - | ForeignDecl Position CallConv (Maybe String) a Ident TypeExpr -- foreign ccall "lib.h" fun :: Int | ExternalDecl Position [Var a] -- f, g external | PatternDecl Position (Pattern a) (Rhs a) -- Just x = ... | FreeDecl Position [Var a] -- x, y free @@ -361,7 +360,6 @@ instance Functor Decl where fmap _ (TypeDecl p tc tvs ty) = TypeDecl p tc tvs ty fmap _ (TypeSig p fs qty) = TypeSig p fs qty fmap f (FunctionDecl p a f' eqs) = FunctionDecl p (f a) f' (map (fmap f) eqs) - fmap f (ForeignDecl p cc mmod a f' ty) = ForeignDecl p cc mmod (f a) f' ty fmap f (ExternalDecl p vs) = ExternalDecl p (map (fmap f) vs) fmap f (PatternDecl p t rhs) = PatternDecl p (fmap f t) (fmap f rhs) fmap f (FreeDecl p vs) = FreeDecl p (map (fmap f) vs) diff --git a/src/Curry/Syntax/Utils.hs b/src/Curry/Syntax/Utils.hs index 772e2a2..452ac37 100644 --- a/src/Curry/Syntax/Utils.hs +++ b/src/Curry/Syntax/Utils.hs @@ -102,13 +102,11 @@ isInstanceDecl _ = False -- |Is the declaration a type signature? isTypeSig :: Decl a -> Bool isTypeSig (TypeSig _ _ _) = True -isTypeSig (ForeignDecl _ _ _ _ _ _) = True isTypeSig _ = False -- |Is the declaration a value declaration? isValueDecl :: Decl a -> Bool isValueDecl (FunctionDecl _ _ _ _) = True -isValueDecl (ForeignDecl _ _ _ _ _ _) = True isValueDecl (ExternalDecl _ _) = True isValueDecl (PatternDecl _ _ _) = True isValueDecl (FreeDecl _ _) = True @@ -121,9 +119,8 @@ isFunctionDecl _ = False -- |Is the declaration an external declaration? isExternalDecl :: Decl a -> Bool -isExternalDecl (ForeignDecl _ _ _ _ _ _) = True -isExternalDecl (ExternalDecl _ _) = True -isExternalDecl _ = False +isExternalDecl (ExternalDecl _ _ ) = True +isExternalDecl _ = False -- |Is the pattern semantically equivalent to a variable pattern? isVariablePattern :: Pattern a -> Bool -- GitLab From 4181e22b5223be0c4b75f8cb28cada460e479b30 Mon Sep 17 00:00:00 2001 From: Unknown Date: Wed, 26 Jul 2017 19:34:55 +0200 Subject: [PATCH 2/2] Removed KW_foreign --- src/Curry/Syntax/Lexer.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/Curry/Syntax/Lexer.hs b/src/Curry/Syntax/Lexer.hs index ce6d274..25d12cf 100644 --- a/src/Curry/Syntax/Lexer.hs +++ b/src/Curry/Syntax/Lexer.hs @@ -86,7 +86,6 @@ instance Symbol Token where dist _ (Token KW_module _) = (0, 5) dist _ (Token Id_forall _) = (0, 5) dist _ (Token Id_hiding _) = (0, 5) - dist _ (Token KW_foreign _) = (0, 6) dist _ (Token KW_newtype _) = (0, 6) dist _ (Token KW_external _) = (0, 7) dist _ (Token Id_interface _) = (0, 8) @@ -173,7 +172,6 @@ data Category | KW_else | KW_external | KW_fcase - | KW_foreign | KW_free | KW_if | KW_import @@ -334,7 +332,6 @@ instance Show Token where showsPrec _ (Token KW_else _) = showsEscaped "else" showsPrec _ (Token KW_external _) = showsEscaped "external" showsPrec _ (Token KW_fcase _) = showsEscaped "fcase" - showsPrec _ (Token KW_foreign _) = showsEscaped "foreign" showsPrec _ (Token KW_free _) = showsEscaped "free" showsPrec _ (Token KW_if _) = showsEscaped "if" showsPrec _ (Token KW_import _) = showsEscaped "import" @@ -456,7 +453,6 @@ keywords = Map.fromList , ("else" , KW_else ) , ("external", KW_external) , ("fcase" , KW_fcase ) - , ("foreign" , KW_foreign ) , ("free" , KW_free ) , ("if" , KW_if ) , ("import" , KW_import ) -- GitLab