freesect 0.0.5 → 0.6
raw patch · 16 files changed
+797/−220 lines, 16 filesdep +directorydep +randomdep −haskell98dep ~arraydep ~basedep ~cpphs
Dependencies added: directory, random
Dependencies removed: haskell98
Dependency ranges changed: array, base, cpphs, mtl, parallel, pretty, syb
Files
- Doc/index.html +124/−78
- FilesAndParsing.hs +5/−2
- Main.hs +98/−14
- Makefile +3/−1
- S14.hs +2/−3
- S15.hs +12/−7
- S24.hs +156/−0
- S25.hs +152/−0
- S26.hs +10/−0
- cln +13/−8
- freesect.cabal +19/−15
- freesect.sh +8/−7
- ile +6/−1
- z +75/−58
- zpack +114/−0
- zz +0/−26
Doc/index.html view
@@ -10,12 +10,22 @@ margin-top: 24px; margin-bottom: 16px; }-pre-inline {+pre, pre2 {+ font-weight: bold;+}+pre2, pre3 { font-family: "Courier New"; padding: 0 0 0 0; margin: 0 0 0 0; border: 0 0 0 0; }+pre4 {+ font-family: "Courier New";+ font-size: 12pt;+ padding: 0 0 0 0;+ margin: 0 0 0 0;+ border: 0 0 0 0;+} pre.showhide2 { font-family: "Courier New"; padding: 0 0 0 0;@@ -28,6 +38,12 @@ margin: 0 0 0 0; border: 0 0 0 0; }+pre.showhide4 {+ font-family: "Courier New";+ padding: 0 0 0 0;+ margin: 0 0 0 0;+ border: 0 0 0 0;+} A:link { font-weight: bold; color: #27e; text-decoration: none; } A:visited { font-weight: bold; color: #14a; text-decoration: none; } A:hover { font-weight: bold; color: #795; text-decoration: none; }@@ -56,35 +72,44 @@ <div style="color: #B52; font-size: 9pt; font-weight: bold; margin-left: 20px; margin-right: 20%; margin-bottom: 15px; margin-top: 10px;">The reader is strongly encouraged to navigate to <a href="http://www.fremissant.net/freesect">fremissant.net/freesect</a> as these documents are currently experiencing rapid growth and refinement. The local files represent the best documentation available at packaging of this v.0.0.5 source distribution (March 11, 2012).</div> -<i>Free sections</i> are syntactic sugar to extend the usual notion of "section" in functional programming.-Recall that a section is just a function which has been applied to some but not all of its arguments.-Unless the function is modified, arguments must be supplied in the lexical order determined by the function binding's parameters.-For instance, <pre-inline>sect</pre-inline> is partially applied, but is still a function type and can absorb two more arguments of types <pre-inline>Char</pre-inline> and <pre-inline>Float</pre-inline>, in that order.+<i>Free sections</i> are syntactic sugar to extend the usual notion of +"section" in functional programming.+Recall that a section is just a function which has been applied to some +but not all of its arguments.+Unless the function is modified, arguments must be supplied in the +lexical order determined by the function binding's parameters.+For instance, <pre2>f 4 True</pre2> is partially applied, but is still a function type and can absorb two more arguments of types <pre2>Char</pre2> and <pre2>Float</pre2>, in that order. -<pre>- f :: Int -> Bool -> Char -> Float -> String- sect = f 4 True -- Char -> Float -> String+<pre> f :: Int -> Bool -> Char -> Float -> String+ f 4 True -- Char -> Float -> String </pre> -By using wildcard symbols (<pre-inline>__</pre-inline>, a double-underscore), any subset of values occurring in a RHS context can be deferred, in the same spirit as partial function application.-Special brackets (<pre-inline>_[…]_</pre-inline>) are used to delimit the lexical extent (or context) of the section, although these could sometimes be omitted (details below).-The free section is then a function with arity at least equal to the number of wildcards, and behaves as if a helper function had been defined which shuffled the argument order of the functional expression, turning it into a normal section.+By using wildcard symbols (<pre2>__</pre2>, a +double-underscore), any subset of values occurring in a RHS context can +be deferred, in the same spirit as partial function application.+Special brackets (<pre2>_[…]_</pre2>) are used to delimit +the lexical extent (or context) of the section, although these can +sometimes be omitted (details below).+The free section is then a function with arity at least equal to the +number of wildcards, and behaves as if a helper function had been +defined which shuffled the argument order of the functional expression, +turning it into a normal section. <p>-Some examples, including illustrations of context inferencing.-<ul>-<li><pre-inline>_[ __ ]_ <=> ( __ ) <=> id</pre-inline></li>-<li><pre-inline>map _[ (+) __ 2 ]_ [1,2,3] => [3,4,5]</pre-inline></li>-<li><pre-inline>map ( (+) __ 2 ) [1,2,3] => [3,4,5]</pre-inline></li>-<li><pre-inline>zipWith $ f __ $ g __ z <=> zipWith _[ f __ $ g __ z ]_</pre-inline></li>-</ul>+Philosophically, use of this sort of syntax promotes "higher-order programming", since any expression can so easily be made into a function, in numerous ways, simply by replacing parts of it with freesect wildcards.+That this is worthwhile is demonstrated by the frequent usefulness of sections. <p>-An more complex example...+Some examples, including illustrations of context inferencing:+<ul id="examples">+<li><pre2>_[ __ ]_ <=> ( __ ) <=> id</pre2></li>+<li><pre2>map _[ (+) __ 2 ]_ [1,2,3] => [3,4,5]</pre2></li>+<li><pre2>map ( (+) __ 2 ) [1,2,3] => [3,4,5]</pre2></li>+<li><pre2>zipWith $ f __ $ g __ z <=> zipWith _[ f __ $ g __ z ]_</pre2></li>+</ul> <p>-Here I depict a situation where some API provides you with the dreaded <pre-inline>dreadme</pre-inline> function, which you have need of using.-The example is designed to show that you can really put the <pre-inline>__</pre-inline>'s anywhere on a RHS that an expression can go.+For a more complex example, consider a situation where some API provides you with the dreaded <pre2>dreadme</pre2> function, which you have need of using.+The example is designed to show that you can really put the <pre2>__</pre2>'s anywhere on a RHS that an expression can go. -<pre>- {-# LANGUAGE FreeSections #-} -- use "{- #" if compiling with ghc -F+<pre> {-# LANGUAGE FreeSections #-} -- use "{- #" if compiling with ghc -F tableA = [ [1,2,3], [4,5], [6,7,8,9] ] tableB = [ [9,8,7], [6,5], [4,3,2,1] ]@@ -97,10 +122,9 @@ [-1,1] </pre> -FreeSect rewrites the RHS of <pre-inline>rslt</pre-inline> (where <pre-inline>fs0…fs2</pre-inline> must be fresh identifiers) to:+FreeSect rewrites the RHS of <pre2>v</pre2> (where <pre2>fs0…fs2</pre2> must be fresh identifiers) to: -<pre>- v = map3 (\ fs0 fs1 fs2 -> dreadme tableA fs0 (repeat True,fs1) (D fs2 [(+),(*)]) )+<pre> v = map3 (\ fs0 fs1 fs2 -> dreadme tableA fs0 (repeat True,fs1) (D fs2 [(+),(*)]) ) [tableA,tableB] [0..] [-1,1]@@ -108,38 +132,33 @@ (Here is <a id="collapsed1" href="#collapsed1" onclick="collapse(this,'.showhide1');">the rest</a> of the code to make a closed module.) -<pre class="showhide1" style="display: none;">- dreadme :: [[Int]] -> [[Int]] -> ([Bool],Int) -> D (Int->Int->Int) -> String+<pre class="showhide1" style="display: none;"> dreadme :: [[Int]] -> [[Int]] -> ([Bool],Int) -> D (Int->Int->Int) -> String dreadme tabA tabB (ps,q) (D wt flst)- = show $ map (!!q) $ map2 f tabA tabB- where f :: [Int] -> [Int] -> [Bool]- f rowA rowB = map2 (==) (repeat rowA)- $ map2' flst' rowB (map ((q+).(wt*)) rowB)- flst' = filter' ps flst-(<a id="collapsed2" href="#collapsed2" onclick="collapse(this,'.showhide2'); collapse(this,'.showhide3');">base cases</a>)<pre class="showhide2" style="display: block;">- filter' :: [Bool] -> [a] -> [a]+ = show $ map (!!q) $ map2 f tabA tabB+ where f rowA rowB = map2 (<) (repeat rowA)+ $ map2' (filter' ps flst) rowB (map ((q+).(wt*)) rowB)+(<a id="collapsed2" href="#collapsed2" onclick="collapse(this,'.showhide2'); collapse(this,'.showhide3');">base cases</a>)<pre class="showhide2" style="display: block;"> filter' :: [Bool] -> [a] -> [a] filter' (p:ps) (x:xs) = if p then x:filter' ps xs else filter' ps xs- map2 :: (a->b->c) -> [a] -> [b] -> [c]+ map2 :: (a->b->c) -> [a] -> [b] -> [c] map2 f (x:xs) (y:ys) = (f x y) : map2 f xs ys- map2' :: [a->a->a] -> [a] -> [a] -> [[a]]+ map2' :: [a->a->a] -> [a] -> [a] -> [[a]] map2' (f:fs) xs ys = (map2 f xs ys) : map2' fs xs ys- map3 :: (a->b->c->d) -> [a] -> [b] -> [c] -> [d]+ map3 :: (a->b->c->d) -> [a] -> [b] -> [c] -> [d] map3 f (x:xs) (y:ys) (z:zs) = (f x y z) : map3 f xs ys zs-</pre><pre class="showhide3" style="display: none;">- filter' :: [Bool] -> [a] -> [a]+</pre><pre class="showhide3" style="display: none;"> filter' :: [Bool] -> [a] -> [a] filter' (p:ps) (x:xs) = if p then x:filter' ps xs else filter' ps xs- map2 :: (a->b->c) -> [a] -> [b] -> [c]+ map2 :: (a->b->c) -> [a] -> [b] -> [c] map2 f _ [] = [] map2 f [] _ = [] map2 f (x:xs) (y:ys) = (f x y) : map2 f xs ys- map2' :: [a->a->a] -> [a] -> [a] -> [[a]]- map2' _ _ [] = []- map2' _ [] _ = []+ map2' :: [a->a->a] -> [a] -> [a] -> [[a]] map2' [] _ _ = []+ map2' _ [] _ = []+ map2' _ _ [] = [] map2' (f:fs) xs ys = (map2 f xs ys) : map2' fs xs ys- map3 :: (a->b->c->d) -> [a] -> [b] -> [c] -> [d]+ map3 :: (a->b->c->d) -> [a] -> [b] -> [c] -> [d] map3 f _ _ [] = [] map3 f _ [] _ = [] map3 f [] _ _ = []@@ -149,65 +168,92 @@ <h2>Some virtues of the new syntax</h2> -Although the rewrite provided by the extension is simple, there are advantages of free sections relative to explicitly written lambdas:+Although the rewrite provided by the extension is simple, there are +advantages of free sections relative to explicitly written lambdas: <ul> <li>the lambda forces the programmer to invent names for the wildcards</li> <li>the lambda forces the programmer to repeat those names, and place them correctly</li> <li>freesect wildcards stand out vividly, indicating where the awaited expressions will go</li> <li>reading the lambda requires visual pattern-matching between left and right sides of the lambda-<li>the lambda is longer overall, and prefaces the expression of interest with something like micro-boilerplate</li>+</li><li>the lambda is longer overall, and prefaces the expression of interest with something like micro-boilerplate</li> </ul> On the other hand, the lambda is more powerful and can achieve arbitrary permutations without further ado. <h2>Implementation</h2> -The <a href="freesect-0.0.5.tar.gz">implementation</a> seems to be working.-The freesect package can also be installed from hackage.haskell.org, for instance using cabal-install.-I offer fair warning that I'm <i>not</i> a good Haskell coder, but this does demonstrate how a person of modest abilities can use <a href="http://www.hackage.haskell.org/package/syb">SYB</a> with <a href="http://www.hackage.haskell.org/package/haskell-src-exts">HSE</a> to create a robust Haskell syntax extension.+The <a href="http://fremissant.net/freesect/freesect-0.0.5.tar.gz">implementation</a> seems to be working.+The <pre2>freesect</pre2> package can also be installed from <a href="http://hackage.haskell.org/package/freesect">Hackage</a>, for instance using <pre2>cabal-install</pre2>.+I offer fair warning that I'm <i>not</i> a good Haskell coder, but this does demonstrate how a person of modest abilities can use <a href="http://hackage.haskell.org/package/syb">SYB</a> with <a href="http://hackage.haskell.org/package/haskell-src-exts">HSE</a> to create a robust Haskell syntax extension. +<h2>Default context inferencing</h2>++A default context is automatically applied when the <pre2>_[…]_</pre2> grouping syntax is omitted.+Defining this default can be tricky, and a bit arbitrary, so for robust code it's best to use explicit bracketing.+As of v.0.0.5, when the <pre2>_[…]_</pre2> are omitted, the defaulting rules are as follows:+The semilattice join of all unbacketed wildcards in a RHS are given context of the innermost enclosing parentheses or infix <pre2>$</pre2> operation.+If no such parentheses or infix <pre2>$</pre2> are present, the whole RHS becomes the default context.+Some of the examples at the top of the page demonstrate these rules.+One hopes that the default will result in a type error, should the inferred context differ from the intended.+I haven't thought of any situation where more than one bracketing of freesect wildcards yield typeable expressions, but neither have I ruled it out.+A context inference policy based on typeability tests among various possible scopes would also be possible...+ <h2>Background</h2> -There was <a href="irc.html">discussion</a> about this on the #haskell IRC channel.-Strangely, eyebloom suggested the same thing about an hour after I had started making inquiries about how to go about writing an extension, and this is the one I had in mind.-It's an extraordinary coincidence, as I first sketched the idea in 2003, and had never seen it mentioned per se, beyond discussions of point-free and the like.-(Despite eyebloom asking to be contacted if I wanted to work on this, my email was never answered.)-Some of the examples mentioned in the chat have been presented above, to show how FreeSect deals with them.+There was <a href="http://fremissant.net/freesect/irc.html">discussion</a>+ about this on the <pre4>#haskell</pre4> IRC channel.+Strangely, <pre4><eyebloom></pre4> suggested the same thing an hour after I had started making inquiries about how to go about writing an extension -- and this is the one I had in mind.+It's an extraordinary coincidence, as I first sketched the idea in 2003, and had never seen it mentioned <i>per se</i>, beyond discussions of point-free and the like.+(Despite <pre4><eyebloom></pre4> asking to be contacted if I wanted to work on this, my email was never answered; I didn't run off with their idea!)+The principal example from that chat is described here.+<br />+<pre style="font-weight: normal;">+ <dolio> map (foo (g _) x) (h _)+ <dolio> Matter of fact, what does "map (foo (g _) x) (h _)" mean?+</pre>+Given the present context inferencing policy,+<pre>+ (map (foo (g _) x) (h _)) => \ y z -> map (foo (g y) x) (h z)+</pre>+The outer parentheses might be necessary, depending on the larger context of the expression.+This interpretation might not be what the programmer intended, in which case at least a <pre2>$</pre2> is needed+<pre>+ (map $ (foo (g __) x) (h __)) => map ( \ y z -> (foo (g y) x) (h z) )+</pre>+Finally, if two separate free sections were intended, the programmer would need to use <pre2>_[…]_</pre2> bracketing for at least one of them+<pre>+ map _[foo (g __) x]_ _[h __]_+ <=> map (foo (g __) x) _[h __]_+ <=> map _[foo (g __) x]_ (h __)+ <=> (map _[foo (g __) x]_ $ h __)+</pre>+all of which are rewritten by FreeSect to+<pre>+ map (\y->foo (g y) x) (\z->h z)+</pre>+This interpretation cannot by typed, since the second argument of <pre2>map</pre2> must be have kind <pre2>*</pre2>, while <pre2>\z->h z</pre2> has kind <pre2>*->*</pre2>. <h2>Other details</h2> Nested free sections work correctly, thanks to bottom-up traversal.-Note that, as wildcards are syntactically indistinguishable, it is impossible for an outermore freesect to place a wildcard inside an innermore freesect.+Note that, as wildcards are syntactically indistinguishable, it is impossible for an enclosing freesect to have a wildcard inside any enclosed freesect. <p>-Temporary names created by FreeSect are guaranteed to be unique among names referenced within a module.+Fresh identifiers generated by FreeSect are guaranteed to be unique among names referenced within a module.+There is no danger of exporting these names inadvertently, as they never have top-level scope. Imported names which are in scope but never used will not incur conflicts.-Also, there is no danger of exporting the temporary names inadvertently, as they never have top-level scope. <p>-A default context is automatically applied when the <pre-inline>_[…]_</pre-inline> grouping syntax is omitted.-Defining this default can be tricky, and a bit arbitrary, so for robust code it's best to use explicit bracketing.-As of v.0.0.5, when the <pre-inline>_[…]_</pre-inline> are omitted, the defaulting rules are as follows:-The semilattice join of all unbacketed wildcards in a RHS are given context of the innermost enclosing parentheses or infix $ operation.-If no such parentheses or infix $ are present, the whole RHS becomes the default context.-Some of the examples at the top of the page demonstrate these rules.-One hopes that the default will result in a type error, should the inferred context differ from the intended.-I haven't thought of any situation where more than one bracketing of freesect wildcards yield typeable expressions, but neither have I ruled it out.-<p>-Philosophically, use of this sort of syntax promotes "higher-order programming", since any expression can so easily be made into a function, in numerous ways, simply by replacing parts of it with freesect wildcards.-That this is worthwhile is demonstrated frequently by usefulness of sections.--<h2>Work in progress</h2> A few things don't work quite right yet.-Free sections in let expressions are one.-Also, guarded RHS's are not yet handled.+Guarded RHS's are not yet handled.+Default free section contexts in <pre2>let</pre2> expressions need to be parenthesised. Work continues... <h2>How to run it</h2> The extension runs as a preprocessor. This can be done with or without the knowledge of GHC.-If you use <pre-inline>ghc -F</pre-inline> (see scripts in the download), then unfortunately GHC checks language pragmas before preprocessing, which means you cannot declare <pre-inline>{-# LANGUAGE FreeSections #-}</pre-inline> at the top.+If you use <pre2>ghc -F</pre2> (see scripts in the download), then unfortunately GHC checks language pragmas before preprocessing, which means you cannot declare <pre2>{-# LANGUAGE FreeSections #-}</pre2> at the top. Although the patched HSE is capable of rejecting source which uses free sections without the pragma, this feature is disabled for interoperability with GHC.-All compilers are supported by running freesect as an independent preprocessor, but there are some inconveniences involving temporary files.+All compilers are supported by running FreeSect as an independent preprocessor, but there are some inconveniences involving temporary files. <h2>Feedback</h2> @@ -215,10 +261,10 @@ <p> <div style="margin-top: 30px;">Kind Reg'ds,</div> <div style="margin-top: 10px;">Andrew Seniuk</div>-<div style="font-size: 10pt; margin-top: 0px;">(rasfar on #haskell)</div>+<div style="font-family: Courier New; font-size: 8pt; font-weight: bold; margin-top: 0px;"><rasfar> on #haskell</div> <div style="font-size: 8pt; margin-top: 8px;"> Feb. 29, 2012</div> <br /> <br />-</body>-</html>++</body></html>
FilesAndParsing.hs view
@@ -1,5 +1,5 @@ --- Package: freesect-0.0.5+-- Package: freesect-0.6 -- Executable: freesect -- Author: Andrew Seniuk <rasfar@gmail.com> -- Date: March 11, 2012@@ -15,7 +15,10 @@ module FilesAndParsing where - import Directory+ import System.Directory(doesFileExist,+ doesDirectoryExist,+ getDirectoryContents,+ getCurrentDirectory) import Data.Maybe(fromMaybe)
Main.hs view
@@ -1,5 +1,5 @@ --- Package: freesect-0.0.5+-- Package: freesect-0.6 -- Executable: freesect -- Author: Andrew Seniuk <rasfar@gmail.com> -- Date: March 11, 2012@@ -28,11 +28,16 @@ module Main(main) where - import System- import IO+ import System.Environment(getArgs)+ import System.IO(writeFile,hFlush,stdout) + import Data.Data(Data)+ import Data.Generics.Aliases(mkQ,mkT,mkM)+ import Data.Generics.Schemes(everywhere,everywhereM,everything,gcount)+--import Data.Generics -- this suffices to import all the above+ #if PARALLEL- import Control.Parallel.Strategies+ import Control.Parallel.Strategies(rpar,parTraversable,runEval) --import Control.Parallel -- Not imported with Strategies, but -- contains only par and pseq. --import Control.Concurrent@@ -41,10 +46,10 @@ ---import Foreign #endif - import Data.Generics import Control.Monad.State - import Random(StdGen,mkStdGen,next)+ import System.Random(StdGen,mkStdGen,next)+ import Data.List(isPrefixOf) #if ANNOTATED@@ -65,19 +70,21 @@ #else fs_module :: Module -> Module #endif- fs_module m = m''+ fs_module m0 = m4 where- m' = everywhere (mkT step) m- m'' = everywhere (mkT step2) m'+ m1 = everywhere (mkT step) m0+ m2 = everywhere (mkT step2) m1+ m3 = fs_guarded_rhss m2+ m4 = fs_error_if_any_remain m3 #if ANNOTATED step :: Rhs SrcSpanInfo -> Rhs SrcSpanInfo -- seems nec. #else -- step :: Rhs -> Rhs -- unnec. #endif #if ANNOTATED- step (UnGuardedRhs srcSpanInfo e) = UnGuardedRhs srcSpanInfo e'+ step (UnGuardedRhs srcSpanInfo e) = UnGuardedRhs srcSpanInfo e' #else- step (UnGuardedRhs e) = UnGuardedRhs e'+ step (UnGuardedRhs e) = UnGuardedRhs e' #endif where e' = fs_rhs_exp fresh e step x = x@@ -88,7 +95,7 @@ #endif #if ANNOTATED step2 x@(UnGuardedRhs srcSpanInfo e)- | still_fsss = UnGuardedRhs srcSpanInfo e'+ | still_fsss = UnGuardedRhs srcSpanInfo e'' #else step2 x@(UnGuardedRhs e) | still_fsss = UnGuardedRhs e''@@ -111,8 +118,84 @@ e' = Paren e #endif step2 x = x+ fresh = fs_fresh_name m0++#if ANNOTATED+ fs_guarded_rhss :: Module SrcSpanInfo -> Module SrcSpanInfo+#else+ fs_guarded_rhss :: Module -> Module+#endif+ fs_guarded_rhss m = m''+ where+ m' = everywhere (mkT step) m+ m'' = everywhere (mkT step2) m'+#if ANNOTATED+ step :: GuardedRhs SrcSpanInfo -> GuardedRhs SrcSpanInfo -- seems nec.+#else+-- step :: GuardedRhs -> GuardedRhs -- unnec.+#endif+#if ANNOTATED+ step (GuardedRhs srcSpanInfo slst e) = GuardedRhs srcSpanInfo slst e'+#else+ step (GuardedRhs srcLoc slst e) = GuardedRhs srcLoc slst e'+#endif+ where e' = fs_rhs_exp fresh e+ step x = x+#if ANNOTATED+ step2 :: GuardedRhs SrcSpanInfo -> GuardedRhs SrcSpanInfo -- seems nec.+#else+-- step2 :: GuardedRhs -> GuardedRhs -- unnec.+#endif+#if ANNOTATED+ step2 x@(GuardedRhs srcSpanInfo slst e)+ | still_fsss = GuardedRhs srcSpanInfo slst e''+#else+ step2 x@(GuardedRhs srcLoc slst e)+ | still_fsss = GuardedRhs srcLoc slst e''+#endif+ | otherwise = x+ where+ still_fsss = 0 < ( ( gcount (False `mkQ` p) x ) :: Int )+#if ANNOTATED+ p :: Exp SrcSpanInfo -> Bool+ p x@(FreeSectSlot _) = True+#else+-- p :: Exp -> Bool+ p x@FreeSectSlot = True+#endif+ p _ = False+ e'' = fs_rhs_exp fresh e'+#if ANNOTATED+ e' = Paren srcSpanInfo e+#else+ e' = Paren e+#endif+ step2 x = x fresh = fs_fresh_name m +#if ANNOTATED+ fs_error_if_any_remain :: Module SrcSpanInfo -> Module SrcSpanInfo+#else+ fs_error_if_any_remain :: Module -> Module+#endif+ fs_error_if_any_remain m = m'+ where+ m' | still_fsss = error "Free sections can only occur in RHS Exp contexts."+ | otherwise = m+ still_fsss = 0 < ( ( gcount (False `mkQ` p) m ) :: Int )+#if ANNOTATED+ p :: Exp SrcSpanInfo -> Bool+ p x@(FreeSectSlot _) = True+ p x@(FSContext _ _) = True+#else+-- p :: Exp -> Bool+ p x@FreeSectSlot = True+ p x@(FSContext _) = True+#endif+ p _ = False++--------------------------------------------------------------------------------+ -- v.0.0.5: fs_rhs_exp :: Data a => String -> a -> a --fs_rhs_exp fresh rhs = rhs'@@ -351,7 +434,8 @@ | not fail = (True,s'') | otherwise = f' s (1+n,ntop) where s' = take n s- s'' = "fs" ++ s' ++ "_"+ s'' = s' ++ "_"+-- s'' = "fs" ++ s' ++ "_" fail = or $ map (isPrefixOf s'') ss --------------------------------------------------------------------------------@@ -503,7 +587,7 @@ putStrLn $ show ms putStrLn $ show ms' #endif-#if 0+#if 1 putStrLn $ concatMap prettyPrint ms putStrLn $ concatMap prettyPrint ms' #endif
Makefile view
@@ -1,5 +1,7 @@ -./freesect: ./Main.hs ./FilesAndParsing.hs ./HSE.hs ./HSE/Annotated.hs ./HSE/Annotated/Build.hs ./HSE/Annotated/ExactPrint.hs ./HSE/Annotated/Fixity.hs ./HSE/Annotated/Simplify.hs ./HSE/Annotated/Syntax.hs ./HSE/Build.hs ./HSE/Comments.hs ./HSE/ExtScheme.hs ./HSE/Extension.hs ./HSE/Fixity.hs ./HSE/Lexer.hs ./HSE/ParseMonad.hs ./HSE/ParseSyntax.hs ./HSE/ParseUtils.hs ./HSE/Parser.hs ./HSE/Pretty.hs ./HSE/SrcLoc.hs ./HSE/Syntax.hs ./HSE/InternalParser.hs+# BINPATHNAME+/media/ramdisk/freesect: \+./Main.hs ./FilesAndParsing.hs ./HSE.hs ./HSE/Annotated.hs ./HSE/Annotated/Build.hs ./HSE/Annotated/ExactPrint.hs ./HSE/Annotated/Fixity.hs ./HSE/Annotated/Simplify.hs ./HSE/Annotated/Syntax.hs ./HSE/Build.hs ./HSE/Comments.hs ./HSE/ExtScheme.hs ./HSE/Extension.hs ./HSE/Fixity.hs ./HSE/Lexer.hs ./HSE/ParseMonad.hs ./HSE/ParseSyntax.hs ./HSE/ParseUtils.hs ./HSE/Parser.hs ./HSE/Pretty.hs ./HSE/SrcLoc.hs ./HSE/Syntax.hs ./HSE/InternalParser.hs csh ile # Needed because of use of CPP definitions across multiple source files.
S14.hs view
@@ -4,17 +4,16 @@ module S14(main) where import Char(ord)- import List(intersperse) data D = D Int String main = printList $ zipWith _[ f (__,b) $ D __ d ]_ as cs where f :: (Char,Float) -> D -> String- f (a,b) (D x y) = d ++ ( show ( b * fromIntegral (ord a + x) ) )+ f (a,b) (D c d) = d ++ ( show ( b * fromIntegral (ord a + c) ) ) as = take 20 ['a','b'..] cs = take 20 [1,3..] b = 1.7 d = "pleasant"- printList = putStrLn . concat . intersperse "\n"+ printList = putStrLn . unlines
S15.hs view
@@ -3,11 +3,16 @@ module S15(main) where ---main = print $ let f = (+) in zipWith f [1,2,3] [4,5,6]---main = print $ let f = ( (+) __ 2 ) in map f [1,2,3]- main = print $ let f = (+) __ 2 in map f [1,2,3]---main = print $ map f [1,2,3] where f = (+) __ 2---main = print $ map ( (+) __ 2 ) [1,2,3]---main = print $ map _[ (+) __ 2 ]_ [1,2,3]---main = print $ map _[ (\x y -> x+y) __ 2 ]_ [1,2,3]+ main = do putStrLn $ unlines $ map show [v1,v2,v3,v4,v5,v6,v7,v8,v9]++ v0= (f __ y)+ v9= map (foo (g __) x) (h __)+ v8= _[ __ ]_ 5+ v7= let f = (+) in zipWith f [1,2,3] [4,5,6]+ v6= let f = ( (+) __ 2 ) in map f [1,2,3]+ v5= let f = (+) __ 2 in map f [1,2,3]+ v4= map f [1,2,3] where f = (+) __ 2+ v3= map ( (+) __ 2 ) [1,2,3]+ v2= map _[ (+) __ 2 ]_ [1,2,3]+ v1= map _[ (\x y -> x+y) __ 2 ]_ [1,2,3]
+ S24.hs view
@@ -0,0 +1,156 @@++ {- # LANGUAGE FreeSections #-} -- with GHC's -F you cannot...++ -- Might as well test interaction with the pre-existing+ -- tuple section generalisation.+ {-# LANGUAGE TupleSections #-}++ module S24 where++ -- Tests of each of the Exp contexts.+ -- Here, all free section contexts are given explicitly with _[ ... ]_.+ -- S25.hs is an analogous file, but default contexts are attempted.+ --+ -- This module won't compile, but you can examine the preprocessed code.+++ -- InfixApp Exp QOp Exp -- infix application+ v= _[ __ + 2 ]_+ -- App Exp Exp -- ordinary application+ v= _[ f __ ]_+ v= _[ __ x ]_+ -- NegApp Exp+ v= _[ - __ ]_+ -- Lambda SrcLoc [Pat] Exp -- lambda expression+ v= _[ \ x -> __ x ]_+ -- Let Binds Exp -- local declarations with let ... in ...+ v= _[ let x=2 in __ x ]_+ -- If Exp Exp Exp -- conditional expression+ v= _[ if __ then __ else __ ]_+ -- Case Exp [Alt] -- case expression+ v= _[ case __ of _ -> 2 ]_+ -- Tuple [Exp] -- tuple expression+ v= _[ (__,2,__,4,5,__,7) ]_+ -- TupleSection [Maybe Exp] -- tuple section expression, e.g. (,,3)+ v= _[ (,,__) ]_+ v= _[ (,__,,__) ]_+ -- List [Exp] -- list expression+ v= _[ [__,2,__,4,5,__,7] ]_+ -- FSContext Exp -- free section context+ v= a _[ __ c __ ]_ e+ -- Paren Exp -- parenthesised expression+ v= _[ (__) ]_+ v= _[ ( __ b __ ) ]_+ -- LeftSection Exp QOp -- left section ( /exp/ /qop/ )+ v= _[ (__ +) ]_+ -- RightSection QOp Exp -- right section ( /qop/ /exp/ )+ v= _[ (+ __) ]_+ -- RecUpdate Exp [FieldUpdate] -- record update expression+ v= _[ __ { f3 = 2 } ]_ Ctor+ v= _[ Ctor { f3 = __ } ]_ 2+ -- EnumFrom Exp -- unbounded arithmetic sequence+ v= _[ [__..] ]_+ v= _[ [__..] ]_ $ 3+ -- EnumFromTo Exp Exp -- bounded arithmetic sequence+ v= _[ [__..__] ]_ $ 3 5+ -- EnumFromThen Exp Exp -- unbounded arithmetic sequence with stride+ v= _[ [__,__..] ]_ $ 3 5+ -- EnumFromThenTo Exp Exp Exp -- bounded arithmetic sequence with stride+ v= _[ [__,__..__] ]_ $ 3 5 8+ -- ListComp Exp [QualStmt] -- ordinary list comprehension+ v= _[ [f __ x|x<-[1..3]] $ 2 ]_+{- still not working+ v= _[ [f 2 x|x<- __ ] $ [1..3] ]_+ v= _[ [f __ x|x<- __ ] $ 2 [1..3] ]_+-}+ -- ParComp Exp [[QualStmt]] -- parallel list comprehension+--v= ??+ -- ExpTypeSig SrcLoc Exp Type -- expression with explicit type signature+--v= __ :: Int->Int $ 2+ v= _[ __ :: Int->Int ]_ 2++ -- Arrows+ -- Proc SrcLoc Pat Exp -- arrows proc: proc /pat/ -> /exp/+ -- LeftArrApp Exp Exp -- arrow application (from left): /exp/ -< /exp/+ -- RightArrApp Exp Exp -- arrow application (from right): /exp/ >- /exp/+ -- LeftArrHighApp Exp Exp -- higher-order arrow application (from left): /exp/ -<< /exp/+ -- RightArrHighApp Exp Exp -- higher-order arrow application (from right): /exp/ >>- /exp/++{-+-- Haskell expressions.+-- Those which contain Exp in their productions are tested here.+-- This doesn't mean that there is an immediate Exp child in every+-- case (some are wrapped in List or Maybe); and it doesn't mean+-- that FreeSect won't perform rewriting in the branches of any+-- of the non-*'d alternates either -- a Stmt, for instance, may+-- contain Exp's.+data Exp+ = Var QName -- ^ variable+ | FreeSectSlot -- ^ FreeSect placeholder: @__@+ | IPVar IPName -- ^ implicit parameter variable+ | Con QName -- ^ data constructor+ | Lit Literal -- ^ literal constant+ * | InfixApp Exp QOp Exp -- ^ infix application+ * | App Exp Exp -- ^ ordinary application+ * | NegApp Exp -- ^ negation expression @-/exp/@ (unary minus)+ * | Lambda SrcLoc [Pat] Exp -- ^ lambda expression+ * | Let Binds Exp -- ^ local declarations with @let@ ... @in@ ...+ * | If Exp Exp Exp -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/+ * | Case Exp [Alt] -- ^ @case@ /exp/ @of@ /alts/+ | Do [Stmt] -- ^ @do@-expression:+ -- the last statement in the list+ -- should be an expression.+ | MDo [Stmt] -- ^ @mdo@-expression+ * | Tuple [Exp] -- ^ tuple expression+ * | TupleSection [Maybe Exp] -- ^ tuple section expression, e.g. @(,,3)@+ * | List [Exp] -- ^ list expression+ * | FSContext Exp -- ^ FreeSect context+ * | Paren Exp -- ^ parenthesised expression+ * | LeftSection Exp QOp -- ^ left section @(@/exp/ /qop/@)@+ * | RightSection QOp Exp -- ^ right section @(@/qop/ /exp/@)@+ | RecConstr QName [FieldUpdate]+ -- ^ record construction expression+ * | RecUpdate Exp [FieldUpdate]+ -- ^ record update expression+ * | EnumFrom Exp -- ^ unbounded arithmetic sequence,+ -- incrementing by 1: @[from ..]@+ * | EnumFromTo Exp Exp -- ^ bounded arithmetic sequence,+ -- incrementing by 1 @[from .. to]@+ * | EnumFromThen Exp Exp -- ^ unbounded arithmetic sequence,+ -- with first two elements given @[from, then ..]@+ * | EnumFromThenTo Exp Exp Exp+ -- ^ bounded arithmetic sequence,+ -- with first two elements given @[from, then .. to]@+ * | ListComp Exp [QualStmt] -- ^ ordinary list comprehension+ * | ParComp Exp [[QualStmt]] -- ^ parallel list comprehension+ * | ExpTypeSig SrcLoc Exp Type -- ^ expression with explicit type signature++ | VarQuote QName -- ^ @'x@ for template haskell reifying of expressions+ | TypQuote QName -- ^ @''T@ for template haskell reifying of types+ | BracketExp Bracket -- ^ template haskell bracket expression+ | SpliceExp Splice -- ^ template haskell splice expression+ | QuasiQuote String String -- ^ quasi-quotaion: @[$/name/| /string/ |]@++-- Hsx+ * | XTag SrcLoc XName [XAttr] (Maybe Exp) [Exp]+ -- ^ xml element, with attributes and children+ * | XETag SrcLoc XName [XAttr] (Maybe Exp)+ -- ^ empty xml element, with attributes+ | XPcdata String -- ^ PCDATA child element+ * | XExpTag Exp -- ^ escaped haskell expression inside xml+ * | XChildTag SrcLoc [Exp] -- ^ children of an xml element++-- Pragmas+ * | CorePragma String Exp -- ^ CORE pragma+ * | SCCPragma String Exp -- ^ SCC pragma+ * | GenPragma String (Int, Int) (Int, Int) Exp+ -- ^ GENERATED pragma++-- Arrows+ * | Proc SrcLoc Pat Exp -- ^ arrows proc: @proc@ /pat/ @->@ /exp/+ * | LeftArrApp Exp Exp -- ^ arrow application (from left): /exp/ @-<@ /exp/+ * | RightArrApp Exp Exp -- ^ arrow application (from right): /exp/ @>-@ /exp/+ * | LeftArrHighApp Exp Exp -- ^ higher-order arrow application (from left): /exp/ @-<<@ /exp/+ * | RightArrHighApp Exp Exp -- ^ higher-order arrow application (from right): /exp/ @>>-@ /exp/+-}+
+ S25.hs view
@@ -0,0 +1,152 @@++ {- # LANGUAGE FreeSections #-} -- with GHC's -F you cannot...+ {-# LANGUAGE TupleSections #-} -- with GHC's -F you cannot...++ module S25 where++ -- Tests of each of the Exp contexts.+ --+ -- This module won't compile, but you can examine the preprocessed code.+++ -- InfixApp Exp QOp Exp -- infix application+ v= __ + 2+ -- App Exp Exp -- ordinary application+ v= f __+ v= __ x+ -- NegApp Exp+ v= - __+ -- Lambda SrcLoc [Pat] Exp -- lambda expression+ v= \ x -> __ x+ -- Let Binds Exp -- local declarations with let ... in ...+ v= let x=2 in __ x+ -- If Exp Exp Exp -- conditional expression+ v= if __ then __ else __+ -- Case Exp [Alt] -- case expression+ v= case __ of _ -> 2+ -- Tuple [Exp] -- tuple expression+ v= (__,2,__,4,5,__,7)+ -- TupleSection [Maybe Exp] -- tuple section expression, e.g. (,,3)+ v= (,,__)+ v= (,__,,__)+ -- List [Exp] -- list expression+ v= [__,2,__,4,5,__,7]+ -- FSContext Exp -- free section context+ v= a _[ __ c __ ]_ e+ -- Paren Exp -- parenthesised expression+ v= (__)+ v= ( __ b __ )+ -- LeftSection Exp QOp -- left section @(@/exp/ /qop/@)@+ v= (__ +)+ -- RightSection QOp Exp -- right section @(@/qop/ /exp/@)@+ v= (+ __)+ -- RecUpdate Exp [FieldUpdate] -- record update expression+ v= __ { f3 = 2 } $ Ctor+ v= Ctor { f3 = __ } $ 2+ -- EnumFrom Exp -- unbounded arithmetic sequence+ v= [__..]+ v= [__..] $ 3+ -- EnumFromTo Exp Exp -- bounded arithmetic sequence+ v= [__..__] $ 3 5+ -- EnumFromThen Exp Exp -- unbounded arithmetic sequence with stride+ v= [__,__..] $ 3 5+ -- EnumFromThenTo Exp Exp Exp -- bounded arithmetic sequence with stride+ v= [__,__..__] $ 3 5 8+ -- ListComp Exp [QualStmt] -- ordinary list comprehension+ v= [f __ x|x<-[1..3]] $ 2+{- still not working+ v= [f 2 x|x<- __ ] $ [1..3]+ v= [f __ x|x<- __ ] $ 2 [1..3]+-}+ -- ParComp Exp [[QualStmt]] -- parallel list comprehension+--v= ??+ -- ExpTypeSig SrcLoc Exp Type -- expression with explicit type signature+--v= __ :: Int->Int $ 2+ v= (__ :: Int->Int) 2++ -- Arrows+ -- Proc SrcLoc Pat Exp -- arrows proc: proc /pat/ -> /exp/+ -- LeftArrApp Exp Exp -- arrow application (from left): /exp/ -< /exp/+ -- RightArrApp Exp Exp -- arrow application (from right): /exp/ >- /exp/+ -- LeftArrHighApp Exp Exp -- higher-order arrow application (from left): /exp/ -<< /exp/+ -- RightArrHighApp Exp Exp -- higher-order arrow application (from right): /exp/ >>- /exp/+++{-+-- Haskell expressions.+-- Those which contain Exp in their productions are tested here.+-- This doesn't mean that there is an immediate Exp child in every+-- case (some are wrapped in List or Maybe); and it doesn't mean+-- that FreeSect won't perform rewriting in the branches of any+-- of the non-*'d alternates either -- a Stmt, for instance, may+-- contain Exp's.+data Exp+ = Var QName -- ^ variable+ | FreeSectSlot -- ^ FreeSect placeholder: @__@+ | IPVar IPName -- ^ implicit parameter variable+ | Con QName -- ^ data constructor+ | Lit Literal -- ^ literal constant+ * | InfixApp Exp QOp Exp -- ^ infix application+ * | App Exp Exp -- ^ ordinary application+ * | NegApp Exp -- ^ negation expression @-/exp/@ (unary minus)+ * | Lambda SrcLoc [Pat] Exp -- ^ lambda expression+ * | Let Binds Exp -- ^ local declarations with @let@ ... @in@ ...+ * | If Exp Exp Exp -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/+ * | Case Exp [Alt] -- ^ @case@ /exp/ @of@ /alts/+ | Do [Stmt] -- ^ @do@-expression:+ -- the last statement in the list+ -- should be an expression.+ | MDo [Stmt] -- ^ @mdo@-expression+ * | Tuple [Exp] -- ^ tuple expression+ * | TupleSection [Maybe Exp] -- ^ tuple section expression, e.g. @(,,3)@+ * | List [Exp] -- ^ list expression+ * | FSContext Exp -- ^ FreeSect context+ * | Paren Exp -- ^ parenthesised expression+ * | LeftSection Exp QOp -- ^ left section @(@/exp/ /qop/@)@+ * | RightSection QOp Exp -- ^ right section @(@/qop/ /exp/@)@+ | RecConstr QName [FieldUpdate]+ -- ^ record construction expression+ * | RecUpdate Exp [FieldUpdate]+ -- ^ record update expression+ * | EnumFrom Exp -- ^ unbounded arithmetic sequence,+ -- incrementing by 1: @[from ..]@+ * | EnumFromTo Exp Exp -- ^ bounded arithmetic sequence,+ -- incrementing by 1 @[from .. to]@+ * | EnumFromThen Exp Exp -- ^ unbounded arithmetic sequence,+ -- with first two elements given @[from, then ..]@+ * | EnumFromThenTo Exp Exp Exp+ -- ^ bounded arithmetic sequence,+ -- with first two elements given @[from, then .. to]@+ * | ListComp Exp [QualStmt] -- ^ ordinary list comprehension+ * | ParComp Exp [[QualStmt]] -- ^ parallel list comprehension+ * | ExpTypeSig SrcLoc Exp Type -- ^ expression with explicit type signature++ | VarQuote QName -- ^ @'x@ for template haskell reifying of expressions+ | TypQuote QName -- ^ @''T@ for template haskell reifying of types+ | BracketExp Bracket -- ^ template haskell bracket expression+ | SpliceExp Splice -- ^ template haskell splice expression+ | QuasiQuote String String -- ^ quasi-quotaion: @[$/name/| /string/ |]@++-- Hsx+ * | XTag SrcLoc XName [XAttr] (Maybe Exp) [Exp]+ -- ^ xml element, with attributes and children+ * | XETag SrcLoc XName [XAttr] (Maybe Exp)+ -- ^ empty xml element, with attributes+ | XPcdata String -- ^ PCDATA child element+ * | XExpTag Exp -- ^ escaped haskell expression inside xml+ * | XChildTag SrcLoc [Exp] -- ^ children of an xml element++-- Pragmas+ * | CorePragma String Exp -- ^ CORE pragma+ * | SCCPragma String Exp -- ^ SCC pragma+ * | GenPragma String (Int, Int) (Int, Int) Exp+ -- ^ GENERATED pragma++-- Arrows+ * | Proc SrcLoc Pat Exp -- ^ arrows proc: @proc@ /pat/ @->@ /exp/+ * | LeftArrApp Exp Exp -- ^ arrow application (from left): /exp/ @-<@ /exp/+ * | RightArrApp Exp Exp -- ^ arrow application (from right): /exp/ @>-@ /exp/+ * | LeftArrHighApp Exp Exp -- ^ higher-order arrow application (from left): /exp/ @-<<@ /exp/+ * | RightArrHighApp Exp Exp -- ^ higher-order arrow application (from right): /exp/ @>>-@ /exp/+-}+
+ S26.hs view
@@ -0,0 +1,10 @@++ {-# LANGUAGE FreeSections #-} -- with GHC's -F you cannot...++ module S26 where++ v x | x == 1 = g _[ a __ b ]_ __ c+ | x == 2 = g _[ a __ b ]_ __ c+ | _[ __ == 2 ]_ = g _[ a __ b ]_ __ c+ | otherwise = g _[ a __ b ]_ __ c+
cln view
@@ -1,26 +1,31 @@ #!/bin/csh -echo "Check script first, it uses rm..."-exit 1+# CLNSCRIPT (don't remove this comment or change the two following lines)+#echo "Check script first, it uses rm..."+#exit 1 -# Temp dirs created by GHC:+## Temp file created by freesect (non GHC -F mode):+rm -f Z_[0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f]* >&! /dev/null++## Temp dirs created by GHC: rm -rf ghc* >&! /dev/null -# Test input's GHC-generated files:+## Test input's GHC-generated files: rm -f S[0-9][0-9].{o,hi} S[0-9][0-9] >&! /dev/null -# FreeSect linked binary:+## FreeSect linked binary:+#rm -f /media/ramdisk/freesect >&! /dev/null #rm -f freesect >&! /dev/null -# FreeSect generated object and interface files:+## FreeSect generated object and interface files: #rm -f Main.{o,hi} >&! /dev/null #rm -f FilesAndParsing.{o,hi} >&! /dev/null -# Patched HSE generated object and interface files:+## Patched HSE generated object and interface files: #rm -f HSE.{o,hi} >&! /dev/null #rm -f HSE/*.{o,hi} >&! /dev/null #rm -f HSE/Annotated/*.{o,hi} >&! /dev/null -# Can be regenerated by make, if you have Happy installed:+## Can be regenerated by make, if you have Happy installed: #rm -f HSE/InternalParser.hs >&! /dev/null
freesect.cabal view
@@ -1,13 +1,12 @@ Name: freesect-Version: 0.0.5+Version: 0.6 Synopsis: A Haskell syntax extension for generalised sections. Description:- This package provides an preprocessor executable, \'freesect\', + This package provides a preprocessor executable, \'freesect\', which implements a generalisation of sections (\'free sections\') for partial application and higher-order style. Some examples of free sections can be found in the included test suite; refer- to the homepage for more info. Should be built manually (this- is very easy; please see the 000-readme file).+ to the homepage for more info. Homepage: http://fremissant.net/freesect License: BSD3 License-file: LICENSE@@ -20,9 +19,9 @@ Cabal-version: >= 1.2.3 Extra-source-files: -- You may not make use of all of these ones:- 000-readme, Makefile, cln, freesect.sh, ile, z, zz,+ 000-readme, Makefile, cln, freesect.sh, ile, z, zpack -- These are example modules containing free sections for testing:- S14.hs, S15.hs, S23.hs,+ S14.hs, S15.hs, S23.hs, S24.hs, S25.hs, S26.hs -- Snapshot of documentation; visit the homepage for up-to-date versions: Doc/index.html, Doc/irc.html, -- The rest are critical for building freesect:@@ -55,20 +54,25 @@ Executable freesect Main-Is: Main.hs Build-depends:- base >= 4.0 && < 5 ,+ base >= 4.0 && < 4.6 ,+ directory >= 1.0 ,+ random >= 1.0 ,+-- Control.Monad.State:+ mtl >= 1.0 ,+-- syn >= 0.1 should suffice judging by the API but this is not tested...+ syb >= 0.1 , -- Recommended but not actually needed if the CPP #define PARALLEL is 0.- parallel >= 3.2.0.2 ,- syb >= 0.3.6 ,+-- >= 3.0 for parTraversable (could use parList, and get >= 2.0)+ parallel >= 3.0 , -- haskell-src-exts >= 1.11.1 , -- Since HSE is not yet patched to include -XFreeSections, we need -- to build a patched version locally, hence these dependencies:- cpphs >= 1.13.3 ,- pretty >= 1.0.1.2 ,- array >= 0.3.0.2 ,- haskell98 >= 1.1.0.1 ,- mtl >= 2.0.1.0+ cpphs >= 1.3 ,+ pretty >= 1.0 ,+ array >= 0.1 extensions: DeriveDataTypeable, FlexibleContexts, CPP- Build-tools: happy+ Build-tools:+--Build-tools: happy other-modules: ghc-options: -O0 -rtsopts -threaded cpp-options: -DANNOTATED=0 -DPARALLEL=0 -DGHC_F=1
freesect.sh view
@@ -1,13 +1,14 @@ #!/bin/sh -# # +RTS -p -RTS \-# +RTS -K96m -RTS \-# # +RTS -K16m -RTS \-# # +RTS -i20 -RTS # (default value of granularity of resched. in ms) \-# +RTS -N2 -RTS # Control.Parallel : # of cores (not including hyperthr.) \+# RTSOPTS (do not remove this comment; the next line is automatically edited)+rtsopts="+RTS -K96m -RTS" -./freesect \- +RTS -N2 -RTS \+# BINPATHNAME (do not remove comment, or change the following two lines)+ binpathname=/media/ramdisk/freesect+#binpathname=./dist/build/freesect/freesect++$binpathname \+ $rtsopts \ $3 \ $1
ile view
@@ -10,6 +10,10 @@ mkdir -p dist/build/freesect/freesect-tmp >&! /dev/null +# BINPATHNAME (do not remove comment, or change the following two lines)+ set binpathname = /media/ramdisk/freesect+#set binpathname = ./dist/build/freesect/freesect+ ghc --make \ -idist/build/freesect/freesect-tmp \ -outputdir dist/build/freesect/freesect-tmp \@@ -24,6 +28,7 @@ -optP "-DANNOTATED=$FS_ANNOTATED" \ -optP "-DPARALLEL=$FS_PARALLEL" \ -optP "-DGHC_F=$FS_GHC_F" \- Main -o freesect \+ -fno-warn-overlapping-patterns \+ Main -o $binpathname \ ##!!
z view
@@ -7,39 +7,74 @@ setenv FS_PARALLEL 0 setenv FS_GHC_F 1 -#set test=S23- set test=S15-#set test=S14+if ( ${#argv} == 0 ) then+ set test=S25+else if ( ${#argv} > 1 ) then+ shift+ foreach i ( $* )+ source ./z+ end+else+ set test=$1+endif make if ( $? ) exit 1 +set rtsopts = ( \+ +RTS -K96m -RTS \+# +RTS -K16m -RTS \+\+# Don't forget you need the -prof ghc flag when compiling: \+# +RTS -p -RTS \+)+if ( $FS_PARALLEL ) then+ set rtsopts = ( $rtsopts \+# +RTS -i20 -RTS # (default value of granularity of resched. in ms) \+ +RTS -N2 -RTS # Control.Parallel : # of cores (not including hyperthr.) \+ )+endif++echo rtsopts=$rtsopts++ if ( $FS_GHC_F ) then +ed -s ./freesect.sh <<EOF+/RTSOPTS/+1s/..*/rtsopts="$rtsopts"/+wq+EOF -./zz $test >&! ./zz.log-set zzstat=$?+ghc \+ --make \+ $test \+ -main-is $test \+ -keep-tmp-files \+ -tmpdir . \+# -fno-warn-unrecognised-pragmas \+ -F -pgmF freesect.sh \+ -o $test \+ >&! z.log \+##!! -cat ./zz.log \-# We can also prune these in Main.hs (that's how doing now): \-# |& not |, or won't see these if use "error" b/c goes to stderr \-## |& sed -e 's/SrcLoc {[^}]*}/SrcLoc .../g' \- |& sed -e 's/SrcLoc {[^}]*}//g' \-## |& sed -e 's/(SrcSpanInfo {[^[][^[]*\[[^]]*]})//g' \- |& sed -e 's/)))))*/)..)/g' \+set zstat=$?++cat ./z.log \+# | sed -e 's/SrcLoc {[^}]*}/SrcLoc .../g' \+ | sed -e 's/SrcLoc {[^}]*}//g' \+ | sed -e 's/(SrcSpanInfo {[^[][^[]*\[[^]]*]})//g' \+ | sed -e 's/)))))*/)..)/g' \ ##!! -if ( $test == S23 ) then- echo- echo- echo "(Ignore errors about missing symbols; you can examine"- echo "freesect pre-processor output in the intermediate file.)"- echo-endif+echo+echo+echo "(Ignore errors about missing symbols; you can examine"+echo "freesect pre-processor output in the intermediate file.)"+echo -if ( $zzstat ) exit 1+if ( $zstat ) exit 1 ./$test @@ -64,44 +99,28 @@ #echo $infiles #echo $outfile #exit-set extra_rtsopts-if ( $FS_PARALLEL ) then- set extra_rtsopts = ( \-# +RTS -i20 -RTS # (default value of granularity of resched. in ms) \- +RTS -N2 -RTS # Control.Parallel : # of cores (not including hyperthr.) \- )-endif echo freesect infiles=$infiles outfile=$outfile -./freesect \-\-# Don't forget you need the -prof ghc flag when compiling: \-# +RTS -p -RTS \-\- +RTS -K96m -RTS \-# +RTS -K16m -RTS \-\- $extra_rtsopts \-\- $outfile \-\- $infiles \-\- >&! ./z.log+# BINPATHNAME (do not remove comment, or change the following two lines)+ set binpathname = /media/ramdisk/freesect+#set binpathname = ./dist/build/freesect/freesect +$binpathname \+ $rtsopts \+ $outfile \+ $infiles \+ >&! ./z.log \+##!!+ set zstat=$? cat ./z.log \-# We can also prune these in Main.hs (that's how doing now): \-# |& not |, or won't see these if use "error" b/c goes to stderr \-# |& sed -e 's/SrcLoc {[^}]*}/SrcLoc .../g' \-# |& sed -e 's/SrcLoc {[^}]*}//g' \-# |& sed -e 's/(SrcSpanInfo {[^[][^[]*\[[^]]*]})//g' \- |& sed -e 's/)))))*/)..)/g' \-\-#& \-#!+# | sed -e 's/SrcLoc {[^}]*}/SrcLoc .../g' \+ | sed -e 's/SrcLoc {[^}]*}//g' \+ | sed -e 's/(SrcSpanInfo {[^[][^[]*\[[^]]*]})//g' \+ | sed -e 's/)))))*/)..)/g' \+##!! if ( $zstat ) exit 1 # won't work for Main's exit status, after the pipe @@ -109,13 +128,11 @@ set zstat=$? -if ( $test == S23 ) then- echo- echo- echo "(Ignore errors about missing symbols; you can examine"- echo "freesect pre-processor output in the intermediate file.)"- echo-endif+echo+echo+echo "(Ignore errors about missing symbols; you can examine"+echo "freesect pre-processor output in the intermediate file.)"+echo if ( $zstat ) exit 1 # won't work for Main's exit status, after the pipe
+ zpack view
@@ -0,0 +1,114 @@+#++# Package with cabal, and attempt build in test dir ../TestPack.++# 1) We need to change the path to build the binary executable,+# from /media/ramdisk to . (dot).++ed -s ./z >&! /dev/null <<'EOF'+/BINPATHNAME/+.+1s/^ /#/+.+1s/^#/ /+wq+'EOF'+ed -s ./freesect.sh >&! /dev/null <<'EOF'+/BINPATHNAME/+.+1s/^ /#/+.+1s/^#/ /+wq+'EOF'+ed -s ./ile >&! /dev/null <<'EOF'+/BINPATHNAME/+.+1s/^ /#/+.+1s/^#/ /+wq+'EOF'+ed -s ./Makefile >&! /dev/null <<'EOF'+/BINPATHNAME/+.+1s/..*/.\/.\/dist\/build\/freesect\/freesect: \\/+wq+'EOF'+ed -s ./cln >&! /dev/null <<'EOF'+/CLNSCRIPT/+.+1s/^#/ /+.+1s/^#/ /+wq+'EOF'++# 2) Attempt to run cabal sdist.++echo cabal sdist+cabal sdist++if ( $? ) then+ echo "cabal sdist failed"+ exit 1+endif++# 3) Change back the binpathnames:++ed -s ./z >&! /dev/null <<'EOF'+/BINPATHNAME/+.+1s/^#/ /+.+1s/^ /#/+wq+'EOF'+ed -s ./freesect.sh >&! /dev/null <<'EOF'+/BINPATHNAME/+.+1s/^#/ /+.+1s/^ /#/+wq+'EOF'+ed -s ./ile >&! /dev/null <<'EOF'+/BINPATHNAME/+.+1s/^#/ /+.+1s/^ /#/+wq+'EOF'+ed -s ./Makefile >&! /dev/null <<'EOF'+/BINPATHNAME/+.+1s/..*/\/media\/ramdisk\/freesect: \\/+wq+'EOF'+ed -s ./cln >&! /dev/null <<'EOF'+/CLNSCRIPT/+.+1s/^ /#/+.+1s/^ /#/+wq+'EOF'++# 4) Set up the TestBuild dir.++set srcdir=$cwd+/bin/rm -rf ../TestBuild >&! /dev/null+mkdir ../TestBuild+cp -p dist/freesect-*.tar.gz ../TestBuild+cd ../TestBuild+tar zxf freesect-*.tar.gz+cd freesect-*[0-9]++# 5) Attempt to cabal configure and build.++echo cabal configure+cabal configure+if ( $? ) then+ echo "cabal configure failed"+ exit 1+endif+echo cabal build+cabal build+if ( $? ) then+ echo "cabal build failed"+ exit 1+endif++# 6) Attempt to run freesect test in new build.++./z++# 7) Finish up.++echo+echo "cwd = "$srcdir+echo+
− zz
@@ -1,26 +0,0 @@-#!/bin/csh--# Supply the name of the main-bearing module, if not ./Main.hs--set main_is="Main"-if ( ${#argv} > 1 ) then- echo "Too many args; provide at most one module name for -main-is."- exit 1-else if ( ${#argv} == 1 ) then- set main_is=$1-endif--echo $main_is-#exit--ghc \- --make \- $main_is \- -main-is $main_is \- -keep-tmp-files \- -tmpdir . \-# -fno-warn-unrecognised-pragmas \- -F -pgmF freesect.sh \- -o $main_is \-##!!-