[Pkg-haskell-commits] r749 - in /packages/haskell-src-exts/branches/upstream/current/src: haskell-src-exts/ haskell-src-exts/Language/Haskell/Hsx/ trhsx/
arjan at users.alioth.debian.org
arjan at users.alioth.debian.org
Fri Jun 22 18:15:18 UTC 2007
Author: arjan
Date: Fri Jun 22 18:15:18 2007
New Revision: 749
URL: http://svn.debian.org/wsvn/pkg-haskell/?sc=1&rev=749
Log:
[svn-upgrade] Integrating new upstream version, haskell-src-exts (1.2.1~darcs20070622)
Modified:
packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Build.hs
packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Lexer.hs
packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/ParseUtils.hs
packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Parser.ly
packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Pretty.hs
packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Syntax.hs
packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Transform.hs
packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/haskell-src-exts.cabal
packages/haskell-src-exts/branches/upstream/current/src/trhsx/Hsx.hs
packages/haskell-src-exts/branches/upstream/current/src/trhsx/trhsx.cabal
Modified: packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Build.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Build.hs?rev=749&op=diff
==============================================================================
--- packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Build.hs (original)
+++ packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Build.hs Fri Jun 22 18:15:18 2007
@@ -16,6 +16,7 @@
-- * Syntax building functions
name, -- :: String -> HsName
+ sym, -- :: String -> HsName
var, -- :: HsName -> HsExp
op, -- :: HsName -> HsQOp
qvar, -- :: Module -> HsName -> HsExp
@@ -72,6 +73,9 @@
name :: String -> HsName
name = HsIdent
+sym :: String -> HsName
+sym = HsSymbol
+
var :: HsName -> HsExp
var = HsVar . UnQual
@@ -228,4 +232,4 @@
metaConPat :: String -> [HsPat] -> HsPat
-metaConPat s ps = pApp (name s) ps
+metaConPat s ps = pApp (name s) ps
Modified: packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Lexer.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Lexer.hs?rev=749&op=diff
==============================================================================
--- packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Lexer.hs (original)
+++ packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Lexer.hs Fri Jun 22 18:15:18 2007
@@ -33,6 +33,7 @@
| ILinVarId (String) -- linear implicit parameter
| ConId String
| QConId (String,String)
+ | DVarId [String] -- to enable varid's with '-' in them
| VarSym String
| ConSym String
| QVarSym (String,String)
@@ -120,6 +121,7 @@
| KW_Deriving
| KW_DLet -- implictit parameter binding
| KW_Do
+ | KW_MDo
| KW_Else
| KW_Forall -- universal/existential types
| KW_Hiding
@@ -139,6 +141,15 @@
| KW_Where
| KW_With -- implicit parameter binding
| KW_Qualified
+
+ -- FFI
+ | KW_Foreign
+ | KW_Export
+ | KW_Safe
+ | KW_Unsafe
+ | KW_Threadsafe
+ | KW_StdCall
+ | KW_CCall
| EOF
deriving (Eq,Show)
@@ -185,6 +196,7 @@
( "infixr", KW_InfixR ),
( "instance", KW_Instance ),
( "let", KW_Let ),
+ ( "mdo", KW_MDo ),
( "module", KW_Module ),
( "newtype", KW_NewType ),
( "of", KW_Of ),
@@ -196,7 +208,10 @@
-- Template Haskell
( "reifyDecl", THReifyDecl ),
( "reifyType", THReifyType ),
- ( "reifyFixity", THReifyFixity )
+ ( "reifyFixity", THReifyFixity ),
+
+-- FFI
+ ( "foreign", KW_Foreign )
]
@@ -204,12 +219,20 @@
special_varids = [
( "as", KW_As ),
( "qualified", KW_Qualified ),
- ( "hiding", KW_Hiding )
+ ( "hiding", KW_Hiding ),
+
+-- FFI
+ ( "export", KW_Export),
+ ( "safe", KW_Safe),
+ ( "unsafe", KW_Unsafe),
+ ( "threadsafe", KW_Threadsafe),
+ ( "stdcall", KW_StdCall),
+ ( "ccall", KW_CCall)
]
-isIdent, isSymbol :: Char -> Bool
-isIdent c = isAlpha c || isDigit c || c == '\'' || c == '_'
-isSymbol c = elem c ":!#$%&*+./<=>?@\\^|-~"
+isIdent, isHSymbol :: Char -> Bool
+isIdent c = isAlpha c || isDigit c || c == '\'' || c == '_'
+isHSymbol c = elem c ":!#$%&*+./<=>?@\\^|-~"
matchChar :: Char -> String -> Lex a ()
matchChar c msg = do
@@ -231,7 +254,7 @@
-- then we want to care about the whitespace
Just ChildCtxt | not bol && ws -> return $ XPcdata " "
_ -> do startToken
- if bol then lexBOL else lexToken
+ if bol then lexBOL else lexToken
lexWhiteSpace :: Bool -> Lex a (Bool, Bool)
lexWhiteSpace bol = do
@@ -242,7 +265,7 @@
bol <- lexNestedComment bol
(bol, _) <- lexWhiteSpace bol
return (bol, True)
- '-':'-':s | all (== '-') (takeWhile isSymbol s) -> do
+ '-':'-':s | all (== '-') (takeWhile isHSymbol s) -> do
lexWhile (== '-')
lexWhile (/= '\n')
lexNewline
@@ -335,10 +358,27 @@
s <- getInput
case s of
[] -> return EOF
- _ -> do let pcd = takeWhile (\c -> not $ elem c "<[") s
- l = length pcd
- discard l
- return $ XPcdata pcd
+ _ -> case s of
+ '\n':_ -> do
+ x <- lexNewline >> lexPCDATA
+ case x of
+ XPcdata p -> return $ XPcdata $ '\n':p
+ EOF -> return EOF
+ '<':_ -> return $ XPcdata ""
+ '[':'/':_ -> return $ XPcdata ""
+ '[':s' -> do discard 1
+ pcd <- lexPCDATA
+ case pcd of
+ XPcdata pcd' -> return $ XPcdata $ '[':pcd'
+ EOF -> return EOF
+ _ -> do let pcd = takeWhile (\c -> not $ elem c "<[\n") s
+ l = length pcd
+ discard l
+ x <- lexPCDATA
+ case x of
+ XPcdata pcd' -> return $ XPcdata $ pcd ++ pcd'
+ EOF -> return EOF
+
lexCodeTagCtxt :: Lex a Token
lexCodeTagCtxt = do
@@ -484,13 +524,15 @@
| isUpper c -> lexConIdOrQual ""
| isLower c || c == '_' -> do
- ident <- lexWhile isIdent
- return $ case lookup ident (reserved_ids ++ special_varids) of
- Just keyword -> keyword
- Nothing -> VarId ident
-
- | isSymbol c -> do
- sym <- lexWhile isSymbol
+ idents <- lexIdents
+ case idents of
+ [ident] -> return $ case lookup ident (reserved_ids ++ special_varids) of
+ Just keyword -> keyword
+ Nothing -> VarId ident
+ _ -> return $ DVarId idents
+
+ | isHSymbol c -> do
+ sym <- lexWhile isHSymbol
return $ case lookup sym (reserved_ops ++ special_varops) of
Just t -> t
Nothing -> case c of
@@ -524,6 +566,19 @@
'"' -> lexString
_ -> fail ("Illegal character \'" ++ show c ++ "\'\n")
+
+ where lexIdents :: Lex a [String]
+ lexIdents = do
+ ident <- lexWhile isIdent
+ s <- getInput
+ case s of
+ '-':c:_ | isIdent c -> do
+ discard 1
+ idents <- lexIdents
+ return $ ident : idents
+ _ -> return [ident]
+
+
lexDecimalOrFloat :: Lex a Token
lexDecimalOrFloat = do
@@ -586,9 +641,9 @@
discard 1
lexConIdOrQual qual'
- | isSymbol c -> do -- qualified symbol?
+ | isHSymbol c -> do -- qualified symbol?
discard 1
- sym <- lexWhile isSymbol
+ sym <- lexWhile isHSymbol
case lookup sym reserved_ops of
-- cannot qualify a reserved operator
Just _ -> just_a_conid
Modified: packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/ParseUtils.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/ParseUtils.hs?rev=749&op=diff
==============================================================================
--- packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/ParseUtils.hs (original)
+++ packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/ParseUtils.hs Fri Jun 22 18:15:18 2007
@@ -38,11 +38,16 @@
, checkEqNames -- HsXName -> HsXName -> P HsXName
, mkPageModule -- HsExp -> P HsModule
, mkPage -- HsModule -> SrcLoc -> HsExp -> P HsModule
+ , mkDVar -- [String] -> String
+ , mkDVarExpr -- [String] -> HsExp
) where
import Language.Haskell.Hsx.Syntax
import Language.Haskell.Hsx.ParseMonad
import Language.Haskell.Hsx.Pretty
+import Language.Haskell.Hsx.Build
+
+import Data.List (intersperse)
splitTyConApp :: HsType -> P (HsName,[HsType])
splitTyConApp t0 = split t0 []
@@ -50,6 +55,7 @@
split :: HsType -> [HsType] -> P (HsName,[HsType])
split (HsTyApp t u) ts = split t (u:ts)
split (HsTyCon (UnQual t)) ts = return (t,ts)
+ split (HsTyInfix a op b) ts = split (HsTyCon op) (a:b:ts)
split _ _ = fail "Illegal data/newtype declaration"
-----------------------------------------------------------------------------
@@ -70,6 +76,7 @@
checkAssertion t = checkAssertion' [] t
where checkAssertion' ts (HsTyCon c) = return $ HsClassA c ts
checkAssertion' ts (HsTyApp a t) = checkAssertion' (t:ts) a
+ checkAssertion' ts (HsTyInfix a op b) = checkAssertion' (a:b:ts) (HsTyCon op)
checkAssertion' _ _ = fail "Illegal class assertion"
@@ -91,6 +98,7 @@
checkSimple :: String -> HsType -> [HsName] -> P (HsName,[HsName])
checkSimple kw (HsTyApp l (HsTyVar a)) xs = checkSimple kw l (a:xs)
+checkSimple _ (HsTyInfix (HsTyVar a) (UnQual t) (HsTyVar b)) xs = return (t,a:b:xs)
checkSimple _kw (HsTyCon (UnQual t)) xs = return (t,xs)
checkSimple kw _ _ = fail ("Illegal " ++ kw ++ " declaration")
@@ -281,6 +289,9 @@
HsDo stmts -> do
stmts <- mapM checkStmt stmts
return (HsDo stmts)
+ HsMDo stmts -> do
+ stmts <- mapM checkStmt stmts
+ return (HsMDo stmts)
HsTuple es -> checkManyExprs es HsTuple
HsList es -> checkManyExprs es HsList
HsParen e -> check1Expr e HsParen
@@ -504,6 +515,15 @@
[pageFun loc xml])
---------------------------------------
+-- Handle dash-identifiers
+
+mkDVar :: [String] -> String
+mkDVar = concat . intersperse "-"
+
+mkDVarExpr :: [String] -> HsExp
+mkDVarExpr = foldl1 (\x y -> infixApp x (op $ sym "-") y) . map (var . name)
+
+---------------------------------------
-- Combine adjacent for-alls.
--
-- A valid type must have one for-all at the top of the type, or of the fn arg types
Modified: packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Parser.ly
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Parser.ly?rev=749&op=diff
==============================================================================
--- packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Parser.ly (original)
+++ packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Parser.ly Fri Jun 22 18:15:18 2007
@@ -30,6 +30,10 @@
* Multi-parameter type classes with functional dependencies
* Implicit parameters
* Pattern guards
+* Mdo notation
+* FFI
+* HaRP
+* HSP
Most of the code is blatantly stolen from the GHC module Language.Haskell.Parser.
Some of the code for extensions is greatly influenced by GHC's internal parser
@@ -60,6 +64,7 @@
> ILINID { ILinVarId $$ } -- linear implicit parameter %x
> CONID { ConId $$ }
> QCONID { QConId $$ }
+> DVARID { DVarId $$ } -- VARID containing dashes
> VARSYM { VarSym $$ }
> CONSYM { ConSym $$ }
> QVARSYM { QVarSym $$ }
@@ -139,6 +144,16 @@
> '>' { XStdTagClose }
> '/>' { XEmptyTagClose }
> '%>' { XCodeTagClose }
+
+FFI
+
+> 'foreign' { KW_Foreign }
+> 'export' { KW_Export }
+> 'safe' { KW_Safe }
+> 'unsafe' { KW_Unsafe }
+> 'threadsafe' { KW_Threadsafe }
+> 'stdcall' { KW_StdCall }
+> 'ccall' { KW_CCall }
Reserved Ids
@@ -161,6 +176,7 @@
> 'infixr' { KW_InfixR }
> 'instance' { KW_Instance }
> 'let' { KW_Let }
+> 'mdo' { KW_MDo }
> 'module' { KW_Module }
> 'newtype' { KW_NewType }
> 'of' { KW_Of }
@@ -330,7 +346,7 @@
> | topdecl { [$1] }
> topdecl :: { HsDecl }
-> : srcloc 'type' simpletype '=' type
+> : srcloc 'type' simpletype '=' ctype
> { HsTypeDecl $1 (fst $3) (snd $3) $5 }
> | srcloc 'data' ctype constrs0 deriving
> {% do { (cs,c,t) <- checkDataHeader $3;
@@ -351,6 +367,14 @@
> return (HsInstDecl $1 cs c ts $4) } }
> | srcloc 'default' '(' typelist ')'
> { HsDefaultDecl $1 $4 }
+> | srcloc '$(' exp ')'
+> {% do { e <- checkExpr $3;
+> return $ HsSpliceDecl $1 $ HsParenSplice e } }
+>
+> | srcloc 'foreign' 'import' callconv safety fspec
+> { let (s,n,t) = $6 in HsForImp $1 $4 $5 s n t }
+> | srcloc 'foreign' 'export' callconv fspec
+> { let (s,n,t) = $5 in HsForExp $1 $4 s n t }
> | decl { $1 }
> typelist :: { [HsType] }
@@ -404,11 +428,30 @@
> return [n] } }
-----------------------------------------------------------------------------
+FFI
+
+> callconv :: { HsCallConv }
+> : 'stdcall' { StdCall }
+> | 'ccall' { CCall }
+
+> safety :: { HsSafety }
+> : 'safe' { PlaySafe False }
+> | 'unsafe' { PlayRisky }
+> | 'threadsafe' { PlaySafe True }
+> | {- empty -} { PlaySafe False }
+
+> fspec :: { (String, HsName, HsType) }
+> : STRING var_no_safety '::' dtype { ($1, $2, $4) }
+> | var_no_safety '::' dtype { ("", $1, $3) }
+
+-----------------------------------------------------------------------------
Types
> dtype :: { HsType }
-> : btype '->' dtype { HsTyFun $1 $3 }
-> | btype { $1 }
+> : btype { $1 }
+> | btype qtyconop dtype { HsTyInfix $1 $2 $3 }
+> | btype qtyvarop dtype { HsTyInfix $1 $2 $3 }
+> | btype '->' dtype { HsTyFun $1 $3 }
Implicit parameters can occur in normal types, as well as in contexts.
@@ -434,6 +477,14 @@
> | '(' '->' ')' { fun_tycon_name }
> | '[' ']' { list_tycon_name }
> | '(' commas ')' { tuple_tycon_name $2 }
+
+These are for infix types
+
+> qtyconop :: { HsQName }
+> : qconop { $1 }
+
+
+
(Slightly edited) Comment from GHC's hsparser.y:
@@ -640,6 +691,7 @@
> exp0b :: { HsExp }
> : exp0b qop exp10b { HsInfixApp $1 $2 $3 }
+> | dvarexp { $1 }
> | exp10b { $1 }
> exp10a :: { HsExp }
@@ -653,6 +705,7 @@
> : 'case' exp 'of' altslist { HsCase $2 $4 }
> | '-' fexp { HsNegApp $2 }
> | 'do' stmtlist { HsDo $2 }
+> | 'mdo' stmtlist { HsMDo $2 }
> | reifyexp { HsReifyExp $1 }
> | fexp { $1 }
@@ -726,7 +779,7 @@
> | '[p|' exp0 '|]' {% do { p <- checkPattern $2;
> return $ HsBracketExp $ HsPatBracket p } }
> | '[t|' ctype '|]' { HsBracketExp $ HsTypeBracket $2 }
-> | '[d|' topdecls '|]' { HsBracketExp $ HsDeclBracket $2 }
+> | '[d|' open topdecls close '|]' { HsBracketExp $ HsDeclBracket $3 }
> reifyexp :: { HsReify }
> : 'reifyDecl' gtycon { HsReifyDecl $2 }
@@ -790,6 +843,7 @@
> xmlname :: { String }
> : VARID { $1 }
> | CONID { $1 }
+> | DVARID { mkDVar $1 }
> | 'type' { "type" }
> | 'class' { "class" }
@@ -800,12 +854,13 @@
> attr :: { HsXAttr }
> : name '=' aexp { HsXAttr $1 $3 }
- attrname :: { String }
- : VARID { $1 }
-
> mattr :: { Maybe HsExp }
> : aexp { Just $1 }
> | {-empty-} { Nothing }
+
+Turning dash variables into infix expressions with '-'
+> dvarexp :: { HsExp }
+> : DVARID { mkDVarExpr $1 }
-----------------------------------------------------------------------------
List expressions
@@ -930,6 +985,10 @@
> : varid { $1 }
> | '(' varsym ')' { $2 }
+> var_no_safety :: { HsName }
+> : varid_no_safety { $1 }
+> | '(' varsym ')' { $2 }
+
> qvar :: { HsQName }
> : qvarid { $1 }
> | '(' qvarsym ')' { $2 }
@@ -989,11 +1048,21 @@
> : varid { UnQual $1 }
> | QVARID { Qual (Module (fst $1)) (HsIdent (snd $1)) }
-> varid :: { HsName }
+> varid_no_safety :: { HsName }
> : VARID { HsIdent $1 }
> | 'as' { as_name }
> | 'qualified' { qualified_name }
> | 'hiding' { hiding_name }
+> | 'export' { export_name }
+> | 'stdcall' { stdcall_name }
+> | 'ccall' { ccall_name }
+
+> varid :: { HsName }
+> : varid_no_safety { $1 }
+> | 'safe' { safe_name }
+> | 'unsafe' { unsafe_name }
+> | 'threadsafe' { threadsafe_name }
+
Implicit parameter
> ivarid :: { HsIPName }
@@ -1075,6 +1144,13 @@
> tyvar :: { HsName }
> : varid { $1 }
+> qtyvarop :: { HsQName }
+> qtyvarop : '`' tyvar '`' { UnQual $2 }
+> | tyvarsym { UnQual $1 }
+
+> tyvarsym :: { HsName }
+> tyvarsym : VARSYM { HsSymbol $1 }
+
-----------------------------------------------------------------------------
> {
Modified: packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Pretty.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Pretty.hs?rev=749&op=diff
==============================================================================
--- packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Pretty.hs (original)
+++ packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Pretty.hs Fri Jun 22 18:15:18 2007
@@ -375,6 +375,11 @@
markLine pos $
text "default" <+> parenList (map pretty htypes)
+ pretty (HsSpliceDecl pos splice) =
+ blankline $
+ markLine pos $
+ pretty splice
+
pretty (HsTypeSig pos nameList qualType) =
blankline $
markLine pos $
@@ -393,6 +398,18 @@
markLine pos $
mySep ([pretty assoc, int prec]
++ (punctuate comma . map pretty $ opList))
+
+ pretty (HsForImp pos cconv saf str name typ) =
+ blankline $
+ markLine pos $
+ mySep [text "foreign import", pretty cconv, pretty saf,
+ text (show str), pretty name, text "::", pretty typ]
+
+ pretty (HsForExp pos cconv str name typ) =
+ blankline $
+ markLine pos $
+ mySep [text "foreign export", pretty cconv,
+ text (show str), pretty name, text "::", pretty typ]
instance Pretty HsAssoc where
pretty HsAssocNone = text "infix"
@@ -416,6 +433,15 @@
ppWhere (HsBDecls []) = empty
ppWhere (HsBDecls l) = nest 2 (text "where" $$$ ppBody whereIndent (map pretty l))
ppWhere (HsIPBinds b) = nest 2 (text "where" $$$ ppBody whereIndent (map pretty b))
+
+------------------------- FFI stuff -------------------------------------
+instance Pretty HsSafety where
+ pretty PlayRisky = text "unsafe"
+ pretty (PlaySafe b) = text $ if b then "threadsafe" else "safe"
+
+instance Pretty HsCallConv where
+ pretty StdCall = text "stdcall"
+ pretty CCall = text "ccall"
------------------------- Data & Newtype Bodies -------------------------
instance Pretty HsQualConDecl where
@@ -485,6 +511,8 @@
prettyPrec _ (HsTyVar name) = pretty name
prettyPrec _ (HsTyCon name) = pretty name
prettyPrec _ (HsTyPred asst) = pretty asst
+ prettyPrec _ (HsTyInfix a op b) = parens (myFsep [pretty op, pretty a, pretty b])
+
ppForall :: Maybe [HsName] -> Doc
ppForall Nothing = empty
@@ -550,6 +578,8 @@
$$$ ppBody caseIndent (map pretty altList)
pretty (HsDo stmtList) =
text "do" $$$ ppBody doIndent (map pretty stmtList)
+ pretty (HsMDo stmtList) =
+ text "mdo" $$$ ppBody doIndent (map pretty stmtList)
-- Constructors & Vars
pretty (HsVar name) = pretty name
pretty (HsIPVar ipname) = pretty ipname
Modified: packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Syntax.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Syntax.hs?rev=749&op=diff
==============================================================================
--- packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Syntax.hs (original)
+++ packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Syntax.hs Fri Jun 22 18:15:18 2007
@@ -71,6 +71,9 @@
-- * Hsx
HsXAttr(..), HsXName(..), HsPXAttr(..),
+ -- * FFI
+ HsSafety(..), HsCallConv(..),
+
-- * Builtin names
-- ** Modules
@@ -82,6 +85,7 @@
unit_con, tuple_con,
-- ** Special identifiers
as_name, qualified_name, hiding_name, minus_name, pling_name, dot_name,
+ export_name, safe_name, unsafe_name, threadsafe_name, stdcall_name, ccall_name,
-- ** Type constructors
unit_tycon_name, fun_tycon_name, list_tycon_name, tuple_tycon_name,
unit_tycon, fun_tycon, list_tycon, tuple_tycon,
@@ -280,9 +284,12 @@
| HsClassDecl SrcLoc HsContext HsName [HsName] [HsFunDep] [HsDecl]
| HsInstDecl SrcLoc HsContext HsQName [HsType] [HsDecl]
| HsDefaultDecl SrcLoc [HsType]
+ | HsSpliceDecl SrcLoc HsSplice
| HsTypeSig SrcLoc [HsName] HsType
| HsFunBind [HsMatch]
| HsPatBind SrcLoc HsPat HsRhs {-where-} HsBinds
+ | HsForImp SrcLoc HsCallConv HsSafety String HsName HsType
+ | HsForExp SrcLoc HsCallConv String HsName HsType
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Show,Typeable,Data)
#else
@@ -389,6 +396,7 @@
| HsTyVar HsName -- ^ type variable
| HsTyCon HsQName -- ^ named type or type constructor
| HsTyPred HsAsst -- ^ assertion of an implicit parameter
+ | HsTyInfix HsType HsQName HsType -- ^ infix type constructor
#ifdef __GLASGOW_HASKELL__
deriving (Eq,Show,Typeable,Data)
#else
@@ -481,6 +489,7 @@
| HsDo [HsStmt] -- ^ @do at -expression:
-- the last statement in the list
-- should be an expression.
+ | HsMDo [HsStmt] -- ^ @mdo at -expression
| HsTuple [HsExp] -- ^ tuple expression
| HsList [HsExp] -- ^ list expression
| HsParen HsExp -- ^ parenthesized expression
@@ -579,6 +588,28 @@
#else
deriving (Eq,Show)
#endif
+
+
+-- FFI stuff
+data HsSafety
+ = PlayRisky
+ | PlaySafe Bool
+#ifdef __GLASGOW_HASKELL__
+ deriving (Eq,Show,Typeable,Data)
+#else
+ deriving (Eq,Show)
+#endif
+
+data HsCallConv
+ = StdCall
+ | CCall
+#ifdef __GLASGOW_HASKELL__
+ deriving (Eq,Show,Typeable,Data)
+#else
+ deriving (Eq,Show)
+#endif
+
+
-- | A pattern, to be matched against a value.
data HsPat
@@ -738,6 +769,14 @@
pling_name = HsSymbol "!"
dot_name = HsSymbol "."
+export_name, safe_name, unsafe_name, threadsafe_name, stdcall_name, ccall_name :: HsName
+export_name = HsIdent "export"
+safe_name = HsIdent "safe"
+unsafe_name = HsIdent "unsafe"
+threadsafe_name = HsIdent "threadsafe"
+stdcall_name = HsIdent "stdcall"
+ccall_name = HsIdent "ccall"
+
unit_tycon_name, fun_tycon_name, list_tycon_name :: HsQName
unit_tycon_name = unit_con_name
fun_tycon_name = Special HsFunCon
@@ -752,4 +791,4 @@
list_tycon = HsTyCon list_tycon_name
tuple_tycon :: Int -> HsType
-tuple_tycon i = HsTyCon (tuple_tycon_name i)
+tuple_tycon i = HsTyCon (tuple_tycon_name i)
Modified: packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Transform.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Transform.hs?rev=749&op=diff
==============================================================================
--- packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Transform.hs (original)
+++ packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/Language/Haskell/Hsx/Transform.hs Fri Jun 22 18:15:18 2007
@@ -214,7 +214,7 @@
-- ... transform the children
cs' <- mapM transformChild cs
-- ... and lift the values into the XML datatype.
- return $ metaMkTag name as mattr cs'
+ return $ paren $ metaMkTag name as mattr cs'
where -- | Transform expressions appearing in child position of an xml tag.
-- Expressions are first transformed, then wrapped in a call to
@@ -234,7 +234,7 @@
let -- ... make tuples of the attributes
as = map mkAttr attrs
-- ... and lift the values into the XML datatype.
- return $ metaMkETag name as mattr
+ return $ paren $ metaMkETag name as mattr
-- PCDATA should be lifted as a string into the XML datatype.
HsXPcdata pcdata -> do setXmlTransformed
return $ metaMkPcdata pcdata
@@ -255,7 +255,8 @@
texp = varTuple rns
-- ... and put it all in a case expression, which
-- can then be transformed in the normal way.
- rhs' <- transformExp $ caseE texp [alt1]
+ e = if null rns then rhs else caseE texp [alt1]
+ rhs' <- transformExp e
return $ HsLambda s ps rhs'
-- A let expression can contain regular patterns in the declarations,
-- or in the expression that makes up the body of the let.
@@ -292,6 +293,9 @@
HsDo stmts -> do
stmts' <- fmap concat $ mapM (transformStmt Do) stmts
return $ HsDo stmts'
+ HsMDo stmts -> do
+ stmts' <- fmap concat $ mapM (transformStmt Do) stmts
+ return $ HsMDo stmts'
-- A list comprehension can contain regular patterns in the result
-- expression, or in any of its statements.
HsListComp e stmts -> do
@@ -1270,7 +1274,7 @@
HsIdent n -> fail $ "Attempting to bind variable "++n++
" inside the context of a numerable regular pattern"
_ -> fail $ "This should never ever ever happen...\
- \ how the ¤#% did you do it??!?"
+ \ how the #% did you do it??!?"
where -- | Generate a declaration for a @ binding.
mkAsDecl :: SrcLoc -> MFunMetaInfo -> Tr HsName
@@ -1773,4 +1777,4 @@
metaMkName :: HsXName -> HsExp
metaMkName n = case n of
HsXName s -> strE s
- HsXDomName d s -> tuple [strE d, strE s]
+ HsXDomName d s -> tuple [strE d, strE s]
Modified: packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/haskell-src-exts.cabal
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/haskell-src-exts.cabal?rev=749&op=diff
==============================================================================
--- packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/haskell-src-exts.cabal (original)
+++ packages/haskell-src-exts/branches/upstream/current/src/haskell-src-exts/haskell-src-exts.cabal Fri Jun 22 18:15:18 2007
@@ -1,5 +1,5 @@
Name: haskell-src-exts
-Version: 0.2
+Version: 0.2.1
License: PublicDomain
Author: Niklas Broberg
Maintainer: nibro at cs.chalmers.se
Modified: packages/haskell-src-exts/branches/upstream/current/src/trhsx/Hsx.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-src-exts/branches/upstream/current/src/trhsx/Hsx.hs?rev=749&op=diff
==============================================================================
--- packages/haskell-src-exts/branches/upstream/current/src/trhsx/Hsx.hs (original)
+++ packages/haskell-src-exts/branches/upstream/current/src/trhsx/Hsx.hs Fri Jun 22 18:15:18 2007
@@ -2,7 +2,7 @@
import Language.Haskell.Hsx
-import System (getArgs)
+import System.Environment (getArgs)
import Data.List (intersperse, isPrefixOf)
checkParse p = case p of
@@ -18,13 +18,13 @@
testFile :: String -> IO ()
testFile file = do
f <- readFile file
- putStrLn $ prettyPrint $ transform $ checkParse $ parse file f
+ putStrLn $ process file f
testTransform :: String -> IO ()
testTransform file = do
f <- readFile file
- putStrLn $ prettyPrint $ transform $ checkParse $ parse file f
+ putStrLn $ show $ transform $ checkParse $ parse file f
testPretty :: String -> IO ()
testPretty file = do
@@ -41,12 +41,13 @@
case args of
[origfile, infile, outfile] -> transformFile origfile infile outfile
[infile, outfile] -> transformFile infile infile outfile
- [infile] -> testTransform infile
+ [infile] -> testFile infile
_ -> putStrLn usageString
process :: FilePath -> String -> String
-process fp fc = prettyPrint $ transform $ checkParse $ parse fp fc
+process fp fc = prettyPrintWithMode (defaultMode {linePragmas=True}) $
+ transform $ checkParse $ parse fp fc
parse fn fc = parseModuleWithMode (ParseMode fn) fcuc
where fcuc= unlines $ filter (not . isPrefixOf "#") $ lines fc
Modified: packages/haskell-src-exts/branches/upstream/current/src/trhsx/trhsx.cabal
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-src-exts/branches/upstream/current/src/trhsx/trhsx.cabal?rev=749&op=diff
==============================================================================
--- packages/haskell-src-exts/branches/upstream/current/src/trhsx/trhsx.cabal (original)
+++ packages/haskell-src-exts/branches/upstream/current/src/trhsx/trhsx.cabal Fri Jun 22 18:15:18 2007
@@ -3,7 +3,7 @@
License: PublicDomain
Author: Niklas Broberg
Maintainer: nibro at cs.chalmers.se
-Build-Depends: haskell-src-exts
+Build-Depends: base, haskell-src-exts
Executable: trhsx
Main-Is: Hsx.hs
More information about the Pkg-haskell-commits
mailing list