├── .gitignore ├── diffmerge ├── ghc-inplace-setup ├── skim ├── ghc-libraries-rebuild ├── wake-equinox ├── chelmer-tunnel ├── ghc-clean-testsuite ├── configuredance.sh ├── git-fix-remote-branch ├── darcs-send ├── ghc-rebuild ├── mount-equinox-via-chelmer ├── mount-equinox-at-lab ├── emacs-merge.sh ├── histogram ├── startup ├── git-find-keyword ├── tabful-haskell ├── correctpermissions.sh ├── github-init-pages-branch ├── find-copy-to-dir-one ├── ogg2mp3 ├── mp32ogg ├── harmonic-mean ├── nfc ├── cabal-inplace ├── find-copy-to-dir ├── cabaldance.sh ├── whitespace-align ├── ghc-nofib-dump-old ├── pyqt4-clean ├── copy.sh ├── lined-paper ├── darcs-bundle-install.sh ├── start-ssh-agent ├── markcolumns ├── lapwing-authenticate ├── diffmerge-series ├── knees ├── amacs ├── ghc-612-setup ├── cabalsetup-inplace.sh ├── diffmerge-git-wrapper ├── darcs-flatten ├── darcs-rewrite ├── darcs-clone ├── ghc-nofib-compare ├── ghc-compare ├── my-cabal-depends ├── dsl-mp3-rename ├── ghc-dump-split ├── ghc-nofib-sat-compare ├── plainbbl ├── darcs-sendmail ├── git-publish-branch ├── ec2-socks-proxy ├── my-cabal-install ├── renameanime.hs ├── ec2-proxy ├── ghc-nofib-dump ├── summarise └── ec2-tunnel /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | *~ 3 | -------------------------------------------------------------------------------- /diffmerge: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | /Applications/DiffMerge.app/Contents/MacOS/DiffMerge $1 $2 & 4 | -------------------------------------------------------------------------------- /ghc-inplace-setup: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ln ../../utils/ghc-pkg/install-inplace/bin/ghc-pkg . -------------------------------------------------------------------------------- /skim: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | /Applications/Skim.app/Contents/MacOS/Skim $* >& /dev/null & 5 | -------------------------------------------------------------------------------- /ghc-libraries-rebuild: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | make clean 4 | 5 | make boot && make configure && make all -------------------------------------------------------------------------------- /wake-equinox: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | wakeonlan -i mb566.robinson.private.cam.ac.uk 00:1d:4f:45:f0:04 4 | -------------------------------------------------------------------------------- /chelmer-tunnel: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | ssh -f mb566@chelmer.cl.cam.ac.uk -L 2222:mb566.robinson.private.cam.ac.uk:22 -N 5 | -------------------------------------------------------------------------------- /ghc-clean-testsuite: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | 4 | find . -iname '*.hi' -o -iname '*.o' -o -iname '*.comp.*' -o -iname '*.normalised' | xargs rm -------------------------------------------------------------------------------- /configuredance.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | autoconf configure.ac > configure && chmod +x configure && autoheader configure.ac && ./configure -------------------------------------------------------------------------------- /git-fix-remote-branch: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | 4 | git config --add branch.master.remote origin 5 | git config --add branch.master.merge refs/heads/master -------------------------------------------------------------------------------- /darcs-send: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Because there is no way to globally override the sendmail-command 4 | darcs send -v --sendmail-command="darcs-sendmail """%t""" %<" "$@" -------------------------------------------------------------------------------- /ghc-rebuild: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | 4 | # These -could- fail if the Makefile isn't ready yet 5 | make clean && make distclean 6 | 7 | sh boot && ./configure && make -j12 8 | 9 | -------------------------------------------------------------------------------- /mount-equinox-via-chelmer: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | mkdir /Volumes/Equinox 4 | sshfs -p 2222 localhost:/Users/mbolingbroke /Volumes/Equinox -oauto_cache,reconnect,volname=Equinox 5 | -------------------------------------------------------------------------------- /mount-equinox-at-lab: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | mkdir /Volumes/Equinox 4 | sshfs mb566.robinson.private.cam.ac.uk.:/Users/mbolingbroke /Volumes/Equinox -oauto_cache,reconnect,volname=Equinox -------------------------------------------------------------------------------- /emacs-merge.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # 3 way merge using emacs from the command line 4 | # http://wiki.darcs.net/DarcsWiki/CategoryEmacs 5 | 6 | amacs --eval="(ediff-merge-files-with-ancestor \"$1\" \"$2\" \"$3\" nil \"$4\")" -------------------------------------------------------------------------------- /histogram: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | 3 | import Data.List 4 | import Data.Ord 5 | import System.IO 6 | 7 | main = interact (unlines . map (\(x:xs) -> x ++ ": " ++ show (1 + length xs)) . reverse . sortBy (comparing length) . group . sort . words) 8 | -------------------------------------------------------------------------------- /startup: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | if [ $(scutil --get LocalHostName) == "Perihelion" ]; then 3 | (cd ~/Programming/Checkouts/ghc-builder-instance && screen -A -m -d -S ghc-builder builder-client) 4 | fi 5 | (cd ~/Dropbox/Wiki/ && screen -A -m -d -S gitit make start) 6 | -------------------------------------------------------------------------------- /git-find-keyword: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Finds commits that changed the number of occurrences of the keyword 4 | git log -S"$1" -- . 5 | 6 | # Find commits that changed a line containing the keyword (interpreted as a regex) 7 | #git grep $1 $(git rev-list --all) 8 | -------------------------------------------------------------------------------- /tabful-haskell: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | echo "=== Files not containing tabs:" 4 | find . -iname '*.lhs' -o -iname '*.hs' | xargs grep -v -R -H -l $'\t' 5 | 6 | echo 7 | echo "=== Files containing tabs:" 8 | find . -iname '*.lhs' -o -iname '*.hs' | xargs grep -R -H -l $'\t' 9 | -------------------------------------------------------------------------------- /correctpermissions.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | #chflags nouchg "$1" 5 | 6 | chown mbolingbroke:staff "$1" 7 | 8 | if [ -d "$1" ] 9 | then 10 | # World readable, sticky bit 11 | chmod 755 "$1" 12 | else 13 | # World readable 14 | chmod 644 "$1" 15 | fi 16 | -------------------------------------------------------------------------------- /github-init-pages-branch: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | 4 | echo "WARNING: this operation will lose any uncommitted changes! Kill me in the next 10 seconds if you don't want to do this" 5 | sleep 10 6 | 7 | git symbolic-ref HEAD refs/heads/gh-pages 8 | rm .git/index 9 | git clean -fdx -------------------------------------------------------------------------------- /find-copy-to-dir-one: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # INTERNAL script for use by find-copy-to-dir 4 | 5 | NAME=$1 6 | DESTINATION=$2 7 | 8 | DESTINATION_NAME=`echo $NAME | sed s,\\\./,,g | sed s,/,-,g` 9 | 10 | echo "Copying $NAME to $DESTINATION_NAME" 11 | cp $NAME $DESTINATION/$DESTINATION_NAME -------------------------------------------------------------------------------- /ogg2mp3: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | if [ -z "$1" ]; then 5 | echo "Usage: `basename $0` FILES" 6 | exit 1 7 | fi 8 | 9 | until [ -z "$1" ]; do 10 | echo $1 11 | oggdec -Q $1 -o /tmp/$!.wav && lame -V2 /tmp/$!.wav "${1%.ogg}.mp3" 12 | rm /tmp/$!.wav 13 | shift 14 | done -------------------------------------------------------------------------------- /mp32ogg: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | if [ -z "$1" ]; then 5 | echo "Usage: `basename $0` FILES" 6 | exit 1 7 | fi 8 | 9 | until [ -z "$1" ]; do 10 | echo $1 11 | mpg321 -q $1 -w /tmp/$!.wav && oggenc -Q /tmp/$!.wav -o `basename $1 .mp3`.ogg 12 | rm /tmp/$!.wav 13 | shift 14 | done -------------------------------------------------------------------------------- /harmonic-mean: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | 3 | import Data.List 4 | 5 | main = interact f 6 | 7 | f :: String -> String 8 | f s = show harmonic_mean 9 | where 10 | nums = [read l :: Double | l <- lines s, l /= ""] 11 | n = genericLength nums 12 | harmonic_mean = n / sum (map (1.0/) nums) -------------------------------------------------------------------------------- /nfc: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import sys 3 | import codecs 4 | import unicodedata 5 | (utf8_encode, utf8_decode, utf8_reader, utf8_writer) = codecs.lookup('utf-8') 6 | outfile = utf8_writer(sys.stdout) 7 | infile=utf8_reader(sys.stdin) 8 | outfile.write(unicodedata.normalize('NFC',infile.read())) 9 | sys.exit(0) 10 | -------------------------------------------------------------------------------- /cabal-inplace: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | if [ $# -lt 1 ] ; then 5 | echo "Usage: $0 " 6 | exit 1 7 | fi 8 | 9 | INPLACE_DIR=$(cd $1/inplace; pwd); shift 10 | 11 | cabal $* --with-ghc=$INPLACE_DIR/bin/ghc-stage2 --with-ghc-pkg=$INPLACE_DIR/bin/ghc-pkg --package-db=$INPLACE_DIR/lib/package.conf.d -------------------------------------------------------------------------------- /find-copy-to-dir: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | if [ $# -ne 2 ]; then 4 | echo "Usage: $0 pattern destination" 5 | exit 1 6 | fi 7 | 8 | PATTERN=$1 9 | DESTINATION=$2 10 | 11 | # Pruning stuff prevents us from looking at the same directory twice 12 | find . -path ./$DESTINATION -prune -o -iname $PATTERN -exec find-copy-to-dir-one {} $DESTINATION \; -------------------------------------------------------------------------------- /cabaldance.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | if [ -e "Setup.lhs" ] ; then 5 | filename="Setup.lhs" 6 | elif [ -e "Setup.hs" ] ; then 7 | filename="Setup.hs" 8 | else 9 | echo "No Cabal setup file found!" 10 | exit 0 11 | fi 12 | 13 | 14 | runghc $filename configure 15 | if [ $? -eq 0 ] ; then 16 | runghc $filename build 17 | if [ $? -eq 0 ] ; then 18 | sudo runghc $filename install 19 | fi 20 | fi 21 | -------------------------------------------------------------------------------- /whitespace-align: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | import System.Environment 3 | import Data.List 4 | 5 | main = interact $ \text -> let rows = map words (lines text) 6 | cols = transpose rows 7 | rows' = transpose $ map (\col -> map (padTo (maximum (map length col))) col) cols 8 | in unlines $ map unwords rows' 9 | 10 | padTo n s = s ++ replicate (n - length s) ' ' 11 | -------------------------------------------------------------------------------- /ghc-nofib-dump-old: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | if [ "$#" -ne "1" ]; then 5 | echo "Must supply a suffix" 6 | exit 1 7 | fi 8 | 9 | SUFFIX=$1 10 | 11 | STAGE=2 12 | GHC="$GHC_ROOT../../../ghc/stage$STAGE-inplace/ghc" 13 | GHC_OPTS="-O -fforce-recomp -c -dverbose-core2core -ddump-stg $GHC_OPTS" 14 | echo "Stage: $STAGE, Options: $GHC_OPTS" 15 | 16 | for sourcefile in *.hs *.lhs ; do 17 | echo "Compiling $sourcefile.core-$SUFFIX" 18 | $GHC $GHC_OPTS $sourcefile >& $sourcefile.core-$SUFFIX 19 | done 20 | -------------------------------------------------------------------------------- /pyqt4-clean: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | sudo port deactivate py25-pyqt4 4 | sudo rm /opt/local/Library/Frameworks/Python.framework/Versions/2.5/bin/pylupdate4 5 | sudo rm /opt/local/Library/Frameworks/Python.framework/Versions/2.5/bin/pyrcc4 6 | sudo rm /opt/local/Library/Frameworks/Python.framework/Versions/2.5/bin/pyuic4 7 | sudo rm -rd /opt/local/Library/Frameworks/Python.framework/Versions/2.5/lib/python2.5/site-packages/PyQt4 8 | sudo rm -rd /opt/local/share/doc/py25-pyqt4/ 9 | sudo rm -rd /opt/local/share/sip/PyQt4/ 10 | -------------------------------------------------------------------------------- /copy.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # sudo runs the backup as root 4 | # --eahfs enables HFS+ mode 5 | # -a turns on archive mode (recursive copy + retain attributes) 6 | # -x don't cross device boundaries (ignore mounted volumes) 7 | # -S handle sparse files efficiently 8 | # --showtogo shows the number of files left to process 9 | # --delete deletes any files that have been deleted locally 10 | # $* expands to any extra command line options you may give 11 | 12 | for directory in $*; do 13 | echo "Copying $directory"; 14 | /usr/bin/rsync -E -a -x -S --delete "/Volumes/Data-1/$directory" "./$directory"; 15 | done -------------------------------------------------------------------------------- /lined-paper: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'rubygems' 4 | require 'prawn' 5 | require 'prawn/measurement_extensions' 6 | 7 | if ARGV.size < 1 8 | puts "Usage: #{$0} output-file" 9 | exit 1 10 | end 11 | 12 | Prawn::Document.generate(ARGV[0], 13 | :page_layout => :portrait, 14 | :left_margin => 1.5.cm, 15 | :right_margin => 1.5.cm, 16 | :top_margin => 1.5.cm, 17 | :bottom_margin => 1.5.cm, 18 | :page_size => 'A5') do 19 | for i in (1..(bounds.height / 5.15.mm) + 1) 20 | next if i % 2 == 0 21 | 22 | stroke do 23 | rectangle [bounds.left, i*5.15.mm], bounds.width, 5.15.mm 24 | end 25 | end 26 | end 27 | -------------------------------------------------------------------------------- /darcs-bundle-install.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | LC_CTYPE=en_US.UTF-8 4 | SVN=`which svn` 5 | 6 | echo Changing to Bundles directory... 7 | mkdir -p /Library/Application\ Support/TextMate/Bundles 8 | cd /Library/Application\ Support/TextMate/Bundles 9 | 10 | if [ -d /Library/Application\ Support/TextMate/Bundles/Darcs.tmbundle ]; then 11 | echo Darcs bundle already exists - updating... 12 | $SVN up Darcs.tmbundle 13 | else 14 | echo Checking out Darcs bundle... 15 | $SVN --username anon --password anon co http://macromates.com/svn/Bundles/trunk/Bundles/Darcs.tmbundle/ 16 | fi 17 | 18 | echo Reloading bundles in TextMate... 19 | osascript -e 'tell app "TextMate" to reload bundles' -------------------------------------------------------------------------------- /start-ssh-agent: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | SSH_ENV="$HOME/.ssh/environment" 5 | 6 | function start_agent { 7 | echo "Initialising new SSH agent..." 8 | /usr/bin/ssh-agent | sed 's/^echo/#echo/' > "${SSH_ENV}" 9 | echo succeeded 10 | chmod 600 "${SSH_ENV}" 11 | . "${SSH_ENV}" > /dev/null 12 | /usr/bin/ssh-add; 13 | } 14 | 15 | # Source SSH settings, if applicable 16 | 17 | if [ -f "${SSH_ENV}" ]; then 18 | . "${SSH_ENV}" > /dev/null 19 | #ps ${SSH_AGENT_PID} doesnt work under cywgin 20 | ps -ef | grep ${SSH_AGENT_PID} | grep ssh-agent$ > /dev/null || { 21 | start_agent; 22 | } 23 | else 24 | start_agent; 25 | fi 26 | -------------------------------------------------------------------------------- /markcolumns: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | 3 | import System.Environment 4 | import System.IO 5 | import Data.Char 6 | import Data.List 7 | 8 | main = do 9 | ls <- fmap lines $ hGetContents stdin 10 | length ls `seq` return () 11 | 12 | let go :: String -> (Int, [String]) -> (Int, [String]) 13 | go line (col, result) 14 | | not ("Step" `isPrefixOf` rest) = (col, line : result) 15 | | otherwise = (col', (replicate col' '#' ++ drop col' spaces ++ rest) : result) 16 | where (spaces, rest) = span isSpace line 17 | col' = col `min` length spaces 18 | 19 | putStr $ unlines $ snd $ foldr go (maxBound, []) ls -------------------------------------------------------------------------------- /lapwing-authenticate: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | # 3 | require 'rubygems' 4 | require 'safariwatir' 5 | 6 | raven_user_id="mb566" 7 | raw_raven_password = `security find-generic-password -ga #{raven_user_id} 2>&1 | grep password | sed 's/password: //'` 8 | raven_password=raw_raven_password.strip[1...-1] 9 | 10 | # Initiate login 11 | browser = Watir::Safari.new 12 | browser.goto("http://www.google.co.uk") 13 | browser.button(:name, "Raven").click 14 | 15 | # Enter username and password 16 | browser.text_field(:name, "userid").set(raven_user_id) 17 | browser.text_field(:name, "pwd").set(raven_password) 18 | browser.button(:name, "submit").click 19 | 20 | # Finish off authentication 21 | browser.button(:value, "here").click -------------------------------------------------------------------------------- /diffmerge-series: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | HERE=`pwd` 4 | 5 | TEMP_DIR="/tmp/$(basename $0).$$" 6 | LEFT_DIR="$TEMP_DIR/left" 7 | RIGHT_DIR="$TEMP_DIR/right" 8 | rm -rdf $TEMP_DIR 9 | mkdir $TEMP_DIR 10 | mkdir $LEFT_DIR 11 | mkdir $RIGHT_DIR 12 | 13 | cd "$HERE" 14 | eval "LEFT_FILES=$1*" 15 | for LEFT_FILE in $LEFT_FILES; do 16 | LEFT_FILE_BASE=`echo $LEFT_FILE | sed s,$1,,` 17 | cp $LEFT_FILE $LEFT_DIR/$LEFT_FILE_BASE 18 | done 19 | 20 | cd "$HERE" 21 | eval "RIGHT_FILES=$2*" 22 | for RIGHT_FILE in $RIGHT_FILES; do 23 | RIGHT_FILE_BASE=`echo $RIGHT_FILE | sed s,$2,,` 24 | cp $RIGHT_FILE $RIGHT_DIR/$RIGHT_FILE_BASE 25 | done 26 | 27 | /Applications/DiffMerge.app/Contents/MacOS/DiffMerge $LEFT_DIR $RIGHT_DIR & 28 | -------------------------------------------------------------------------------- /knees: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | 3 | import Control.Arrow 4 | import System.IO 5 | import Data.Char 6 | import Data.List 7 | import System.Environment 8 | 9 | main = do 10 | ls <- fmap lines $ hGetContents stdin 11 | length ls `seq` return () 12 | 13 | let go :: String -> (Int, [String]) -> (Int, [String]) 14 | go line (col, result) 15 | | thiscol == 0 || 16 | not ("Step" `isPrefixOf` rest) = (col, result) 17 | | thiscol < col = (thiscol, line : result) 18 | | otherwise = (col, result) 19 | where (thiscol, rest) = first length $ span isSpace line 20 | 21 | putStr $ unlines $ snd $ foldr go (maxBound, []) ls 22 | -------------------------------------------------------------------------------- /amacs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | $pid = 0; 4 | open I, "ps -axww -U $ENV{'USER'} |"; 5 | while () 6 | { 7 | if (/Aquamacs Emacs/ && !/grep/) 8 | { 9 | if (/^\s*([0-9]+)\s/) 10 | { 11 | $pid = $1; 12 | } 13 | } 14 | } 15 | 16 | close I; 17 | $args = ""; 18 | for my $f (@ARGV) 19 | { 20 | if (! -e $f) 21 | { 22 | system("touch \"$f\""); 23 | } 24 | $args .= "\"$f\" "; 25 | } 26 | 27 | # there is still an issue: 28 | # if the sudo emacs is still open, it will 29 | # call 'open' and open the files in the wrong 30 | # emacs process. 31 | 32 | if ($pid) 33 | { 34 | system("open -a /Applications/Aquamacs\\ Emacs.app $args"); 35 | } 36 | else 37 | { 38 | system("/Applications/Aquamacs\\ Emacs.app/Contents/MacOS/Aquamacs\\ Emacs $args &"); 39 | } 40 | 41 | exit; 42 | -------------------------------------------------------------------------------- /ghc-612-setup: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | my-cabal-install QuickCheck 1.2.0.0 || exit 1 4 | my-cabal-install HUnit 1.2.2.1 || exit 1 5 | my-cabal-install testpack 1.0.2 || exit 1 6 | my-cabal-install mtl 1.1.0.2 || exit 1 7 | my-cabal-install parsec 2.1.0.1 || exit 1 8 | my-cabal-install mtlparse 0.0.1 || exit 1 9 | my-cabal-install regexpr 0.5.1 || exit 1 10 | my-cabal-install split 0.1.1 || exit 1 11 | my-cabal-install hledger 0.6.1 || exit 1 12 | my-cabal-install csv 0.1.1 || exit 1 13 | my-cabal-install MonadCatchIO-mtl 0.2.0.0 || exit 1 14 | my-cabal-install ghc-mtl 1.0.1.0 || exit 1 15 | my-cabal-install ghc-paths 0.1.0.5 || exit 1 16 | my-cabal-install haskell-src 1.0.1.3 || exit 1 17 | my-cabal-install hint 0.3.1.0 || exit 1 18 | my-cabal-install network 2.2.1.5 || exit 1 19 | # Probably better versions available: 20 | my-cabal-install regex-base 0.93.1 || exit 1 21 | my-cabal-install regex-posix 0.93.1 || exit 1 22 | my-cabal-install tagsoup 0.6 || exit 1 23 | -------------------------------------------------------------------------------- /cabalsetup-inplace.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | setupfile=$1 5 | setupfilebin="./${setupfile}.out" 6 | 7 | prefix=~/Programming/Checkouts/ghc.$2 8 | compiler="${prefix}/compiler/stage1/ghc-inplace" 9 | packager="${prefix}/utils/ghc-pkg/ghc-pkg-inplace" 10 | 11 | bindir="${prefix}/experiment/bin" 12 | libdir="${prefix}/experiment/lib" 13 | libexecdir="${prefix}/experiment/libexec" 14 | datadir="${prefix}/experiment/data" 15 | 16 | # I'm not totally certain these actually need to exist.. at least, the GHC build process doesn't bother to supply them 17 | echo "Creating directory structure" 18 | mkdir ${prefix}/experiment 19 | mkdir $bindir 20 | mkdir $libdir 21 | mkdir $libexecdir 22 | mkdir $datadir 23 | 24 | echo "Building $setupfile" 25 | $compiler --make $setupfile -o $setupfilebin 26 | 27 | echo "Running Cabal" 28 | $setupfilebin configure --with-compiler=$compiler --with-hc-pkg=$packager --prefix=$prefix --bindir=$bindir --libdir=$libdir --libexecdir=$libexecdir --datadir=$datadir 29 | $setupfilebin build 30 | sudo $setupfilebin install -------------------------------------------------------------------------------- /diffmerge-git-wrapper: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Author: Olek Poplavsky 4 | # Script name: diffmerge-git-wrapper 5 | # This script works as interface bridge between git and DiffMerge and allows to get nice visual 6 | # diffs from git; right now script requires empty file diffmerge-git-wrapper-empty-file in the same 7 | # directory as script 8 | # easiest way to integrate it with git is by setting environment variable "export GIT_EXTERNAL_DIFF='diffmerge-git-wrapper'" 9 | 10 | left_path=$2 11 | right_path=$5 12 | 13 | 14 | basedir=`dirname $0` 15 | 16 | # working around bug in diffmerge, it does not like /dev/null yet as of 3.1.0 17 | if [[ "$left_path" = "/dev/null" ]] 18 | then 19 | left_path="$basedir/diffmerge-git-wrapper-empty-file" 20 | fi 21 | 22 | if [[ "$right_path" = "/dev/null" ]] 23 | then 24 | right_path="$basedir/diffmerge-git-wrapper-empty-file" 25 | fi 26 | 27 | left_title="$1 $3" 28 | right_title="$1 $6" 29 | 30 | # Note: I've swapped left and right!! 31 | /Applications/DiffMerge.app/Contents/MacOS/DiffMerge $left_path $right_path --title1="$left_title" --title2="$right_title" -------------------------------------------------------------------------------- /darcs-flatten: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | FROM=$1 5 | TO=$2 6 | 7 | TO_ABS="`pwd`/to" 8 | 9 | # Find the list of files only in $FROM 10 | diff -rq --exclude=_darcs $FROM $TO | grep "^Only in $FROM" | sed "s/^Only in //" | sed "s/: /\//" | sed "s/^$FROM\///" > files_only_in_from.txt 11 | # r: Recurse 12 | # q: Just show whether files differ 13 | 14 | # Sync $FROM into $TO without messing with the revision control state. This will 15 | # handle updating files that have /changed/ in $FROM, deleting those that have 16 | # been /deleted/ in $FROM (automatically telling Darcs to delete them) and adds 17 | # the files that were /added/ in $FROM, though we need to tell Darcs about those 18 | # manually: this is why we built a list of files only in $FROM up earlier 19 | rsync -az --exclude=_darcs --delete $FROM/ $TO 20 | # a: Use archive mode (preserve permissions, links etc) - what the hell 21 | # r: Recurse 22 | # --delete: Remove things that aren't in $FROM 23 | 24 | # Add the files that were only in $FROM to the repo maintained in $TO 25 | cat files_only_in_from.txt | (cd $TO; xargs -I __loc__ darcs add $TO_ABS/__loc__) 26 | rm files_only_in_from.txt 27 | 28 | # Let the user commit the final patch containing all the changes 29 | (cd $TO; darcs record --all) -------------------------------------------------------------------------------- /darcs-rewrite: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | if [ "$#" -eq "2" ]; then 5 | WHERE=$1 6 | NEW=$(cd $2; pwd) 7 | SEDCOMMAND="s,http://darcs.haskell.org/packages,$NEW/libraries,g; s,http://darcs.haskell.org/hsc2hs,$NEW/utils/hsc2hs,g; s,http://darcs.haskell.org/haddock2,$NEW/utils/haddock,g; s,http://darcs.haskell.org/ghc,$NEW,g; s,http://darcs.haskell.org,$NEW,g" 8 | elif [ "$#" -eq "3" ]; then 9 | WHERE=$1 10 | OLD=$(cd $2; pwd) 11 | NEW=$(cd $3; pwd) 12 | SEDCOMMAND="s,$OLD,$NEW,g" 13 | else 14 | echo "Usage: $0 directory [old-source] new-source" 15 | exit 1 16 | fi 17 | 18 | find $WHERE \( -name repos -o -name defaultrepo \) -print0 | xargs -0 sed -i -e "$SEDCOMMAND" 19 | exit $? 20 | 21 | # Alternative version: 22 | # 23 | # if [ "$#" -eq "0" ]; then 24 | # echo "Listing current defaultrepo/repos:" 25 | # find . -path '*/_darcs/prefs/defaultrepo' -o -path '*/_darcs/prefs/repos' | xargs cat 26 | # elif [ "$#" -eq "2" ]; then 27 | # for file in $(find . -path '*/_darcs/prefs/defaultrepo' -o -path '*/_darcs/prefs/repos'); do 28 | # echo "Rewriting $file from $1 to $2" 29 | # sed 's/$1/$2/' $file 30 | # done 31 | # else 32 | # echo "Usage: $0 old-prefix new-prefix" 33 | # exit 1 34 | # fi -------------------------------------------------------------------------------- /darcs-clone: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | if [ "$#" -ne "2" ]; then 5 | echo "Usage: $0 source-repo target-repo" 6 | exit 1 7 | fi 8 | 9 | SOURCE=$1 10 | TARGET=$2 11 | 12 | #SOURCE=ghc.head 13 | #TARGET=ghc.working 14 | 15 | SOURCEPATH=$(cd $SOURCE; pwd) 16 | TARGETPATH="$(pwd)/$TARGET" 17 | 18 | if [ -d $TARGETPATH ]; then 19 | echo "$TARGET already exists" 20 | exit 1; 21 | fi 22 | 23 | # Do the "clone" 24 | cp -r $SOURCEPATH $TARGETPATH 25 | 26 | # Fix all the repos to point to ghc.head as the thing to pull from 27 | find $TARGETPATH \( -name repos -o -name defaultrepo \) -print0 | xargs -0 sed -i -e "s,http://darcs.haskell.org/packages,$SOURCEPATH/libraries,g; s,http://darcs.haskell.org/hsc2hs,$SOURCEPATH/utils/hsc2hs,g; s,http://darcs.haskell.org/haddock2,$SOURCEPATH/utils/haddock,g; s,http://darcs.haskell.org/ghc,$SOURCEPATH,g; s,http://darcs.haskell.org,$SOURCEPATH,g" 28 | 29 | # Old version (BAD): 30 | #find ghc.working \( -name pristine -prune -o -type f -print0 | xargs -0 sed -i 's/Application/whatever/g' 31 | 32 | # If I screwed up and set the repo pointers wrongly: 33 | #find ghc.working \( -name repos -o -name defaultrepo \) -print0 | xargs -0 sed -i -e "s,Users/mbolingbroke/Programming/Checkouts/ghc.working,Users/mbolingbroke/Programming/Checkouts/ghc.head,g" 34 | -------------------------------------------------------------------------------- /ghc-nofib-compare: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | if [ ! -d "results" ]; then 5 | echo "Please run this in the root directory!" 6 | exit 1 7 | fi 8 | 9 | if [ $# -lt 5 -o $# -gt 6 ]; then 10 | echo "Usage: $0 [--skip-diff] ghc-relative-path left-variant left-suffix right-variant right-suffix" 11 | exit 1 12 | fi 13 | 14 | if [ $# -eq 6 ]; then 15 | if [ $1 = "--skip-diff" ]; then 16 | echo "OK skipping the diff step as requested.." 17 | DIFF_COMMAND="echo diffmerge-series" 18 | else 19 | echo "Unknown flag: $1" 20 | exit 1 21 | fi 22 | shift 23 | else 24 | DIFF_COMMAND=diffmerge-series 25 | fi 26 | 27 | TEST_PATH=$1 28 | LEFT_VARIANT=$2 29 | LEFT_SUFFIX=$3 30 | RIGHT_VARIANT=$4 31 | RIGHT_SUFFIX=$5 32 | 33 | echo "Building left hand side.." 34 | pushd "$LEFT_VARIANT/$TEST_PATH" || (echo "Could not find left test directory" && exit 2) 35 | ghc-nofib-dump --split core $LEFT_SUFFIX 36 | popd 37 | 38 | echo "Building right hand side.." 39 | pushd "$RIGHT_VARIANT/$TEST_PATH" || (echo "Could not find right test directory" && exit 2) 40 | ghc-nofib-dump --split core $RIGHT_SUFFIX 41 | popd 42 | 43 | # Need to strip nofib/ from the test path if it exists.. 44 | STORED_AT_TEST_PATH=${TEST_PATH#nofib/} 45 | 46 | echo "Showing results.." 47 | $DIFF_COMMAND "results/code/$LEFT_VARIANT-$LEFT_SUFFIX/$STORED_AT_TEST_PATH/" "results/code/$RIGHT_VARIANT-$RIGHT_SUFFIX/$STORED_AT_TEST_PATH/" -------------------------------------------------------------------------------- /ghc-compare: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | ### OPTIONS ### 5 | 6 | HC_PATH=~/Programming/Checkouts/ghc.working/compiler/stage1/ghc-inplace 7 | EDITOR=`which mate` 8 | 9 | SWITCHES_BEFORE='-O2 -fold-static-argument-transformation' 10 | SWITCHES_AFTER='-O2 -fno-old-static-argument-transformation' 11 | 12 | ### SCRIPT ### 13 | 14 | # Handle command line arguments 15 | 16 | if [ $# -lt 1 ] 17 | then 18 | echo "Usage: $0 source-file [extra-hc-opts]" 19 | exit 1 20 | fi 21 | 22 | # NOTE: can't generate code reliably if using -dsuppress-uniques 23 | SWITCHES_VERBOSE='-dverbose-core2core -dppr-debug -dsuppress-uniques -fno-code' 24 | 25 | FILE=$1 26 | BINARY_FILE=`echo $FILE | sed s/.lhs/.o/ | sed s/.hs/.o/` 27 | HI_FILE=`echo $FILE | sed s/.lhs/.hi/ | sed s/.hs/.hi/` 28 | BEFORE_FILE=$1.before.core2core 29 | AFTER_FILE=$1.after.core2core 30 | DIFF_FILE=$1.diff.core2core 31 | 32 | # Run compiler 33 | echo "Before..." 34 | rm -f $BINARY_FILE $HI_FILE 35 | $HC_PATH $SWITCHES_BEFORE $SWITCHES_VERBOSE $2 $FILE > $BEFORE_FILE 36 | 37 | echo "After..." 38 | rm -f $BINARY_FILE $HI_FILE 39 | $HC_PATH $SWITCHES_AFTER $SWITCHES_VERBOSE $2 $FILE > $AFTER_FILE 40 | 41 | # Report differences 42 | 43 | # -s: report identical files, then check if we got them 44 | diff -s $BEFORE_FILE $AFTER_FILE > $DIFF_FILE 45 | if [ $? -eq 1 ] 46 | then 47 | $EDITOR $BEFORE_FILE 48 | $EDITOR $AFTER_FILE 49 | $EDITOR $FILE 50 | else 51 | # Should show error / that there were no changes 52 | cat $DIFF_FILE 53 | fi 54 | rm $DIFF_FILE -------------------------------------------------------------------------------- /my-cabal-depends: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Data.Graph 4 | import Data.Maybe 5 | 6 | import System.Environment 7 | 8 | import Distribution.InstalledPackageInfo 9 | import Distribution.Simple.Compiler 10 | import Distribution.Simple.GHC 11 | import Distribution.Simple.PackageIndex (allPackages) 12 | import Distribution.Simple.Program.Builtin 13 | import Distribution.Simple.Program.Db 14 | import Distribution.Text (Text(..)) 15 | import Distribution.Package (pkgName) 16 | import Distribution.Verbosity 17 | 18 | 19 | fst3 (x, _, _) = x 20 | 21 | main = do 22 | [package_name] <- getArgs 23 | packages <- getAllInstalledPackages 24 | 25 | let pkg_id_plain_name = show . disp . pkgName 26 | package_id <- case [installedPackageId ipi | ipi <- packages, pkg_id_plain_name (sourcePackageId ipi) == package_name] of 27 | (ipi:_) -> return ipi 28 | _ -> error "Unknown package" 29 | 30 | let (package_graph, vertex_lookup, key_lookup) = graphFromEdges [(pkg_id_plain_name $ sourcePackageId ipi, installedPackageId ipi, depends ipi) | ipi <- packages] 31 | reachable_packages = reachable package_graph (fromJust $ key_lookup package_id) 32 | dependencies = map (fst3 . vertex_lookup) $ filter (\v -> v `elem` reachable_packages) $ topSort package_graph 33 | 34 | putStrLn $ unwords $ reverse dependencies 35 | 36 | getAllInstalledPackages :: IO [InstalledPackageInfo] 37 | getAllInstalledPackages = do 38 | (_, db) <- requireProgram normal ghcProgram defaultProgramDb 39 | (_, db) <- requireProgram normal ghcPkgProgram db 40 | 41 | fmap allPackages $ getInstalledPackages normal [GlobalPackageDB, UserPackageDB] db -------------------------------------------------------------------------------- /dsl-mp3-rename: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | # 3 | 4 | import os 5 | import codecs 6 | import shutil 7 | 8 | dsl_file = "out.dsl" 9 | dsl_lines = codecs.open(dsl_file, encoding="utf-16").read().split('\r\n') 10 | 11 | mp3_directory = "MP3/" 12 | 13 | for i in range(3, len(dsl_lines) - 1, 9): 14 | record = dsl_lines[i:i+9] 15 | 16 | character = record[0] 17 | pinyin = record[4] 18 | 19 | filename_line = record[1] 20 | filename_start = filename_line.index("[s]") + 3 21 | filename_end = filename_line.index("[/s]", filename_start) 22 | filename = filename_line[filename_start:filename_end] 23 | 24 | # In output of converter, .wav is written while the files are actually still mp3 25 | mp3_filename = filename.rstrip(".wav") + ".mp3" 26 | 27 | source_mp3_path = mp3_directory + mp3_filename 28 | if os.path.exists(source_mp3_path): 29 | def lazy_pinyin_strategy(): 30 | target_mp3_path = mp3_directory + character + ".mp3" 31 | if os.path.exists(target_mp3_path): 32 | print "Giving", mp3_filename, "a name including pinyin", "(" + pinyin +")", "because we already have a file called", character 33 | shutil.move(source_mp3_path, mp3_directory + character + " (" + pinyin +").mp3") 34 | else: 35 | shutil.move(source_mp3_path, target_mp3_path) 36 | 37 | def always_pinyin_strategy(): 38 | target_mp3_path = mp3_directory + character + " (" + pinyin +").mp3" 39 | if os.path.exists(target_mp3_path): 40 | print "Skipping file ", mp3_filename, '(' + character + ", " + pinyin + ')', "because we already have such a target file" 41 | else: 42 | shutil.move(source_mp3_path, target_mp3_path) 43 | 44 | #print character, filename 45 | #lazy_pinyin_strategy() 46 | always_pinyin_strategy() 47 | else: 48 | # print "Skipping", character, "because MP3 is missing" 49 | None -------------------------------------------------------------------------------- /ghc-dump-split: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | # 3 | 4 | import re, sys, itertools 5 | 6 | # Don't match on the end of line marker because some debug traces will 7 | # accidentally append to that line 8 | seperator_regex = re.compile("^==================== ([^$]+) ====================", re.M) 9 | 10 | SANITIZE_PAIRS = { 11 | ' ' : '', 12 | ':' : '' 13 | } 14 | 15 | def filename_sanitize(filename): 16 | for from_str, to_str in SANITIZE_PAIRS.items(): 17 | filename = filename.replace(from_str, to_str) 18 | return filename 19 | 20 | def drop(iterator, n): 21 | return itertools.islice(iterator, n, None) 22 | 23 | for filename in sys.argv[1:]: 24 | file = open(filename, 'r') 25 | contents = file.read() 26 | file.close() 27 | 28 | overall_index = 1 29 | seen_segments = {} 30 | pending_segment = None 31 | for segment in drop(seperator_regex.split(contents), 1): 32 | segment_stripped = segment.strip() 33 | 34 | if pending_segment: 35 | output_filename = filename + '.' + format(overall_index, "0>2") + '.' + filename_sanitize(pending_segment) 36 | output_file = open(output_filename, 'w') 37 | output_file.write(segment_stripped) 38 | output_file.close() 39 | 40 | pending_segment = None 41 | overall_index = overall_index + 1 42 | else: 43 | # Work out an index number for the segment, so that duplicate segment 44 | # names do not get written to identical files 45 | index = seen_segments.get(segment_stripped, 0) 46 | seen_segments[segment_stripped] = index + 1 47 | 48 | pending_segment = segment_stripped + " - " + str(index) 49 | 50 | if len(pending_segment) > 100 or len(pending_segment) == 0: 51 | raise Exception("Pending segment fails sanity check:\n" + pending_segment) 52 | 53 | print 'Segment:', pending_segment 54 | -------------------------------------------------------------------------------- /ghc-nofib-sat-compare: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | ### OPTIONS ### 5 | 6 | # Must be run in nofib directory... 7 | NOFIB_DIR=`echo ~/Programming/Checkouts/ghc.working/nofib` 8 | ANALYSE_DIR=~/Programming/Checkouts/ghc.working/utils/nofib-analyse 9 | ANALYSE_PATH=$ANALYSE_DIR/nofib-analyse 10 | EDITOR=`which mate` 11 | 12 | # NOTE: Should --clean if switches change 13 | SWITCHES_BEFORE='-O2 -fold-static-argument-transformation' 14 | SWITCHES_AFTER='-O2 -fno-old-static-argument-transformation' 15 | 16 | # Sanity testing: 17 | #SWITCHES_AFTER=$SWITCHES_BEFORE 18 | 19 | ### SCRIPT ### 20 | 21 | # Handle command line arguments 22 | 23 | if [ $# -lt 1 ] 24 | then 25 | echo "Usage: $0 run-name [--clean|--clean-after]" 26 | exit 1 27 | fi 28 | 29 | # Defaults 30 | CLEAN_BEFORE=0 31 | CLEAN_AFTER=0 32 | 33 | if [ $# -gt 1 ] 34 | then 35 | if [ $2 == "--clean" ] 36 | then 37 | CLEAN_BEFORE=1 38 | CLEAN_AFTER=1 39 | fi 40 | 41 | if [ $2 == "--clean-after" ] 42 | then 43 | CLEAN_AFTER=1 44 | fi 45 | fi 46 | 47 | # Find test and run name 48 | 49 | RUN=$1 50 | TEST=$(pwd | sed s,$NOFIB_DIR/*,, | sed s,/,-,g | sed 's, ,,g') 51 | 52 | if ! [ -n "$TEST" ] 53 | then 54 | TEST=nofib 55 | fi 56 | 57 | echo Run: $RUN 58 | echo Test: $TEST 59 | 60 | # Find files 61 | BEFORE_FILE=$ANALYSE_DIR/$TEST-before 62 | AFTER_FILE=$ANALYSE_DIR/$TEST-after-$RUN 63 | DIFF_FILE=$ANALYSE_DIR/$TEST-compare-$RUN 64 | 65 | # Clean files 66 | 67 | if [ $CLEAN_AFTER -eq 1 ] 68 | then 69 | rm -f $AFTER_FILE 70 | fi 71 | 72 | if [ $CLEAN_BEFORE -eq 1 ] 73 | then 74 | rm -f $BEFORE_FILE 75 | fi 76 | 77 | # Generate files 78 | 79 | if ! [ -f $BEFORE_FILE ] 80 | then 81 | make clean >& /dev/null 82 | make -k EXTRA_HC_OPTS="$SWITCHES_BEFORE" >& $BEFORE_FILE 83 | fi 84 | 85 | if ! [ -f $AFTER_FILE ] 86 | then 87 | make clean >& /dev/null 88 | make -k EXTRA_HC_OPTS="$SWITCHES_AFTER" >& $AFTER_FILE 89 | fi 90 | 91 | $ANALYSE_PATH $BEFORE_FILE $AFTER_FILE > $DIFF_FILE 92 | $EDITOR -w $DIFF_FILE -------------------------------------------------------------------------------- /plainbbl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | {-# LANGUAGE ViewPatterns #-} 3 | import Data.Char 4 | import Data.List 5 | import Data.List.Split 6 | 7 | 8 | main = interact parse 9 | 10 | -- \begin{thebibliography}{10} 11 | -- 12 | -- \bibitem{ConceptOfASupercompiler} 13 | -- Valentin~F. Turchin. 14 | -- \newblock The concept of a supercompiler. 15 | -- \newblock {\em ACM Trans. Program. Lang. Syst.}, 8(3):292--325, 1986. 16 | -- 17 | -- ... 18 | 19 | parse :: String -> String 20 | parse = unlines . map parseOne . tail . splitOn "\\bibitem" 21 | 22 | parseOne :: String -> String 23 | parseOne s = dropTrailingDot title ++ ", " ++ dropTrailingDot author ++ ": " ++ venue 24 | where 25 | -- {ConceptOfASupercompiler} 26 | -- Valentin~F. Turchin. 27 | -- \newblock The concept of a supercompiler. 28 | -- \newblock {\em ACM Trans. Program. Lang. Syst.}, 8(3):292--325, 1986. 29 | 30 | -- {VerificationAsSpecializationOfInterpreters} 31 | -- Alexei~P. Lisitsa and Andrei~P. Nemytykh. 32 | -- \newblock {Verification as specialization of interpreters with respect to 33 | -- data}. 34 | -- \newblock In {\em Proocedings of First International Workshop on 35 | -- Metacomputation in Russia}, pages 94--112, 2008. 36 | _latex_name:author:rest0 = map deTex (lines s) 37 | (title, rest1) = takeBlock rest0 38 | (venue, _) = takeBlock rest1 39 | 40 | takeBlock :: [String] -> (String, [String]) 41 | takeBlock (l:ls) = (unwords $ map stripLeft $ drop (length "\\newblock") l : block, rest) 42 | where (block, rest) = span (\l -> not (null l) && isSpace (head l)) ls 43 | 44 | stripLeft :: String -> String 45 | stripLeft = dropWhile isSpace 46 | 47 | dropTrailingDot :: String -> String 48 | dropTrailingDot s | last s == '.' = init s 49 | | otherwise = s 50 | 51 | deTex :: String -> String 52 | deTex = replace "--" "-" . replace " " " " . replace "~" " " . replace "\\em" "" . replace "{" "" . replace "}" "" . replace "{\\o}" "o" . replace "\\\"{u}" "u" 53 | 54 | 55 | replace :: Eq a => [a] -> [a] -> [a] -> [a] 56 | replace [] newSub list = join newSub list 57 | where 58 | join :: [a] -> [a] -> [a] 59 | join glue [h] = [h] 60 | join glue (h:ts) = h : glue ++ join glue ts 61 | join _ [] = [] 62 | replace oldSub newSub list = _replace list 63 | where 64 | len = length oldSub 65 | 66 | _replace [] = [] 67 | _replace list@(h:ts) | isPrefixOf oldSub list = newSub ++ _replace (drop len list) 68 | | otherwise = h : _replace ts 69 | -------------------------------------------------------------------------------- /darcs-sendmail: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | # Based on the script to technonik from 4 | # Modified by Max Bolingbroke to add Keychain integration on 20th December 2010. 5 | # 6 | # Replacement for sendmail utility that uses SMTP protocol for delivery. 7 | # By default, sendmail reads message body from stdin and delivers it to 8 | # address(es) passed on the commandline. 9 | # http://www.feep.net/sendmail/tutorial/run/commandline.html 10 | # 11 | # Various sendmail options are not supported, because the script was 12 | # developed as a simple way to send mails from console tools like Darcs 13 | # through GMail. 14 | # 15 | # With Darcs 1.x.x on windows use: 16 | # darcs send -v --sendmail-command="c:\path\to\python sendmail.py """%t""" %<" 17 | # or from batch file: 18 | # darcs send -v --sendmail-command="c:\path\to\python sendmail.py """%%t""" %%<" 19 | # 20 | # techtonik // php.net 2008-03-30 21 | 22 | 23 | # --*- Username/password -*-- 24 | # 25 | import subprocess 26 | import re 27 | 28 | p = subprocess.Popen(["security", "find-generic-password", "-l", "Google Service: Google Notifier", "-g"], stdout=subprocess.PIPE, stderr=subprocess.PIPE) 29 | output = p.stdout.read() + "\n" + p.stderr.read() # For some reason the password is sent on stderr 30 | 31 | LOGIN = re.search(r'"acct"="([^"]*)"', output).group(1) 32 | PASS = re.search(r'password: "([^"]*)"', output).group(1) 33 | 34 | 35 | # --*- Configuration -*-- 36 | # 37 | MAILSERV = "smtp.gmail.com" 38 | # Secure TLS connections are required by GMail 39 | SECURE = 1 40 | SMTPDEBUG = 0 41 | 42 | 43 | # --*- Parameters -*-- 44 | # 45 | FROM = "anything@example.com" 46 | TO = "anything@example.com" 47 | 48 | 49 | 50 | import sys 51 | import smtplib 52 | from getpass import getpass 53 | 54 | def sendmail(sndr, rcpt, body): 55 | 56 | # Even though To: and Cc: headers are present in the message, SMTP 57 | # protocol still requires that all recepient addresses are passed 58 | # to server explicitly 59 | 60 | server = smtplib.SMTP() 61 | if SMTPDEBUG: 62 | server.set_debuglevel(1) 63 | server.connect(MAILSERV) 64 | if SECURE: 65 | server.ehlo() 66 | server.starttls() 67 | server.ehlo() 68 | if LOGIN != None: 69 | if PASS == None: 70 | pswd = getpass() 71 | else: 72 | pswd = PASS 73 | server.login(LOGIN, pswd) 74 | server.sendmail(sndr, rcpt, body) 75 | server.quit() 76 | 77 | 78 | 79 | if __name__ == "__main__": 80 | if len(sys.argv) > 1: 81 | to = sys.argv[1:] 82 | else: 83 | to = TO 84 | mailbody = sys.stdin.read() 85 | sendmail(FROM, to, mailbody) 86 | -------------------------------------------------------------------------------- /git-publish-branch: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | ## git-publish-branch: a simple script to ease the unnecessarily complex 4 | ## task of "publishing" a branch, i.e., taking a local branch, creating a 5 | ## reference to it on a remote repo, and setting up the local branch to 6 | ## track the remote one, all in one go. you can even delete that remote 7 | ## reference. 8 | ## 9 | ## Usage: git publish-branch [-d] [repository] 10 | ## 11 | ## '-d' signifies deletion. is the branch to publish, and 12 | ## [repository] defaults to "origin". The remote branch name will be the 13 | ## same as the local branch name. Don't make life unnecessarily complex 14 | ## for yourself. 15 | ## 16 | ## Note that unpublishing a branch doesn't delete the local branch. 17 | ## Safety first! 18 | ## 19 | ## git-publish-branch Copyright 2008 William Morgan . 20 | ## This program is free software: you can redistribute it and/or modify 21 | ## it under the terms of the GNU General Public License as published by 22 | ## the Free Software Foundation, either version 3 of the License, or (at 23 | ## your option) any later version. 24 | ## 25 | ## This program is distributed in the hope that it will be useful, 26 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of 27 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 | ## GNU General Public License for more details. 29 | ## 30 | ## You can find the GNU General Public License at: 31 | ## http://www.gnu.org/licenses/ 32 | 33 | def exec cmd 34 | puts cmd 35 | system cmd or die unless $fake 36 | end 37 | 38 | def die s=nil 39 | $stderr.puts s if s 40 | exit(-1) 41 | end 42 | 43 | head = `git symbolic-ref HEAD`.chomp.gsub(/refs\/heads\//, "") 44 | delete = ARGV.delete "-d" 45 | $fake = ARGV.delete "-n" 46 | branch = (ARGV.shift || head).gsub(/refs\/heads\//, "") 47 | remote = ARGV.shift || "origin" 48 | local_ref = `git show-ref heads/#{branch}` 49 | remote_ref = `git show-ref remotes/#{remote}/#{branch}` 50 | remote_config = `git config branch.#{branch}.merge` 51 | 52 | if delete 53 | ## we don't do any checking here because the remote branch might actually 54 | ## exist, whether we actually know about it or not. 55 | exec "git push #{remote} :refs/heads/#{branch}" 56 | 57 | unless local_ref.empty? 58 | exec "git config --unset branch.#{branch}.remote" 59 | exec "git config --unset branch.#{branch}.merge" 60 | end 61 | else 62 | die "No local branch #{branch} exists!" if local_ref.empty? 63 | die "A remote branch #{branch} on #{remote} already exists!" unless remote_ref.empty? 64 | die "Local branch #{branch} is already a tracking branch!" unless remote_config.empty? 65 | 66 | exec "git push #{remote} #{branch}:refs/heads/#{branch}" 67 | exec "git config branch.#{branch}.remote #{remote}" 68 | exec "git config branch.#{branch}.merge refs/heads/#{branch}" 69 | end -------------------------------------------------------------------------------- /ec2-socks-proxy: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | # =============== 4 | # EC2 SOCKS Proxy 5 | # =============== 6 | # 7 | # Getting Started 8 | # =============== 9 | # 10 | # To set this up: 11 | # 12 | # 1. Run: 13 | # ec2-authorize default -p 22 14 | # 15 | # 2. Install: 16 | # sudo gem install amazon-ec2 net-ssh 17 | # 18 | # 3. Change the constants immediately below as appropriate for your setup: 19 | # 20 | # 21 | # Credits 22 | # ======= 23 | # 24 | # Based on manual procedure at http://bityard.blogspot.com/2009/01/make-openssh-socks-proxy.html 25 | # EC2 gem usage based on http://fushizen.net/~bd/ec2-backup-scrubbed.rb.txt 26 | 27 | # Useful configuration 28 | KEYPAIR = "ec2-key" 29 | IMAGE_ID = "ami-5647a33f" # ec2-public-images/fedora-8-i386-base-v1.08.manifest.xml 30 | KEYS = [File.expand_path("~/.ec2/id_rsa-" + KEYPAIR)] 31 | 32 | 33 | require 'EC2' 34 | require 'net/ssh' 35 | 36 | def wait_forever() 37 | while true 38 | sleep 5 39 | end 40 | end 41 | 42 | def fancy_sleep(seconds) 43 | (1..seconds).each { |i| 44 | sleep 1 45 | print "." 46 | $stdout.flush 47 | } 48 | end 49 | 50 | 51 | # Connect to EC2 52 | puts("[*] Connecting to EC2") 53 | access_key_id = ENV['AMAZON_ACCESS_KEY_ID'] 54 | secret_access_key = ENV['AMAZON_SECRET_ACCESS_KEY'] 55 | ec2 = EC2::Base.new(:access_key_id => access_key_id, :secret_access_key => secret_access_key) 56 | 57 | # Start the instance 58 | puts("[*] Starting instance of image #{IMAGE_ID}") 59 | response = ec2.run_instances(:image_id => IMAGE_ID, :min_count => 1, :max_count => 1, :key_name => KEYPAIR) 60 | instance_id = response.instancesSet.item[0].instanceId 61 | 62 | # Make sure that we kill the instance when the script gets killed 63 | at_exit { 64 | puts("[*] Terminating instance #{instance_id}") 65 | (1..5).each { |i| 66 | ec2.terminate_instances(:instance_id => [instance_id]) 67 | sleep 1 68 | } 69 | } 70 | 71 | # Wait for the instance to come up 72 | puts("[*] Waiting for instance") 73 | instance_state = nil 74 | while true 75 | fancy_sleep(5) 76 | response = ec2.describe_instances(:instance_id => [instance_id]) 77 | instance_state = response.reservationSet.item[0].instancesSet.item[0].instanceState.name 78 | puts " #{instance_id} is #{instance_state}" 79 | break unless instance_state == "pending" 80 | end 81 | 82 | # Check that the instance hasn't failed during startup 83 | if instance_state != "running" 84 | puts "[*] Unexpected state: #{instance_state}, terminating and aborting" 85 | exit 1 86 | end 87 | 88 | # Retrieve DNS name and wait for SSH to start up 89 | instance_dns_name = response.reservationSet.item[0].instancesSet.item[0].dnsName 90 | puts "[*] Instance up at #{instance_dns_name}, waiting for SSH" 91 | fancy_sleep(30) 92 | puts " attempting to connect" 93 | 94 | # Dial-in to the newly built instance using the private key 95 | puts "[*] Starting SOCKS proxy via SSH with keys #{KEYS.join(" ")} - Ctrl+C to terminate instance" 96 | `ssh #{KEYS.map{|key| '-i ' + key}} -o StrictHostKeyChecking=no -q -D 1080 root@#{instance_dns_name}` 97 | 98 | wait_forever() -------------------------------------------------------------------------------- /my-cabal-install: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | import os.path 4 | import subprocess 5 | import sys 6 | import re 7 | 8 | 9 | if len(sys.argv) <= 1: 10 | print "Usage: `basename %s` [--clean] package[-version] ... [-- configure-arg ...]" % sys.argv[0] 11 | sys.exit(1) 12 | 13 | args = sys.argv[1:] 14 | args, clean = (args[0] == "--clean") and (args[1:], True) or (args, False) 15 | 16 | packageargs, configureargs = ("--" in args) and (args[:args.index("--")], args[args.index("--") + 1:]) or (args, []) 17 | 18 | def takelastwhile(xs, p): 19 | ys = [] 20 | for x in reversed(xs): 21 | if p(x): 22 | ys.append(x) 23 | else: 24 | break 25 | 26 | return list(reversed(ys)) 27 | 28 | def splitlast(xs, p): 29 | tail = takelastwhile(xs, p) 30 | return (xs[:len(xs) - len(tail)], tail) 31 | 32 | def parsepackage(package): 33 | (name, mb_version) = splitlast(package, lambda c: c in ['.'] + [str(i) for i in range(0, 10)]) 34 | if name[-1] == "-" and mb_version: 35 | return (name[:-1], "".join(mb_version)) 36 | else: 37 | return (package, None) 38 | 39 | packages = map(parsepackage, packageargs) 40 | 41 | for name, mb_version in packages: 42 | # Abuse Hackage index page to discover most recent version. Remember: 43 | # -e /pattern/!d == delete lines not matching this pattern 44 | # -e 's,foo,bar,g' == substitute foo for bar globally. \1 is the first capture from foo 45 | # -e '/latest/d' == delete lines matching latest 46 | if mb_version: 47 | version = mb_version 48 | else: 49 | html = subprocess.Popen(["wget", "http://hackage.haskell.org/packages/archive/%s/" % name, "-O", "-"], stdout=subprocess.PIPE).communicate()[0] 50 | versions = re.findall(r'\\<\/td\>\\', html) 51 | versions = sorted(filter(lambda v: v != "latest", versions)) 52 | version = versions[-1] 53 | 54 | downloads_dir = os.path.expanduser("~/Downloads") 55 | target_dir = os.path.join(downloads_dir, name + "-" + version) 56 | 57 | # Create if not present 58 | if not os.path.exists(target_dir): 59 | archive_file = os.path.join(downloads_dir, name + "-" + version + ".tar.gz") 60 | 61 | # Download if not present 62 | if not os.path.exists(archive_file): 63 | subprocess.check_call(["wget", "http://hackage.haskell.org/packages/archive/%(name)s/%(version)s/%(name)s-%(version)s.tar.gz" % { "name" : name, "version" : version }, "-O", archive_file]) 64 | 65 | # Extract 66 | subprocess.check_call(["tar", "-xzf", archive_file], cwd=downloads_dir) 67 | 68 | setup_file = os.path.exists(os.path.join(target_dir, "Setup.hs")) and "Setup.hs" or "Setup.lhs" 69 | 70 | # Build the Setup program. Strictly speaking we could use runghc, but this is slightly more reliable 71 | # because I've observed problems where a GHC extra library won't be present 72 | build_setup = True 73 | if build_setup: 74 | subprocess.check_call(["ghc", "--make", setup_file, "-o", "setup"], cwd=target_dir) 75 | 76 | # Actually build the package 77 | cabal = lambda command, sudo=False: subprocess.check_call((sudo and ["sudo"] or []) + (build_setup and ["./setup"] or ["runghc", setup_file]) + command, cwd=target_dir) 78 | if clean: 79 | cabal(["clean"]) 80 | cabal(["configure"] + configureargs) 81 | cabal(["build"]) 82 | cabal(["install"], sudo=("--user" not in configureargs)) 83 | -------------------------------------------------------------------------------- /renameanime.hs: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/runghc 2 | 3 | {-# OPTIONS_GHC -XPatternSignatures #-} 4 | 5 | import System(getArgs) 6 | import System.Directory(renameFile) 7 | import System.FilePath 8 | 9 | import Numeric(readHex) 10 | 11 | import Data.Char(toLower) 12 | import Data.Maybe(mapMaybe) 13 | import Data.List(intersperse) 14 | 15 | import Text.ParserCombinators.Parsec 16 | import Text.ParserCombinators.Parsec.Prim 17 | import Text.ParserCombinators.Parsec.Combinator 18 | import Text.ParserCombinators.Parsec.Char 19 | 20 | square_bracketed = between (char '[') (char ']') 21 | round_bracketed = between (char '[') (char ']') 22 | seperators = spaces <|> skipMany1 (char '_') 23 | 24 | word = many1 alphaNum 25 | hexWord = many1 hexDigit 26 | sentence = word `sepBy1` seperators >>= (return . concat . (intersperse " ")) "sentence" 27 | 28 | group = square_bracketed sentence "group" 29 | series = sentence "series name" 30 | episode_number_string = many1 digit "episode number" 31 | additional_info = round_bracketed sentence "additional info" 32 | checksum_string = square_bracketed hexWord "checksum" 33 | 34 | type Group = String 35 | type Checksum = Integer 36 | 37 | data Episode = Episode { 38 | ep_group :: Maybe Group, 39 | ep_series :: String, 40 | ep_number :: Integer, 41 | ep_checksum :: Maybe Checksum } 42 | 43 | episode = do 44 | maybe_group :: Maybe Group <- optionMaybe group 45 | optional seperators 46 | series <- series 47 | optional seperators 48 | char '-' 49 | optional seperators 50 | episode_number_string <- episode_number_string 51 | optional seperators 52 | optional (additional_info `sepBy1` (optional seperators)) 53 | optional seperators 54 | maybe_checksum_string <- optionMaybe checksum_string 55 | return $ Episode { 56 | ep_group = maybe_group, 57 | ep_series = series, 58 | ep_number = read episode_number_string, 59 | ep_checksum = fmap (fst . head . readHex) maybe_checksum_string 60 | } 61 | 62 | parseEpisode :: FilePath -> Either ParseError Episode 63 | parseEpisode filename = parse episode filename filename 64 | 65 | episodeToFileName :: Episode -> String 66 | episodeToFileName (Episode { ep_series = series, ep_number = number }) = series ++ " - " ++ (show number) 67 | 68 | 69 | readShouldProceed :: IO Bool 70 | readShouldProceed = do 71 | putStr "Continue [yn]: " 72 | result <- getLine 73 | case (map toLower result) of 74 | "y" -> return True 75 | "n" -> return False 76 | _ -> readShouldProceed 77 | 78 | unzipEithers :: [Either a b] -> ([a], [b]) 79 | unzipEithers = foldr unzipEitherF ([], []) 80 | where unzipEitherF (Left left) (lefts, rights) = (left:lefts, rights) 81 | unzipEitherF (Right right) (lefts, rights) = (lefts, right:rights) 82 | 83 | main :: IO () 84 | main = do 85 | to_rename <- getArgs 86 | let (errors, renamings) = unzipEithers [either Left (Right . obtainFilenames) either_parsed_episode 87 | | path <- to_rename 88 | , let (directory, filename) = splitFileName path 89 | (filename_root, extension) = splitExtensions filename 90 | either_parsed_episode = parseEpisode filename_root 91 | obtainFilenames parsed_episode = (path, directory `combine` ((episodeToFileName parsed_episode) `addExtension` extension))] 92 | 93 | if (length errors) > 0 94 | then do 95 | putStrLn "Could not understand the following:" 96 | mapM_ print errors 97 | putStrLn "" 98 | else return () 99 | 100 | if (length renamings) > 0 101 | then do 102 | putStrLn "The proposed changes are as follows:" 103 | mapM_ putStrLn (map (\(old, new) -> old ++ " -> " ++ new) renamings) 104 | should_proceed <- readShouldProceed 105 | 106 | if should_proceed 107 | then mapM_ (uncurry renameFile) renamings 108 | else return () 109 | else putStrLn "There is nothing to do!" -------------------------------------------------------------------------------- /ec2-proxy: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | # ========= 4 | # EC2 Proxy 5 | # ========= 6 | # 7 | # Getting Started 8 | # =============== 9 | # 10 | # To set this up: 11 | # 12 | # 1. Run: 13 | # ec2-authorize default -p 22 14 | # ec2-authorize default -p 3128 15 | # 16 | # 2. Install: 17 | # sudo gem install amazon-ec2 net-ssh 18 | # 19 | # 3. Change the constants immediately below as appropriate for your setup: 20 | # 21 | # 22 | # Credits 23 | # ======= 24 | # 25 | # Based on manual procedure at http://www.softwarevoices.com/archives/54-ssh-tunnel-to-Amazon-EC2-as-a-temporary-web-proxy-for-privacy-and-security.html 26 | # EC2 gem usage based on http://fushizen.net/~bd/ec2-backup-scrubbed.rb.txt 27 | 28 | # Useful configuration 29 | KEYPAIR = "ec2-key" 30 | IMAGE_ID = "ami-5647a33f" # ec2-public-images/fedora-8-i386-base-v1.08.manifest.xml 31 | KEYS = [File.expand_path("~/.ec2/id_rsa-" + KEYPAIR)] 32 | 33 | 34 | require 'EC2' 35 | require 'net/ssh' 36 | 37 | def wait_forever() 38 | while true 39 | sleep 5 40 | end 41 | end 42 | 43 | def fancy_sleep(seconds) 44 | (1..seconds).each { |i| 45 | sleep 1 46 | print "." 47 | $stdout.flush 48 | } 49 | end 50 | 51 | 52 | # Connect to EC2 53 | puts("[*] Connecting to EC2") 54 | access_key_id = ENV['AMAZON_ACCESS_KEY_ID'] 55 | secret_access_key = ENV['AMAZON_SECRET_ACCESS_KEY'] 56 | ec2 = EC2::Base.new(:access_key_id => access_key_id, :secret_access_key => secret_access_key) 57 | 58 | # Start the instance 59 | puts("[*] Starting instance of image #{IMAGE_ID}") 60 | response = ec2.run_instances(:image_id => IMAGE_ID, :min_count => 1, :max_count => 1, :key_name => KEYPAIR) 61 | instance_id = response.instancesSet.item[0].instanceId 62 | 63 | # Make sure that we kill the instance when the script gets killed 64 | at_exit { 65 | puts("[*] Terminating instance #{instance_id}") 66 | (1..5).each { |i| 67 | ec2.terminate_instances(:instance_id => [instance_id]) 68 | sleep 1 69 | } 70 | } 71 | 72 | # Wait for the instance to come up 73 | puts("[*] Waiting for instance") 74 | instance_state = nil 75 | while true 76 | fancy_sleep(5) 77 | response = ec2.describe_instances(:instance_id => [instance_id]) 78 | instance_state = response.reservationSet.item[0].instancesSet.item[0].instanceState.name 79 | puts " #{instance_id} is #{instance_state}" 80 | break unless instance_state == "pending" 81 | end 82 | 83 | # Check that the instance hasn't failed during startup 84 | if instance_state != "running" 85 | puts "[*] Unexpected state: #{instance_state}, terminating and aborting" 86 | exit 1 87 | end 88 | 89 | # Retrieve DNS name and wait for SSH to start up 90 | instance_dns_name = response.reservationSet.item[0].instancesSet.item[0].dnsName 91 | puts "[*] Instance up at #{instance_dns_name}, waiting for SSH" 92 | fancy_sleep(30) 93 | puts " attempting to connect" 94 | 95 | # Dial-in to the newly built instance using the private key 96 | puts "[*] Connecting via SSH with keys #{KEYS.join(" ")}" 97 | Net::SSH.start(instance_dns_name, 'root', :keys => KEYS) do |ssh| 98 | # A helper to execute a command showing it's output on stdout/stderr 99 | # NB: due to weird-ass Ruby scoping rules I can't use ssh from the enclosing context 100 | def exec_directly!(ssh, command) 101 | channel = ssh.open_channel do |ch| 102 | ch.exec(command) do |ch, success| 103 | raise "Could not execute command '#{command}'" unless success 104 | puts("#{command}:") 105 | 106 | ch.on_data do |c, data| 107 | $stdout.print data 108 | end 109 | 110 | ch.on_extended_data do |c, type, data| 111 | $stderr.print data 112 | end 113 | end 114 | end 115 | 116 | channel.wait 117 | end 118 | 119 | puts(" [*] Installing prerequisites") 120 | exec_directly!(ssh, "yum install -y squid") 121 | 122 | # Start the proxy in the background 123 | puts(" [*] Starting proxy") 124 | exec_directly!(ssh, "service squid start") 125 | 126 | # Forward the port 127 | puts(" [*] Forwarding port - terminate the script when you are down browsing") 128 | ssh.forward.local(3128, "localhost", 3128) 129 | #ssh.loop { true } 130 | 131 | # Show the log file 132 | exec_directly!(ssh, "tail -f /var/log/squid/access.log") 133 | end 134 | 135 | wait_forever() -------------------------------------------------------------------------------- /ghc-nofib-dump: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | # 3 | 4 | import sys 5 | import os 6 | import glob 7 | import getopt 8 | from itertools import takewhile 9 | 10 | 11 | def path_as_list(path): 12 | previous_head = None 13 | (head, tail) = os.path.split(path) 14 | path_list = [] 15 | while head != previous_head: 16 | path_list = [tail] + path_list 17 | previous_head = head 18 | (head, tail) = os.path.split(head) 19 | 20 | path_list = [head] + path_list 21 | return path_list 22 | 23 | def breakwhere(predicate, iterable): 24 | left, right = [], [] 25 | in_left = True 26 | for x in iterable: 27 | if in_left and predicate(x): 28 | in_left = False 29 | 30 | if in_left: 31 | left.append(x) 32 | else: 33 | right.append(x) 34 | return (left, right) 35 | 36 | 37 | def usage(program): 38 | print "Usage:", program, "[--split] core/benchmark [variant-base-name] variant-code" 39 | 40 | def main(program, arguments): 41 | options, args = getopt.getopt(arguments, "", ["split", "stage="]) 42 | do_split = False 43 | stage = 2 44 | for key, arg in options: 45 | if key == "--split": 46 | do_split = True 47 | elif key == "--stage": 48 | stage = int(arg) 49 | else: 50 | raise Exception("Unrecognised option: " + key) 51 | 52 | if len(args) == 2: 53 | mode = args[0] 54 | supplied_variant_base_name = None 55 | variant_code = args[1] 56 | elif len(args) == 3: 57 | mode = args[0] 58 | supplied_variant_base_name = args[1] 59 | variant_code = args[2] 60 | else: 61 | usage(program) 62 | return 2 63 | 64 | ghc_opts = '-O ' + os.environ.get("EXTRA_HC_OPTS", '') 65 | 66 | current_directory = os.getcwd() 67 | full_directory_path = path_as_list(current_directory) 68 | (ghc_root_from_nofib, nofib_relative) = breakwhere(lambda x: x == 'nofib', full_directory_path) 69 | (ghc_root_from_libraries, libraries_relative) = breakwhere(lambda x: x == 'libraries', full_directory_path) 70 | 71 | if ghc_root_from_nofib != full_directory_path: 72 | is_nofib = True 73 | ghc_root = os.path.join(*ghc_root_from_nofib) 74 | output_relative = len(nofib_relative) > 1 and os.path.join(*nofib_relative[1:]) or "" # Drop the 'nofib' prefix here.. 75 | elif ghc_root_from_libraries != full_directory_path: 76 | is_nofib = False 77 | ghc_root = os.path.join(*ghc_root_from_libraries) 78 | output_relative = os.path.join(*libraries_relative) # ..but don't drop the 'libraries' prefix here 79 | else: 80 | raise Exception("Could not find GHC root!") 81 | 82 | ghc = os.path.join(ghc_root, 'ghc', 'stage' + str(stage) + '-inplace', 'ghc') 83 | investigation_root, inferred_variant_base_name = os.path.split(ghc_root) 84 | 85 | if supplied_variant_base_name: 86 | variant_base_name = supplied_variant_base_name 87 | else: 88 | variant_base_name = inferred_variant_base_name 89 | 90 | variant = variant_base_name + '-' + variant_code 91 | print "Variant:", variant, "Stage:", stage 92 | 93 | if mode == 'core': 94 | ghc_opts += " -fforce-recomp -fno-code -c -dverbose-core2core -ddump-stg" 95 | print "Options:", ghc_opts 96 | 97 | output_root = os.path.join(investigation_root, 'results', 'code', variant, output_relative) 98 | print "Output to", output_root 99 | 100 | if not os.path.exists(output_root): 101 | os.makedirs(output_root) 102 | 103 | for source_path in glob.glob(os.path.join(current_directory, '*.hs')) + glob.glob(os.path.join(current_directory, '*.lhs')): 104 | source_file = os.path.basename(source_path) 105 | print "Compiling", source_file 106 | 107 | output_path = os.path.join(output_root, source_file) 108 | output_file = open(output_path, 'w') 109 | lines = os.popen(ghc + ' ' + ghc_opts + ' ' + source_path + ' 2>&1', 'r').readlines() 110 | output_file.writelines(lines) 111 | output_file.close() 112 | 113 | if do_split: 114 | print "Splitting" 115 | os.system('ghc-dump-split ' + output_path) 116 | elif mode == 'benchmark': 117 | if not is_nofib or output_relative: 118 | raise Exception("Can only benchmark if we are in the nofib root directory!") 119 | 120 | print "Options:", ghc_opts 121 | 122 | output_path = os.path.join(investigation_root, 'results', variant + '.log') 123 | print "Output to", output_path 124 | 125 | command = 'make clean && make boot && HC="' + ghc + '" EXTRA_HC_OPTS="' + ghc_opts + '" make -k >& ' + output_path 126 | print "Running:", command 127 | os.system(command) 128 | else: 129 | usage(program) 130 | return 2 131 | 132 | return 0 133 | 134 | if __name__ == "__main__": 135 | sys.exit(main(sys.argv[0], sys.argv[1:])) -------------------------------------------------------------------------------- /summarise: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | {-# LANGUAGE PatternGuards #-} 3 | import Control.Arrow ((&&&)) 4 | 5 | import Data.Char 6 | import Data.List 7 | import Data.List.Split 8 | import Data.Maybe 9 | 10 | import Numeric 11 | 12 | main = interact summarise 13 | 14 | {- 15 | append & 0.0s & 0.88 & 0.86 & 0.85 & 1.29 & 0.0s & 1.00 & 0.89 & 0.87 & 3.24 & 0.0s & 1.03 & 0.92 & 0.87 & 3.24 \\ 16 | exp3\_8 & 0.8s & 1.34 & 0.96 & 1.00 & 6.59 & 8.7s & 2.85 & 0.59 & 0.67 & 85.17 & 15.4s & 3.35 & 0.55 & 0.67 & \!\!\!\!\!114.31 \\ 17 | sumtree & 0.1s & 1.01 & 0.13 & 0.00 & 1.50 & 0.0s & 1.02 & 0.14 & 0.00 & 2.46 & 0.2s & 1.24 & 0.68 & 0.93 & 9.09 \\ 18 | tak & 0.1s & 0.86 & 0.81 & 655.04 & 0.59 & 0.1s & 1.34 & 0.74 & 18644.34 & 7.22 & N/A & N/A & N/A & N/A & N/A \\ 19 | treeflip & 0.1s & 1.03 & 0.56 & 0.45 & 1.99 & 0.0s & 1.02 & 0.13 & 0.05 & 2.53 & 0.2s & 1.47 & 0.81 & 0.91 & 19.40 \\ 20 | wheel-sieve1 & N/A & N/A & N/A & N/A & N/A & 22.2s & 7.87 & 0.90 & 0.53 & 71.07 & 16.8s & 10.61 & 1.00 & 0.54 & 71.47 \\ 21 | -} 22 | 23 | {- 24 | append & 0.0s & 0.88 & 0.86 & 0.85 & 1.29 & 0.0s & 1.00 & 0.89 & 0.87 & 3.24 & 0.0s & 1.03 & 0.92 & 0.87 & 3.24 \\ 25 | bernouilli & 5.8s & 1.63 & 0.98 & 0.97 & 3.76 & 0.1s & 1.07 & 0.98 & 0.95 & 2.26 & 0.1s & 1.07 & 0.98 & 0.95 & 2.24 \\ 26 | digitsofe2 & 4.2s & 1.24 & 0.32 & 0.46 & 1.15 & 0.1s & 1.07 & 1.17 & 1.08 & 2.81 & 0.1s & 1.08 & 1.18 & 1.09 & 2.79 \\ 27 | exp3\_8 & 0.8s & 1.34 & 0.96 & 1.00 & 6.59 & 8.7s & 2.85 & 0.59 & 0.67 & 85.17 & 15.4s & 3.35 & 0.55 & 0.67 & \!\!\!\!\!114.31 \\ 28 | factorial & 0.0s & 0.99 & 0.95 & 1.00 & 0.77 & 0.0s & 0.96 & 0.99 & 1.00 & 1.00 & 0.0s & 0.98 & 1.05 & 1.00 & 0.91 \\ 29 | primes & 0.1s & 1.04 & 0.63 & 0.99 & 0.79 & 0.0s & 0.98 & 0.72 & 1.07 & 0.87 & 0.0s & 0.98 & 0.71 & 1.07 & 0.80 \\ 30 | raytracer & 0.0s & 1.00 & 0.57 & 0.44 & 1.54 & 0.0s & 1.00 & 0.52 & 0.45 & 1.37 & 0.0s & 1.00 & 0.51 & 0.45 & 1.38 \\ 31 | rfib & 0.0s & 0.94 & 0.93 & 1.00 & 0.87 & 0.0s & 1.00 & 0.67 & 1.00 & 2.00 & 0.0s & 1.00 & 0.67 & 1.01 & 2.00 \\ 32 | sumsquare & 19.5s & 1.45 & 0.36 & 0.00 & 7.38 & 2.3s & 1.97 & 0.05 & 0.00 & 20.78 & 3.0s & 1.95 & 0.06 & 0.00 & 21.15 \\ 33 | sumtree & 0.1s & 1.01 & 0.13 & 0.00 & 1.50 & 0.0s & 1.02 & 0.14 & 0.00 & 2.46 & 0.2s & 1.24 & 0.68 & 0.93 & 9.09 \\ 34 | tak & 0.1s & 0.86 & 0.81 & 655.04 & 0.59 & 0.1s & 1.34 & 0.74 & 18644.34 & 7.22 & N/A & N/A & N/A & N/A & N/A \\ 35 | treeflip & 0.1s & 1.03 & 0.56 & 0.45 & 1.99 & 0.0s & 1.02 & 0.13 & 0.05 & 2.53 & 0.2s & 1.47 & 0.81 & 0.91 & 19.40 \\ 36 | wheel-sieve1 & N/A & N/A & N/A & N/A & N/A & 22.2s & 7.87 & 0.90 & 0.53 & 71.07 & 16.8s & 10.61 & 1.00 & 0.54 & 71.47 \\ 37 | wheel-sieve2 & N/A & N/A & N/A & N/A & N/A & 1.3s & 3.16 & 1.55 & 1.21 & 18.35 & 1.4s & 3.06 & 1.55 & 1.21 & 18.24 \\ 38 | x2n1 & 0.1s & 1.06 & 0.92 & 0.99 & 1.39 & 0.0s & 1.10 & 0.99 & 0.95 & 1.21 & 0.0s & 1.15 & 0.99 & 0.95 & 1.18 \\ 39 | -} 40 | 41 | summarise :: String -> String 42 | summarise = pretty . summaries . tabular 43 | 44 | tabular :: String -> [[String]] 45 | tabular = map (splitOn "& " . dropSuffix "\\\\") . lines 46 | 47 | summaries :: [[String]] -> [[String]] 48 | summaries = transpose . (uncurry (:) . ((summaryHeader . head) &&& (map summary . tail))) . transpose 49 | 50 | summaryHeader :: [String] -> [String] 51 | summaryHeader ls = ls ++ padFieldsToMatch ls ["Average", "Minimum", "Maximum"] 52 | 53 | summary :: [String] -> [String] 54 | summary ls 55 | | any ("s" `isSuffixOf`) (map strip ls) 56 | , let xs = readMany (map (dropLast 1 . strip) ls) :: [Double] 57 | = ls ++ padFieldsToMatch ls [showDP 1 (mean xs) ++ "s", showDP 1 (minimum xs) ++ "s", showDP 1 (maximum xs) ++ "s"] 58 | | let xs = readManyWithDefault 1.0 (map (strip . replace "\\!" "") ls) :: [Double] 59 | = ls ++ padFieldsToMatch ls [showDP 2 (mean xs), showDP 2 (minimum xs), showDP 2 (maximum xs)] 60 | 61 | padFieldsToMatch :: [[a]] -> [String] -> [String] 62 | padFieldsToMatch ls = map (padTo (maximum (map length ls))) 63 | 64 | padTo :: Int -> String -> String 65 | padTo n xs = take (n `max` length xs) (xs ++ repeat ' ') 66 | 67 | 68 | readMany :: Read a => [String] -> [a] 69 | readMany xs = [y | x <- xs, Just y <- [readOne x]] 70 | 71 | readManyWithDefault :: Read a => a -> [String] -> [a] 72 | readManyWithDefault def xs = [fromMaybe def (readOne x) | x <- xs] 73 | 74 | readOne :: Read a => String -> Maybe a 75 | readOne s = case reads s of ((x, []):_) -> Just x; _ -> Nothing 76 | 77 | dropLast :: Int -> [a] -> [a] 78 | dropLast n = reverse . drop n . reverse 79 | 80 | liat :: [a] -> [a] 81 | liat = reverse . tail . reverse 82 | 83 | pretty :: [[String]] -> String 84 | pretty = unlines . map ((++ "\\\\") . intercalate "& ") 85 | 86 | mean :: Fractional a => [a] -> a 87 | mean xs = sum xs / fromIntegral (length xs) 88 | 89 | 90 | strip :: String -> String 91 | strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse 92 | 93 | 94 | showDP :: RealFloat a => Int -> a -> String 95 | showDP n x = showFFloat (Just n) x "" 96 | 97 | 98 | replace::(Eq a) => [a] -> [a] -> [a] -> [a] 99 | replace [] newSub list = join newSub list 100 | where 101 | join :: [a] -> [a] -> [a] 102 | join glue [h] = [h] 103 | join glue (h:ts) = h : glue ++ join glue ts 104 | join _ [] = [] 105 | replace oldSub newSub list = _replace list 106 | where 107 | _replace list@(h:ts) = if isPrefixOf oldSub list 108 | then newSub ++ _replace (drop len list) 109 | else h : _replace ts 110 | 111 | _replace [] = [] 112 | len = length oldSub 113 | 114 | 115 | dropSuffix :: Eq a => [a] -> [a] -> [a] 116 | dropSuffix what xs | what `isSuffixOf` xs = dropLast (length what) xs 117 | | otherwise = xs 118 | -------------------------------------------------------------------------------- /ec2-tunnel: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | # ========== 4 | # EC2 Tunnel 5 | # ========== 6 | # 7 | # Important Notes 8 | # =============== 9 | # 10 | # This script will overwrite your openvpn.conf file! 11 | # 12 | # 13 | # Getting Started 14 | # =============== 15 | # 16 | # To set this up: 17 | # 18 | # 1. Run: 19 | # ec2-authorize default -p 22 20 | # ec2-authorize default -p 1194 -P udp 21 | # 22 | # 2. Install: 23 | # sudo gem install amazon-ec2 net-ssh 24 | # 25 | # 3. Change the constants immediately below as appropriate for your setup: 26 | # 27 | # 28 | # Credits 29 | # ======= 30 | # 31 | # Based on manual procedure at http://gist.github.com/3997 32 | # EC2 gem usage based on http://fushizen.net/~bd/ec2-backup-scrubbed.rb.txt 33 | 34 | # Useful configuration 35 | KEYPAIR = "ec2-key" 36 | IMAGE_ID = "ami-5647a33f" # ec2-public-images/fedora-8-i386-base-v1.08.manifest.xml 37 | KEYS = [File.expand_path("~/.ec2/id_rsa-" + KEYPAIR)] 38 | 39 | AWS_NAMESERVER = "172.16.0.23" 40 | 41 | # Esoteric VPN configuration 42 | OPENVPN_CONF = File.expand_path("~/Library/openvpn/openvpn.conf") 43 | VPN_DEV = "tun" 44 | VPN_PROTO = "udp" 45 | VPN_PORT = "1194" 46 | VPN_IFCONFIG_LIST = ["10.4.0.2", "10.4.0.1"] 47 | VPN_REDIRECT_GATEWAY = "def1" 48 | 49 | 50 | require 'tempfile' 51 | require 'EC2' 52 | require 'net/ssh' 53 | 54 | def wait_forever() 55 | while true 56 | sleep 5 57 | end 58 | end 59 | 60 | def fancy_sleep(seconds) 61 | (1..seconds).each { |i| 62 | sleep 1 63 | print "." 64 | $stdout.flush 65 | } 66 | end 67 | 68 | # Preflight checks 69 | begin 70 | File.open(OPENVPN_CONF, 'w') {|f| } 71 | rescue e 72 | puts("OpenVPN configuration file not accessible at #{OPENVPN_CONF}:\r\n$!") 73 | exit 1 74 | end 75 | 76 | # Connect to EC2 77 | puts("[*] Connecting to EC2") 78 | access_key_id = ENV['AMAZON_ACCESS_KEY_ID'] 79 | secret_access_key = ENV['AMAZON_SECRET_ACCESS_KEY'] 80 | ec2 = EC2::Base.new(:access_key_id => access_key_id, :secret_access_key => secret_access_key) 81 | 82 | # Start the instance 83 | puts("[*] Starting instance of image #{IMAGE_ID}") 84 | response = ec2.run_instances(:image_id => IMAGE_ID, :min_count => 1, :max_count => 1, :key_name => KEYPAIR) 85 | instance_id = response.instancesSet.item[0].instanceId 86 | 87 | # Make sure that we kill the instance when the script gets killed 88 | at_exit { 89 | puts("[*] Terminating instance #{instance_id}") 90 | (1..5).each { |i| 91 | ec2.terminate_instances(:instance_id => [instance_id]) 92 | sleep 1 93 | } 94 | } 95 | 96 | # Wait for the instance to come up 97 | puts("[*] Waiting for instance") 98 | instance_state = nil 99 | while true 100 | fancy_sleep(5) 101 | response = ec2.describe_instances(:instance_id => [instance_id]) 102 | instance_state = response.reservationSet.item[0].instancesSet.item[0].instanceState.name 103 | puts " #{instance_id} is #{instance_state}" 104 | break unless instance_state == "pending" 105 | end 106 | 107 | # Check that the instance hasn't failed during startup 108 | if instance_state != "running" 109 | puts "[*] Unexpected state: #{instance_state}, terminating and aborting" 110 | exit 1 111 | end 112 | 113 | # Retrieve DNS name and wait for SSH to start up 114 | instance_dns_name = response.reservationSet.item[0].instancesSet.item[0].dnsName 115 | puts "[*] Instance up at #{instance_dns_name}, waiting for SSH" 116 | fancy_sleep(30) 117 | puts " attempting to connect" 118 | 119 | # Prepare a temporary storage place for the secret key 120 | secret_key_tempfile = Tempfile.new('vpnsecretkey') 121 | 122 | # Make sure that we kill the keyfile when the script gets killed 123 | at_exit { 124 | secret_key_tempfile.close!() 125 | } 126 | 127 | # Dial-in to the newly built instance using the private key 128 | puts "[*] Connecting via SSH with keys #{KEYS.join(" ")}" 129 | Net::SSH.start(instance_dns_name, 'root', :keys => KEYS) do |ssh| 130 | # A helper to execute a command showing it's output on stdout/stderr 131 | # NB: due to weird-ass Ruby scoping rules I can't use ssh from the enclosing context 132 | def exec_directly!(ssh, command) 133 | channel = ssh.open_channel do |ch| 134 | ch.exec(command) do |ch, success| 135 | raise "Could not execute command '#{command}'" unless success 136 | puts("#{command}:") 137 | 138 | ch.on_data do |c, data| 139 | $stdout.print data 140 | end 141 | 142 | ch.on_extended_data do |c, type, data| 143 | $stderr.print data 144 | end 145 | end 146 | end 147 | 148 | channel.wait 149 | end 150 | 151 | puts(" [*] Installing prerequisites") 152 | exec_directly!(ssh, "yum install -y openvpn") 153 | exec_directly!(ssh, "yum install -y screen") 154 | 155 | # Retrieve secret key and store it locally 156 | puts(" [*] Generating and retrieving secret key") 157 | exec_directly!(ssh, "openvpn --genkey --secret ~/secret.key") 158 | secret_key_tempfile.write("cat ~/secret.key") 159 | secret_key_tempfile.flush() 160 | 161 | # Get new openvpn.conf contents 162 | new_openvpn_conf_contents = " 163 | dev #{VPN_DEV} 164 | proto #{VPN_PROTO} 165 | port #{VPN_PORT} 166 | remote #{instance_dns_name} 167 | ifconfig #{VPN_IFCONFIG_LIST.join(" ")} 168 | secret #{secret_key_tempfile.path()} 169 | redirect-gateway #{VPN_REDIRECT_GATEWAY} 170 | persist-key 171 | persist-tun 172 | " 173 | 174 | # Write new conf file 175 | puts("[*] Setting up local VPN configuration") 176 | File.open(OPENVPN_CONF, 'w') {|f| f.write(new_openvpn_conf_contents) } 177 | 178 | # Set up the VPN 179 | puts("[*] Setting up remote VPN configuration") 180 | exec_directly!(ssh, "modprobe tun") 181 | exec_directly!(ssh, "modprobe iptable_nat") 182 | exec_directly!(ssh, "echo 1 > /proc/sys/net/ipv4/ip_forward") 183 | exec_directly!(ssh, "iptables -t nat -A POSTROUTING -s #{VPN_IFCONFIG_LIST[0]}/2 -o eth0 -j MASQUERADE") 184 | 185 | # Start the VPN 186 | puts(" [*] Starting VPN in background") 187 | exec_directly!(ssh, "screen -md openvpn --proto #{VPN_PROTO} --port #{VPN_PORT} --dev #{VPN_DEV} --ifconfig #{VPN_IFCONFIG_LIST.join(" ")} --verb 1 --secret ~/secret.key --push 'redirect-gateway #{VPN_REDIRECT_GATEWAY}' --push 'dhcp-option DNS #{AWS_NAMESERVER}'") 188 | end 189 | 190 | puts("[*] Finished setup - use your openvpn client to initiate the connection, then disconnect and kill this process when you are done") 191 | wait_forever() --------------------------------------------------------------------------------