This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "". The branch, master has been updated via 391b9dc071ae7d788fc5e164775b157a6595d040 (commit) from 97936c02164071391652bf807af983f7133a3dbf (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 391b9dc071ae7d788fc5e164775b157a6595d040 Author: Justin M Wozniak <[email protected]> Date: Mon Jun 4 14:13:49 2012 -0500 Initial application of Sam's patch- works but needs cleanup ----------------------------------------------------------------------- Summary of changes: code/Makefile.in | 4 +- .../{language-c.patch => language-c-0.4.2.patch} | 214 ++++++++++---------- code/maint/hs/setup-hs-local | 34 +++- code/maint/hs/setup-langc | 45 ++--- code/src/aesop/parser/ae-remote-parser.lhs | 46 ++-- 5 files changed, 168 insertions(+), 175 deletions(-) copy code/maint/hs/{language-c.patch => language-c-0.4.2.patch} (68%) Diff of changes: diff --git a/code/Makefile.in b/code/Makefile.in index 401eb37..d87197c 100644 --- a/code/Makefile.in +++ b/code/Makefile.in @@ -485,7 +485,7 @@ lib/libasg.a: $(ASGLIBOBJS) lib/libtriton.so: $(AERLIBOBJS) $(AELIBOBJS) $(LIBOBJS) $(Q) " LDSO $@" $(E)$(INSTALL) -d lib - $(E)$(LDSHARED) -Wl,-soname,libtriton.so -o $@ $(AERLIBOBJS) $(AELIBOBJS) $(LIBOBJS) + $(E)$(LDSHARED) -Wl,-soname,libtriton.so -o $@ $(AERLIBOBJS) $(AELIBOBJS) $(LIBOBJS) lib/libtriton.dylib: $(AERLIBOBJS) $(AELIBOBJS) $(LIBOBJS) $(Q) " DYLIB $@" @@ -564,7 +564,7 @@ $(HSBIN): %: $(srcdir)/%.lhs $(HSSRC) -hidir $(call canonname,$<) \ -o $@ \ -main-is $(call modname,$<) \ - -i$(call dir,$<) --make $< >/dev/null + -i$(call dir,$<) --make -XFlexibleInstances $< >/dev/null # User targets diff --git a/code/maint/hs/language-c.patch b/code/maint/hs/language-c-0.4.2.patch similarity index 68% copy from code/maint/hs/language-c.patch copy to code/maint/hs/language-c-0.4.2.patch index fffc133..77dfc24 100644 --- a/code/maint/hs/language-c.patch +++ b/code/maint/hs/language-c-0.4.2.patch @@ -1,11 +1,11 @@ -diff -Naur language-c-0.4/language-c.cabal language-c-0.4-new/language-c.cabal ---- language-c-0.4/language-c.cabal 2011-01-06 11:46:35.000000000 -0600 -+++ language-c-0.4-new/language-c.cabal 2011-01-06 15:31:57.629238232 -0600 +diff -Naur language-c-0.4.2/language-c.cabal language-c-0.4.2-new/language-c.cabal +--- language-c-0.4.2/language-c.cabal 2011-08-24 09:51:22.000000000 -0500 ++++ language-c-0.4.2-new/language-c.cabal 2012-05-26 11:43:57.893087938 -0500 @@ -1,4 +1,4 @@ -Name: language-c +Name: language-aesop - Version: 0.4 - Cabal-Version: >= 1.2 + Version: 0.4.2 + Cabal-Version: >= 1.6 Build-Type: Simple @@ -6,7 +6,7 @@ License-File: LICENSE @@ -16,25 +16,17 @@ diff -Naur language-c-0.4/language-c.cabal language-c-0.4-new/language-c.cabal Stability: experimental Homepage: http://www.sivity.net/projects/language.c/ Bug-reports: http://www.sivity.net/projects/language.c/ -@@ -14,6 +14,7 @@ +@@ -15,6 +15,7 @@ Description: Language C is a haskell library for the analysis and generation of C code. It features a complete, well tested parser and pretty printer for all of C99 and a large set of GNU extensions. + This modified version includes extensions for AESOP. Category: Language - + Extra-Source-Files: AUTHORS AUTHORS.c2hs ChangeLog README -@@ -48,7 +49,6 @@ - Build-Depends: bytestring >= 0.9.0 - else - cpp-options: -DNO_BYTESTRING -- Build-Tools: happy, alex - - Hs-Source-Dirs: src - Exposed-Modules: -diff -Naur language-c-0.4/src/Language/C/Data/Ident.hs language-c-0.4-new/src/Language/C/Data/Ident.hs ---- language-c-0.4/src/Language/C/Data/Ident.hs 2011-01-06 11:46:35.000000000 -0600 -+++ language-c-0.4-new/src/Language/C/Data/Ident.hs 2011-01-06 15:31:57.632007216 -0600 +diff -Naur language-c-0.4.2/src/Language/C/Data/Ident.hs language-c-0.4.2-new/src/Language/C/Data/Ident.hs +--- language-c-0.4.2/src/Language/C/Data/Ident.hs 2011-08-24 09:51:19.000000000 -0500 ++++ language-c-0.4.2-new/src/Language/C/Data/Ident.hs 2012-05-26 11:45:06.753087732 -0500 @@ -17,7 +17,7 @@ module Language.C.Data.Ident ( Ident(..), @@ -42,7 +34,7 @@ diff -Naur language-c-0.4/src/Language/C/Data/Ident.hs language-c-0.4-new/src/La - mkIdent, builtinIdent, internalIdent, internalIdentAt, isInternalIdent, identToString, dumpIdent) + mkIdent, builtinIdent, internalIdent, internalIdentAt, isInternalIdent, identToString, dumpIdent, hashIdent) where - + -- TODO (comment from manuel): @@ -133,3 +133,6 @@ -- | dump the identifier string and its positions for debugging purposes @@ -51,25 +43,14 @@ diff -Naur language-c-0.4/src/Language/C/Data/Ident.hs language-c-0.4-new/src/La + +hashIdent :: Ident -> Int +hashIdent (Ident _ h _) = h -diff -Naur language-c-0.4/src/Language/C/Data/Position.hs language-c-0.4-new/src/Language/C/Data/Position.hs ---- language-c-0.4/src/Language/C/Data/Position.hs 2011-01-06 11:46:35.000000000 -0600 -+++ language-c-0.4-new/src/Language/C/Data/Position.hs 2011-01-06 15:31:57.634482017 -0600 -@@ -50,7 +50,7 @@ - show BuiltinPosition = "<builtin>" - show InternalPosition = "<internal>" - --{-# DEPRECATED posColumn "column number information is inaccurate in presence of macros - do not rely on it." #-} -+{-- DEPRECATED posColumn "column number information is inaccurate in presence of macros - do not rely on it." --} - - -- | @position absoluteOffset fileName lineNumber columnNumber@ initializes a @Position@ using the given arguments - position :: Int -> String -> Int -> Int -> Position -diff -Naur language-c-0.4/src/Language/C/Parser/Lexer.x language-c-0.4-new/src/Language/C/Parser/Lexer.x ---- language-c-0.4/src/Language/C/Parser/Lexer.x 2011-01-06 11:46:35.000000000 -0600 -+++ language-c-0.4-new/src/Language/C/Parser/Lexer.x 2011-01-06 15:31:57.636922062 -0600 -@@ -351,6 +351,13 @@ +diff -Naur language-c-0.4.2/src/Language/C/Parser/Lexer.x language-c-0.4.2-new/src/Language/C/Parser/Lexer.x +--- language-c-0.4.2/src/Language/C/Parser/Lexer.x 2011-08-24 09:51:19.000000000 -0500 ++++ language-c-0.4.2-new/src/Language/C/Parser/Lexer.x 2012-05-26 11:46:33.213087517 -0500 +@@ -358,7 +358,14 @@ idkwtok ('v' : 'o' : 'l' : 'a' : 't' : 'i' : 'l' : 'e' : []) = tok 8 CTokVolatile idkwtok ('_' : '_' : 'v' : 'o' : 'l' : 'a' : 't' : 'i' : 'l' : 'e' : '_' : '_' : []) = tok 12 CTokVolatile idkwtok ('w' : 'h' : 'i' : 'l' : 'e' : []) = tok 5 CTokWhile +- +idkwtok ('_':'_':'b':'l':'o':'c':'k':'i':'n':'g':[]) = tok 10 CTokBlocking +idkwtok ('_':'_':'r':'e':'m':'o':'t':'e':[]) = tok 10 CTokRemote +idkwtok ('p':'w':'a':'i':'t':[]) = tok 5 CTokPWait @@ -77,12 +58,13 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Lexer.x language-c-0.4-new/src/L +idkwtok ('p':'b':'r':'e':'a':'k':[]) = tok 6 CTokPBreak +idkwtok ('p':'p':'r':'i':'v':'a':'t':'e':[]) = tok 6 CTokPPrivate +idkwtok ('p':'s':'h':'a':'r':'e':'d':[]) = tok 6 CTokPShared - ++ idkwtok cs = \pos -> do name <- getNewName -diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/Language/C/Parser/Parser.y ---- language-c-0.4/src/Language/C/Parser/Parser.y 2011-01-11 11:33:19.331089585 -0600 -+++ language-c-0.4-new/src/Language/C/Parser/Parser.y 2011-01-11 11:44:45.593786776 -0600 + let len = case length cs of l -> l +diff -Naur language-c-0.4.2/src/Language/C/Parser/Parser.y language-c-0.4.2-new/src/Language/C/Parser/Parser.y +--- language-c-0.4.2/src/Language/C/Parser/Parser.y 2011-08-24 09:51:19.000000000 -0500 ++++ language-c-0.4.2-new/src/Language/C/Parser/Parser.y 2012-05-26 11:51:02.101086845 -0500 @@ -217,6 +217,8 @@ typedef { CTokTypedef _ } typeof { CTokTypeof _ } @@ -92,30 +74,33 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/ union { CTokUnion _ } unsigned { CTokUnsigned _ } void { CTokVoid _ } -@@ -236,6 +238,11 @@ +@@ -236,7 +238,12 @@ "__builtin_va_arg" { CTokGnuC GnuCVaArg _ } "__builtin_offsetof" { CTokGnuC GnuCOffsetof _ } "__builtin_types_compatible_p" { CTokGnuC GnuCTyCompat _ } +- +pwait { CTokPWait _ } +pbranch { CTokPBranch _ } +pbreak { CTokPBreak _ } +pshared { CTokPShared _ } +pprivate { CTokPPrivate _ } - ++ %% - + + @@ -359,6 +366,7 @@ | iteration_statement { $1 } | jump_statement { $1 } | asm_statement {% withNodeInfo $1 (CAsm $1) } + | parallel_statement { $1 } - - + + -- parse C labeled statement (C99 6.8.1) -@@ -473,6 +481,16 @@ - | for '(' enter_scope declaration expression_opt ';' expression_opt ')' statement leave_scope - {% withNodeInfo $1 $ CFor (Right $4) $5 $7 $9 } - +@@ -374,7 +382,19 @@ + {% withNodeInfo $1 $ CCases $2 $4 $6 } + + +--- parse C compound statement (C99 6.8.2) +-- parse Parallel C statement +-- +parallel_statement :: { CStat } @@ -126,10 +111,13 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/ + {% withNodeInfo $1 $ CPBranch $2 } + | pbreak + {% withNodeInfo $1 $ CPBreak } - - -- parse C jump statement (C99 6.8.6) ++ ++ ++ -- parse C compound statement (C99 6.8.2) -- -@@ -550,7 +568,7 @@ + -- * GNU extension: '__label__ ident;' declarations + -- +@@ -550,7 +570,7 @@ -- storage class and type qualifier --------------------------------------------------------------------------------------------------------------- attr :- __attribute__((..)) @@ -137,17 +125,17 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/ +storage_class :- typedef | extern | static | auto | register | __thread | __blocking | pprivate | ppshared type_qualifier :- const | volatile | restrict | inline type_qualifier_list :- type_qualifier+ - -@@ -755,7 +773,7 @@ - - + +@@ -755,7 +775,7 @@ + + -- A mixture of type qualifiers (const, volatile, restrict, inline) and storage class specifiers --- (extern, static, auto, register, __thread), in any order, but containing at least one storage class specifier. +-- (extern, static, auto, register, __thread, __blocking, pshared, pprivate), in any order, but containing at least one storage class specifier. -- -- declaration_qualifier_list :- <permute> type_qualifier* storage_class+ -- -@@ -1188,6 +1206,10 @@ +@@ -1188,6 +1208,10 @@ | volatile {% withNodeInfo $1 $ CVolatQual } | restrict {% withNodeInfo $1 $ CRestrQual } | inline {% withNodeInfo $1 $ CInlineQual } @@ -155,12 +143,12 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/ + | "__remote" {% withNodeInfo $1 $ CRemote } + | pshared {% withNodeInfo $1 $ CPShared } + | pprivate {% withNodeInfo $1 $ CPPrivate } - + -- a list containing at least one type_qualifier (const, volatile, restrict, inline) -- and additionally CAttrs -@@ -2161,13 +2183,17 @@ +@@ -2161,13 +2185,17 @@ withAsmNameAttrs (mAsmName, newAttrs) declr = setAsmName mAsmName (appendObjAttrsR newAttrs declr) - + appendDeclrAttrs :: [CAttr] -> CDeclrR -> CDeclrR -appendDeclrAttrs newAttrs (CDeclrR ident (Reversed []) asmname cattrs at) - = CDeclrR ident empty asmname (cattrs ++ newAttrs) at @@ -179,26 +167,28 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/ + hasFunDeclr ds = any isFunDeclr ds +appendDeclrAttrs newAttrs (CDeclrR ident derived asmname cattrs at) + = CDeclrR ident derived asmname (cattrs ++ newAttrs) at - + ptrDeclr :: CDeclrR -> [CTypeQual] -> NodeInfo -> CDeclrR ptrDeclr (CDeclrR ident derivedDeclrs asmname cattrs dat) tyquals at -diff -Naur language-c-0.4/src/Language/C/Parser/Tokens.hs language-c-0.4-new/src/Language/C/Parser/Tokens.hs ---- language-c-0.4/src/Language/C/Parser/Tokens.hs 2011-01-06 11:46:35.000000000 -0600 -+++ language-c-0.4-new/src/Language/C/Parser/Tokens.hs 2011-01-06 15:31:57.643469288 -0600 -@@ -132,6 +132,13 @@ +diff -Naur language-c-0.4.2/src/Language/C/Parser/Tokens.hs language-c-0.4.2-new/src/Language/C/Parser/Tokens.hs +--- language-c-0.4.2/src/Language/C/Parser/Tokens.hs 2011-08-24 09:51:19.000000000 -0500 ++++ language-c-0.4.2-new/src/Language/C/Parser/Tokens.hs 2012-05-26 11:52:19.589086751 -0500 +@@ -132,7 +132,14 @@ | CTokTyIdent !PosLength !Ident -- `typedef-name' identifier | CTokGnuC !GnuCTok !PosLength -- special GNU C tokens | CTokEof -- end of file -+ | CTokBlocking !PosLength -- '__blocking' -+ | CTokRemote !PosLength -- '__remote' -+ | CTokPWait !PosLength -- `pwait' -+ | CTokPBranch !PosLength -- `pbranch' -+ | CTokPBreak !PosLength -- `pbreak' +- ++ | CTokBlocking !PosLength -- '__blocking' ++ | CTokRemote !PosLength -- '__remote' ++ | CTokPWait !PosLength -- `pwait' ++ | CTokPBranch !PosLength -- `pbranch' ++ | CTokPBreak !PosLength -- `pbreak' + | CTokPShared !PosLength -- `pshared' + | CTokPPrivate !PosLength -- `pprivate' - ++ -- special tokens used in GNU C extensions to ANSI C -- + data GnuCTok = GnuCAttrTok -- `__attribute__' @@ -242,6 +249,13 @@ posLenOfTok (CTokIdent pos _) = pos posLenOfTok (CTokTyIdent pos _) = pos @@ -211,7 +201,7 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Tokens.hs language-c-0.4-new/src +posLenOfTok (CTokPPrivate pos ) = pos +posLenOfTok (CTokPShared pos ) = pos posLenOfTok CTokEof = error "tokenPos: Eof" - + instance Show CToken where @@ -327,11 +341,18 @@ showsPrec _ (CTokTypedef _ ) = showString "typedef" @@ -232,9 +222,9 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Tokens.hs language-c-0.4-new/src showsPrec _ (CTokCLit _ c) = shows c showsPrec _ (CTokILit _ i) = shows i showsPrec _ (CTokFLit _ f) = shows f -diff -Naur language-c-0.4/src/Language/C/Pretty.hs language-c-0.4-new/src/Language/C/Pretty.hs ---- language-c-0.4/src/Language/C/Pretty.hs 2011-01-06 11:46:35.000000000 -0600 -+++ language-c-0.4-new/src/Language/C/Pretty.hs 2011-01-06 15:31:57.646019992 -0600 +diff -Naur language-c-0.4.2/src/Language/C/Pretty.hs language-c-0.4.2-new/src/Language/C/Pretty.hs +--- language-c-0.4.2/src/Language/C/Pretty.hs 2011-08-24 09:51:19.000000000 -0500 ++++ language-c-0.4.2-new/src/Language/C/Pretty.hs 2012-05-26 11:53:45.233086438 -0500 @@ -154,7 +154,11 @@ pretty (CReturn Nothing _) = ii $ text "return" <> semi pretty (CReturn (Just e) _) = ii $ text "return" <+> pretty e <> semi @@ -248,17 +238,19 @@ diff -Naur language-c-0.4/src/Language/C/Pretty.hs language-c-0.4-new/src/Langua let inner = text "{" $+$ mlistP ppLblDecls localLabels $+$ vcat (map pretty bis) $$ text "}" in if p == -1 then inner else ii inner where ppLblDecls = vcat . map (\l -> text "__label__" <+> identP l <+> semi) -@@ -253,6 +257,10 @@ +@@ -253,7 +257,11 @@ pretty (CRestrQual _) = text "__restrict" pretty (CInlineQual _) = text "inline" pretty (CAttrQual a) = attrlistP [a] +- + pretty (CBlocking _) = text "__blocking" + pretty (CRemote _) = text "__remote" + pretty (CPShared _) = text "pshared" + pretty (CPPrivate _) = text "pprivate" - ++ instance Pretty CStructUnion where pretty (CStruct tag ident Nothing cattrs _) = pretty tag <+> attrlistP cattrs <+> maybeP identP ident + pretty (CStruct tag ident (Just []) cattrs _) = @@ -375,8 +383,8 @@ <+> maybeP pretty expr2 <+> text ":" <+> prettyPrec 4 expr3 prettyPrec p (CBinary op expr1 expr2 _) = @@ -270,20 +262,20 @@ diff -Naur language-c-0.4/src/Language/C/Pretty.hs language-c-0.4-new/src/Langua prettyPrec p (CCast decl expr _) = parenPrec p 25 $ text "(" <> pretty decl <> text ")" <+> prettyPrec 25 expr -diff -Naur language-c-0.4/src/Language/C/Syntax/AST.hs language-c-0.4-new/src/Language/C/Syntax/AST.hs ---- language-c-0.4/src/Language/C/Syntax/AST.hs 2011-01-06 11:46:35.000000000 -0600 -+++ language-c-0.4-new/src/Language/C/Syntax/AST.hs 2011-01-06 15:31:57.648960933 -0600 -@@ -276,6 +276,9 @@ +diff -Naur language-c-0.4.2/src/Language/C/Syntax/AST.hs language-c-0.4.2-new/src/Language/C/Syntax/AST.hs +--- language-c-0.4.2/src/Language/C/Syntax/AST.hs 2011-08-24 09:51:19.000000000 -0500 ++++ language-c-0.4.2-new/src/Language/C/Syntax/AST.hs 2012-05-26 11:55:23.797086194 -0500 +@@ -295,6 +295,9 @@ | CReturn (Maybe (CExpression a)) a -- | assembly statement - | CAsm CAsmStmt a -+ | CPWait CStat a -+ | CPBranch CStat a + | CAsm (CAssemblyStatement a) a ++ | CPWait (CStatement a) a ++ | CPBranch (CStatement a) a + | CPBreak a - deriving (Data,Typeable {-! CNode !-}) - - -- | GNU Assembler statement -@@ -399,6 +402,10 @@ + deriving (Show, Data,Typeable {-! , CNode , Annotated !-}) + + -- Derived instance relies on fmap2 :( +@@ -453,6 +456,10 @@ | CRestrQual a | CInlineQual a | CAttrQual (CAttribute a) @@ -291,27 +283,27 @@ diff -Naur language-c-0.4/src/Language/C/Syntax/AST.hs language-c-0.4-new/src/La + | CRemote a -- ^ remote function + | CPShared a -- ^ shared variable across pbranch blocks + | CPPrivate a -- ^ private variable across pbranch blocks - deriving (Data,Typeable {-! CNode !-}) - - -- | C structure or union specifiers (K&R A8.3, C99 6.7.2.1) -@@ -663,6 +670,9 @@ - nodeInfo (CBreak d) = nodeInfo d - nodeInfo (CReturn _ t) = nodeInfo t - nodeInfo (CAsm _ t) = nodeInfo t -+ nodeInfo (CPWait _ t) = nodeInfo t -+ nodeInfo (CPBranch _ t) = nodeInfo t -+ nodeInfo (CPBreak t) = nodeInfo t - instance CNode t1 => Pos (CStatement t1) - where posOf x = posOfNode (nodeInfo x) - -@@ -726,6 +736,10 @@ - nodeInfo (CRestrQual d) = nodeInfo d - nodeInfo (CInlineQual d) = nodeInfo d - nodeInfo (CAttrQual d) = nodeInfo d -+ nodeInfo (CBlocking d) = nodeInfo d -+ nodeInfo (CRemote d) = nodeInfo d -+ nodeInfo (CPPrivate d) = nodeInfo d -+ nodeInfo (CPShared d) = nodeInfo d - instance CNode t1 => Pos (CTypeQualifier t1) - where posOf x = posOfNode (nodeInfo x) - + deriving (Show, Data,Typeable {-! ,CNode ,Functor ,Annotated !-}) + + +@@ -857,6 +864,9 @@ + nodeInfo (CBreak d) = nodeInfo d + nodeInfo (CReturn _ n) = nodeInfo n + nodeInfo (CAsm _ n) = nodeInfo n ++ nodeInfo (CPWait _ t) = nodeInfo t ++ nodeInfo (CPBranch _ t) = nodeInfo t ++ nodeInfo (CPBreak t) = nodeInfo t + + instance (CNode t1) => Pos (CStatement t1) where + posOf x = posOf (nodeInfo x) +@@ -1102,6 +1112,10 @@ + nodeInfo (CRestrQual d) = nodeInfo d + nodeInfo (CInlineQual d) = nodeInfo d + nodeInfo (CAttrQual d) = nodeInfo d ++ nodeInfo (CBlocking d) = nodeInfo d ++ nodeInfo (CRemote d) = nodeInfo d ++ nodeInfo (CPPrivate d) = nodeInfo d ++ nodeInfo (CPShared d) = nodeInfo d + + instance (CNode t1) => Pos (CTypeQualifier t1) where + posOf x = posOf (nodeInfo x) diff --git a/code/maint/hs/setup-hs-local b/code/maint/hs/setup-hs-local index fda92be..a5c56dc 100755 --- a/code/maint/hs/setup-hs-local +++ b/code/maint/hs/setup-hs-local @@ -53,19 +53,33 @@ install_pkg() vpkg() { if [ "x$verbose" != "x" ]; then - install_pkg $1 $2 + install_pkg $1 $2 else echo -n "Installing package $1, version $2..." install_pkg $1 $2 > /dev/null echo "done." fi } - -vpkg transformers 0.2.2.0 -vpkg mtl 2.0.1.0 -vpkg happy 1.18.6 -vpkg alex 2.3.5 -vpkg regex-base 0.93.2 -vpkg regex-posix 0.94.4 -vpkg regex-pcre-builtin 0.94.2.1.7.7 -vpkg syb 0.3 + +#vpkg transformers 0.2.2.0 +#vpkg mtl 2.0.1.0 +#vpkg happy 1.18.6 +#vpkg QuickCheck 2.4.2 +#vpkg alex 3.0.2 +#vpkg regex-base 0.93.2 +#vpkg regex-posix 0.94.4 +#vpkg regex-pcre-builtin 0.94.2.1.7.7 +#vpkg syb 0.3.6.1 + +# Installs cabal locally - apt-get install cabal-install to install globally +wget http://www.haskell.org/cabal/release/cabal-install-0.14.0/cabal-install-0.14... +tar xvfz cabal-install-0.14.0.tar.gz +cd cabal-install-0.14.0 +sh ./bootstrap.sh +cabal update +cabal install alex +cabal install happy + +cabal install regex-posix +cabal install regex-pcre +cabal install mtl diff --git a/code/maint/hs/setup-langc b/code/maint/hs/setup-langc index d30a539..5c5d7a3 100755 --- a/code/maint/hs/setup-langc +++ b/code/maint/hs/setup-langc @@ -1,51 +1,38 @@ -#!/bin/sh +#!/bin/bash -#wget --connect-timeout=2 --read-timeout=2 --tries=1 http://hackage.haskell.org/packages/archive/language-c/0.3.1/language-c-0.3.... +cmdpath=$(echo $0|sed -e "s|^\(.*\)/[^/]*$|\1|") -VERSION=0.4 +VERSION=0.4.2 -OLDPWD=$PWD +pushd ${cmdpath} +wget --connect-timeout=2 --read-timeout=2 --tries=1 http://hackage.haskell.org/packages/archive/language-c/${VERSION}/language-c-${VERSION}.tar.gz +popd -cmdpath=$(echo $0|sed -e "s|^\(.*\)/[^/]*$|\1|") +set -x # put happy and alex in the path -PATH=${OLDPWD}/GHC/bin:$PATH - -echo "Patching language-c-${VERSION} with Aesop extensions..." +PATH=$HOME/.cabal/bin:$PATH # use local copy for now -tar xvfz ${cmdpath}/language-c-${VERSION}.tar.gz >/dev/null 2>&1 +tar xvfz ${cmdpath}/language-c-${VERSION}.tar.gz >/dev/null 2>&1 if [ $? != 0 ]; then echo "Untar of language-c-${VERSION}.tar.gz failed!" exit 1 fi +echo "Patching language-c-${VERSION} with Aesop extensions..." + cd language-c-${VERSION} -patch -p 1 < ${OLDPWD}/${cmdpath}/language-c.patch >/dev/null 2>&1 +patch -p 1 < ${OLDPWD}/${cmdpath}/language-c-${VERSION}.patch >/dev/null 2>&1 if [ $? != 0 ]; then echo "Patch of language-c failed!" exit 1 fi echo "Building/Installing language-aesop-${VERSION} package..." -runhaskell Setup configure --prefix=${OLDPWD}/GHC --user >/dev/null 2>&1 -if [ $? != 0 ]; then - echo "Configure of language-aesop failed!" - exit 1 -fi - -runhaskell Setup build >/dev/null 2>&1 -if [ $? != 0 ]; then - echo "Build of language-aesop failed!" - exit 1 -fi - -runhaskell Setup install --user >/dev/null 2>&1 -if [ $? != 0 ]; then - echo "Install of language-aesop failed!" - exit 1 -fi - +cabal configure +cabal build +cabal install cd - -rm -r language-c-${VERSION} +# rm -r language-c-${VERSION} diff --git a/code/src/aesop/parser/ae-remote-parser.lhs b/code/src/aesop/parser/ae-remote-parser.lhs index e0130bd..91940ce 100644 --- a/code/src/aesop/parser/ae-remote-parser.lhs +++ b/code/src/aesop/parser/ae-remote-parser.lhs @@ -28,7 +28,7 @@
import CGen import Header import Text.Regex.PCRE -> import Array +> import Data.Array import System.Directory
Each type in the registry is the name and a set of truth values each function @@ -223,7 +223,7 @@ is set to true. typeof(expr) -CTypeOfType CDecl NodeInfo +CTypeOfType CDecl NodeInfo
mkDeclsFromRemote :: String -> [String] -> NodeInfo -> RemoteT [CDecl] mkDeclsFromRemote macro params ni = do @@ -280,7 +280,7 @@ CTypeOfType CDecl NodeInfo stmts
mkDecodeBlock :: NodeInfo -> String -> String -> Bool -> RemoteT [CStat] -> mkDecodeBlock ni typeName fieldName isPtr = do +> mkDecodeBlock ni typeName fieldName isPtr = do let ptrParam = if isPtr then "" else "&" mkStmtFromRemote "AER_MK_DECODE_TYPE" [typeName, fieldName, ptrParam] ni
mkDecodeStmts stype fields ni = do fieldsInfo <- mapM getFieldInfo fields let anonSType = mkAnonFromDecl stype -> decodeBlocks <- liftM concat $ sequence $ map (uncurry3 $ mkDecodeBlock ni) fieldsInfo +> decodeBlocks <- liftM concat $ sequence $ map (uncurry3 $ mkDecodeBlock ni) fieldsInfo decodeDecls <- mkDeclsFromRemote "AER_MK_DECODE_DECLS" [show $ pretty anonSType] ni let typeStr = show $ pretty anonSType canon ' ' = '_' @@ -410,7 +410,7 @@ CTypeOfType CDecl NodeInfo initDecls <- mkDeclsFromRemote "AER_MK_INIT_DECLS" [show $ pretty anonSType] ni startStmts <- mkStmtFromRemote "AER_MK_INIT_STMTS_START" [show $ pretty anonSType] ni endStmts <- mkStmtFromRemote "AER_MK_INIT_STMTS_END" [] ni
@@ -288,7 +288,7 @@ CTypeOfType CDecl NodeInfo - +
return $ mkCompoundWithDecls Nothing initDecls (startStmts ++ nullBlocks ++ initBlocks ++ endStmts) ni
mkInitFun :: CDecl -> String -> [CDecl] -> NodeInfo -> RemoteT CExtDecl @@ -453,7 +453,7 @@ CTypeOfType CDecl NodeInfo initDecls <- mkDeclsFromRemote "AER_MK_COPY_DECLS" [show $ pretty anonSType] ni startStmts <- mkStmtFromRemote "AER_MK_COPY_STMTS_START" [show $ pretty anonSType] ni endStmts <- mkStmtFromRemote "AER_MK_COPY_STMTS_END" [] ni
- +
return $ mkCompoundWithDecls Nothing initDecls (startStmts ++ ptrInitBlocks ++ initBlocks ++ endStmts) ni
mkCopyFun :: CDecl -> String -> [CDecl] -> NodeInfo -> RemoteT CExtDecl @@ -525,17 +525,17 @@ CTypeOfType CDecl NodeInfo bools <- mapM isFullEncoding types let nInfos = map nodeInfo fields tbns = zip4 types bools nInfos fields -> let checkRemoteFields (t, b, n, f) = when (not b) $ -> invalid ("struct '" ++ (show $ fromJust structName) ++ "' with parameter '" ++ +> let checkRemoteFields (t, b, n, f) = when (not b) $ +> invalid ("struct '" ++ (show $ fromJust structName) ++ "' with parameter '" ++ (show $ getCDeclName $ f) ++ "' is not a valid remote type\n") n mapM_ checkRemoteFields tbns -> +> let (s:_) = filter isStructTypeSpec specs if (structSpecHasFields s) then do let newS = CDeclExt $ CDecl (filterOutRemoteSpec specs) inits ni enc <- mkEncodeFun d sname allFields ni -> size <- mkSizeFun d sname allFields ni +> size <- mkSizeFun d sname allFields ni dec <- mkDecodeFun d sname allFields ni initNull <- mkInitNullFun d sname allFields ni init <- mkInitFun d sname allFields ni @@ -608,7 +608,7 @@ CTypeOfType CDecl NodeInfo return ()
checkRemoteParams ni _ = do -> invalid "only two parameters allowed for a __remote declaration" ni +> invalid "only two parameters allowed for a __remote declaration" ni return ()
isAEReturnType :: CTypeSpec -> Bool @@ -675,7 +675,7 @@ CTypeOfType CDecl NodeInfo
registerRemoteDecl e@(CFDefExt fd) = do registerEFun $ getFunDefName fd -> return [e] +> return [e]
registerRemoteDecl e = return [e]
@@ -760,7 +760,7 @@ CTypeOfType CDecl NodeInfo
isInPtr = any isDerivedPtr (join $ map getDerivedDeclrs inDerived) stubBlock <- mkStubBlock fname inTypeName inParamName isInPtr outTypeName outParamName ni stubDecls <- mkDeclsFromRemote "AER_MK_STUB_DECLS" [fname] ni
-> return $ mkCompoundWithDecls Nothing +> return $ mkCompoundWithDecls Nothing
-- declarations stubDecls stubBlock
@@ -792,13 +792,13 @@ CTypeOfType CDecl NodeInfo
(Ident outParamName _ _) = getCDeclName outparam inTypeName = show $ pretty (removeAPtr $ emptyDeclrList inparam) outTypeName = show $ pretty (removeAPtr $ emptyDeclrList outparam)
-> canonInType = getRemoteTypeName $ getTypeSpecFromDecl inparam +> canonInType = getRemoteTypeName $ getTypeSpecFromDecl inparam
canonOutType = getRemoteTypeName $ getTypeSpecFromDecl outparam (CDecl _ inDerived _) = inparam isInPtr = any isDerivedPtr (join $ map getDerivedDeclrs inDerived) ptrParam = if isInPtr then "" else "*" when (not $ isJust canonInType) $
-> invalid ("'" ++ inTypeName ++ "'" ++ +> invalid ("'" ++ inTypeName ++ "'" ++
" is not a recognized encoding type for input parameter '" ++ inParamName ++ "' to function: " ++ fname) ni when (not $ isJust canonOutType) $ invalid ("'" ++ outTypeName ++ "'" ++
@@ -861,7 +861,7 @@ CTypeOfType CDecl NodeInfo
transformRemote :: CExtDecl -> RemoteT [CExtDecl] transformRemote e@(CFDefExt funDef) | isRemoteFunDef funDef = do -> let re = removeRemoteSpecFromFunDef e +> let re = removeRemoteSpecFromFunDef e ni = nodeInfo funDef stub <- mkStubFun funDef servF <- mkServiceFun funDef @@ -889,15 +889,15 @@ CTypeOfType CDecl NodeInfo mkRegFun :: String -> NodeInfo -> RemoteT CExtDecl mkRegFun sname ni = do decls <- mkDeclsFromRemote "AER_MK_REG_DECLS" [sname] ni -> rs <- getRemoteNames -> stmts <- liftM concat $ sequence $ map (mkRegBlock ni) rs +> rs <- getRemoteNames +> stmts <- liftM concat $ sequence $ map (mkRegBlock ni) rs startStmts <- mkStmtFromRemote "AER_MK_REG_START" [sname] ni endStmts <- mkStmtFromRemote "AER_MK_REG_END" [sname] ni return $ mkFunDef ((CTypeDef (newIdent "triton_ret_t" ni) ni), []) [] ("aer_remote_register_" ++ sname) [mkAnonCDecl (CVoidType ni) [] ni] -> (mkCompoundWithDecls Nothing +> (mkCompoundWithDecls Nothing decls (startStmts ++ stmts ++ endStmts) ni) @@ -914,7 +914,7 @@ CTypeOfType CDecl NodeInfo mkOpIdDecls :: NodeInfo -> RemoteT [CExtDecl] mkOpIdDecls ni = do rs <- getRemoteNames -> return $ map (mkOpIdDecl ni) rs +> return $ map (mkOpIdDecl ni) rs
mkServiceDecl :: NodeInfo -> String -> RemoteT [CExtDecl] mkServiceDecl ni s = do @@ -959,7 +959,7 @@ CTypeOfType CDecl NodeInfo funDecls <- mapM mkStructFunDecls rdecls let allDecls = concat $ zipWith (\a b -> a:b) rdecls funDecls rs <- getRemotes -> stubs <- sequence $ map (\((,,) f r p) -> mkStubDecl f r p ni) rs +> stubs <- sequence $ map (\((,,) f r p) -> mkStubDecl f r p ni) rs return $ CTranslUnit (allDecls ++ stubs) ni
generateAST :: FilePath -> IO CTranslUnit @@ -971,7 +971,7 @@ CTypeOfType CDecl NodeInfo Right ast -> return ast
getRegistryDecl :: String -> NodeInfo -> CTranslUnit -> getRegistryDecl s ni = CTranslUnit [ +> getRegistryDecl s ni = CTranslUnit [ CDeclExt $ (mkFunDecl ("aer_remote_register_" ++ s) (CTypeDef (newIdent "triton_ret_t" ni) ni) [] [mkAnonCDecl (CVoidType ni) [] ni]) ] ni @@ -1048,7 +1048,7 @@ CTypeOfType CDecl NodeInfo regdir = getRegistryDir opts compiler = getCompiler opts header = "Usage: ae-remote-parser [OPTIONS...] files..." -> +> when (not $ null errs) $ ioError $ userError ((concat errs) ++ (usageInfo header parserOpts))
hooks/post-receive --