# HG changeset patch # User Robert McIntyre # Date 1282691205 14400 # Node ID f952052e37b7e22ac2c39afb590e57a2c8f528fa # Parent ef7dbbd6452cdaa9c8c983f76d4c3c4af136f681 trying a fix. diff -r ef7dbbd6452c -r f952052e37b7 graster/.#signer4laser2x1.png.raster.gmask --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/.#signer4laser2x1.png.raster.gmask Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +r@RLM.8437:1282362081 \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/config.yml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/config.yml Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,10 @@ +feed: 120 +dpi: [500, 500] +offset: [1.0, 1.0] +cut_feed: 20 +on_range: [0.0, 0.5] +corner_radius: 0 +overshoot: 0.5 +tile_size: [false, false] +repeat: [1, 1] +tile_spacing: [0.125, 0.125] diff -r ef7dbbd6452c -r f952052e37b7 graster/graster-example.tgz Binary file graster/graster-example.tgz has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/HEAD --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/HEAD Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +ref: refs/heads/master diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/config --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/config Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,11 @@ +[core] + repositoryformatversion = 0 + filemode = true + bare = false + logallrefupdates = true +[remote "origin"] + fetch = +refs/heads/*:refs/remotes/origin/* + url = http://github.com/jedediah/graster.git +[branch "master"] + remote = origin + merge = refs/heads/master diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/description --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/description Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +Unnamed repository; edit this file 'description' to name the repository. diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/hooks/applypatch-msg.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/hooks/applypatch-msg.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,15 @@ +#!/bin/sh +# +# An example hook script to check the commit log message taken by +# applypatch from an e-mail message. +# +# The hook should exit with non-zero status after issuing an +# appropriate message if it wants to stop the commit. The hook is +# allowed to edit the commit message file. +# +# To enable this hook, rename this file to "applypatch-msg". + +. git-sh-setup +test -x "$GIT_DIR/hooks/commit-msg" && + exec "$GIT_DIR/hooks/commit-msg" ${1+"$@"} +: diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/hooks/commit-msg.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/hooks/commit-msg.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,24 @@ +#!/bin/sh +# +# An example hook script to check the commit log message. +# Called by git-commit with one argument, the name of the file +# that has the commit message. The hook should exit with non-zero +# status after issuing an appropriate message if it wants to stop the +# commit. The hook is allowed to edit the commit message file. +# +# To enable this hook, rename this file to "commit-msg". + +# Uncomment the below to add a Signed-off-by line to the message. +# Doing this in a hook is a bad idea in general, but the prepare-commit-msg +# hook is more suited to it. +# +# SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p') +# grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1" + +# This example catches duplicate Signed-off-by lines. + +test "" = "$(grep '^Signed-off-by: ' "$1" | + sort | uniq -c | sed -e '/^[ ]*1[ ]/d')" || { + echo >&2 Duplicate Signed-off-by lines. + exit 1 +} diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/hooks/post-commit.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/hooks/post-commit.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,8 @@ +#!/bin/sh +# +# An example hook script that is called after a successful +# commit is made. +# +# To enable this hook, rename this file to "post-commit". + +: Nothing diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/hooks/post-receive.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/hooks/post-receive.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,15 @@ +#!/bin/sh +# +# An example hook script for the "post-receive" event. +# +# The "post-receive" script is run after receive-pack has accepted a pack +# and the repository has been updated. It is passed arguments in through +# stdin in the form +# +# For example: +# aa453216d1b3e49e7f6f98441fa56946ddcd6a20 68f7abf4e6f922807889f52bc043ecd31b79f814 refs/heads/master +# +# see contrib/hooks/ for a sample, or uncomment the next line and +# rename the file to "post-receive". + +#. /usr/share/doc/git-core/contrib/hooks/post-receive-email diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/hooks/post-update.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/hooks/post-update.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,8 @@ +#!/bin/sh +# +# An example hook script to prepare a packed repository for use over +# dumb transports. +# +# To enable this hook, rename this file to "post-update". + +exec git-update-server-info diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/hooks/pre-applypatch.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/hooks/pre-applypatch.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,14 @@ +#!/bin/sh +# +# An example hook script to verify what is about to be committed +# by applypatch from an e-mail message. +# +# The hook should exit with non-zero status after issuing an +# appropriate message if it wants to stop the commit. +# +# To enable this hook, rename this file to "pre-applypatch". + +. git-sh-setup +test -x "$GIT_DIR/hooks/pre-commit" && + exec "$GIT_DIR/hooks/pre-commit" ${1+"$@"} +: diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/hooks/pre-commit.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/hooks/pre-commit.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,46 @@ +#!/bin/sh +# +# An example hook script to verify what is about to be committed. +# Called by git-commit with no arguments. The hook should +# exit with non-zero status after issuing an appropriate message if +# it wants to stop the commit. +# +# To enable this hook, rename this file to "pre-commit". + +if git-rev-parse --verify HEAD >/dev/null 2>&1 +then + against=HEAD +else + # Initial commit: diff against an empty tree object + against=4b825dc642cb6eb9a060e54bf8d69288fbee4904 +fi + +# If you want to allow non-ascii filenames set this variable to true. +allownonascii=$(git config hooks.allownonascii) + +# Cross platform projects tend to avoid non-ascii filenames; prevent +# them from being added to the repository. We exploit the fact that the +# printable range starts at the space character and ends with tilde. +if [ "$allownonascii" != "true" ] && + # Note that the use of brackets around a tr range is ok here, (it's + # even required, for portability to Solaris 10's /usr/bin/tr), since + # the square bracket bytes happen to fall in the designated range. + test "$(git diff --cached --name-only --diff-filter=A -z $against | + LC_ALL=C tr -d '[ -~]\0')" +then + echo "Error: Attempt to add a non-ascii file name." + echo + echo "This can cause problems if you want to work" + echo "with people on other platforms." + echo + echo "To be portable it is advisable to rename the file ..." + echo + echo "If you know what you are doing you can disable this" + echo "check using:" + echo + echo " git config hooks.allownonascii true" + echo + exit 1 +fi + +exec git diff-index --check --cached $against -- diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/hooks/pre-rebase.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/hooks/pre-rebase.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,169 @@ +#!/bin/sh +# +# Copyright (c) 2006, 2008 Junio C Hamano +# +# The "pre-rebase" hook is run just before "git-rebase" starts doing +# its job, and can prevent the command from running by exiting with +# non-zero status. +# +# The hook is called with the following parameters: +# +# $1 -- the upstream the series was forked from. +# $2 -- the branch being rebased (or empty when rebasing the current branch). +# +# This sample shows how to prevent topic branches that are already +# merged to 'next' branch from getting rebased, because allowing it +# would result in rebasing already published history. + +publish=next +basebranch="$1" +if test "$#" = 2 +then + topic="refs/heads/$2" +else + topic=`git symbolic-ref HEAD` || + exit 0 ;# we do not interrupt rebasing detached HEAD +fi + +case "$topic" in +refs/heads/??/*) + ;; +*) + exit 0 ;# we do not interrupt others. + ;; +esac + +# Now we are dealing with a topic branch being rebased +# on top of master. Is it OK to rebase it? + +# Does the topic really exist? +git show-ref -q "$topic" || { + echo >&2 "No such branch $topic" + exit 1 +} + +# Is topic fully merged to master? +not_in_master=`git-rev-list --pretty=oneline ^master "$topic"` +if test -z "$not_in_master" +then + echo >&2 "$topic is fully merged to master; better remove it." + exit 1 ;# we could allow it, but there is no point. +fi + +# Is topic ever merged to next? If so you should not be rebasing it. +only_next_1=`git-rev-list ^master "^$topic" ${publish} | sort` +only_next_2=`git-rev-list ^master ${publish} | sort` +if test "$only_next_1" = "$only_next_2" +then + not_in_topic=`git-rev-list "^$topic" master` + if test -z "$not_in_topic" + then + echo >&2 "$topic is already up-to-date with master" + exit 1 ;# we could allow it, but there is no point. + else + exit 0 + fi +else + not_in_next=`git-rev-list --pretty=oneline ^${publish} "$topic"` + perl -e ' + my $topic = $ARGV[0]; + my $msg = "* $topic has commits already merged to public branch:\n"; + my (%not_in_next) = map { + /^([0-9a-f]+) /; + ($1 => 1); + } split(/\n/, $ARGV[1]); + for my $elem (map { + /^([0-9a-f]+) (.*)$/; + [$1 => $2]; + } split(/\n/, $ARGV[2])) { + if (!exists $not_in_next{$elem->[0]}) { + if ($msg) { + print STDERR $msg; + undef $msg; + } + print STDERR " $elem->[1]\n"; + } + } + ' "$topic" "$not_in_next" "$not_in_master" + exit 1 +fi + +exit 0 + +################################################################ + +This sample hook safeguards topic branches that have been +published from being rewound. + +The workflow assumed here is: + + * Once a topic branch forks from "master", "master" is never + merged into it again (either directly or indirectly). + + * Once a topic branch is fully cooked and merged into "master", + it is deleted. If you need to build on top of it to correct + earlier mistakes, a new topic branch is created by forking at + the tip of the "master". This is not strictly necessary, but + it makes it easier to keep your history simple. + + * Whenever you need to test or publish your changes to topic + branches, merge them into "next" branch. + +The script, being an example, hardcodes the publish branch name +to be "next", but it is trivial to make it configurable via +$GIT_DIR/config mechanism. + +With this workflow, you would want to know: + +(1) ... if a topic branch has ever been merged to "next". Young + topic branches can have stupid mistakes you would rather + clean up before publishing, and things that have not been + merged into other branches can be easily rebased without + affecting other people. But once it is published, you would + not want to rewind it. + +(2) ... if a topic branch has been fully merged to "master". + Then you can delete it. More importantly, you should not + build on top of it -- other people may already want to + change things related to the topic as patches against your + "master", so if you need further changes, it is better to + fork the topic (perhaps with the same name) afresh from the + tip of "master". + +Let's look at this example: + + o---o---o---o---o---o---o---o---o---o "next" + / / / / + / a---a---b A / / + / / / / + / / c---c---c---c B / + / / / \ / + / / / b---b C \ / + / / / / \ / + ---o---o---o---o---o---o---o---o---o---o---o "master" + + +A, B and C are topic branches. + + * A has one fix since it was merged up to "next". + + * B has finished. It has been fully merged up to "master" and "next", + and is ready to be deleted. + + * C has not merged to "next" at all. + +We would want to allow C to be rebased, refuse A, and encourage +B to be deleted. + +To compute (1): + + git-rev-list ^master ^topic next + git-rev-list ^master next + + if these match, topic has not merged in next at all. + +To compute (2): + + git-rev-list master..topic + + if this is empty, it is fully merged to "master". diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/hooks/prepare-commit-msg.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/hooks/prepare-commit-msg.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,36 @@ +#!/bin/sh +# +# An example hook script to prepare the commit log message. +# Called by git-commit with the name of the file that has the +# commit message, followed by the description of the commit +# message's source. The hook's purpose is to edit the commit +# message file. If the hook fails with a non-zero status, +# the commit is aborted. +# +# To enable this hook, rename this file to "prepare-commit-msg". + +# This hook includes three examples. The first comments out the +# "Conflicts:" part of a merge commit. +# +# The second includes the output of "git diff --name-status -r" +# into the message, just before the "git status" output. It is +# commented because it doesn't cope with --amend or with squashed +# commits. +# +# The third example adds a Signed-off-by line to the message, that can +# still be edited. This is rarely a good idea. + +case "$2,$3" in + merge,) + perl -i.bak -ne 's/^/# /, s/^# #/#/ if /^Conflicts/ .. /#/; print' "$1" ;; + +# ,|template,) +# perl -i.bak -pe ' +# print "\n" . `git diff --cached --name-status -r` +# if /^#/ && $first++ == 0' "$1" ;; + + *) ;; +esac + +# SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p') +# grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1" diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/hooks/update.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/hooks/update.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,128 @@ +#!/bin/sh +# +# An example hook script to blocks unannotated tags from entering. +# Called by git-receive-pack with arguments: refname sha1-old sha1-new +# +# To enable this hook, rename this file to "update". +# +# Config +# ------ +# hooks.allowunannotated +# This boolean sets whether unannotated tags will be allowed into the +# repository. By default they won't be. +# hooks.allowdeletetag +# This boolean sets whether deleting tags will be allowed in the +# repository. By default they won't be. +# hooks.allowmodifytag +# This boolean sets whether a tag may be modified after creation. By default +# it won't be. +# hooks.allowdeletebranch +# This boolean sets whether deleting branches will be allowed in the +# repository. By default they won't be. +# hooks.denycreatebranch +# This boolean sets whether remotely creating branches will be denied +# in the repository. By default this is allowed. +# + +# --- Command line +refname="$1" +oldrev="$2" +newrev="$3" + +# --- Safety check +if [ -z "$GIT_DIR" ]; then + echo "Don't run this script from the command line." >&2 + echo " (if you want, you could supply GIT_DIR then run" >&2 + echo " $0 )" >&2 + exit 1 +fi + +if [ -z "$refname" -o -z "$oldrev" -o -z "$newrev" ]; then + echo "Usage: $0 " >&2 + exit 1 +fi + +# --- Config +allowunannotated=$(git config --bool hooks.allowunannotated) +allowdeletebranch=$(git config --bool hooks.allowdeletebranch) +denycreatebranch=$(git config --bool hooks.denycreatebranch) +allowdeletetag=$(git config --bool hooks.allowdeletetag) +allowmodifytag=$(git config --bool hooks.allowmodifytag) + +# check for no description +projectdesc=$(sed -e '1q' "$GIT_DIR/description") +case "$projectdesc" in +"Unnamed repository"* | "") + echo "*** Project description file hasn't been set" >&2 + exit 1 + ;; +esac + +# --- Check types +# if $newrev is 0000...0000, it's a commit to delete a ref. +zero="0000000000000000000000000000000000000000" +if [ "$newrev" = "$zero" ]; then + newrev_type=delete +else + newrev_type=$(git-cat-file -t $newrev) +fi + +case "$refname","$newrev_type" in + refs/tags/*,commit) + # un-annotated tag + short_refname=${refname##refs/tags/} + if [ "$allowunannotated" != "true" ]; then + echo "*** The un-annotated tag, $short_refname, is not allowed in this repository" >&2 + echo "*** Use 'git tag [ -a | -s ]' for tags you want to propagate." >&2 + exit 1 + fi + ;; + refs/tags/*,delete) + # delete tag + if [ "$allowdeletetag" != "true" ]; then + echo "*** Deleting a tag is not allowed in this repository" >&2 + exit 1 + fi + ;; + refs/tags/*,tag) + # annotated tag + if [ "$allowmodifytag" != "true" ] && git rev-parse $refname > /dev/null 2>&1 + then + echo "*** Tag '$refname' already exists." >&2 + echo "*** Modifying a tag is not allowed in this repository." >&2 + exit 1 + fi + ;; + refs/heads/*,commit) + # branch + if [ "$oldrev" = "$zero" -a "$denycreatebranch" = "true" ]; then + echo "*** Creating a branch is not allowed in this repository" >&2 + exit 1 + fi + ;; + refs/heads/*,delete) + # delete branch + if [ "$allowdeletebranch" != "true" ]; then + echo "*** Deleting a branch is not allowed in this repository" >&2 + exit 1 + fi + ;; + refs/remotes/*,commit) + # tracking branch + ;; + refs/remotes/*,delete) + # delete tracking branch + if [ "$allowdeletebranch" != "true" ]; then + echo "*** Deleting a tracking branch is not allowed in this repository" >&2 + exit 1 + fi + ;; + *) + # Anything else (is there anything else?) + echo "*** Update hook: unknown type of update to ref $refname of type $newrev_type" >&2 + exit 1 + ;; +esac + +# --- Finished +exit 0 diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/index Binary file graster/graster/.git/index has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/info/exclude --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/info/exclude Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,6 @@ +# git-ls-files --others --exclude-from=.git/info/exclude +# Lines that start with '#' are comments. +# For a project mostly in C, the following would be a good set of +# exclude patterns (uncomment them if you want to use them): +# *.[oa] +# *~ diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/logs/HEAD --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/logs/HEAD Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +0000000000000000000000000000000000000000 ab8a364c0ac60270552542e41675a32a71a22ac8 Robert McIntyre 1282257434 -0400 clone: from http://github.com/jedediah/graster.git diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/logs/refs/heads/master --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/logs/refs/heads/master Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +0000000000000000000000000000000000000000 ab8a364c0ac60270552542e41675a32a71a22ac8 Robert McIntyre 1282257434 -0400 clone: from http://github.com/jedediah/graster.git diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/objects/pack/pack-5656912d40e5e13e8ad82152331d45add23e8aac.idx Binary file graster/graster/.git/objects/pack/pack-5656912d40e5e13e8ad82152331d45add23e8aac.idx has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/objects/pack/pack-5656912d40e5e13e8ad82152331d45add23e8aac.pack Binary file graster/graster/.git/objects/pack/pack-5656912d40e5e13e8ad82152331d45add23e8aac.pack has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/packed-refs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/packed-refs Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,2 @@ +# pack-refs with: peeled +ab8a364c0ac60270552542e41675a32a71a22ac8 refs/remotes/origin/master diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/refs/heads/master --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/refs/heads/master Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +ab8a364c0ac60270552542e41675a32a71a22ac8 diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.git/refs/remotes/origin/HEAD --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.git/refs/remotes/origin/HEAD Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +ref: refs/remotes/origin/master diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/.gitignore --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/.gitignore Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,4 @@ +*.ngc +*.png +*.raw +*.pal diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/README.rdoc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/README.rdoc Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ += Graster \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/RMagick-2.13.1.tar.bz2 Binary file graster/graster/RMagick-2.13.1.tar.bz2 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/Rakefile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/Rakefile Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,24 @@ +begin + require 'jeweler' + Jeweler::Tasks.new do |s| + s.name = "graster" + s.description = s.summary = "G Raster!" + s.email = "joshbuddy@gmail.com" + s.homepage = "http://github.com/joshbuddy/graster" + s.authors = ["Jedediah Smith", "Joshua Hull"] + s.files = FileList["[A-Z]*", "{lib,bin}/**/*"] + s.add_dependency 'rmagick' + s.rubyforge_project = 'graster' + end + Jeweler::GemcutterTasks.new +rescue LoadError + puts "Jeweler not available. Install it with: sudo gem install technicalpickles-jeweler -s http://gems.github.com" +end + +require 'rake/rdoctask' +desc "Generate documentation" +Rake::RDocTask.new do |rd| + rd.main = "README.rdoc" + rd.rdoc_files.include("README.rdoc", "lib/**/*.rb") + rd.rdoc_dir = 'rdoc' +end diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/VERSION --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/VERSION Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +0.0.7 diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/bin/graster --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/bin/graster Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,9 @@ +#!/usr/bin/env ruby +# Tokyo cache cow command line interface script. +# Run tokyo_cache_cow -h to get more usage. +require File.dirname(__FILE__) + '/../lib/graster' + +Graster::Runner.new(ARGV).start! + + + diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/bin/gtile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/bin/gtile Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,74 @@ +#!/usr/bin/env ruby -rubygems +# Tokyo cache cow command line interface script. +# Run tokyo_cache_cow -h to get more usage. +require File.dirname(__FILE__) + '/../lib/graster' + +unless ARGV.size == 5 + puts "usage: ruby tile.rb " + exit(1) +end + +def parse_line line + nc = {} + line.gsub(/\([^)]*\)/,'').upcase.scan(/([A-Z])\s*([0-9\.]+)?/).each {|code| nc[code[0].intern] = (code[1] && code[1].to_f) } + nc +end + +def gcode ncs + ncs = [ncs] unless ncs.is_a? Array + ncs.reduce('') {|a,nc| a << (nc.map {|k,v| "#{k}#{v}" }.join(' ') + "\n") } +end + +tile_width = ARGV[1].to_f +tile_height = ARGV[2].to_f +horiz_count = ARGV[3].to_i +vert_count = ARGV[4].to_i + +header = [] +body = [] +footer = [] +state = :header + + +File.open ARGV[0] do |io| + io.each_line do |line| + if (nc = parse_line(line)) != {} + case state + when :header + if nc[:G] == 0 || nc[:G] == 1 + state = :body + body << nc + else + header << nc + end + + when :body + if nc[:G] == 0 || nc[:G] == 1 + body << nc + else + state = :footer + footer << nc + end + + when :footer + footer << nc + end + end # case + + end # io.each_line +end # File.open + +print gcode(header) + +vert_count.times do |yc| + horiz_count.times do |xc| + body.each do |nc| + nc = nc.dup + nc[:X] += xc*tile_width if nc[:X] + nc[:Y] += yc*tile_height if nc[:Y] + print gcode(nc) + end + end +end + +print gcode(footer) diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/config/graster.yml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/config/graster.yml Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,10 @@ +dpi: [500, 500] +on_range: [0.0, 0.5] +overshoot: 0.5 +offset: [1.0, 1.0] +repeat: [1, 1] +tile_size: [false, false] +tile_spacing: [0.125, 0.125] +feed: 120 +cut_feed: 20 +corner_radius: 0 diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/graster.gemspec --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/graster.gemspec Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,51 @@ +# Generated by jeweler +# DO NOT EDIT THIS FILE DIRECTLY +# Instead, edit Jeweler::Tasks in Rakefile, and run the gemspec command +# -*- encoding: utf-8 -*- + +Gem::Specification.new do |s| + s.name = %q{graster} + s.version = "0.0.7" + + s.required_rubygems_version = Gem::Requirement.new(">= 0") if s.respond_to? :required_rubygems_version= + s.authors = ["Jedediah Smith", "Joshua Hull"] + s.date = %q{2009-12-18} + s.description = %q{G Raster!} + s.email = %q{joshbuddy@gmail.com} + s.executables = ["graster", "gtile"] + s.extra_rdoc_files = [ + "README.rdoc" + ] + s.files = [ + "README.rdoc", + "Rakefile", + "VERSION", + "bin/graster", + "bin/gtile", + "lib/graster.rb", + "lib/graster/gcode_file.rb", + "lib/graster/gmask_file.rb", + "lib/graster/image.rb", + "lib/graster/runner.rb" + ] + s.homepage = %q{http://github.com/joshbuddy/graster} + s.rdoc_options = ["--charset=UTF-8"] + s.require_paths = ["lib"] + s.rubyforge_project = %q{graster} + s.rubygems_version = %q{1.3.5} + s.summary = %q{G Raster!} + + if s.respond_to? :specification_version then + current_version = Gem::Specification::CURRENT_SPECIFICATION_VERSION + s.specification_version = 3 + + if Gem::Version.new(Gem::RubyGemsVersion) >= Gem::Version.new('1.2.0') then + s.add_runtime_dependency(%q, [">= 0"]) + else + s.add_dependency(%q, [">= 0"]) + end + else + s.add_dependency(%q, [">= 0"]) + end +end + diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/lib/graster.rb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/lib/graster.rb Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,328 @@ +#!/usr/bin/env ruby + +require 'rubygems' +require 'yaml' +require 'RMagick' + +class Graster + + autoload :Runner, File.join(File.dirname(__FILE__), 'graster', 'runner') + autoload :Image, File.join(File.dirname(__FILE__), 'graster', 'image') + autoload :GcodeFile, File.join(File.dirname(__FILE__), 'graster', 'gcode_file') + autoload :GmaskFile, File.join(File.dirname(__FILE__), 'graster', 'gmask_file') + + ROOT2 = Math.sqrt(2) + + OPTIONS = { + :dpi => [[Float],"X,Y","Dots per inch of your device"], + :on_range => [[Float], + "MIN,MAX","Luminosity range for which the", + "laser should be on"], + :overshoot => [Float,"INCHES", + "Distance the X axis should travel", + "past the outer boundaries of the outer", + "images. This needs to be wide enough", + "so that the X axis doesn't start", + "decelerating until after it has", + "cleared the image"], + :offset => [[Float],"X,Y", + "Location for the bottom left corner", + "of the bottom left tile. The X", + "component of this setting must be", + "equal to or greater than overshoot"], + :repeat => [[Integer],"X,Y", + "Number of times to repeat the image", + "in the X and Y axes, respectively.", + "Size of the tile(s) inches. Any nil", + "value is calculated from the size of", + "the bitmap"], + :tile_spacing => [[Float],"X,Y", + "X,Y gap between repeated tiles in", + "inches"], + :feed => [Float,"N", + "Speed to move the X axis while", + "burning, in inches/minute"], + :cut_feed => [Float,"N", + "Speed at which to cut out tiles"], + :corner_radius => [Float,"N", + "Radius of rounded corners for", + "cutout, 0 for pointy corners"] + } + + DEFAULTS = { + :dpi => [500,500], # X,Y dots per inch of your device + :on_range => [0.0,0.5], # Luminosity range for which the laser should be on + :overshoot => 0.5, # Distance the X axis should travel past the outer boundaries of the outer images. + # This needs to be wide enough so that the X axis doesn't start decelerating + # until after it has cleared the image. + :offset => [1.0,1.0], # X,Y location for the bottom left corner of the bottom left tile. + # The X component of this setting must be equal to or greater than :overshoot. + :repeat => [1,1], # Number of times to repeat the image in the X and Y axes, respectively. + :tile_size => [false,false], # Size of the tile(s) inches. Any nil value is calculated from + # the size of the bitmap. + :tile_spacing => [0.125,0.125], # X,Y gap between repeated tiles in inches + :feed => 120, # Speed to move the X axis while burning, in inches/minute + :cut_feed => 20, # Speed at which to cut out tiles + :corner_radius => 0 # Radius of rounded corners for cutout, 0 for pointy corners + } + + class InvalidConfig < Exception; end + def update_config + @scale = @config[:dpi].map{|n| 1.0/n } + @offset = @config[:offset] + + if @image + 2.times {|i| @config[:tile_size][i] ||= @image.size[i]*@scale[i] } + @tile_interval = [] + 2.times {|i| + @tile_interval << @config[:tile_size][i] + @config[:tile_spacing][i] + } + @tile_interval + end + + @on_range = Range.new Image.f_to_pix(@config[:on_range].first), + Image.f_to_pix(@config[:on_range].last) + end + + def validate_config + raise InvalidConfig.new "X offset (#{@config[:offset][0]}) must be greater or equal to overshoot (#{@config[:overshoot]})" + end + + def config= h + @config = {} + DEFAULTS.each {|k,v| @config[k] = h[k] || v } + update_config + return h + end + + def merge_config h + @config ||= DEFAULTS.dup + h.each {|k,v| @config[k] = v if DEFAULTS[k] } + update_config + return h + end + + attr_reader :config + + def image= img + debug "image set to #{img.filename} #{img.size.inspect} #{img.pixels.size} pixels" + @image = img + @image.build_spans @on_range + update_config + build_tiled_rows + return img + end + + attr_reader :image + + def try_load_config_file pn + if File.exist?(pn) + c = {} + YAML.load_file(pn).each {|k,v| c[k.intern] = v } + return c + end + end + + def try_load_default_config_file + try_load_config_file './graster.yml' + end + + def load_config_file pn + try_load_config_file pn or raise "config file not found '#{pn}'" + end + + def load_image_file pn + self.image = Image.from_file(pn) + end + + # convert tile + pixel coordinates to inches + def axis_inches axis, tile, pixel + @offset[axis] + tile*@tile_interval[axis] + pixel*@scale[axis] + end + + def x_inches tile, pixel + axis_inches 0, tile, pixel + end + + def y_inches tile, pixel + axis_inches 1, tile, pixel + end + + # return a complete tiled row of spans converted to inches + def tiled_row_spans y, forward=true + spans = @image.spans[y] + return spans if spans.empty? + tiled_spans = [] + + if forward + @config[:repeat][0].times do |tile| + spans.each do |span| + tiled_spans << [x_inches(tile,span[0]), x_inches(tile,span[1])] + end + end + else + (0...@config[:repeat][0]).to_a.reverse.each do |tile| + spans.reverse.each do |span| + tiled_spans << [x_inches(tile,span[1]), x_inches(tile,span[0])] + end + end + end + + return tiled_spans + end + + def build_tiled_rows + forward = false + @tiled_rows = [] + @image.size[1].times {|y| @tiled_rows << tiled_row_spans(y, (forward = !forward)) } + end + + # generate a unique id for this job + def job_hash + [@image,@config].hash + end + + # render a complete tiled image to gcode and gmask streams + def render_tiled_image gcode, gmask + debug "rendering tiled image" + job_id = job_hash + hyst = -@scale[0]/2 + gcode.comment "raster gcode for job #{job_id}" + gcode.comment "image: #{@image.filename} #{@image.size.inspect}" + gcode.comment "config: #{@config.inspect}" + + gcode.preamble :feed => @config[:feed], :mask => true + gmask.preamble + + @config[:repeat][1].times do |ytile| + debug "begin tile row #{ytile}" + ypix = 0 + (0...@tiled_rows).each do |spans| + debug "pixel row #{ypix} is empty" if spans.empty? + unless spans.empty? + yinches = y_inches(ytile, ypix) + forward = spans[0][0] < spans[-1][1] + dir = forward ? 1 : -1 + + debug "pixel row #{ypix} at #{yinches} inches going #{forward ? 'forward' : 'backward'} with #{spans.size} spans" + + gcode.g0 :x => spans[0][0] - dir*@config[:overshoot], :y => yinches + gcode.g1 :x => spans[-1][1] + dir*@config[:overshoot], :y => yinches + gmask.begin_row forward + # G0 X0.606 Y1.976 + # G1 X3.396 Y1.976 + # G0 X3.392 Y1.978 + # G1 X0.610 Y1.978 + # G0 X0.614 Y1.980 + # G1 X3.388 Y1.980 + + spans.each {|span| gmask.span forward, span[0]+hyst, span[1]+hyst } + end # unless spans.empty? + ypix += 1 + end # @image.each_row + debug "end tile row #{ytile}" + end # @config[:repeat][i].times + + gcode.epilogue + end # def render_tiled_image + + # cut out the tile with bottom left at x,y + def render_cut gcode, x, y + radius = @config[:corner_radius] + left = x + bottom = y + right = x+@config[:tile_size][0] + top = y+@config[:tile_size][1] + + gcode.instance_eval do + if radius && radius > 0 + jog :x => left, :y => bottom+radius + move :x => left, :y => top-radius, :laser => true + turn_cw :x => left+radius, :y => top, :i => radius + move :x => right-radius, :y => top + turn_cw :x => right, :y => top-radius, :j => -radius + move :x => right, :y => bottom+radius + turn_cw :x => right-radius, :y => bottom, :i => -radius + move :x => left+radius, :y => bottom + turn_cw :x => left, :y => bottom+radius, :j => radius + nc :laser => false + else + jog :x => left, :y => bottom + move :x => left, :y => top, :laser => true + move :x => right, :y => top + move :x => right, :y => bottom + move :x => left, :y => bottom + nc :laser => false + end + end + end + + # render gcode to cut out the tiles + def render_all_cuts gcode + gcode.preamble :feed => @config[:cut_feed] + @config[:repeat][1].times do |ytile| + @config[:repeat][0].times do |xtile| + render_cut gcode, x_inches(xtile, 0), y_inches(ytile, 0) + end + end + gcode.epilogue + end + + def render_all gcode, gmask, cuts + render_tiled_image gcode, gmask + render_all_cuts cuts + end + + def open_gcode_file &block + io = GcodeFile.open "#{@image.filename}.raster.ngc", "w", &block + end + + def open_gmask_file &block + io = GmaskFile.open "#{@image.filename}.raster.gmask", "w", &block + end + + def open_cut_file &block + io = GcodeFile.open "#{@image.filename}.cut.ngc", "w", &block + end + + def generate_all_files + open_gcode_file do |gcode| + open_gmask_file do |gmask| + render_tiled_image gcode, gmask + end + end + + open_cut_file do |cut| + render_all_cuts cut + end + end + + def config_to_yaml + @config.map {|k,v| "#{k}: #{v.inspect}\n" }.join + end + + def debug msg + STDERR.puts msg if @debug + end + + def initialize opts={} + self.config = DEFAULTS.dup + + if opts[:config_file] + self.merge_config load_config_file opts[:config_file] + elsif opts[:default_config_file] && c = try_load_default_config_file + self.merge_config c + end + + self.merge_config opts[:config] if opts[:config] + + @debug = opts[:debug] + + if opts[:image] + image = opts[:image] + elsif opts[:image_file] + load_image_file opts[:image_file] + end + end + +end # class Graster diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/lib/graster/.#gmask_file.rb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/lib/graster/.#gmask_file.rb Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +r@RLM.2766:1282362081 \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/lib/graster/gcode_file.rb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/lib/graster/gcode_file.rb Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,71 @@ +class Graster + class GcodeFile < File + def preamble opts + @laser = false + self << "M63 P0\nG61\nF#{opts[:feed] || 60}\n" + self << "M101\n" if opts[:mask] + self << "M3 S1\n" + end + + def epilogue + self << "M63 P0\nM5\nM2\n" + end + + PRIORITY = [:g,:x,:y,:z,:w,:i,:j,:k,:m,:p,:s] + + def nc codes + codes = codes.dup + + if codes[:laser] == true && !@laser + @laser = true + codes.merge!(:m => 62, :p => 0) + elsif codes[:laser] == false && @laser + @laser = false + codes.merge!(:m => 63, :p => 0) + end + + codes.delete :laser + + self << codes.sort {|(k1,v1),(k2,v2)| + PRIORITY.index(k1) <=> PRIORITY.index(k2) + }.map {|k,v| + if v.is_a? Integer + "#{k.to_s.upcase}#{v}" + elsif v.is_a? Float + "#{k.to_s.upcase}%0.3f" % v + else + k.to_s.upcase + end + }.join(' ') + "\n" + end + + def g0 codes + nc({:g => 0}.merge codes) + end + alias_method :jog, :g0 + + def g1 codes + nc({:g => 1}.merge codes) + end + alias_method :move, :g1 + + def g2 codes + nc codes.merge(:g => 2) + end + alias_method :turn_cw, :g2 + + def g3 codes + nc codes.merge(:g => 3) + end + alias_method :turn_ccw, :g3 + + def comment txt + txt = txt.gsub(/\(\)/,'') + self << "(#{txt})\n" + end + + def puts *a + self.puts *a + end + end +end diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/lib/graster/gmask_file.rb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/lib/graster/gmask_file.rb Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,24 @@ +class Graster + class GmaskFile < File + def preamble + self << "1 0 0 0\n" + end + + def begin_row forward + @begin_row = true + end + + def span forward, x1, x2 + if forward + self << "0 0 0 %0.3f\n" % x1 if @begin_row + self << "0 0 1 %0.3f\n" % x1 + self << "0 1 1 %0.3f\n" % x2 + else + self << "0 0 1 %0.3f\n" % x1 if @begin_row + self << "0 0 0 %0.3f\n" % x1 + self << "0 1 0 %0.3f\n" % x2 + end + @begin_row = false + end + end +end \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/lib/graster/image.rb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/lib/graster/image.rb Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,83 @@ +class Graster + class Image + PROPS = [:filename,:size,:pixels] + + def initialize(props) + PROPS.each do |p| + raise "required image property :#{p} missing" unless props[p] + instance_variable_set "@#{p}", props[p] + end + end + + PROPS.each{|p| attr_reader p } + + def self.from_file pathname + raise "file not found #{pathname}" unless File.exist? pathname + img = Magick::Image.read(pathname) + raise "bad image data in #{pathname}" unless img = img[0] + new :filename => File.basename(pathname), + :size => [img.columns,img.rows], + :pixels => img.export_pixels(0,0,img.columns,img.rows,"I") + end + + # get pixel(s) from x,y coords + # 0,0 is bottom,left + # image[x,y] => pixel at x,y + # image[y] => row at y + def [] y, x=nil + if x + @pixels[(@size[1]-y)*@size[0]+x] + else + @pixels[(@size[1]-y)*@size[0],@size[0]] + end + end + + def each_row &block + @pixels.chars.each_slice(@size[0]).each_with_index &block + end + + # "encode" a float 0..1 to a pixel + def self.f_to_pix f + (f*65535).round + end + + # "decode" an encoded pixel to a float 0..1 + def self.pix_to_f pix + pix/65535.0 + end + + + # convert bitmap data to spans (or runs) of contiguous pixels + # also invert the Y axis + def build_spans on_range + # TODO: rewrite in terms of each_row + @spans = Array.new @size[1] + + @size[1].times do |y| + spans = [] + left = (@size[1]-y-1)*@size[0] + start = nil + + @size[0].times do |x| + d = on_range.include?(@pixels[left+x]) + + if !start && d + start = x + elsif start && !d + spans << [start, x] + start = nil + end + end + + spans << [start, @size[0]] if start + @spans[y] = spans + end + end + + attr_reader :spans + + def hash + [@pixels,@width,@height].hash + end + end +end \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/lib/graster/runner.rb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/lib/graster/runner.rb Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,66 @@ +require 'optparse' + +class Graster + class Runner + + attr_reader :options, :args, :opts + + def initialize(args) + @args = args + @options = { :default_config_file => true } + @opts = OptionParser.new do |opts| + opts.banner = "Usage: graster [options] image" + + opts.on "-c", "--config FILE", "Use specified configuration file.", + "The default is ./graster.yml" do |c| + @options[:config_file] = c + end + + opts.on "-g", "--generate", "generate a configuration file with","defaults" do + @options[:generate_config] = true + end + + opts.on "-d", "--debug", "Dump useless debug info" do + @options[:debug] = true + end + + Graster::OPTIONS.each do |key,info| + type,sym,*desc = info + + if type.is_a? Array + cast = type[0].name.intern + type = Array + else + cast = type.name.intern + end + + opts.on "--#{key.to_s.gsub /_/, '-'} #{sym}", type, *desc do |x| + @options[:config] ||= {} + if type == Array + x = x.map {|s| Kernel.send(cast,s) } + else + x = Kernel.send(cast,x) + end + + @options[:config][key] = x + end + end + end + + @opts.parse!(args) + end + + def start! + if @options[:generate_config] + print Graster.new(@options).config_to_yaml + else + unless options[:image_file] = args.shift + puts @opts + exit 1 + end + + Graster.new(options).generate_all_files + end + end + end +end \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/rmagick-2.13.1.gem Binary file graster/graster/rmagick-2.13.1.gem has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/graster/tile.rb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/graster/tile.rb Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,2 @@ +#!/usr/bin/ruby + diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/HEAD --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/HEAD Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +ref: refs/heads/master diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/config --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/config Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,11 @@ +[core] + repositoryformatversion = 0 + filemode = true + bare = false + logallrefupdates = true +[remote "origin"] + fetch = +refs/heads/*:refs/remotes/origin/* + url = http://github.com/jedediah/hacklab-engraver.git +[branch "master"] + remote = origin + merge = refs/heads/master diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/description --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/description Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +Unnamed repository; edit this file 'description' to name the repository. diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/hooks/applypatch-msg.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/hooks/applypatch-msg.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,15 @@ +#!/bin/sh +# +# An example hook script to check the commit log message taken by +# applypatch from an e-mail message. +# +# The hook should exit with non-zero status after issuing an +# appropriate message if it wants to stop the commit. The hook is +# allowed to edit the commit message file. +# +# To enable this hook, rename this file to "applypatch-msg". + +. git-sh-setup +test -x "$GIT_DIR/hooks/commit-msg" && + exec "$GIT_DIR/hooks/commit-msg" ${1+"$@"} +: diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/hooks/commit-msg.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/hooks/commit-msg.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,24 @@ +#!/bin/sh +# +# An example hook script to check the commit log message. +# Called by git-commit with one argument, the name of the file +# that has the commit message. The hook should exit with non-zero +# status after issuing an appropriate message if it wants to stop the +# commit. The hook is allowed to edit the commit message file. +# +# To enable this hook, rename this file to "commit-msg". + +# Uncomment the below to add a Signed-off-by line to the message. +# Doing this in a hook is a bad idea in general, but the prepare-commit-msg +# hook is more suited to it. +# +# SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p') +# grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1" + +# This example catches duplicate Signed-off-by lines. + +test "" = "$(grep '^Signed-off-by: ' "$1" | + sort | uniq -c | sed -e '/^[ ]*1[ ]/d')" || { + echo >&2 Duplicate Signed-off-by lines. + exit 1 +} diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/hooks/post-commit.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/hooks/post-commit.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,8 @@ +#!/bin/sh +# +# An example hook script that is called after a successful +# commit is made. +# +# To enable this hook, rename this file to "post-commit". + +: Nothing diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/hooks/post-receive.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/hooks/post-receive.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,15 @@ +#!/bin/sh +# +# An example hook script for the "post-receive" event. +# +# The "post-receive" script is run after receive-pack has accepted a pack +# and the repository has been updated. It is passed arguments in through +# stdin in the form +# +# For example: +# aa453216d1b3e49e7f6f98441fa56946ddcd6a20 68f7abf4e6f922807889f52bc043ecd31b79f814 refs/heads/master +# +# see contrib/hooks/ for a sample, or uncomment the next line and +# rename the file to "post-receive". + +#. /usr/share/doc/git-core/contrib/hooks/post-receive-email diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/hooks/post-update.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/hooks/post-update.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,8 @@ +#!/bin/sh +# +# An example hook script to prepare a packed repository for use over +# dumb transports. +# +# To enable this hook, rename this file to "post-update". + +exec git-update-server-info diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/hooks/pre-applypatch.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/hooks/pre-applypatch.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,14 @@ +#!/bin/sh +# +# An example hook script to verify what is about to be committed +# by applypatch from an e-mail message. +# +# The hook should exit with non-zero status after issuing an +# appropriate message if it wants to stop the commit. +# +# To enable this hook, rename this file to "pre-applypatch". + +. git-sh-setup +test -x "$GIT_DIR/hooks/pre-commit" && + exec "$GIT_DIR/hooks/pre-commit" ${1+"$@"} +: diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/hooks/pre-commit.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/hooks/pre-commit.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,46 @@ +#!/bin/sh +# +# An example hook script to verify what is about to be committed. +# Called by git-commit with no arguments. The hook should +# exit with non-zero status after issuing an appropriate message if +# it wants to stop the commit. +# +# To enable this hook, rename this file to "pre-commit". + +if git-rev-parse --verify HEAD >/dev/null 2>&1 +then + against=HEAD +else + # Initial commit: diff against an empty tree object + against=4b825dc642cb6eb9a060e54bf8d69288fbee4904 +fi + +# If you want to allow non-ascii filenames set this variable to true. +allownonascii=$(git config hooks.allownonascii) + +# Cross platform projects tend to avoid non-ascii filenames; prevent +# them from being added to the repository. We exploit the fact that the +# printable range starts at the space character and ends with tilde. +if [ "$allownonascii" != "true" ] && + # Note that the use of brackets around a tr range is ok here, (it's + # even required, for portability to Solaris 10's /usr/bin/tr), since + # the square bracket bytes happen to fall in the designated range. + test "$(git diff --cached --name-only --diff-filter=A -z $against | + LC_ALL=C tr -d '[ -~]\0')" +then + echo "Error: Attempt to add a non-ascii file name." + echo + echo "This can cause problems if you want to work" + echo "with people on other platforms." + echo + echo "To be portable it is advisable to rename the file ..." + echo + echo "If you know what you are doing you can disable this" + echo "check using:" + echo + echo " git config hooks.allownonascii true" + echo + exit 1 +fi + +exec git diff-index --check --cached $against -- diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/hooks/pre-rebase.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/hooks/pre-rebase.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,169 @@ +#!/bin/sh +# +# Copyright (c) 2006, 2008 Junio C Hamano +# +# The "pre-rebase" hook is run just before "git-rebase" starts doing +# its job, and can prevent the command from running by exiting with +# non-zero status. +# +# The hook is called with the following parameters: +# +# $1 -- the upstream the series was forked from. +# $2 -- the branch being rebased (or empty when rebasing the current branch). +# +# This sample shows how to prevent topic branches that are already +# merged to 'next' branch from getting rebased, because allowing it +# would result in rebasing already published history. + +publish=next +basebranch="$1" +if test "$#" = 2 +then + topic="refs/heads/$2" +else + topic=`git symbolic-ref HEAD` || + exit 0 ;# we do not interrupt rebasing detached HEAD +fi + +case "$topic" in +refs/heads/??/*) + ;; +*) + exit 0 ;# we do not interrupt others. + ;; +esac + +# Now we are dealing with a topic branch being rebased +# on top of master. Is it OK to rebase it? + +# Does the topic really exist? +git show-ref -q "$topic" || { + echo >&2 "No such branch $topic" + exit 1 +} + +# Is topic fully merged to master? +not_in_master=`git-rev-list --pretty=oneline ^master "$topic"` +if test -z "$not_in_master" +then + echo >&2 "$topic is fully merged to master; better remove it." + exit 1 ;# we could allow it, but there is no point. +fi + +# Is topic ever merged to next? If so you should not be rebasing it. +only_next_1=`git-rev-list ^master "^$topic" ${publish} | sort` +only_next_2=`git-rev-list ^master ${publish} | sort` +if test "$only_next_1" = "$only_next_2" +then + not_in_topic=`git-rev-list "^$topic" master` + if test -z "$not_in_topic" + then + echo >&2 "$topic is already up-to-date with master" + exit 1 ;# we could allow it, but there is no point. + else + exit 0 + fi +else + not_in_next=`git-rev-list --pretty=oneline ^${publish} "$topic"` + perl -e ' + my $topic = $ARGV[0]; + my $msg = "* $topic has commits already merged to public branch:\n"; + my (%not_in_next) = map { + /^([0-9a-f]+) /; + ($1 => 1); + } split(/\n/, $ARGV[1]); + for my $elem (map { + /^([0-9a-f]+) (.*)$/; + [$1 => $2]; + } split(/\n/, $ARGV[2])) { + if (!exists $not_in_next{$elem->[0]}) { + if ($msg) { + print STDERR $msg; + undef $msg; + } + print STDERR " $elem->[1]\n"; + } + } + ' "$topic" "$not_in_next" "$not_in_master" + exit 1 +fi + +exit 0 + +################################################################ + +This sample hook safeguards topic branches that have been +published from being rewound. + +The workflow assumed here is: + + * Once a topic branch forks from "master", "master" is never + merged into it again (either directly or indirectly). + + * Once a topic branch is fully cooked and merged into "master", + it is deleted. If you need to build on top of it to correct + earlier mistakes, a new topic branch is created by forking at + the tip of the "master". This is not strictly necessary, but + it makes it easier to keep your history simple. + + * Whenever you need to test or publish your changes to topic + branches, merge them into "next" branch. + +The script, being an example, hardcodes the publish branch name +to be "next", but it is trivial to make it configurable via +$GIT_DIR/config mechanism. + +With this workflow, you would want to know: + +(1) ... if a topic branch has ever been merged to "next". Young + topic branches can have stupid mistakes you would rather + clean up before publishing, and things that have not been + merged into other branches can be easily rebased without + affecting other people. But once it is published, you would + not want to rewind it. + +(2) ... if a topic branch has been fully merged to "master". + Then you can delete it. More importantly, you should not + build on top of it -- other people may already want to + change things related to the topic as patches against your + "master", so if you need further changes, it is better to + fork the topic (perhaps with the same name) afresh from the + tip of "master". + +Let's look at this example: + + o---o---o---o---o---o---o---o---o---o "next" + / / / / + / a---a---b A / / + / / / / + / / c---c---c---c B / + / / / \ / + / / / b---b C \ / + / / / / \ / + ---o---o---o---o---o---o---o---o---o---o---o "master" + + +A, B and C are topic branches. + + * A has one fix since it was merged up to "next". + + * B has finished. It has been fully merged up to "master" and "next", + and is ready to be deleted. + + * C has not merged to "next" at all. + +We would want to allow C to be rebased, refuse A, and encourage +B to be deleted. + +To compute (1): + + git-rev-list ^master ^topic next + git-rev-list ^master next + + if these match, topic has not merged in next at all. + +To compute (2): + + git-rev-list master..topic + + if this is empty, it is fully merged to "master". diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/hooks/prepare-commit-msg.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/hooks/prepare-commit-msg.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,36 @@ +#!/bin/sh +# +# An example hook script to prepare the commit log message. +# Called by git-commit with the name of the file that has the +# commit message, followed by the description of the commit +# message's source. The hook's purpose is to edit the commit +# message file. If the hook fails with a non-zero status, +# the commit is aborted. +# +# To enable this hook, rename this file to "prepare-commit-msg". + +# This hook includes three examples. The first comments out the +# "Conflicts:" part of a merge commit. +# +# The second includes the output of "git diff --name-status -r" +# into the message, just before the "git status" output. It is +# commented because it doesn't cope with --amend or with squashed +# commits. +# +# The third example adds a Signed-off-by line to the message, that can +# still be edited. This is rarely a good idea. + +case "$2,$3" in + merge,) + perl -i.bak -ne 's/^/# /, s/^# #/#/ if /^Conflicts/ .. /#/; print' "$1" ;; + +# ,|template,) +# perl -i.bak -pe ' +# print "\n" . `git diff --cached --name-status -r` +# if /^#/ && $first++ == 0' "$1" ;; + + *) ;; +esac + +# SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p') +# grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1" diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/hooks/update.sample --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/hooks/update.sample Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,128 @@ +#!/bin/sh +# +# An example hook script to blocks unannotated tags from entering. +# Called by git-receive-pack with arguments: refname sha1-old sha1-new +# +# To enable this hook, rename this file to "update". +# +# Config +# ------ +# hooks.allowunannotated +# This boolean sets whether unannotated tags will be allowed into the +# repository. By default they won't be. +# hooks.allowdeletetag +# This boolean sets whether deleting tags will be allowed in the +# repository. By default they won't be. +# hooks.allowmodifytag +# This boolean sets whether a tag may be modified after creation. By default +# it won't be. +# hooks.allowdeletebranch +# This boolean sets whether deleting branches will be allowed in the +# repository. By default they won't be. +# hooks.denycreatebranch +# This boolean sets whether remotely creating branches will be denied +# in the repository. By default this is allowed. +# + +# --- Command line +refname="$1" +oldrev="$2" +newrev="$3" + +# --- Safety check +if [ -z "$GIT_DIR" ]; then + echo "Don't run this script from the command line." >&2 + echo " (if you want, you could supply GIT_DIR then run" >&2 + echo " $0 )" >&2 + exit 1 +fi + +if [ -z "$refname" -o -z "$oldrev" -o -z "$newrev" ]; then + echo "Usage: $0 " >&2 + exit 1 +fi + +# --- Config +allowunannotated=$(git config --bool hooks.allowunannotated) +allowdeletebranch=$(git config --bool hooks.allowdeletebranch) +denycreatebranch=$(git config --bool hooks.denycreatebranch) +allowdeletetag=$(git config --bool hooks.allowdeletetag) +allowmodifytag=$(git config --bool hooks.allowmodifytag) + +# check for no description +projectdesc=$(sed -e '1q' "$GIT_DIR/description") +case "$projectdesc" in +"Unnamed repository"* | "") + echo "*** Project description file hasn't been set" >&2 + exit 1 + ;; +esac + +# --- Check types +# if $newrev is 0000...0000, it's a commit to delete a ref. +zero="0000000000000000000000000000000000000000" +if [ "$newrev" = "$zero" ]; then + newrev_type=delete +else + newrev_type=$(git-cat-file -t $newrev) +fi + +case "$refname","$newrev_type" in + refs/tags/*,commit) + # un-annotated tag + short_refname=${refname##refs/tags/} + if [ "$allowunannotated" != "true" ]; then + echo "*** The un-annotated tag, $short_refname, is not allowed in this repository" >&2 + echo "*** Use 'git tag [ -a | -s ]' for tags you want to propagate." >&2 + exit 1 + fi + ;; + refs/tags/*,delete) + # delete tag + if [ "$allowdeletetag" != "true" ]; then + echo "*** Deleting a tag is not allowed in this repository" >&2 + exit 1 + fi + ;; + refs/tags/*,tag) + # annotated tag + if [ "$allowmodifytag" != "true" ] && git rev-parse $refname > /dev/null 2>&1 + then + echo "*** Tag '$refname' already exists." >&2 + echo "*** Modifying a tag is not allowed in this repository." >&2 + exit 1 + fi + ;; + refs/heads/*,commit) + # branch + if [ "$oldrev" = "$zero" -a "$denycreatebranch" = "true" ]; then + echo "*** Creating a branch is not allowed in this repository" >&2 + exit 1 + fi + ;; + refs/heads/*,delete) + # delete branch + if [ "$allowdeletebranch" != "true" ]; then + echo "*** Deleting a branch is not allowed in this repository" >&2 + exit 1 + fi + ;; + refs/remotes/*,commit) + # tracking branch + ;; + refs/remotes/*,delete) + # delete tracking branch + if [ "$allowdeletebranch" != "true" ]; then + echo "*** Deleting a tracking branch is not allowed in this repository" >&2 + exit 1 + fi + ;; + *) + # Anything else (is there anything else?) + echo "*** Update hook: unknown type of update to ref $refname of type $newrev_type" >&2 + exit 1 + ;; +esac + +# --- Finished +exit 0 diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/index Binary file graster/hacklab-engraver/.git/index has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/info/exclude --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/info/exclude Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,6 @@ +# git-ls-files --others --exclude-from=.git/info/exclude +# Lines that start with '#' are comments. +# For a project mostly in C, the following would be a good set of +# exclude patterns (uncomment them if you want to use them): +# *.[oa] +# *~ diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/logs/HEAD --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/logs/HEAD Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +0000000000000000000000000000000000000000 4a654eac48d62e718b71c65eabd923b916ff7acb Robert McIntyre 1282265224 -0400 clone: from http://github.com/jedediah/hacklab-engraver.git diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/logs/refs/heads/master --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/logs/refs/heads/master Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +0000000000000000000000000000000000000000 4a654eac48d62e718b71c65eabd923b916ff7acb Robert McIntyre 1282265224 -0400 clone: from http://github.com/jedediah/hacklab-engraver.git diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/00/e8b290d784d38f4cd0495586799e98fea4f45f Binary file graster/hacklab-engraver/.git/objects/00/e8b290d784d38f4cd0495586799e98fea4f45f has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/02/c08b67e102c8ccddc18c609ec20f71a0468312 Binary file graster/hacklab-engraver/.git/objects/02/c08b67e102c8ccddc18c609ec20f71a0468312 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/07/05d4debff7c18448ab48687ff7a997b6c8d0d0 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/objects/07/05d4debff7c18448ab48687ff7a997b6c8d0d0 Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +xAn @Ѯ9,EaHUu90 2I-k=s@nx*~T Fe{Df6+o:Qx[JQ#P\}H2xbg 5kv8XsF^]j|7xUOէSFT_/՗KR]#a0B!FvFogvFoG}>HR!uHR!uHR!uHR!uHR!uHR!uHR!uHR!uH-7 \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/25/1c450dde1eeab662d00967bb41f13a12ceadc3 Binary file graster/hacklab-engraver/.git/objects/25/1c450dde1eeab662d00967bb41f13a12ceadc3 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/27/2b76446d8d70feddc23fe033994eae0ae54be7 Binary file graster/hacklab-engraver/.git/objects/27/2b76446d8d70feddc23fe033994eae0ae54be7 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/2b/2693d5073f492ac90963f33a8452a31bbcf6bb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/objects/2b/2693d5073f492ac90963f33a8452a31bbcf6bb Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,3 @@ +xUn03_qlR(ZiB+Bj%RPAsՉv_?;x8RPN|=5kK^G,)Cb.2 h.s$|^b(9!q).b&zrnqEgܗT<<[XJ曜% D aE}$晔OaMzOFeJX>GH Mb;kЬA(Fad)bQp\$a0W%$)cҋpn245ɰB +,,9B,U,!`d/sysA)dJ(usoolrSkQQd)un>RrhQDhhc=: +|5rddciƐE-T&O`_32o![NgAr%.d| /-y\o5tՇҌˏ 91 B+"Yv݈ea{Z5+6#opr6YZdhoBpr7!ڊnS뚥mEYN&Vr2vK h_k^ղEhwc ;kX:O;zѲ \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/37/c611a4fe5ebcf722cfb0370d42eb714b52af1e Binary file graster/hacklab-engraver/.git/objects/37/c611a4fe5ebcf722cfb0370d42eb714b52af1e has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/39/5d366090051b462e9f6be2003791a40e969c86 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/objects/39/5d366090051b462e9f6be2003791a40e969c86 Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,3 @@ +x =0 PzX@bq%FCTNO7(q9_O+ddn!VGj ; +5ZV +wl,"PsD}І;}3M) \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/39/e4809471abf02fc5d1922bd32d0d14400aaeca Binary file graster/hacklab-engraver/.git/objects/39/e4809471abf02fc5d1922bd32d0d14400aaeca has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/3d/3c25ca420571813c3729711741718994c2988f Binary file graster/hacklab-engraver/.git/objects/3d/3c25ca420571813c3729711741718994c2988f has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/3d/c982cae4470a7c3b324027d05b2c377878e388 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/objects/3d/c982cae4470a7c3b324027d05b2c377878e388 Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,2 @@ +x=n!Ss)"0YӦs7,C; .i^k_ J!S2R*k# єEƵi4I| +JHw#h6ĩ_v Gۡ(m4.( r3ʀ}}Sg(uL ZፌbS \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/48/0396695515689f1ac537c08480180970892e9d Binary file graster/hacklab-engraver/.git/objects/48/0396695515689f1ac537c08480180970892e9d has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/4a/654eac48d62e718b71c65eabd923b916ff7acb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/objects/4a/654eac48d62e718b71c65eabd923b916ff7acb Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +xAN0 DYGǮ_N"Âhm(af)DК3-9c2BQVVnß[ɝDf` Bl|YPVzaVm*mR>%XÿX_ϛzajo}=$Y7ϳOY \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/4e/bf8847d4464aabff8af13901492405f4ebd687 Binary file graster/hacklab-engraver/.git/objects/4e/bf8847d4464aabff8af13901492405f4ebd687 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/4f/b9341cc80ee60a78fb335bb4c951f3b1ba510f Binary file graster/hacklab-engraver/.git/objects/4f/b9341cc80ee60a78fb335bb4c951f3b1ba510f has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/54/162a6c26dfa90d099aa06fadefd17cd4483394 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/objects/54/162a6c26dfa90d099aa06fadefd17cd4483394 Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,2 @@ +xUKrB1 L +(붟qØBfQKy3UǸ MSөiiiښ>Uߪoշ[V}{=^OzSTz=zQ/|R?C#ױo3.......S/1ST}>UOe02R}T_/՗2 F#`d02//3~;3~;/u~ :C:C:C:C:C:C:C:C:/^ \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/54/c13cded8582bdd8bf57e2c58618a8be9d09732 Binary file graster/hacklab-engraver/.git/objects/54/c13cded8582bdd8bf57e2c58618a8be9d09732 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/57/273524331dcfcbb7256dd9ce8e3124e7d6408f Binary file graster/hacklab-engraver/.git/objects/57/273524331dcfcbb7256dd9ce8e3124e7d6408f has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/58/94622e9772e7b5e4c26a7c4cf4379c82b81fd4 Binary file graster/hacklab-engraver/.git/objects/58/94622e9772e7b5e4c26a7c4cf4379c82b81fd4 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/60/1f78eb56a2fbefb77a5f2fe9bd9a8af9486f22 Binary file graster/hacklab-engraver/.git/objects/60/1f78eb56a2fbefb77a5f2fe9bd9a8af9486f22 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/6d/b2a0702414b2f7d4a54181fe45e9093a41e1bd Binary file graster/hacklab-engraver/.git/objects/6d/b2a0702414b2f7d4a54181fe45e9093a41e1bd has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/70/26e67d5af2e7a87b28c6fe30d4c826696f2ef9 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/objects/70/26e67d5af2e7a87b28c6fe30d4c826696f2ef9 Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,3 @@ +xE +@Ehi#X X|`Lٰ;1į78>X?69vLzPKq }oIp)qwg,P -{8 +LN(^ G-O{qnUzT+W7XZH {L \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/b3/0bed63de14c07bd564eac82fe54f010bf92832 Binary file graster/hacklab-engraver/.git/objects/b3/0bed63de14c07bd564eac82fe54f010bf92832 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/cc/b6e0ad8e62b83d682cd474a2b4216f3b70fd8c Binary file graster/hacklab-engraver/.git/objects/cc/b6e0ad8e62b83d682cd474a2b4216f3b70fd8c has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/d1/3c62bbf9d08745832b0a4c58d43f668eb3e207 Binary file graster/hacklab-engraver/.git/objects/d1/3c62bbf9d08745832b0a4c58d43f668eb3e207 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/da/a8c4c5d9403e3de6de63bf00d963522725ba18 Binary file graster/hacklab-engraver/.git/objects/da/a8c4c5d9403e3de6de63bf00d963522725ba18 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/dc/37075577db6f593d8a5c6e60e081e138477e8a Binary file graster/hacklab-engraver/.git/objects/dc/37075577db6f593d8a5c6e60e081e138477e8a has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/de/bcc458e2f4f7f49261278ea90701db1bbc9611 Binary file graster/hacklab-engraver/.git/objects/de/bcc458e2f4f7f49261278ea90701db1bbc9611 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/e2/46361935fe95d0e4629abdaa1e48b8d09f3eee --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/objects/e2/46361935fe95d0e4629abdaa1e48b8d09f3eee Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,5 @@ +xA0 EY^IM$f5ǡM[̜dyZբ +- +hKXO)6DugGj;E +^zVDIi#Ŀ},uX +X 3崟YWhZע!8E4K2ץ4½lL|MʸV ȬPD \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/e4/d9a3115b00e8960dd5555a488b8778b095e8c1 Binary file graster/hacklab-engraver/.git/objects/e4/d9a3115b00e8960dd5555a488b8778b095e8c1 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/e8/ff6ce26c2cd4370986e0cfc5beb41c0a39c061 Binary file graster/hacklab-engraver/.git/objects/e8/ff6ce26c2cd4370986e0cfc5beb41c0a39c061 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/ec/0de6b82e3ba8dc08be4a1d41ad756f1da012fd Binary file graster/hacklab-engraver/.git/objects/ec/0de6b82e3ba8dc08be4a1d41ad756f1da012fd has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/f0/2a7c6678d381e90f39fd7f5b6a1a7e7c53d523 Binary file graster/hacklab-engraver/.git/objects/f0/2a7c6678d381e90f39fd7f5b6a1a7e7c53d523 has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/f5/326e4e272b2b6e7018cc0ab02aa5782d9c9fcc Binary file graster/hacklab-engraver/.git/objects/f5/326e4e272b2b6e7018cc0ab02aa5782d9c9fcc has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/f6/f4f18f2b41ec1c9cfcea1e6c74c6e9da89fb03 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/objects/f6/f4f18f2b41ec1c9cfcea1e6c74c6e9da89fb03 Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,2 @@ +xK0DY?%h;!"d{?NSmYC+",&fю1 ݀Л"k!s^ۈugor +q{cQ_onď\;SrYUWлE:Do&ߓj,T_ྼy\>'i*?2M \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/f7/5c96c6ae9db0be0f79a7e05eb01379bc9a64ac Binary file graster/hacklab-engraver/.git/objects/f7/5c96c6ae9db0be0f79a7e05eb01379bc9a64ac has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/fd/c9663091370e717dc46ca5c52db6b4c7313730 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/objects/fd/c9663091370e717dc46ca5c52db6b4c7313730 Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,3 @@ +x;0}- /Bn#ܟN@͋y +h5qڮMxgc<޹DE%DE +'ґZ F[ԾGt4ޓ'1DunOp~p}"ye[[-8ETqWS yC̀ ߕyy:lY)ȡL \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/objects/fe/62c30f734c6223bc20d82619baca9da73a3a8a Binary file graster/hacklab-engraver/.git/objects/fe/62c30f734c6223bc20d82619baca9da73a3a8a has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/packed-refs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/packed-refs Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,2 @@ +# pack-refs with: peeled +4a654eac48d62e718b71c65eabd923b916ff7acb refs/remotes/origin/master diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/refs/heads/master --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/refs/heads/master Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +4a654eac48d62e718b71c65eabd923b916ff7acb diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.git/refs/remotes/origin/HEAD --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.git/refs/remotes/origin/HEAD Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +ref: refs/remotes/origin/master diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/.gitignore --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/.gitignore Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,5 @@ +/junk +.scope.cfg +autosave.halscope +emc.var +emc.var.bak diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/M101 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/M101 Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,85 @@ +#!/usr/bin/python + +# === Graster Streaming Script === +# +# This script is invoked by g-code M101 at the +# beginning of every graster job. It figures out +# the name of the mask file and forks a process +# to stream it to the HAL while AXIS executes the +# motion code. +# +# This file must be symlinked to the ~/emc2/nc_files dir + +import emc, os, sys, threading, gtk, time, popen2, signal, select + +os.chdir("/home/hacklab/emc2/configs/hacklab-engraver3") +ini = emc.ini("hacklab-engraver3.ini") +emc.nmlfile = ini.find("EMC","NML_FILE") +s = emc.stat() +s.poll() +ngc = s.file +(base,ext) = os.path.splitext(ngc) +gmask = base+".gmask" +if not os.path.exists(gmask): + gmask = ngc+".gmask" + if not os.path.exists(gmask): + os.system('zenity --error --text "Mask file \''+base+'.gmask\' not found. Laser disabled for this job."') + sys.exit(os.EX_NOINPUT) + + +def make_pbar(): + (path,fn) = os.path.split(gmask) + message = "Streaming '"+fn+"'\n\n" + \ + "This dialog should complete and close itself some time before\n" + \ + "your job is done. If you stop the job, wait for this dialog\n" + \ + "to go away before starting another one. If it won't go away,\n" + \ + "click 'Cancel' and kill any processes containing 'M101'.\n" + return popen2.Popen3('zenity --progress --auto-close --auto-kill --title "Graster Streamer" --text "'+message+'"') + +pbar = make_pbar() + +total_lines = 0 +fd = open(gmask,'r') +for x in fd.readlines(): + total_lines += 1 +fd.close() + +total_lines = float(total_lines) +count = 0 + +print "Streaming '"+gmask+"'..." +pid = os.fork() + +if pid: + time.sleep(2) + sys.exit(os.EX_OK) +else: + os.setsid() + fin = open(gmask,'r') + fout = os.popen('halstreamer','w') + try: + for line in fin.readlines(): + #r,w,e = select.select((),(fout,),(fout,),0.1) + if pbar.poll() != -1: raise + + #if len(w) > 0: + fout.write(line) + count += 1 + #elif len(e) > 0: + # os.system("zenity --error --text 'Error writing to halstreamer. Job may not finish.'") + # raise + + pbar.tochild.write(str(int(100.0*count/total_lines))+"\n") + + finally: + print "...cleaning up..." + #fin.close() + #fout.close() + pbar.tochild.close() + pbar.fromchild.close() + #os.kill(pbar.pid,signal.SIGINT) + #os.kill(pbar.pid,signal.SIGKILL) + print "...done!" + os._exit(os.EX_OK) + #sys.exit(os.EX_OK) + diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/README --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/README Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,1 @@ +Generated by stepconf at Sat Mar 21 03:02:15 2009 diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/custom.hal --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/custom.hal Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,2 @@ +# Include your customized HAL commands here +# This file will not be overwritten when you run stepconf again diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/custom_postgui.hal --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/custom_postgui.hal Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,4 @@ +# Include your customized HAL commands here +# The commands in this file are run after the AXIS GUI (including PyVCP panel) +# starts +# This file will not be overwritten when you run stepconf again diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/emc.nml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/emc.nml Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,47 @@ + +# Note: emcsvr is the master for all NML channels, and therefore is the +# first to start. + +# Buffers +# Name Type Host size neut? (old) buffer# MP --- + +# Top-level buffers to EMC +B emcCommand SHMEM localhost 8192 0 0 1 16 1001 TCP=5005 xdr +B emcStatus SHMEM localhost 10240 0 0 2 16 1002 TCP=5005 xdr +B emcError SHMEM localhost 8192 0 0 3 16 1003 TCP=5005 xdr queue + +# These are for the IO controller, EMCIO +B toolCmd SHMEM localhost 1024 0 0 4 16 1004 TCP=5005 xdr +B toolSts SHMEM localhost 8192 0 0 5 16 1005 TCP=5005 xdr + +# Processes +# Name Buffer Type Host Ops server? timeout master? cnum + +P emc emcCommand LOCAL localhost RW 0 1.0 0 0 +P emc emcStatus LOCAL localhost W 0 1.0 0 0 +P emc emcError LOCAL localhost W 0 1.0 0 0 +P emc toolCmd LOCAL localhost W 0 1.0 0 0 +P emc toolSts LOCAL localhost R 0 1.0 0 0 + +P emcsvr emcCommand LOCAL localhost W 1 1.0 1 2 +P emcsvr emcStatus LOCAL localhost R 1 1.0 1 2 +P emcsvr emcError LOCAL localhost R 1 1.0 1 2 +P emcsvr toolCmd LOCAL localhost W 1 1.0 1 2 +P emcsvr toolSts LOCAL localhost R 1 1.0 1 2 +P emcsvr default LOCAL localhost RW 1 1.0 1 2 + +P tool emcError LOCAL localhost W 0 1.0 0 3 +P tool toolCmd LOCAL localhost RW 0 1.0 0 3 +P tool toolSts LOCAL localhost W 0 1.0 0 3 + +P xemc emcCommand LOCAL localhost W 0 10.0 0 10 +P xemc emcStatus LOCAL localhost R 0 10.0 0 10 +P xemc emcError LOCAL localhost R 0 10.0 0 10 +P xemc toolCmd LOCAL localhost W 0 10.0 0 10 +P xemc toolSts LOCAL localhost R 0 10.0 0 10 + +P keystick emcCommand LOCAL localhost W 0 10.0 0 10 +P keystick emcStatus LOCAL localhost R 0 10.0 0 10 +P keystick emcError LOCAL localhost R 0 10.0 0 10 +P keystick toolCmd LOCAL localhost W 0 10.0 0 10 +P keystick toolSts LOCAL localhost R 0 10.0 0 10 diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/hacklab-engraver3.hal --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/hacklab-engraver3.hal Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,233 @@ +# Generated by stepconf at Sun Mar 8 21:32:59 2009 +# If you make changes to this file, they will be +# overwritten when you run stepconf again + +loadrt threads name1=mask-thread period1=100000 + +loadrt trivkins +loadrt [EMCMOT]EMCMOT base_period_nsec=[EMCMOT]BASE_PERIOD servo_period_nsec=[EMCMOT]SERVO_PERIOD traj_period_nsec=[EMCMOT]SERVO_PERIOD key=[EMCMOT]SHMEM_KEY num_joints=[TRAJ]AXES +loadrt probe_parport +loadrt hal_parport cfg=0x378 +setp parport.0.reset-time 100000 +loadrt stepgen step_type=0,0,0,0 +loadrt charge_pump + + +# Boring components that emc makes me load explicitly because it is a cunt +loadrt comp names=comp-mask-lte,comp-discrete-z +loadrt not names=not-mask-ffw,not-mask-not-empty +loadrt xor2 names=xor2-mask-test +loadrt and2 names=and2-mask-forward,and2-laser-mask,and2-laser-final +loadrt or2 names=or2-mask-command-done,or2-mask-not-ffw,or2-mask-read,or2-laser-gcode,or2-laser-fine + + +# Fast thread for generating signals +addf parport.0.read base-thread +addf stepgen.make-pulses base-thread +addf parport.0.write base-thread +addf parport.0.reset base-thread +addf charge-pump base-thread + +# Slow thread for logic (more logic components are added further down) +addf stepgen.capture-position servo-thread +addf motion-command-handler servo-thread +addf motion-controller servo-thread +addf stepgen.update-freq servo-thread + + +################################################################################### +# Raster Mask - stream in laser on/off commands behind AXIS's back +# Input stream format: reset beam xop xarg +# reset: 0=mask command 1=reset (begin mask sequence with "1 0 0 0", every other command starts with 0) +# beam: 0=off 1=on +# xop: X axis comparison operation 0=less-or-equal 1=greater +# xarg: X axis comparison operand + +loadrt streamer depth=256 cfg="bbbf" +net mask-reset <= streamer.0.pin.0 +net mask-beam <= streamer.0.pin.1 +net mask-xop <= streamer.0.pin.2 +net mask-xarg <= streamer.0.pin.3 +net mask-empty <= streamer.0.empty +net mask-read => streamer.0.enable + +# hardware reported X axis position +net motion-xpos-fb <= axis.0.joint-pos-fb + +# mask-lte <= motion-xpos-fb < mask-xarg +addf comp-mask-lte mask-thread +net motion-xpos-fb => comp-mask-lte.in0 +net mask-xarg => comp-mask-lte.in1 +net mask-lte <= comp-mask-lte.out + +# mask-test <= mask-xop ^ mask-lte +addf xor2-mask-test mask-thread +net mask-xop => xor2-mask-test.in0 +net mask-lte => xor2-mask-test.in1 +net mask-test <= xor2-mask-test.out + +# if job is running, read only if test is true or reset +# if job is not running, read until reset +# mask-read <= (laser-coarse && (mask-test || mask-reset)) || !(laser-coarse || mask-reset) + +addf or2-mask-command-done mask-thread +net mask-test => or2-mask-command-done.in0 +net mask-reset => or2-mask-command-done.in1 +net mask-command-done <= or2-mask-command-done.out + +addf and2-mask-forward mask-thread +net laser-coarse => and2-mask-forward.in0 +net mask-command-done => and2-mask-forward.in1 +net mask-forward <= and2-mask-forward.out + +addf or2-mask-not-ffw mask-thread +net laser-coarse => or2-mask-not-ffw.in0 +net mask-reset => or2-mask-not-ffw.in1 +net mask-not-ffw <= or2-mask-not-ffw.out + +addf not-mask-ffw mask-thread +net mask-not-ffw => not-mask-ffw.in +net mask-ffw <= not-mask-ffw.out + +addf or2-mask-read mask-thread +net mask-forward => or2-mask-read.in0 +net mask-ffw => or2-mask-read.in1 +net mask-read <= or2-mask-read.out + +# laser-mask <= mask-not-empty && mask-beam +addf not-mask-not-empty mask-thread +net mask-empty => not-mask-not-empty.in +net mask-not-empty <= not-mask-not-empty.out + +addf and2-laser-mask mask-thread +net mask-beam => and2-laser-mask.in0 +net mask-not-empty => and2-laser-mask.in1 +net laser-mask <= and2-laser-mask.out + +addf streamer.0 mask-thread + +# Raster Mask - end +####################################################################### + +# coarse laser control, wired to spindle on/off (M3/M5), not realtime +net laser-coarse <= motion.spindle-on + +# fine laser control, wired to digital output 0 (M62 P0/M63 P0), realtime +net laser-gate <= motion.digital-out-00 + +# legacy laser control, wired to Z < 0, can be used instead of M62/M63 +addf comp-discrete-z servo-thread +net motion-zpos-fb <= axis.2.joint-pos-fb +net motion-zpos-fb => comp-discrete-z.in0 +setp comp-discrete-z.in1 0 +net discrete-z <= comp-discrete-z.out + +# laser-final <= laser-coarse & (laser-gate | discrete-z | laser-mask) +addf or2-laser-gcode mask-thread +net laser-gate => or2-laser-gcode.in0 +net discrete-z => or2-laser-gcode.in1 +net laser-gcode <= or2-laser-gcode.out + +addf or2-laser-fine mask-thread +net laser-gcode => or2-laser-fine.in0 +net laser-mask => or2-laser-fine.in1 +net laser-fine <= or2-laser-fine.out + +addf and2-laser-final mask-thread +net laser-fine => and2-laser-final.in0 +net laser-coarse => and2-laser-final.in1 +net laser-final <= and2-laser-final.out + +# laser-final => hardware +net laser-final => parport.0.pin-01-out + +# make Z and W axes always homed +#setp axis.2.homed 1 # Z +#setp axis.8.homed 1 # W + +net xdir => parport.0.pin-02-out +net xstep => parport.0.pin-03-out +setp parport.0.pin-03-out-reset 1 +net ydir => parport.0.pin-04-out +net ystep => parport.0.pin-05-out +setp parport.0.pin-05-out-reset 1 +net wdir => parport.0.pin-06-out +net wstep => parport.0.pin-07-out +setp parport.0.pin-07-out-reset 1 + +# invert ydir +#setp parport.0.pin-04-out-invert 1 + + +net xenable => parport.0.pin-14-out + +net home-x <= parport.0.pin-10-in +net home-y <= parport.0.pin-12-in +net estop-ext <= parport.0.pin-15-in + +setp stepgen.0.position-scale [AXIS_0]SCALE +setp stepgen.0.steplen 15200 +setp stepgen.0.stepspace 15200 +setp stepgen.0.dirhold 15200 +setp stepgen.0.dirsetup 15200 +setp stepgen.0.maxaccel [AXIS_0]STEPGEN_MAXACCEL +net xpos-cmd axis.0.motor-pos-cmd => stepgen.0.position-cmd +net xpos-fb stepgen.0.position-fb => axis.0.motor-pos-fb +net xstep <= stepgen.0.step +net xdir <= stepgen.0.dir +net xenable axis.0.amp-enable-out => stepgen.0.enable +net home-x => axis.0.home-sw-in + +setp stepgen.1.position-scale [AXIS_1]SCALE +setp stepgen.1.steplen 15200 +setp stepgen.1.stepspace 15200 +setp stepgen.1.dirhold 15200 +setp stepgen.1.dirsetup 15200 +setp stepgen.1.maxaccel [AXIS_1]STEPGEN_MAXACCEL +net ypos-cmd axis.1.motor-pos-cmd => stepgen.1.position-cmd +net ypos-fb stepgen.1.position-fb => axis.1.motor-pos-fb +net ystep <= stepgen.1.step +net ydir <= stepgen.1.dir +net yenable axis.1.amp-enable-out => stepgen.1.enable +net home-y => axis.1.home-sw-in + +setp stepgen.2.position-scale [AXIS_2]SCALE +setp stepgen.2.steplen 1 +setp stepgen.2.stepspace 0 +setp stepgen.2.dirhold 15200 +setp stepgen.2.dirsetup 15200 +setp stepgen.2.maxaccel [AXIS_2]STEPGEN_MAXACCEL +net zpos-cmd axis.2.motor-pos-cmd => stepgen.2.position-cmd +net zpos-fb stepgen.2.position-fb => axis.2.motor-pos-fb +net zstep <= stepgen.2.step +net zdir <= stepgen.2.dir +net zenable axis.2.amp-enable-out => stepgen.2.enable +net home-z => axis.2.home-sw-in + +setp stepgen.3.position-scale [AXIS_8]SCALE +setp stepgen.3.steplen 1 +setp stepgen.3.stepspace 0 +setp stepgen.3.dirhold 15200 +setp stepgen.3.dirsetup 15200 +setp stepgen.3.maxaccel [AXIS_8]STEPGEN_MAXACCEL +net wpos-cmd axis.8.motor-pos-cmd => stepgen.3.position-cmd +net wpos-fb stepgen.3.position-fb => axis.8.motor-pos-fb +net wstep <= stepgen.3.step +net wdir <= stepgen.3.dir +net wenable axis.8.amp-enable-out => stepgen.3.enable +net home-w => axis.8.home-sw-in + +net estop-out <= iocontrol.0.user-enable-out +net estop-ext => iocontrol.0.emc-enable-in + +loadusr -W hal_manualtoolchange +net tool-change iocontrol.0.tool-change => hal_manualtoolchange.change +net tool-changed iocontrol.0.tool-changed <= hal_manualtoolchange.changed +net tool-number iocontrol.0.tool-prep-number => hal_manualtoolchange.number +net tool-prepare-loopback iocontrol.0.tool-prepare => iocontrol.0.tool-prepared + +# connect the charge pump signal to an output +net charge-pump <= charge-pump.out +setp parport.0.pin-17-out-reset 1 +net charge-pump => parport.0.pin-17-out +setp charge-pump.enable 1 diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/hacklab-engraver3.ini --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/hacklab-engraver3.ini Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,124 @@ +# Generated by stepconf at Sun Mar 8 21:32:59 2009 +# If you make changes to this file, they will be +# overwritten when you run stepconf again + +[EMC] +MACHINE = hacklab-engraver3 +NML_FILE = emc.nml +DEBUG = 0 + +[DISPLAY] +DISPLAY = axis +EDITOR = gedit +POSITION_OFFSET = RELATIVE +POSITION_FEEDBACK = ACTUAL +MAX_FEED_OVERRIDE = 2 +INTRO_GRAPHIC = emc2.gif +INTRO_TIME = 5 +PROGRAM_PREFIX = /home/hacklab/emc2/nc_files +INCREMENTS = 1.0in .1in .05in .01in .005in .001in .0005in + +[TASK] +TASK = milltask +CYCLE_TIME = 0.010 + +[RS274NGC] +PARAMETER_FILE = emc.var + +[EMCMOT] +EMCMOT = motmod +SHMEM_KEY = 111 +COMM_TIMEOUT = 1.0 +COMM_WAIT = 0.010 +BASE_PERIOD = 100000 +#SERVO_PERIOD = 200000 +SERVO_PERIOD = 1000000 + + +[HAL] +HALFILE = hacklab-engraver3.hal +HALFILE = custom.hal +POSTGUI_HALFILE = custom_postgui.hal +HALUI = halui + +[TRAJ] +AXES = 9 +COORDINATES = X Y Z W +LINEAR_UNITS = inch +ANGULAR_UNITS = degree +CYCLE_TIME = 0.010 +DEFAULT_VELOCITY = 6.00 +MAX_LINEAR_VELOCITY = 300.00 + +[EMCIO] +EMCIO = io +CYCLE_TIME = 0.100 +TOOL_TABLE = tool.tbl + +[AXIS_0] +TYPE = LINEAR +HOME = 23.5 +MAX_VELOCITY = 5 +MAX_ACCELERATION = 20.0 +STEPGEN_MAXACCEL = 25.0 +SCALE = 500.0 +FERROR = 0.05 +MIN_FERROR = 0.01 +MIN_LIMIT = 0.0 +MAX_LIMIT = 23.5 +HOME_OFFSET = 22.95 +HOME_SEARCH_VEL = -6 +HOME_LATCH_VEL = -0.100000 +HOME_SEQUENCE = 1 + +[AXIS_1] +TYPE = LINEAR +HOME = 18.05 +MAX_VELOCITY = 5.0 +MAX_ACCELERATION = 20.0 +STEPGEN_MAXACCEL = 25.0 +#MAX_ACCELERATION = 200.0 +#STEPGEN_MAXACCEL = 250.0 +SCALE = 500.0 +FERROR = 0.05 +MIN_FERROR = 0.01 +MIN_LIMIT = 0 +MAX_LIMIT = 18.05 +HOME_OFFSET = 16.7 +HOME_SEARCH_VEL = -5 +HOME_LATCH_VEL = -0.100000 +HOME_SEQUENCE = 0 + +[AXIS_2] +TYPE = LINEAR +HOME = 0.01 +MAX_VELOCITY = 2000.0 +MAX_ACCELERATION = 2000.0 +STEPGEN_MAXACCEL = 3000.0 +SCALE = 1.0 +FERROR = 0.0 +MIN_FERROR = 0.01 +MIN_LIMIT = -4.0 +MAX_LIMIT = 4 +HOME_OFFSET = 0 +HOME_SEARCH_VEL = 0 +HOME_LATCH_VEL = 0 +HOME_SEQUENCE = 2 + +[AXIS_8] +TYPE = LINEAR +HOME = 0.0 +MAX_VELOCITY = 0.250 +MAX_ACCELERATION = 10.0 +STEPGEN_MAXACCEL = 10.0 +#MAX_ACCELERATION = 300.0 +#STEPGEN_MAXACCEL = 370.5 +SCALE = 2000.0 +FERROR = 0.05 +MIN_FERROR = 0.01 +MIN_LIMIT = -4 +MAX_LIMIT = 4 +HOME_OFFSET = 0 +HOME_SEARCH_VEL = 0 +HOME_LATCH_VEL = 0 +HOME_SEQUENCE = 3 diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/probe-results.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/probe-results.txt Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,9 @@ +0.000000 0.000000 -0.076762 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 +0.000000 0.000000 -0.076762 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 +0.000000 0.000000 -0.076762 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 +0.000000 0.000000 -0.076762 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 +0.000000 0.000000 -0.076762 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 +0.000000 0.000000 -0.076762 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 +0.000000 0.000000 -0.076762 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 +0.000000 0.000000 -0.076762 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 +0.000000 0.000000 -0.076762 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 diff -r ef7dbbd6452c -r f952052e37b7 graster/hacklab-engraver/tool.tbl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/hacklab-engraver/tool.tbl Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,8 @@ +POC FMS LEN DIAM COMMENT + +1 1 0.5 0.0625 first tool +2 2 0.7 0.125 +3 3 0.5 1.25 +4 4 0.7 1.0 +5 5 0 0.5 +32 32 0.5 0.0 last tool diff -r ef7dbbd6452c -r f952052e37b7 graster/lasercheck.tgz Binary file graster/lasercheck.tgz has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/signer4laser2x1.png Binary file graster/signer4laser2x1.png has changed diff -r ef7dbbd6452c -r f952052e37b7 graster/signer4laser2x1.png.cut.ngc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/signer4laser2x1.png.cut.ngc Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,13 @@ +M63 P0 +G61 +F20 +M3 S1 +G0 X1.000 Y1.000 +G1 X1.000 Y2.066 M62 P0 +G1 X3.000 Y2.066 +G1 X3.000 Y1.000 +G1 X1.000 Y1.000 +M63 P0 +M63 P0 +M5 +M2 diff -r ef7dbbd6452c -r f952052e37b7 graster/signer4laser2x1.png.raster.gmask --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/signer4laser2x1.png.raster.gmask Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,10808 @@ +1 0 0 0 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.863 +0 0 0 2.769 +0 1 0 2.751 +0 0 0 2.729 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.561 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.385 +0 1 0 2.317 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.177 +0 1 0 2.113 +0 0 0 1.979 +0 1 0 1.869 +0 0 0 1.843 +0 1 0 1.825 +0 0 0 1.731 +0 1 0 1.713 +0 0 0 1.647 +0 1 0 1.585 +0 0 0 1.493 +0 1 0 1.427 +0 0 0 1.369 +0 1 0 1.259 +0 0 0 1.207 +0 1 0 1.143 +0 0 0 1.135 +0 0 1 1.135 +0 1 1 1.217 +0 0 1 1.259 +0 1 1 1.371 +0 0 1 1.419 +0 1 1 1.503 +0 0 1 1.575 +0 1 1 1.657 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.979 +0 0 1 2.105 +0 1 1 2.187 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.309 +0 1 1 2.393 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.559 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.729 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.729 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.557 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.401 +0 1 0 2.303 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.193 +0 1 0 2.099 +0 0 0 1.979 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.663 +0 1 0 1.569 +0 0 0 1.509 +0 1 0 1.413 +0 0 0 1.371 +0 1 0 1.259 +0 0 0 1.221 +0 1 0 1.129 +0 0 0 1.125 +0 0 1 1.125 +0 1 1 1.227 +0 0 1 1.259 +0 1 1 1.371 +0 0 1 1.409 +0 1 1 1.513 +0 0 1 1.565 +0 1 1 1.667 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.979 +0 0 1 2.095 +0 1 1 2.197 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.297 +0 1 1 2.405 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.557 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.729 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.729 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.555 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.407 +0 1 0 2.295 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.199 +0 1 0 2.093 +0 0 0 1.979 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.671 +0 1 0 1.561 +0 0 0 1.517 +0 1 0 1.405 +0 0 0 1.371 +0 1 0 1.259 +0 0 0 1.229 +0 1 0 1.123 +0 0 0 1.121 +0 0 1 1.121 +0 1 1 1.231 +0 0 1 1.259 +0 1 1 1.371 +0 0 1 1.403 +0 1 1 1.519 +0 0 1 1.559 +0 1 1 1.673 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.979 +0 0 1 2.091 +0 1 1 2.201 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.291 +0 1 1 2.411 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.555 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.729 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.729 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.553 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.411 +0 1 0 2.289 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.203 +0 1 0 2.089 +0 0 0 1.979 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.675 +0 1 0 1.557 +0 0 0 1.519 +0 1 0 1.401 +0 0 0 1.371 +0 1 0 1.259 +0 0 0 1.233 +0 1 0 1.119 +0 0 0 1.117 +0 0 1 1.117 +0 1 1 1.235 +0 0 1 1.259 +0 1 1 1.371 +0 0 1 1.399 +0 1 1 1.521 +0 0 1 1.555 +0 1 1 1.677 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.979 +0 0 1 2.087 +0 1 1 2.205 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.289 +0 1 1 2.413 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.551 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.729 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.729 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.551 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.413 +0 1 0 2.379 +0 0 0 2.327 +0 1 0 2.287 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.205 +0 1 0 2.171 +0 0 0 2.121 +0 1 0 2.087 +0 0 0 1.979 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.677 +0 1 0 1.641 +0 0 0 1.591 +0 1 0 1.555 +0 0 0 1.521 +0 1 0 1.485 +0 0 0 1.437 +0 1 0 1.397 +0 0 0 1.369 +0 1 0 1.259 +0 0 0 1.235 +0 1 0 1.199 +0 0 0 1.151 +0 1 0 1.117 +0 0 0 1.115 +0 0 1 1.115 +0 1 1 1.141 +0 0 1 1.211 +0 1 1 1.237 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.397 +0 1 1 1.427 +0 0 1 1.495 +0 1 1 1.523 +0 0 1 1.553 +0 1 1 1.581 +0 0 1 1.651 +0 1 1 1.679 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.085 +0 1 1 2.111 +0 0 1 2.181 +0 1 1 2.207 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.285 +0 1 1 2.315 +0 0 1 2.387 +0 1 1 2.415 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.549 +0 1 1 2.571 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.571 +0 1 0 2.549 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.415 +0 1 0 2.393 +0 0 0 2.309 +0 1 0 2.285 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.207 +0 1 0 2.185 +0 0 0 2.107 +0 1 0 2.085 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.679 +0 1 0 1.655 +0 0 0 1.577 +0 1 0 1.551 +0 0 0 1.523 +0 1 0 1.499 +0 0 0 1.421 +0 1 0 1.395 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.237 +0 1 0 1.215 +0 0 0 1.137 +0 1 0 1.115 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 1.135 +0 0 1 1.217 +0 1 1 1.239 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.395 +0 1 1 1.419 +0 0 1 1.501 +0 1 1 1.525 +0 0 1 1.551 +0 1 1 1.573 +0 0 1 1.657 +0 1 1 1.681 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.105 +0 0 1 2.187 +0 1 1 2.209 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.283 +0 1 1 2.305 +0 0 1 2.395 +0 1 1 2.417 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.547 +0 1 1 2.569 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.567 +0 1 0 2.545 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.417 +0 1 0 2.397 +0 0 0 2.303 +0 1 0 2.283 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.209 +0 1 0 2.189 +0 0 0 2.105 +0 1 0 2.083 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.681 +0 1 0 1.659 +0 0 0 1.573 +0 1 0 1.551 +0 0 0 1.525 +0 1 0 1.503 +0 0 0 1.417 +0 1 0 1.393 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.239 +0 1 0 1.219 +0 0 0 1.135 +0 1 0 1.113 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 1.133 +0 0 1 1.219 +0 1 1 1.239 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.393 +0 1 1 1.415 +0 0 1 1.505 +0 1 1 1.525 +0 0 1 1.549 +0 1 1 1.571 +0 0 1 1.661 +0 1 1 1.681 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.103 +0 0 1 2.189 +0 1 1 2.209 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.283 +0 1 1 2.303 +0 0 1 2.397 +0 1 1 2.417 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.545 +0 1 1 2.567 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.565 +0 1 0 2.543 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.417 +0 1 0 2.399 +0 0 0 2.301 +0 1 0 2.281 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.209 +0 1 0 2.191 +0 0 0 2.103 +0 1 0 2.083 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.683 +0 1 0 1.661 +0 0 0 1.569 +0 1 0 1.549 +0 0 0 1.525 +0 1 0 1.505 +0 0 0 1.413 +0 1 0 1.393 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.239 +0 1 0 1.219 +0 0 0 1.133 +0 1 0 1.113 +0 0 0 1.111 +0 0 1 1.111 +0 1 1 1.131 +0 0 1 1.221 +0 1 1 1.239 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.393 +0 1 1 1.413 +0 0 1 1.505 +0 1 1 1.525 +0 0 1 1.549 +0 1 1 1.569 +0 0 1 1.663 +0 1 1 1.683 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.101 +0 0 1 2.191 +0 1 1 2.211 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.281 +0 1 1 2.301 +0 0 1 2.399 +0 1 1 2.419 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.541 +0 1 1 2.565 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.563 +0 1 0 2.541 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.419 +0 1 0 2.399 +0 0 0 2.299 +0 1 0 2.281 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.211 +0 1 0 2.191 +0 0 0 2.101 +0 1 0 2.081 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.683 +0 1 0 1.663 +0 0 0 1.569 +0 1 0 1.549 +0 0 0 1.527 +0 1 0 1.507 +0 0 0 1.413 +0 1 0 1.391 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.241 +0 1 0 1.221 +0 0 0 1.131 +0 1 0 1.111 +0 0 0 1.111 +0 0 1 1.111 +0 1 1 1.131 +0 0 1 1.221 +0 1 1 1.241 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.391 +0 1 1 1.411 +0 0 1 1.507 +0 1 1 1.527 +0 0 1 1.549 +0 1 1 1.569 +0 0 1 1.663 +0 1 1 1.683 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.081 +0 1 1 2.101 +0 0 1 2.191 +0 1 1 2.211 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.281 +0 1 1 2.299 +0 0 1 2.401 +0 1 1 2.419 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.539 +0 1 1 2.561 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.561 +0 1 0 2.539 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.419 +0 1 0 2.401 +0 0 0 2.299 +0 1 0 2.281 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.211 +0 1 0 2.191 +0 0 0 2.101 +0 1 0 2.081 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.683 +0 1 0 1.663 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.527 +0 1 0 1.507 +0 0 0 1.411 +0 1 0 1.391 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.241 +0 1 0 1.221 +0 0 0 1.131 +0 1 0 1.111 +0 0 0 1.111 +0 0 1 1.111 +0 1 1 1.131 +0 0 1 1.221 +0 1 1 1.241 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.391 +0 1 1 1.411 +0 0 1 1.507 +0 1 1 1.527 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.683 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.081 +0 1 1 2.101 +0 0 1 2.193 +0 1 1 2.211 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.279 +0 1 1 2.297 +0 0 1 2.401 +0 1 1 2.419 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.537 +0 1 1 2.559 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.557 +0 1 0 2.535 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.419 +0 1 0 2.401 +0 0 0 2.297 +0 1 0 2.279 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.211 +0 1 0 2.193 +0 0 0 2.101 +0 1 0 2.081 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.527 +0 1 0 1.507 +0 0 0 1.411 +0 1 0 1.391 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.241 +0 1 0 1.223 +0 0 0 1.131 +0 1 0 1.111 +0 0 0 1.111 +0 0 1 1.111 +0 1 1 1.131 +0 0 1 1.223 +0 1 1 1.241 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.389 +0 1 1 1.411 +0 0 1 1.507 +0 1 1 1.527 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.081 +0 1 1 2.101 +0 0 1 2.193 +0 1 1 2.211 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.279 +0 1 1 2.297 +0 0 1 2.401 +0 1 1 2.419 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.535 +0 1 1 2.557 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.555 +0 1 0 2.533 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.419 +0 1 0 2.401 +0 0 0 2.297 +0 1 0 2.279 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.211 +0 1 0 2.193 +0 0 0 2.101 +0 1 0 2.081 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.527 +0 1 0 1.507 +0 0 0 1.411 +0 1 0 1.389 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.241 +0 1 0 1.223 +0 0 0 1.131 +0 1 0 1.111 +0 0 0 1.111 +0 0 1 1.111 +0 1 1 1.131 +0 0 1 1.223 +0 1 1 1.241 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.389 +0 1 1 1.409 +0 0 1 1.507 +0 1 1 1.527 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.081 +0 1 1 2.101 +0 0 1 2.193 +0 1 1 2.211 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.279 +0 1 1 2.297 +0 0 1 2.401 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.531 +0 1 1 2.555 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.553 +0 1 0 2.531 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.401 +0 0 0 2.297 +0 1 0 2.279 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.211 +0 1 0 2.193 +0 0 0 2.101 +0 1 0 2.081 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.527 +0 1 0 1.507 +0 0 0 1.409 +0 1 0 1.389 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.241 +0 1 0 1.223 +0 0 0 1.129 +0 1 0 1.111 +0 0 0 1.111 +0 0 1 1.111 +0 1 1 1.129 +0 0 1 1.223 +0 1 1 1.241 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.389 +0 1 1 1.409 +0 0 1 1.507 +0 1 1 1.527 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.081 +0 1 1 2.101 +0 0 1 2.193 +0 1 1 2.211 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.297 +0 0 1 2.401 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.529 +0 1 1 2.551 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.551 +0 1 0 2.529 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.401 +0 0 0 2.297 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.211 +0 1 0 2.193 +0 0 0 2.101 +0 1 0 2.081 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.527 +0 1 0 1.507 +0 0 0 1.409 +0 1 0 1.389 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.241 +0 1 0 1.223 +0 0 0 1.129 +0 1 0 1.111 +0 0 0 1.223 +0 0 1 1.223 +0 1 1 1.241 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.389 +0 1 1 1.409 +0 0 1 1.507 +0 1 1 1.527 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.193 +0 1 1 2.211 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.297 +0 0 1 2.401 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.527 +0 1 1 2.549 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.859 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.859 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.549 +0 1 0 2.525 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.401 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.211 +0 1 0 2.193 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.821 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.527 +0 1 0 1.507 +0 0 0 1.409 +0 1 0 1.389 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.241 +0 1 0 1.223 +0 0 0 1.223 +0 0 1 1.223 +0 1 1 1.241 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.389 +0 1 1 1.409 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.821 +0 1 1 1.841 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.193 +0 1 1 2.211 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.401 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.525 +0 1 1 2.547 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.859 +0 1 1 2.879 +0 0 1 2.879 +0 0 0 2.879 +0 1 0 2.857 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.545 +0 1 0 2.523 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.401 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.211 +0 1 0 2.193 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.841 +0 1 0 1.819 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.409 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.241 +0 1 0 1.221 +0 0 0 1.221 +0 0 1 1.221 +0 1 1 1.241 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.409 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.817 +0 1 1 1.841 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.191 +0 1 1 2.211 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.401 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.523 +0 1 1 2.545 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.855 +0 1 1 2.879 +0 0 1 2.877 +0 0 0 2.877 +0 1 0 2.853 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.543 +0 1 0 2.521 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.401 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.211 +0 1 0 2.191 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.839 +0 1 0 1.815 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.409 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.241 +0 1 0 1.221 +0 0 0 1.221 +0 0 1 1.221 +0 1 1 1.241 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.409 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.813 +0 1 1 1.839 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.191 +0 1 1 2.211 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.401 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.519 +0 1 1 2.543 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.851 +0 1 1 2.877 +0 0 1 2.875 +0 0 0 2.875 +0 1 0 2.847 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.541 +0 1 0 2.519 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.401 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.211 +0 1 0 2.189 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.837 +0 1 0 1.809 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.409 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.239 +0 1 0 1.219 +0 0 0 1.219 +0 0 1 1.219 +0 1 1 1.239 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.409 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.799 +0 1 1 1.835 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.189 +0 1 1 2.209 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.347 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.517 +0 1 1 2.539 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.837 +0 1 1 2.873 +0 0 1 2.871 +0 0 0 2.871 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.539 +0 1 0 2.517 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.345 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.209 +0 1 0 2.187 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.833 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.409 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.239 +0 1 0 1.217 +0 0 0 1.213 +0 0 1 1.213 +0 1 1 1.239 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.409 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.829 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.183 +0 1 1 2.209 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.345 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.515 +0 1 1 2.537 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.867 +0 0 1 2.863 +0 0 0 2.863 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.537 +0 1 0 2.513 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.345 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.207 +0 1 0 2.179 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.825 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.237 +0 1 0 1.209 +0 0 0 1.197 +0 0 1 1.197 +0 1 1 1.237 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.819 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.167 +0 1 1 2.207 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.345 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.513 +0 1 1 2.535 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.857 +0 0 1 2.863 +0 0 0 2.863 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.533 +0 1 0 2.511 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.345 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.207 +0 1 0 2.125 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.825 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.237 +0 1 0 1.155 +0 0 0 1.143 +0 0 1 1.143 +0 1 1 1.235 +0 0 1 1.259 +0 1 1 1.367 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.829 +0 0 1 1.867 +0 1 1 1.975 +0 0 1 2.113 +0 1 1 2.205 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.345 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.509 +0 1 1 2.533 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.725 +0 0 1 2.751 +0 1 1 2.867 +0 0 1 2.871 +0 0 0 2.871 +0 1 0 2.751 +0 0 0 2.725 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.531 +0 1 0 2.509 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.345 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.203 +0 1 0 2.107 +0 0 0 1.975 +0 1 0 1.867 +0 0 0 1.833 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.367 +0 1 0 1.259 +0 0 0 1.233 +0 1 0 1.137 +0 0 0 1.133 +0 0 1 1.133 +0 1 1 1.231 +0 0 1 1.259 +0 1 1 1.367 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.835 +0 0 1 1.867 +0 1 1 1.975 +0 0 1 2.103 +0 1 1 2.201 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.347 +0 1 1 2.419 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.507 +0 1 1 2.529 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.725 +0 0 1 2.751 +0 1 1 2.873 +0 0 1 2.875 +0 0 0 2.875 +0 1 0 2.843 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.725 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.529 +0 1 0 2.507 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.199 +0 1 0 2.099 +0 0 0 1.975 +0 1 0 1.867 +0 0 0 1.837 +0 1 0 1.805 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.367 +0 1 0 1.259 +0 0 0 1.229 +0 1 0 1.129 +0 0 0 1.127 +0 0 1 1.127 +0 1 1 1.225 +0 0 1 1.259 +0 1 1 1.367 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.813 +0 1 1 1.839 +0 0 1 1.867 +0 1 1 1.975 +0 0 1 2.097 +0 1 1 2.195 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.505 +0 1 1 2.527 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.725 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.851 +0 1 1 2.877 +0 0 1 2.879 +0 0 0 2.879 +0 1 0 2.855 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.725 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.527 +0 1 0 2.503 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.189 +0 1 0 2.093 +0 0 0 1.975 +0 1 0 1.867 +0 0 0 1.841 +0 1 0 1.817 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.367 +0 1 0 1.259 +0 0 0 1.219 +0 1 0 1.123 +0 0 0 1.121 +0 0 1 1.121 +0 1 1 1.211 +0 0 1 1.259 +0 1 1 1.367 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.819 +0 1 1 1.841 +0 0 1 1.867 +0 1 1 1.975 +0 0 1 2.091 +0 1 1 2.181 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.503 +0 1 1 2.525 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.725 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.857 +0 1 1 2.879 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.859 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.725 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.523 +0 1 0 2.501 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.169 +0 1 0 2.091 +0 0 0 1.975 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.821 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.367 +0 1 0 1.259 +0 0 0 1.199 +0 1 0 1.121 +0 0 0 1.119 +0 0 1 1.119 +0 1 1 1.169 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.889 +0 0 1 2.089 +0 1 1 2.139 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.499 +0 1 1 2.523 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.521 +0 1 0 2.499 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.119 +0 1 0 2.087 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.149 +0 1 0 1.117 +0 0 0 1.117 +0 0 1 1.117 +0 1 1 1.141 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.825 +0 1 1 1.845 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.087 +0 1 1 2.111 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.497 +0 1 1 2.521 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.863 +0 1 1 2.881 +0 0 1 2.883 +0 0 0 2.883 +0 1 0 2.863 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.519 +0 1 0 2.497 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.107 +0 1 0 2.085 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.845 +0 1 0 1.825 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.137 +0 1 0 1.115 +0 0 0 1.115 +0 0 1 1.115 +0 1 1 1.135 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.827 +0 1 1 1.845 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.085 +0 1 1 2.105 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.495 +0 1 1 2.517 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.863 +0 1 1 2.883 +0 0 1 2.883 +0 0 0 2.883 +0 1 0 2.865 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.517 +0 1 0 2.493 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.103 +0 1 0 2.085 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.845 +0 1 0 1.827 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.133 +0 1 0 1.115 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 1.133 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.827 +0 1 1 1.845 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.103 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.295 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.493 +0 1 1 2.515 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.865 +0 1 1 2.883 +0 0 1 2.883 +0 0 0 2.883 +0 1 0 2.865 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.515 +0 1 0 2.491 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.295 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.103 +0 1 0 2.083 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.845 +0 1 0 1.827 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.133 +0 1 0 1.113 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 1.131 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.827 +0 1 1 1.845 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.101 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.297 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.491 +0 1 1 2.513 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.865 +0 1 1 2.883 +0 0 1 2.883 +0 0 0 2.883 +0 1 0 2.865 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.511 +0 1 0 2.489 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.297 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.101 +0 1 0 2.083 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.845 +0 1 0 1.827 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.131 +0 1 0 1.113 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 1.131 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.827 +0 1 1 1.847 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.101 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.297 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.487 +0 1 1 2.511 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.865 +0 1 1 2.883 +0 0 1 2.883 +0 0 0 2.883 +0 1 0 2.865 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.509 +0 1 0 2.487 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.297 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.101 +0 1 0 2.083 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.847 +0 1 0 1.827 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.131 +0 1 0 1.113 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 1.131 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.505 +0 1 1 1.525 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.827 +0 1 1 1.847 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.101 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.297 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.485 +0 1 1 2.507 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.865 +0 1 1 2.883 +0 0 1 2.883 +0 0 0 2.883 +0 1 0 2.865 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.507 +0 1 0 2.485 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.401 +0 0 0 2.297 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.101 +0 1 0 2.083 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.847 +0 1 0 1.827 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.525 +0 1 0 1.505 +0 0 0 1.407 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.131 +0 1 0 1.111 +0 0 0 1.111 +0 0 1 1.111 +0 1 1 1.131 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.387 +0 1 1 1.407 +0 0 1 1.505 +0 1 1 1.525 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.827 +0 1 1 1.847 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.081 +0 1 1 2.101 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.277 +0 1 1 2.297 +0 0 1 2.401 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.483 +0 1 1 2.505 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.865 +0 1 1 2.883 +0 0 1 2.883 +0 0 0 2.883 +0 1 0 2.865 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.505 +0 1 0 2.481 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.401 +0 0 0 2.297 +0 1 0 2.277 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.209 +0 1 0 2.189 +0 0 0 2.101 +0 1 0 2.081 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.847 +0 1 0 1.827 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.525 +0 1 0 1.505 +0 0 0 1.409 +0 1 0 1.387 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.239 +0 1 0 1.219 +0 0 0 1.131 +0 1 0 1.111 +0 0 0 1.111 +0 0 1 1.111 +0 1 1 1.131 +0 0 1 1.219 +0 1 1 1.239 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.389 +0 1 1 1.409 +0 0 1 1.505 +0 1 1 1.525 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.827 +0 1 1 1.847 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.101 +0 0 1 2.189 +0 1 1 2.209 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.279 +0 1 1 2.297 +0 0 1 2.401 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.481 +0 1 1 2.503 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.865 +0 1 1 2.883 +0 0 1 2.883 +0 0 0 2.883 +0 1 0 2.865 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.501 +0 1 0 2.479 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.401 +0 0 0 2.297 +0 1 0 2.279 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.209 +0 1 0 2.189 +0 0 0 2.101 +0 1 0 2.083 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.845 +0 1 0 1.827 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.525 +0 1 0 1.505 +0 0 0 1.409 +0 1 0 1.389 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.239 +0 1 0 1.219 +0 0 0 1.131 +0 1 0 1.111 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 1.131 +0 0 1 1.219 +0 1 1 1.239 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.389 +0 1 1 1.409 +0 0 1 1.505 +0 1 1 1.525 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.827 +0 1 1 1.845 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.101 +0 0 1 2.189 +0 1 1 2.209 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.279 +0 1 1 2.297 +0 0 1 2.401 +0 1 1 2.421 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.479 +0 1 1 2.501 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.865 +0 1 1 2.883 +0 0 1 2.883 +0 0 0 2.883 +0 1 0 2.865 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.499 +0 1 0 2.477 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.421 +0 1 0 2.401 +0 0 0 2.299 +0 1 0 2.279 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.207 +0 1 0 2.189 +0 0 0 2.101 +0 1 0 2.083 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.845 +0 1 0 1.827 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.525 +0 1 0 1.505 +0 0 0 1.409 +0 1 0 1.389 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.237 +0 1 0 1.219 +0 0 0 1.131 +0 1 0 1.113 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 1.131 +0 0 1 1.219 +0 1 1 1.237 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.389 +0 1 1 1.409 +0 0 1 1.505 +0 1 1 1.525 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.827 +0 1 1 1.845 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.101 +0 0 1 2.189 +0 1 1 2.207 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.279 +0 1 1 2.299 +0 0 1 2.401 +0 1 1 2.419 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.475 +0 1 1 2.499 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.863 +0 1 1 2.883 +0 0 1 2.883 +0 0 0 2.883 +0 1 0 2.863 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.497 +0 1 0 2.475 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.419 +0 1 0 2.399 +0 0 0 2.299 +0 1 0 2.281 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.207 +0 1 0 2.187 +0 0 0 2.101 +0 1 0 2.083 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.845 +0 1 0 1.825 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.525 +0 1 0 1.505 +0 0 0 1.411 +0 1 0 1.389 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.237 +0 1 0 1.217 +0 0 0 1.131 +0 1 0 1.113 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 1.131 +0 0 1 1.217 +0 1 1 1.237 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.389 +0 1 1 1.411 +0 0 1 1.505 +0 1 1 1.523 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.825 +0 1 1 1.845 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.101 +0 0 1 2.187 +0 1 1 2.207 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.281 +0 1 1 2.299 +0 0 1 2.399 +0 1 1 2.419 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.473 +0 1 1 2.495 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.863 +0 1 1 2.883 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.863 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.495 +0 1 0 2.473 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.419 +0 1 0 2.399 +0 0 0 2.301 +0 1 0 2.281 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.207 +0 1 0 2.187 +0 0 0 2.103 +0 1 0 2.083 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.845 +0 1 0 1.825 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.523 +0 1 0 1.503 +0 0 0 1.411 +0 1 0 1.389 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.237 +0 1 0 1.217 +0 0 0 1.133 +0 1 0 1.113 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 1.133 +0 0 1 1.217 +0 1 1 1.237 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.391 +0 1 1 1.413 +0 0 1 1.503 +0 1 1 1.523 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.823 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.083 +0 1 1 2.103 +0 0 1 2.187 +0 1 1 2.207 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.281 +0 1 1 2.301 +0 0 1 2.399 +0 1 1 2.419 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.471 +0 1 1 2.493 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.861 +0 1 1 2.881 +0 0 1 2.881 +0 0 0 2.881 +0 1 0 2.861 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.493 +0 1 0 2.469 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.419 +0 1 0 2.397 +0 0 0 2.303 +0 1 0 2.283 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.207 +0 1 0 2.185 +0 0 0 2.105 +0 1 0 2.085 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.843 +0 1 0 1.823 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.523 +0 1 0 1.503 +0 0 0 1.413 +0 1 0 1.391 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.237 +0 1 0 1.215 +0 0 0 1.135 +0 1 0 1.115 +0 0 0 1.115 +0 0 1 1.115 +0 1 1 1.135 +0 0 1 1.215 +0 1 1 1.235 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.393 +0 1 1 1.415 +0 0 1 1.501 +0 1 1 1.523 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.821 +0 1 1 1.843 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.085 +0 1 1 2.105 +0 0 1 2.185 +0 1 1 2.205 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.283 +0 1 1 2.305 +0 0 1 2.397 +0 1 1 2.419 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.469 +0 1 1 2.491 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.859 +0 1 1 2.879 +0 0 1 2.879 +0 0 0 2.879 +0 1 0 2.857 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.489 +0 1 0 2.467 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.417 +0 1 0 2.395 +0 0 0 2.307 +0 1 0 2.285 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.205 +0 1 0 2.183 +0 0 0 2.107 +0 1 0 2.085 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.841 +0 1 0 1.819 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.521 +0 1 0 1.499 +0 0 0 1.417 +0 1 0 1.393 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.235 +0 1 0 1.213 +0 0 0 1.137 +0 1 0 1.115 +0 0 0 1.117 +0 0 1 1.117 +0 1 1 1.141 +0 0 1 1.211 +0 1 1 1.235 +0 0 1 1.259 +0 1 1 1.279 +0 0 1 1.395 +0 1 1 1.421 +0 0 1 1.497 +0 1 1 1.521 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.733 +0 0 1 1.815 +0 1 1 1.841 +0 0 1 1.867 +0 1 1 1.887 +0 0 1 2.087 +0 1 1 2.111 +0 0 1 2.181 +0 1 1 2.205 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.285 +0 1 1 2.309 +0 0 1 2.391 +0 1 1 2.417 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.467 +0 1 1 2.489 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.751 +0 1 1 2.771 +0 0 1 2.853 +0 1 1 2.879 +0 0 1 2.877 +0 0 0 2.877 +0 1 0 2.845 +0 0 0 2.771 +0 1 0 2.751 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.487 +0 1 0 2.445 +0 0 0 2.417 +0 1 0 2.385 +0 0 0 2.317 +0 1 0 2.287 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.203 +0 1 0 2.175 +0 0 0 2.117 +0 1 0 2.087 +0 0 0 1.887 +0 1 0 1.867 +0 0 0 1.839 +0 1 0 1.807 +0 0 0 1.733 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.519 +0 1 0 1.493 +0 0 0 1.429 +0 1 0 1.397 +0 0 0 1.279 +0 1 0 1.259 +0 0 0 1.233 +0 1 0 1.205 +0 0 0 1.147 +0 1 0 1.117 +0 0 0 1.119 +0 0 1 1.119 +0 1 1 1.159 +0 0 1 1.195 +0 1 1 1.233 +0 0 1 1.259 +0 1 1 1.371 +0 0 1 1.397 +0 1 1 1.443 +0 0 1 1.483 +0 1 1 1.519 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.839 +0 0 1 1.867 +0 1 1 1.979 +0 0 1 2.089 +0 1 1 2.129 +0 0 1 2.165 +0 1 1 2.203 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.287 +0 1 1 2.329 +0 0 1 2.371 +0 1 1 2.415 +0 0 1 2.445 +0 1 1 2.485 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.729 +0 0 1 2.751 +0 1 1 2.877 +0 0 1 2.875 +0 0 0 2.875 +0 1 0 2.751 +0 0 0 2.729 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.485 +0 1 0 2.445 +0 0 0 2.413 +0 1 0 2.289 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.201 +0 1 0 2.089 +0 0 0 1.979 +0 1 0 1.867 +0 0 0 1.837 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.517 +0 1 0 1.399 +0 0 0 1.371 +0 1 0 1.259 +0 0 0 1.231 +0 1 0 1.119 +0 0 0 1.121 +0 0 1 1.121 +0 1 1 1.231 +0 0 1 1.259 +0 1 1 1.371 +0 0 1 1.403 +0 1 1 1.517 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.835 +0 0 1 1.867 +0 1 1 1.979 +0 0 1 2.091 +0 1 1 2.201 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.291 +0 1 1 2.413 +0 0 1 2.445 +0 1 1 2.483 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.729 +0 0 1 2.751 +0 1 1 2.873 +0 0 1 2.871 +0 0 0 2.871 +0 1 0 2.751 +0 0 0 2.729 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.483 +0 1 0 2.445 +0 0 0 2.411 +0 1 0 2.293 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.199 +0 1 0 2.093 +0 0 0 1.979 +0 1 0 1.867 +0 0 0 1.833 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.515 +0 1 0 1.405 +0 0 0 1.371 +0 1 0 1.259 +0 0 0 1.229 +0 1 0 1.123 +0 0 0 1.125 +0 0 1 1.125 +0 1 1 1.227 +0 0 1 1.259 +0 1 1 1.371 +0 0 1 1.407 +0 1 1 1.513 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.831 +0 0 1 1.867 +0 1 1 1.979 +0 0 1 2.095 +0 1 1 2.197 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.297 +0 1 1 2.409 +0 0 1 2.445 +0 1 1 2.481 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.729 +0 0 1 2.751 +0 1 1 2.867 +0 0 1 2.863 +0 0 0 2.863 +0 1 0 2.751 +0 0 0 2.729 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.479 +0 1 0 2.445 +0 0 0 2.405 +0 1 0 2.301 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.193 +0 1 0 2.099 +0 0 0 1.979 +0 1 0 1.867 +0 0 0 1.827 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.509 +0 1 0 1.411 +0 0 0 1.371 +0 1 0 1.259 +0 0 0 1.223 +0 1 0 1.129 +0 0 0 1.133 +0 0 1 1.133 +0 1 1 1.219 +0 0 1 1.259 +0 1 1 1.371 +0 0 1 1.417 +0 1 1 1.505 +0 0 1 1.547 +0 1 1 1.567 +0 0 1 1.665 +0 1 1 1.685 +0 0 1 1.713 +0 1 1 1.821 +0 0 1 1.867 +0 1 1 1.979 +0 0 1 2.103 +0 1 1 2.189 +0 0 1 2.233 +0 1 1 2.253 +0 0 1 2.307 +0 1 1 2.401 +0 0 1 2.445 +0 1 1 2.479 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.617 +0 1 1 2.729 +0 0 1 2.751 +0 1 1 2.859 +0 0 1 2.851 +0 0 0 2.851 +0 1 0 2.751 +0 0 0 2.729 +0 1 0 2.617 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.477 +0 1 0 2.445 +0 0 0 2.395 +0 1 0 2.313 +0 0 0 2.253 +0 1 0 2.233 +0 0 0 2.183 +0 1 0 2.109 +0 0 0 1.979 +0 1 0 1.867 +0 0 0 1.815 +0 1 0 1.713 +0 0 0 1.685 +0 1 0 1.665 +0 0 0 1.567 +0 1 0 1.547 +0 0 0 1.499 +0 1 0 1.425 +0 0 0 1.371 +0 1 0 1.259 +0 0 0 1.213 +0 1 0 1.139 +0 0 0 1.153 +0 0 1 1.153 +0 1 1 1.199 +0 0 1 1.441 +0 1 1 1.487 +0 0 1 2.123 +0 1 1 2.169 +0 0 1 2.327 +0 1 1 2.379 +0 0 0 1.121 +0 0 1 1.121 +0 1 1 2.879 +0 0 1 2.885 +0 0 0 2.885 +0 1 0 1.115 +0 0 0 1.109 +0 0 1 1.109 +0 1 1 2.891 +0 0 1 2.895 +0 0 0 2.895 +0 1 0 1.105 +0 0 0 1.101 +0 0 1 1.101 +0 1 1 2.899 +0 0 1 2.901 +0 0 0 2.901 +0 1 0 1.099 +0 0 0 1.095 +0 0 1 1.095 +0 1 1 2.905 +0 0 1 2.907 +0 0 0 2.907 +0 1 0 1.093 +0 0 0 1.091 +0 0 1 1.091 +0 1 1 1.121 +0 0 1 2.879 +0 1 1 2.909 +0 0 1 2.911 +0 0 0 2.911 +0 1 0 2.885 +0 0 0 1.115 +0 1 0 1.089 +0 0 0 1.089 +0 0 1 1.089 +0 1 1 1.111 +0 0 1 2.889 +0 1 1 2.913 +0 0 1 2.915 +0 0 0 2.915 +0 1 0 2.891 +0 0 0 1.109 +0 1 0 1.087 +0 0 0 1.085 +0 0 1 1.085 +0 1 1 1.105 +0 0 1 2.895 +0 1 1 2.915 +0 0 1 2.917 +0 0 0 2.917 +0 1 0 2.897 +0 0 0 1.103 +0 1 0 1.083 +0 0 0 1.083 +0 0 1 1.083 +0 1 1 1.101 +0 0 1 2.899 +0 1 1 2.919 +0 0 1 2.919 +0 0 0 2.919 +0 1 0 2.901 +0 0 0 1.099 +0 1 0 1.081 +0 0 0 1.081 +0 0 1 1.081 +0 1 1 1.099 +0 0 1 2.903 +0 1 1 2.921 +0 0 1 2.921 +0 0 0 2.921 +0 1 0 2.903 +0 0 0 1.097 +0 1 0 1.079 +0 0 0 1.079 +0 0 1 1.079 +0 1 1 1.095 +0 0 1 2.905 +0 1 1 2.921 +0 0 1 2.923 +0 0 0 2.923 +0 1 0 2.907 +0 0 0 1.095 +0 1 0 1.077 +0 0 0 1.077 +0 0 1 1.077 +0 1 1 1.093 +0 0 1 2.907 +0 1 1 2.923 +0 0 1 2.923 +0 0 0 2.923 +0 1 0 2.907 +0 0 0 1.093 +0 1 0 1.077 +0 0 0 1.077 +0 0 1 1.077 +0 1 1 1.091 +0 0 1 2.909 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.909 +0 0 0 1.091 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.091 +0 0 1 2.909 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.909 +0 0 0 1.091 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.091 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.277 +0 1 0 2.179 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.219 +0 1 1 1.427 +0 0 1 1.635 +0 1 1 1.713 +0 0 1 1.871 +0 1 1 1.997 +0 0 1 2.161 +0 1 1 2.295 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.309 +0 1 0 2.149 +0 0 0 2.001 +0 1 0 1.867 +0 0 0 1.715 +0 1 0 1.631 +0 0 0 1.451 +0 1 0 1.215 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.215 +0 1 1 1.467 +0 0 1 1.631 +0 1 1 1.717 +0 0 1 1.865 +0 1 1 2.003 +0 0 1 2.139 +0 1 1 2.321 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.329 +0 1 0 2.131 +0 0 0 2.003 +0 1 0 1.863 +0 0 0 1.717 +0 1 0 1.629 +0 0 0 1.475 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.483 +0 0 1 1.629 +0 1 1 1.719 +0 0 1 1.863 +0 1 1 2.003 +0 0 1 2.125 +0 1 1 2.335 +0 0 1 2.417 +0 1 1 2.507 +0 0 1 2.715 +0 1 1 2.805 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.807 +0 1 0 2.713 +0 0 0 2.509 +0 1 0 2.415 +0 0 0 2.341 +0 1 0 2.119 +0 0 0 2.003 +0 1 0 1.861 +0 0 0 1.719 +0 1 0 1.629 +0 0 0 1.491 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.495 +0 0 1 1.629 +0 1 1 1.719 +0 0 1 1.861 +0 1 1 2.003 +0 0 1 2.115 +0 1 1 2.209 +0 0 1 2.245 +0 1 1 2.347 +0 0 1 2.415 +0 1 1 2.511 +0 0 1 2.711 +0 1 1 2.807 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.809 +0 1 0 2.709 +0 0 0 2.513 +0 1 0 2.415 +0 0 0 2.351 +0 1 0 2.279 +0 0 0 2.177 +0 1 0 2.111 +0 0 0 2.003 +0 1 0 1.859 +0 0 0 1.719 +0 1 0 1.629 +0 0 0 1.499 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.439 +0 1 1 1.505 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.859 +0 1 1 1.877 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.107 +0 1 1 2.157 +0 0 1 2.301 +0 1 1 2.355 +0 0 1 2.415 +0 1 1 2.515 +0 0 1 2.707 +0 1 1 2.807 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.807 +0 1 0 2.705 +0 0 0 2.517 +0 1 0 2.415 +0 0 0 2.359 +0 1 0 2.311 +0 0 0 2.147 +0 1 0 2.103 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.875 +0 1 0 1.857 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.509 +0 1 0 1.457 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.467 +0 1 1 1.511 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.857 +0 1 1 1.873 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.101 +0 1 1 2.139 +0 0 1 2.321 +0 1 1 2.361 +0 0 1 2.417 +0 1 1 2.519 +0 0 1 2.703 +0 1 1 2.805 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.805 +0 1 0 2.701 +0 0 0 2.521 +0 1 0 2.417 +0 0 0 2.363 +0 1 0 2.329 +0 0 0 2.131 +0 1 0 2.097 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.873 +0 1 0 1.855 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.515 +0 1 0 1.477 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.483 +0 1 1 1.517 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.855 +0 1 1 1.871 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.095 +0 1 1 2.125 +0 0 1 2.335 +0 1 1 2.365 +0 0 1 2.419 +0 1 1 2.439 +0 0 1 2.503 +0 1 1 2.523 +0 0 1 2.699 +0 1 1 2.721 +0 0 1 2.783 +0 1 1 2.803 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.801 +0 1 0 2.785 +0 0 0 2.719 +0 1 0 2.699 +0 0 0 2.523 +0 1 0 2.503 +0 0 0 2.439 +0 1 0 2.421 +0 0 0 2.367 +0 1 0 2.339 +0 0 0 2.121 +0 1 0 2.093 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.871 +0 1 0 1.853 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.521 +0 1 0 1.489 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.493 +0 1 1 1.523 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.853 +0 1 1 1.869 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.091 +0 1 1 2.117 +0 0 1 2.345 +0 1 1 2.369 +0 0 1 2.421 +0 1 1 2.439 +0 0 1 2.505 +0 1 1 2.525 +0 0 1 2.697 +0 1 1 2.717 +0 0 1 2.783 +0 1 1 2.801 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.799 +0 1 0 2.781 +0 0 0 2.715 +0 1 0 2.695 +0 0 0 2.527 +0 1 0 2.507 +0 0 0 2.441 +0 1 0 2.423 +0 0 0 2.371 +0 1 0 2.349 +0 0 0 2.113 +0 1 0 2.089 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.869 +0 1 0 1.851 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.525 +0 1 0 1.499 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.501 +0 1 1 1.527 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.851 +0 1 1 1.867 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.089 +0 1 1 2.111 +0 0 1 2.351 +0 1 1 2.373 +0 0 1 2.425 +0 1 1 2.443 +0 0 1 2.509 +0 1 1 2.529 +0 0 1 2.693 +0 1 1 2.713 +0 0 1 2.779 +0 1 1 2.797 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.797 +0 1 0 2.779 +0 0 0 2.711 +0 1 0 2.691 +0 0 0 2.531 +0 1 0 2.511 +0 0 0 2.443 +0 1 0 2.425 +0 0 0 2.375 +0 1 0 2.353 +0 0 0 2.107 +0 1 0 2.087 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.867 +0 1 0 1.849 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.529 +0 1 0 1.505 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.509 +0 1 1 1.531 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.849 +0 1 1 1.865 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.085 +0 1 1 2.105 +0 0 1 2.357 +0 1 1 2.375 +0 0 1 2.427 +0 1 1 2.445 +0 0 1 2.513 +0 1 1 2.533 +0 0 1 2.689 +0 1 1 2.709 +0 0 1 2.777 +0 1 1 2.795 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.793 +0 1 0 2.775 +0 0 0 2.707 +0 1 0 2.687 +0 0 0 2.535 +0 1 0 2.515 +0 0 0 2.447 +0 1 0 2.429 +0 0 0 2.377 +0 1 0 2.357 +0 0 0 2.103 +0 1 0 2.083 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.865 +0 1 0 1.847 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.533 +0 1 0 1.511 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.513 +0 1 1 1.535 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.847 +0 1 1 1.863 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.083 +0 1 1 2.101 +0 0 1 2.359 +0 1 1 2.379 +0 0 1 2.431 +0 1 1 2.449 +0 0 1 2.517 +0 1 1 2.537 +0 0 1 2.685 +0 1 1 2.705 +0 0 1 2.775 +0 1 1 2.793 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.791 +0 1 0 2.773 +0 0 0 2.703 +0 1 0 2.683 +0 0 0 2.539 +0 1 0 2.519 +0 0 0 2.449 +0 1 0 2.431 +0 0 0 2.379 +0 1 0 2.361 +0 0 0 2.099 +0 1 0 2.081 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.863 +0 1 0 1.845 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.535 +0 1 0 1.515 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.517 +0 1 1 1.537 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.845 +0 1 1 1.861 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.081 +0 1 1 2.099 +0 0 1 2.363 +0 1 1 2.381 +0 0 1 2.433 +0 1 1 2.451 +0 0 1 2.521 +0 1 1 2.541 +0 0 1 2.683 +0 1 1 2.703 +0 0 1 2.771 +0 1 1 2.789 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.787 +0 1 0 2.771 +0 0 0 2.701 +0 1 0 2.681 +0 0 0 2.543 +0 1 0 2.523 +0 0 0 2.453 +0 1 0 2.435 +0 0 0 2.381 +0 1 0 2.363 +0 0 0 2.097 +0 1 0 2.079 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.861 +0 1 0 1.843 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.539 +0 1 0 1.519 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.521 +0 1 1 1.539 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.841 +0 1 1 1.859 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.079 +0 1 1 2.095 +0 0 1 2.365 +0 1 1 2.381 +0 0 1 2.435 +0 1 1 2.453 +0 0 1 2.523 +0 1 1 2.543 +0 0 1 2.679 +0 1 1 2.699 +0 0 1 2.769 +0 1 1 2.787 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.785 +0 1 0 2.767 +0 0 0 2.697 +0 1 0 2.677 +0 0 0 2.545 +0 1 0 2.525 +0 0 0 2.455 +0 1 0 2.437 +0 0 0 2.383 +0 1 0 2.367 +0 0 0 2.095 +0 1 0 2.077 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.859 +0 1 0 1.841 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.541 +0 1 0 1.523 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.525 +0 1 1 1.541 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.839 +0 1 1 1.857 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.077 +0 1 1 2.093 +0 0 1 2.367 +0 1 1 2.383 +0 0 1 2.439 +0 1 1 2.457 +0 0 1 2.527 +0 1 1 2.547 +0 0 1 2.675 +0 1 1 2.695 +0 0 1 2.765 +0 1 1 2.783 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.783 +0 1 0 2.765 +0 0 0 2.693 +0 1 0 2.673 +0 0 0 2.549 +0 1 0 2.529 +0 0 0 2.457 +0 1 0 2.439 +0 0 0 2.385 +0 1 0 2.367 +0 0 0 2.093 +0 1 0 2.077 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.857 +0 1 0 1.839 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.543 +0 1 0 1.525 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.527 +0 1 1 1.543 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.837 +0 1 1 1.855 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.075 +0 1 1 2.091 +0 0 1 2.211 +0 1 1 2.259 +0 0 1 2.369 +0 1 1 2.385 +0 0 1 2.441 +0 1 1 2.459 +0 0 1 2.531 +0 1 1 2.551 +0 0 1 2.671 +0 1 1 2.691 +0 0 1 2.763 +0 1 1 2.781 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.779 +0 1 0 2.761 +0 0 0 2.689 +0 1 0 2.669 +0 0 0 2.553 +0 1 0 2.533 +0 0 0 2.461 +0 1 0 2.443 +0 0 0 2.385 +0 1 0 2.369 +0 0 0 2.277 +0 1 0 2.185 +0 0 0 2.091 +0 1 0 2.075 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.855 +0 1 0 1.837 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.545 +0 1 0 1.527 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.529 +0 1 1 1.545 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.835 +0 1 1 1.853 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.075 +0 1 1 2.091 +0 0 1 2.171 +0 1 1 2.289 +0 0 1 2.371 +0 1 1 2.387 +0 0 1 2.443 +0 1 1 2.461 +0 0 1 2.535 +0 1 1 2.555 +0 0 1 2.667 +0 1 1 2.687 +0 0 1 2.761 +0 1 1 2.779 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.777 +0 1 0 2.759 +0 0 0 2.685 +0 1 0 2.665 +0 0 0 2.557 +0 1 0 2.537 +0 0 0 2.463 +0 1 0 2.445 +0 0 0 2.387 +0 1 0 2.371 +0 0 0 2.295 +0 1 0 2.165 +0 0 0 2.089 +0 1 0 2.073 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.853 +0 1 0 1.835 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.547 +0 1 0 1.529 +0 0 0 1.415 +0 1 0 1.291 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.289 +0 1 1 1.429 +0 0 1 1.531 +0 1 1 1.547 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.833 +0 1 1 1.851 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.073 +0 1 1 2.089 +0 0 1 2.159 +0 1 1 2.299 +0 0 1 2.371 +0 1 1 2.387 +0 0 1 2.447 +0 1 1 2.465 +0 0 1 2.539 +0 1 1 2.559 +0 0 1 2.665 +0 1 1 2.685 +0 0 1 2.757 +0 1 1 2.775 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.775 +0 1 0 2.757 +0 0 0 2.683 +0 1 0 2.663 +0 0 0 2.561 +0 1 0 2.541 +0 0 0 2.467 +0 1 0 2.449 +0 0 0 2.387 +0 1 0 2.373 +0 0 0 2.303 +0 1 0 2.155 +0 0 0 2.089 +0 1 0 2.073 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.917 +0 0 0 1.849 +0 1 0 1.833 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.547 +0 1 0 1.531 +0 0 0 1.439 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.445 +0 0 1 1.531 +0 1 1 1.549 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.831 +0 1 1 1.849 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.089 +0 0 1 2.153 +0 1 1 2.305 +0 0 1 2.373 +0 1 1 2.389 +0 0 1 2.449 +0 1 1 2.467 +0 0 1 2.541 +0 1 1 2.561 +0 0 1 2.661 +0 1 1 2.681 +0 0 1 2.755 +0 1 1 2.773 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.771 +0 1 0 2.753 +0 0 0 2.679 +0 1 0 2.659 +0 0 0 2.563 +0 1 0 2.543 +0 0 0 2.469 +0 1 0 2.451 +0 0 0 2.389 +0 1 0 2.373 +0 0 0 2.307 +0 1 0 2.151 +0 0 0 2.087 +0 1 0 2.071 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.933 +0 1 0 1.915 +0 0 0 1.847 +0 1 0 1.831 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.549 +0 1 0 1.533 +0 0 0 1.449 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.455 +0 0 1 1.533 +0 1 1 1.549 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.829 +0 1 1 1.847 +0 0 1 1.913 +0 1 1 1.933 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.087 +0 0 1 2.149 +0 1 1 2.199 +0 0 1 2.267 +0 1 1 2.309 +0 0 1 2.373 +0 1 1 2.389 +0 0 1 2.453 +0 1 1 2.471 +0 0 1 2.545 +0 1 1 2.565 +0 0 1 2.657 +0 1 1 2.677 +0 0 1 2.753 +0 1 1 2.771 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.769 +0 1 0 2.751 +0 0 0 2.675 +0 1 0 2.655 +0 0 0 2.567 +0 1 0 2.547 +0 0 0 2.471 +0 1 0 2.453 +0 0 0 2.389 +0 1 0 2.375 +0 0 0 2.311 +0 1 0 2.281 +0 0 0 2.181 +0 1 0 2.149 +0 0 0 2.087 +0 1 0 2.071 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.933 +0 1 0 1.913 +0 0 0 1.845 +0 1 0 1.829 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.549 +0 1 0 1.535 +0 0 0 1.457 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.461 +0 0 1 1.535 +0 1 1 1.551 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.827 +0 1 1 1.845 +0 0 1 1.911 +0 1 1 1.933 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.087 +0 0 1 2.147 +0 1 1 2.171 +0 0 1 2.287 +0 1 1 2.313 +0 0 1 2.375 +0 1 1 2.391 +0 0 1 2.455 +0 1 1 2.473 +0 0 1 2.549 +0 1 1 2.569 +0 0 1 2.653 +0 1 1 2.673 +0 0 1 2.749 +0 1 1 2.767 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.765 +0 1 0 2.747 +0 0 0 2.671 +0 1 0 2.651 +0 0 0 2.571 +0 1 0 2.551 +0 0 0 2.475 +0 1 0 2.457 +0 0 0 2.391 +0 1 0 2.375 +0 0 0 2.313 +0 1 0 2.293 +0 0 0 2.165 +0 1 0 2.145 +0 0 0 2.085 +0 1 0 2.071 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.933 +0 1 0 1.911 +0 0 0 1.843 +0 1 0 1.827 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.551 +0 1 0 1.535 +0 0 0 1.463 +0 1 0 1.421 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.431 +0 1 1 1.467 +0 0 1 1.535 +0 1 1 1.551 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.825 +0 1 1 1.843 +0 0 1 1.909 +0 1 1 1.933 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.085 +0 0 1 2.145 +0 1 1 2.163 +0 0 1 2.297 +0 1 1 2.315 +0 0 1 2.375 +0 1 1 2.391 +0 0 1 2.457 +0 1 1 2.475 +0 0 1 2.553 +0 1 1 2.573 +0 0 1 2.649 +0 1 1 2.669 +0 0 1 2.747 +0 1 1 2.765 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.763 +0 1 0 2.745 +0 0 0 2.667 +0 1 0 2.647 +0 0 0 2.575 +0 1 0 2.555 +0 0 0 2.477 +0 1 0 2.459 +0 0 0 2.391 +0 1 0 2.375 +0 0 0 2.315 +0 1 0 2.299 +0 0 0 2.161 +0 1 0 2.145 +0 0 0 2.085 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.933 +0 1 0 1.909 +0 0 0 1.841 +0 1 0 1.825 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.553 +0 1 0 1.537 +0 0 0 1.467 +0 1 0 1.439 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.443 +0 1 1 1.469 +0 0 1 1.537 +0 1 1 1.553 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.823 +0 1 1 1.841 +0 0 1 1.909 +0 1 1 1.933 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.085 +0 0 1 2.143 +0 1 1 2.161 +0 0 1 2.299 +0 1 1 2.317 +0 0 1 2.375 +0 1 1 2.391 +0 0 1 2.461 +0 1 1 2.479 +0 0 1 2.557 +0 1 1 2.577 +0 0 1 2.645 +0 1 1 2.665 +0 0 1 2.743 +0 1 1 2.761 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.761 +0 1 0 2.743 +0 0 0 2.665 +0 1 0 2.643 +0 0 0 2.579 +0 1 0 2.559 +0 0 0 2.479 +0 1 0 2.461 +0 0 0 2.393 +0 1 0 2.377 +0 0 0 2.317 +0 1 0 2.301 +0 0 0 2.159 +0 1 0 2.143 +0 0 0 2.085 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.933 +0 1 0 1.907 +0 0 0 1.839 +0 1 0 1.823 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.553 +0 1 0 1.537 +0 0 0 1.471 +0 1 0 1.449 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.451 +0 1 1 1.473 +0 0 1 1.537 +0 1 1 1.553 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.821 +0 1 1 1.839 +0 0 1 1.907 +0 1 1 1.933 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.085 +0 0 1 2.143 +0 1 1 2.159 +0 0 1 2.301 +0 1 1 2.319 +0 0 1 2.377 +0 1 1 2.393 +0 0 1 2.463 +0 1 1 2.481 +0 0 1 2.561 +0 1 1 2.581 +0 0 1 2.643 +0 1 1 2.663 +0 0 1 2.741 +0 1 1 2.759 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.757 +0 1 0 2.739 +0 0 0 2.661 +0 1 0 2.641 +0 0 0 2.581 +0 1 0 2.561 +0 0 0 2.483 +0 1 0 2.465 +0 0 0 2.393 +0 1 0 2.377 +0 0 0 2.319 +0 1 0 2.303 +0 0 0 2.157 +0 1 0 2.141 +0 0 0 2.083 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.933 +0 1 0 1.905 +0 0 0 1.837 +0 1 0 1.821 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.555 +0 1 0 1.539 +0 0 0 1.475 +0 1 0 1.453 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.457 +0 1 1 1.475 +0 0 1 1.539 +0 1 1 1.555 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.819 +0 1 1 1.837 +0 0 1 1.905 +0 1 1 1.933 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.083 +0 0 1 2.141 +0 1 1 2.157 +0 0 1 2.303 +0 1 1 2.319 +0 0 1 2.377 +0 1 1 2.393 +0 0 1 2.467 +0 1 1 2.485 +0 0 1 2.563 +0 1 1 2.583 +0 0 1 2.639 +0 1 1 2.659 +0 0 1 2.739 +0 1 1 2.755 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.755 +0 1 0 2.737 +0 0 0 2.657 +0 1 0 2.637 +0 0 0 2.585 +0 1 0 2.565 +0 0 0 2.485 +0 1 0 2.467 +0 0 0 2.393 +0 1 0 2.377 +0 0 0 2.319 +0 1 0 2.303 +0 0 0 2.157 +0 1 0 2.141 +0 0 0 2.083 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.933 +0 1 0 1.903 +0 0 0 1.835 +0 1 0 1.817 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.555 +0 1 0 1.539 +0 0 0 1.477 +0 1 0 1.457 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.459 +0 1 1 1.477 +0 0 1 1.539 +0 1 1 1.555 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.817 +0 1 1 1.835 +0 0 1 1.903 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.067 +0 1 1 2.083 +0 0 1 2.141 +0 1 1 2.157 +0 0 1 2.305 +0 1 1 2.319 +0 0 1 2.377 +0 1 1 2.393 +0 0 1 2.469 +0 1 1 2.487 +0 0 1 2.567 +0 1 1 2.587 +0 0 1 2.635 +0 1 1 2.655 +0 0 1 2.735 +0 1 1 2.753 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.753 +0 1 0 2.735 +0 0 0 2.653 +0 1 0 2.633 +0 0 0 2.589 +0 1 0 2.569 +0 0 0 2.489 +0 1 0 2.471 +0 0 0 2.393 +0 1 0 2.377 +0 0 0 2.321 +0 1 0 2.305 +0 0 0 2.155 +0 1 0 2.141 +0 0 0 2.083 +0 1 0 2.067 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.901 +0 0 0 1.833 +0 1 0 1.815 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.555 +0 1 0 1.539 +0 0 0 1.479 +0 1 0 1.461 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.463 +0 1 1 1.479 +0 0 1 1.541 +0 1 1 1.555 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.815 +0 1 1 1.833 +0 0 1 1.901 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.067 +0 1 1 2.083 +0 0 1 2.139 +0 1 1 2.155 +0 0 1 2.305 +0 1 1 2.321 +0 0 1 2.377 +0 1 1 2.393 +0 0 1 2.471 +0 1 1 2.489 +0 0 1 2.571 +0 1 1 2.591 +0 0 1 2.631 +0 1 1 2.651 +0 0 1 2.733 +0 1 1 2.751 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.749 +0 1 0 2.731 +0 0 0 2.649 +0 1 0 2.629 +0 0 0 2.593 +0 1 0 2.573 +0 0 0 2.491 +0 1 0 2.473 +0 0 0 2.393 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.305 +0 0 0 2.155 +0 1 0 2.139 +0 0 0 2.083 +0 1 0 2.067 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.899 +0 0 0 1.831 +0 1 0 1.815 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.557 +0 1 0 1.541 +0 0 0 1.479 +0 1 0 1.463 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.463 +0 1 1 1.481 +0 0 1 1.541 +0 1 1 1.557 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.813 +0 1 1 1.831 +0 0 1 1.899 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.067 +0 1 1 2.083 +0 0 1 2.139 +0 1 1 2.155 +0 0 1 2.305 +0 1 1 2.321 +0 0 1 2.379 +0 1 1 2.393 +0 0 1 2.475 +0 1 1 2.493 +0 0 1 2.575 +0 1 1 2.595 +0 0 1 2.627 +0 1 1 2.647 +0 0 1 2.729 +0 1 1 2.747 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.747 +0 1 0 2.729 +0 0 0 2.647 +0 1 0 2.625 +0 0 0 2.597 +0 1 0 2.577 +0 0 0 2.493 +0 1 0 2.475 +0 0 0 2.393 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.305 +0 0 0 2.155 +0 1 0 2.139 +0 0 0 2.083 +0 1 0 2.067 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.897 +0 0 0 1.829 +0 1 0 1.811 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.557 +0 1 0 1.541 +0 0 0 1.481 +0 1 0 1.465 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.465 +0 1 1 1.481 +0 0 1 1.541 +0 1 1 1.557 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.811 +0 1 1 1.829 +0 0 1 1.897 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.067 +0 1 1 2.083 +0 0 1 2.139 +0 1 1 2.155 +0 0 1 2.305 +0 1 1 2.321 +0 0 1 2.379 +0 1 1 2.393 +0 0 1 2.477 +0 1 1 2.495 +0 0 1 2.579 +0 1 1 2.599 +0 0 1 2.625 +0 1 1 2.645 +0 0 1 2.727 +0 1 1 2.745 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.743 +0 1 0 2.725 +0 0 0 2.643 +0 1 0 2.623 +0 0 0 2.601 +0 1 0 2.579 +0 0 0 2.497 +0 1 0 2.479 +0 0 0 2.393 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.307 +0 0 0 2.155 +0 1 0 2.139 +0 0 0 2.083 +0 1 0 2.067 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.913 +0 1 0 1.897 +0 0 0 1.827 +0 1 0 1.809 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.557 +0 1 0 1.543 +0 0 0 1.481 +0 1 0 1.467 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.467 +0 1 1 1.483 +0 0 1 1.543 +0 1 1 1.557 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.809 +0 1 1 1.827 +0 0 1 1.895 +0 1 1 1.913 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.067 +0 1 1 2.083 +0 0 1 2.139 +0 1 1 2.155 +0 0 1 2.307 +0 1 1 2.321 +0 0 1 2.379 +0 1 1 2.395 +0 0 1 2.481 +0 1 1 2.497 +0 0 1 2.581 +0 1 1 2.601 +0 0 1 2.621 +0 1 1 2.641 +0 0 1 2.725 +0 1 1 2.743 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.741 +0 1 0 2.723 +0 0 0 2.639 +0 1 0 2.619 +0 0 0 2.603 +0 1 0 2.583 +0 0 0 2.499 +0 1 0 2.481 +0 0 0 2.395 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.307 +0 0 0 2.155 +0 1 0 2.139 +0 0 0 2.083 +0 1 0 2.067 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.911 +0 1 0 1.895 +0 0 0 1.825 +0 1 0 1.807 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.559 +0 1 0 1.543 +0 0 0 1.483 +0 1 0 1.467 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.467 +0 1 1 1.483 +0 0 1 1.543 +0 1 1 1.559 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.807 +0 1 1 1.823 +0 0 1 1.893 +0 1 1 1.911 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.067 +0 1 1 2.083 +0 0 1 2.139 +0 1 1 2.155 +0 0 1 2.307 +0 1 1 2.321 +0 0 1 2.379 +0 1 1 2.395 +0 0 1 2.483 +0 1 1 2.501 +0 0 1 2.585 +0 1 1 2.605 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.721 +0 1 1 2.739 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.739 +0 1 0 2.721 +0 0 0 2.635 +0 1 0 2.615 +0 0 0 2.607 +0 1 0 2.587 +0 0 0 2.503 +0 1 0 2.485 +0 0 0 2.395 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.307 +0 0 0 2.155 +0 1 0 2.139 +0 0 0 2.083 +0 1 0 2.067 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.909 +0 1 0 1.893 +0 0 0 1.823 +0 1 0 1.805 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.559 +0 1 0 1.543 +0 0 0 1.485 +0 1 0 1.469 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.469 +0 1 1 1.485 +0 0 1 1.543 +0 1 1 1.559 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.805 +0 1 1 1.821 +0 0 1 1.891 +0 1 1 1.909 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.067 +0 1 1 2.083 +0 0 1 2.139 +0 1 1 2.155 +0 0 1 2.307 +0 1 1 2.321 +0 0 1 2.379 +0 1 1 2.395 +0 0 1 2.485 +0 1 1 2.503 +0 0 1 2.589 +0 1 1 2.609 +0 0 1 2.615 +0 1 1 2.633 +0 0 1 2.719 +0 1 1 2.737 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.735 +0 1 0 2.717 +0 0 0 2.631 +0 1 0 2.617 +0 0 0 2.611 +0 1 0 2.591 +0 0 0 2.505 +0 1 0 2.487 +0 0 0 2.395 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.307 +0 0 0 2.155 +0 1 0 2.137 +0 0 0 2.085 +0 1 0 2.067 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.907 +0 1 0 1.891 +0 0 0 1.821 +0 1 0 1.803 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.559 +0 1 0 1.543 +0 0 0 1.485 +0 1 0 1.469 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.469 +0 1 1 1.485 +0 0 1 1.543 +0 1 1 1.559 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.803 +0 1 1 1.819 +0 0 1 1.889 +0 1 1 1.907 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.067 +0 1 1 2.153 +0 0 1 2.307 +0 1 1 2.321 +0 0 1 2.379 +0 1 1 2.395 +0 0 1 2.489 +0 1 1 2.507 +0 0 1 2.593 +0 1 1 2.613 +0 0 1 2.619 +0 1 1 2.629 +0 0 1 2.717 +0 1 1 2.735 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.733 +0 1 0 2.715 +0 0 0 2.629 +0 1 0 2.621 +0 0 0 2.615 +0 1 0 2.595 +0 0 0 2.507 +0 1 0 2.489 +0 0 0 2.395 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.307 +0 0 0 2.153 +0 1 0 2.067 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.905 +0 1 0 1.889 +0 0 0 1.819 +0 1 0 1.801 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.559 +0 1 0 1.545 +0 0 0 1.485 +0 1 0 1.469 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.471 +0 1 1 1.485 +0 0 1 1.545 +0 1 1 1.561 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.801 +0 1 1 1.817 +0 0 1 1.887 +0 1 1 1.905 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.067 +0 1 1 2.153 +0 0 1 2.307 +0 1 1 2.321 +0 0 1 2.379 +0 1 1 2.395 +0 0 1 2.491 +0 1 1 2.509 +0 0 1 2.597 +0 1 1 2.617 +0 0 1 2.621 +0 1 1 2.627 +0 0 1 2.713 +0 1 1 2.731 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.729 +0 1 0 2.711 +0 0 0 2.617 +0 1 0 2.599 +0 0 0 2.511 +0 1 0 2.493 +0 0 0 2.395 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.307 +0 0 0 2.153 +0 1 0 2.067 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.903 +0 1 0 1.887 +0 0 0 1.817 +0 1 0 1.799 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.561 +0 1 0 1.545 +0 0 0 1.487 +0 1 0 1.471 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.471 +0 1 1 1.487 +0 0 1 1.545 +0 1 1 1.561 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.799 +0 1 1 1.815 +0 0 1 1.885 +0 1 1 1.903 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.067 +0 1 1 2.153 +0 0 1 2.307 +0 1 1 2.321 +0 0 1 2.379 +0 1 1 2.395 +0 0 1 2.493 +0 1 1 2.511 +0 0 1 2.599 +0 1 1 2.619 +0 0 1 2.711 +0 1 1 2.729 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.727 +0 1 0 2.709 +0 0 0 2.621 +0 1 0 2.601 +0 0 0 2.513 +0 1 0 2.495 +0 0 0 2.395 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.305 +0 0 0 2.153 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.903 +0 1 0 1.885 +0 0 0 1.815 +0 1 0 1.797 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.561 +0 1 0 1.545 +0 0 0 1.487 +0 1 0 1.471 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.471 +0 1 1 1.487 +0 0 1 1.545 +0 1 1 1.561 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.797 +0 1 1 1.813 +0 0 1 1.883 +0 1 1 1.901 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.151 +0 0 1 2.305 +0 1 1 2.321 +0 0 1 2.379 +0 1 1 2.395 +0 0 1 2.497 +0 1 1 2.515 +0 0 1 2.603 +0 1 1 2.623 +0 0 1 2.707 +0 1 1 2.725 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.725 +0 1 0 2.707 +0 0 0 2.625 +0 1 0 2.605 +0 0 0 2.599 +0 1 0 2.597 +0 0 0 2.515 +0 1 0 2.499 +0 0 0 2.395 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.305 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.901 +0 1 0 1.883 +0 0 0 1.813 +0 1 0 1.795 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.561 +0 1 0 1.545 +0 0 0 1.487 +0 1 0 1.471 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.487 +0 0 1 1.545 +0 1 1 1.561 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.795 +0 1 1 1.811 +0 0 1 1.883 +0 1 1 1.899 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.305 +0 1 1 2.321 +0 0 1 2.379 +0 1 1 2.393 +0 0 1 2.499 +0 1 1 2.517 +0 0 1 2.595 +0 1 1 2.601 +0 0 1 2.607 +0 1 1 2.627 +0 0 1 2.705 +0 1 1 2.723 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.721 +0 1 0 2.703 +0 0 0 2.629 +0 1 0 2.609 +0 0 0 2.603 +0 1 0 2.593 +0 0 0 2.519 +0 1 0 2.501 +0 0 0 2.393 +0 1 0 2.379 +0 0 0 2.321 +0 1 0 2.305 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.899 +0 1 0 1.881 +0 0 0 1.811 +0 1 0 1.793 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.561 +0 1 0 1.545 +0 0 0 1.487 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.487 +0 0 1 1.547 +0 1 1 1.561 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.791 +0 1 1 1.809 +0 0 1 1.881 +0 1 1 1.897 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.305 +0 1 1 2.319 +0 0 1 2.379 +0 1 1 2.393 +0 0 1 2.503 +0 1 1 2.519 +0 0 1 2.593 +0 1 1 2.605 +0 0 1 2.611 +0 1 1 2.631 +0 0 1 2.703 +0 1 1 2.721 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.719 +0 1 0 2.701 +0 0 0 2.631 +0 1 0 2.613 +0 0 0 2.607 +0 1 0 2.591 +0 0 0 2.521 +0 1 0 2.503 +0 0 0 2.393 +0 1 0 2.379 +0 0 0 2.319 +0 1 0 2.303 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.897 +0 1 0 1.879 +0 0 0 1.809 +0 1 0 1.791 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.561 +0 1 0 1.547 +0 0 0 1.487 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.489 +0 0 1 1.547 +0 1 1 1.561 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.791 +0 1 1 1.807 +0 0 1 1.879 +0 1 1 1.895 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.303 +0 1 1 2.319 +0 0 1 2.379 +0 1 1 2.393 +0 0 1 2.505 +0 1 1 2.523 +0 0 1 2.589 +0 1 1 2.607 +0 0 1 2.615 +0 1 1 2.633 +0 0 1 2.699 +0 1 1 2.717 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.717 +0 1 0 2.699 +0 0 0 2.635 +0 1 0 2.615 +0 0 0 2.607 +0 1 0 2.587 +0 0 0 2.525 +0 1 0 2.507 +0 0 0 2.393 +0 1 0 2.377 +0 0 0 2.319 +0 1 0 2.301 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.895 +0 1 0 1.877 +0 0 0 1.807 +0 1 0 1.789 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.561 +0 1 0 1.547 +0 0 0 1.489 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.489 +0 0 1 1.547 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.787 +0 1 1 1.805 +0 0 1 1.877 +0 1 1 1.893 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.301 +0 1 1 2.317 +0 0 1 2.377 +0 1 1 2.393 +0 0 1 2.507 +0 1 1 2.525 +0 0 1 2.585 +0 1 1 2.605 +0 0 1 2.617 +0 1 1 2.637 +0 0 1 2.697 +0 1 1 2.715 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.713 +0 1 0 2.695 +0 0 0 2.639 +0 1 0 2.619 +0 0 0 2.603 +0 1 0 2.583 +0 0 0 2.527 +0 1 0 2.509 +0 0 0 2.393 +0 1 0 2.377 +0 0 0 2.317 +0 1 0 2.299 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.893 +0 1 0 1.875 +0 0 0 1.805 +0 1 0 1.787 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.547 +0 0 0 1.489 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.489 +0 0 1 1.547 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.785 +0 1 1 1.803 +0 0 1 1.875 +0 1 1 1.891 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.295 +0 1 1 2.315 +0 0 1 2.377 +0 1 1 2.393 +0 0 1 2.511 +0 1 1 2.529 +0 0 1 2.621 +0 1 1 2.641 +0 0 1 2.693 +0 1 1 2.711 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.711 +0 1 0 2.693 +0 0 0 2.643 +0 1 0 2.623 +0 0 0 2.529 +0 1 0 2.511 +0 0 0 2.393 +0 1 0 2.377 +0 0 0 2.315 +0 1 0 2.291 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.891 +0 1 0 1.873 +0 0 0 1.803 +0 1 0 1.785 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.547 +0 0 0 1.489 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.489 +0 0 1 1.547 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.783 +0 1 1 1.801 +0 0 1 1.873 +0 1 1 1.889 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.281 +0 1 1 2.313 +0 0 1 2.377 +0 1 1 2.393 +0 0 1 2.513 +0 1 1 2.531 +0 0 1 2.579 +0 1 1 2.619 +0 0 1 2.625 +0 1 1 2.645 +0 0 1 2.691 +0 1 1 2.709 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.707 +0 1 0 2.691 +0 0 0 2.645 +0 1 0 2.627 +0 0 0 2.621 +0 1 0 2.577 +0 0 0 2.533 +0 1 0 2.515 +0 0 0 2.393 +0 1 0 2.377 +0 0 0 2.313 +0 1 0 2.269 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.889 +0 1 0 1.871 +0 0 0 1.801 +0 1 0 1.783 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.547 +0 0 0 1.489 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.489 +0 0 1 1.547 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.781 +0 1 1 1.799 +0 0 1 1.871 +0 1 1 1.887 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.243 +0 1 1 2.311 +0 0 1 2.375 +0 1 1 2.391 +0 0 1 2.517 +0 1 1 2.533 +0 0 1 2.575 +0 1 1 2.623 +0 0 1 2.629 +0 1 1 2.647 +0 0 1 2.689 +0 1 1 2.707 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.705 +0 1 0 2.687 +0 0 0 2.647 +0 1 0 2.629 +0 0 0 2.625 +0 1 0 2.573 +0 0 0 2.535 +0 1 0 2.517 +0 0 0 2.391 +0 1 0 2.375 +0 0 0 2.307 +0 1 0 2.207 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.887 +0 1 0 1.869 +0 0 0 1.797 +0 1 0 1.781 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.547 +0 0 0 1.489 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.489 +0 0 1 1.547 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.779 +0 1 1 1.797 +0 0 1 1.869 +0 1 1 1.885 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.185 +0 1 1 2.305 +0 0 1 2.375 +0 1 1 2.391 +0 0 1 2.519 +0 1 1 2.537 +0 0 1 2.571 +0 1 1 2.625 +0 0 1 2.631 +0 1 1 2.649 +0 0 1 2.685 +0 1 1 2.703 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.703 +0 1 0 2.685 +0 0 0 2.649 +0 1 0 2.633 +0 0 0 2.627 +0 1 0 2.569 +0 0 0 2.537 +0 1 0 2.521 +0 0 0 2.391 +0 1 0 2.375 +0 0 0 2.301 +0 1 0 2.169 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.885 +0 1 0 1.867 +0 0 0 1.797 +0 1 0 1.779 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.489 +0 0 1 1.549 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.777 +0 1 1 1.795 +0 0 1 1.867 +0 1 1 1.883 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.155 +0 1 1 2.297 +0 0 1 2.375 +0 1 1 2.389 +0 0 1 2.521 +0 1 1 2.539 +0 0 1 2.567 +0 1 1 2.629 +0 0 1 2.635 +0 1 1 2.649 +0 0 1 2.653 +0 1 1 2.655 +0 0 1 2.683 +0 1 1 2.701 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.699 +0 1 0 2.681 +0 0 0 2.657 +0 1 0 2.653 +0 0 0 2.649 +0 1 0 2.635 +0 0 0 2.629 +0 1 0 2.565 +0 0 0 2.541 +0 1 0 2.523 +0 0 0 2.389 +0 1 0 2.373 +0 0 0 2.291 +0 1 0 2.145 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.883 +0 1 0 1.865 +0 0 0 1.793 +0 1 0 1.777 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.489 +0 0 1 1.549 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.775 +0 1 1 1.793 +0 0 1 1.865 +0 1 1 1.881 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.137 +0 1 1 2.281 +0 0 1 2.373 +0 1 1 2.389 +0 0 1 2.525 +0 1 1 2.543 +0 0 1 2.563 +0 1 1 2.585 +0 0 1 2.635 +0 1 1 2.649 +0 0 1 2.653 +0 1 1 2.659 +0 0 1 2.681 +0 1 1 2.697 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.697 +0 1 0 2.679 +0 0 0 2.661 +0 1 0 2.653 +0 0 0 2.649 +0 1 0 2.635 +0 0 0 2.581 +0 1 0 2.561 +0 0 0 2.543 +0 1 0 2.525 +0 0 0 2.389 +0 1 0 2.373 +0 0 0 2.263 +0 1 0 2.129 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.881 +0 1 0 1.863 +0 0 0 1.791 +0 1 0 1.775 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.773 +0 1 1 1.791 +0 0 1 1.863 +0 1 1 1.879 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.121 +0 1 1 2.231 +0 0 1 2.371 +0 1 1 2.387 +0 0 1 2.527 +0 1 1 2.545 +0 0 1 2.559 +0 1 1 2.579 +0 0 1 2.635 +0 1 1 2.649 +0 0 1 2.653 +0 1 1 2.663 +0 0 1 2.677 +0 1 1 2.695 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.693 +0 1 0 2.677 +0 0 0 2.665 +0 1 0 2.653 +0 0 0 2.649 +0 1 0 2.635 +0 0 0 2.589 +0 1 0 2.585 +0 0 0 2.579 +0 1 0 2.557 +0 0 0 2.547 +0 1 0 2.529 +0 0 0 2.387 +0 1 0 2.371 +0 0 0 2.205 +0 1 0 2.117 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.879 +0 1 0 1.861 +0 0 0 1.789 +0 1 0 1.773 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.771 +0 1 1 1.789 +0 0 1 1.861 +0 1 1 1.877 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.111 +0 1 1 2.181 +0 0 1 2.369 +0 1 1 2.387 +0 0 1 2.529 +0 1 1 2.547 +0 0 1 2.557 +0 1 1 2.577 +0 0 1 2.581 +0 1 1 2.589 +0 0 1 2.635 +0 1 1 2.649 +0 0 1 2.653 +0 1 1 2.667 +0 0 1 2.675 +0 1 1 2.693 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.691 +0 1 0 2.673 +0 0 0 2.667 +0 1 0 2.653 +0 0 0 2.649 +0 1 0 2.635 +0 0 0 2.589 +0 1 0 2.581 +0 0 0 2.575 +0 1 0 2.555 +0 0 0 2.549 +0 1 0 2.531 +0 0 0 2.385 +0 1 0 2.369 +0 0 0 2.165 +0 1 0 2.107 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.877 +0 1 0 1.859 +0 0 0 1.787 +0 1 0 1.771 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.769 +0 1 1 1.787 +0 0 1 1.859 +0 1 1 1.877 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.103 +0 1 1 2.155 +0 0 1 2.369 +0 1 1 2.385 +0 0 1 2.533 +0 1 1 2.547 +0 0 1 2.553 +0 1 1 2.573 +0 0 1 2.579 +0 1 1 2.589 +0 0 1 2.635 +0 1 1 2.649 +0 0 1 2.653 +0 1 1 2.667 +0 0 1 2.673 +0 1 1 2.689 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.689 +0 1 0 2.671 +0 0 0 2.665 +0 1 0 2.653 +0 0 0 2.649 +0 1 0 2.635 +0 0 0 2.589 +0 1 0 2.577 +0 0 0 2.571 +0 1 0 2.551 +0 0 0 2.545 +0 1 0 2.535 +0 0 0 2.385 +0 1 0 2.367 +0 0 0 2.143 +0 1 0 2.101 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.875 +0 1 0 1.857 +0 0 0 1.785 +0 1 0 1.767 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.767 +0 1 1 1.785 +0 0 1 1.857 +0 1 1 1.873 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.097 +0 1 1 2.135 +0 0 1 2.365 +0 1 1 2.383 +0 0 1 2.535 +0 1 1 2.543 +0 0 1 2.549 +0 1 1 2.569 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.635 +0 1 1 2.649 +0 0 1 2.653 +0 1 1 2.663 +0 0 1 2.669 +0 1 1 2.687 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.685 +0 1 0 2.667 +0 0 0 2.663 +0 1 0 2.655 +0 0 0 2.649 +0 1 0 2.635 +0 0 0 2.589 +0 1 0 2.575 +0 0 0 2.567 +0 1 0 2.547 +0 0 0 2.541 +0 1 0 2.537 +0 0 0 2.383 +0 1 0 2.365 +0 0 0 2.129 +0 1 0 2.095 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.873 +0 1 0 1.855 +0 0 0 1.783 +0 1 0 1.767 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.765 +0 1 1 1.783 +0 0 1 1.855 +0 1 1 1.871 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.093 +0 1 1 2.123 +0 0 1 2.363 +0 1 1 2.381 +0 0 1 2.537 +0 1 1 2.541 +0 0 1 2.545 +0 1 1 2.565 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.635 +0 1 1 2.649 +0 0 1 2.657 +0 1 1 2.661 +0 0 1 2.667 +0 1 1 2.685 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.683 +0 1 0 2.665 +0 0 0 2.649 +0 1 0 2.635 +0 0 0 2.589 +0 1 0 2.575 +0 0 0 2.563 +0 1 0 2.543 +0 0 0 2.381 +0 1 0 2.361 +0 0 0 2.117 +0 1 0 2.091 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.871 +0 1 0 1.853 +0 0 0 1.781 +0 1 0 1.765 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.763 +0 1 1 1.781 +0 0 1 1.853 +0 1 1 1.869 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.089 +0 1 1 2.113 +0 0 1 2.359 +0 1 1 2.379 +0 0 1 2.543 +0 1 1 2.561 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.635 +0 1 1 2.649 +0 0 1 2.663 +0 1 1 2.681 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.679 +0 1 0 2.661 +0 0 0 2.649 +0 1 0 2.635 +0 0 0 2.589 +0 1 0 2.575 +0 0 0 2.559 +0 1 0 2.541 +0 0 0 2.377 +0 1 0 2.357 +0 0 0 2.111 +0 1 0 2.087 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.869 +0 1 0 1.851 +0 0 0 1.779 +0 1 0 1.761 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.761 +0 1 1 1.779 +0 0 1 1.851 +0 1 1 1.867 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.085 +0 1 1 2.107 +0 0 1 2.355 +0 1 1 2.377 +0 0 1 2.539 +0 1 1 2.557 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.635 +0 1 1 2.649 +0 0 1 2.659 +0 1 1 2.679 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.685 +0 1 0 2.683 +0 0 0 2.677 +0 1 0 2.657 +0 0 0 2.649 +0 1 0 2.635 +0 0 0 2.589 +0 1 0 2.575 +0 0 0 2.565 +0 1 0 2.561 +0 0 0 2.555 +0 1 0 2.539 +0 0 0 2.375 +0 1 0 2.351 +0 0 0 2.105 +0 1 0 2.085 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.867 +0 1 0 1.849 +0 0 0 1.777 +0 1 0 1.759 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.759 +0 1 1 1.777 +0 0 1 1.849 +0 1 1 1.865 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.083 +0 1 1 2.103 +0 0 1 2.349 +0 1 1 2.373 +0 0 1 2.537 +0 1 1 2.555 +0 0 1 2.561 +0 1 1 2.567 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.635 +0 1 1 2.649 +0 0 1 2.655 +0 1 1 2.675 +0 0 1 2.681 +0 1 1 2.685 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.687 +0 1 0 2.679 +0 0 0 2.673 +0 1 0 2.653 +0 0 0 2.647 +0 1 0 2.635 +0 0 0 2.589 +0 1 0 2.575 +0 0 0 2.569 +0 1 0 2.559 +0 0 0 2.553 +0 1 0 2.535 +0 0 0 2.371 +0 1 0 2.343 +0 0 0 2.101 +0 1 0 2.083 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.865 +0 1 0 1.847 +0 0 0 1.775 +0 1 0 1.757 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.757 +0 1 1 1.773 +0 0 1 1.847 +0 1 1 1.863 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.081 +0 1 1 2.099 +0 0 1 2.339 +0 1 1 2.369 +0 0 1 2.535 +0 1 1 2.551 +0 0 1 2.557 +0 1 1 2.571 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.635 +0 1 1 2.645 +0 0 1 2.651 +0 1 1 2.671 +0 0 1 2.677 +0 1 1 2.689 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.689 +0 1 0 2.675 +0 0 0 2.669 +0 1 0 2.649 +0 0 0 2.643 +0 1 0 2.635 +0 0 0 2.589 +0 1 0 2.575 +0 0 0 2.571 +0 1 0 2.555 +0 0 0 2.551 +0 1 0 2.533 +0 0 0 2.367 +0 1 0 2.333 +0 0 0 2.097 +0 1 0 2.081 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.863 +0 1 0 1.845 +0 0 0 1.773 +0 1 0 1.755 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.755 +0 1 1 1.773 +0 0 1 1.845 +0 1 1 1.861 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.079 +0 1 1 2.097 +0 0 1 2.323 +0 1 1 2.365 +0 0 1 2.531 +0 1 1 2.549 +0 0 1 2.555 +0 1 1 2.571 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.635 +0 1 1 2.641 +0 0 1 2.647 +0 1 1 2.669 +0 0 1 2.673 +0 1 1 2.691 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.693 +0 1 0 2.675 +0 0 0 2.667 +0 1 0 2.647 +0 0 0 2.641 +0 1 0 2.635 +0 0 0 2.589 +0 1 0 2.575 +0 0 0 2.571 +0 1 0 2.555 +0 0 0 2.547 +0 1 0 2.529 +0 0 0 2.361 +0 1 0 2.315 +0 0 0 2.095 +0 1 0 2.079 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.861 +0 1 0 1.843 +0 0 0 1.771 +0 1 0 1.753 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.753 +0 1 1 1.769 +0 0 1 1.843 +0 1 1 1.859 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.077 +0 1 1 2.095 +0 0 1 2.305 +0 1 1 2.359 +0 0 1 2.529 +0 1 1 2.547 +0 0 1 2.557 +0 1 1 2.571 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.635 +0 1 1 2.639 +0 0 1 2.645 +0 1 1 2.665 +0 0 1 2.677 +0 1 1 2.693 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.695 +0 1 0 2.677 +0 0 0 2.663 +0 1 0 2.643 +0 0 0 2.589 +0 1 0 2.575 +0 0 0 2.571 +0 1 0 2.559 +0 0 0 2.545 +0 1 0 2.527 +0 0 0 2.353 +0 1 0 2.289 +0 0 0 2.093 +0 1 0 2.077 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.859 +0 1 0 1.841 +0 0 0 1.769 +0 1 0 1.751 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.491 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.491 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.751 +0 1 1 1.767 +0 0 1 1.841 +0 1 1 1.857 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.077 +0 1 1 2.093 +0 0 1 2.273 +0 1 1 2.349 +0 0 1 2.525 +0 1 1 2.543 +0 0 1 2.561 +0 1 1 2.571 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.641 +0 1 1 2.661 +0 0 1 2.679 +0 1 1 2.697 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.699 +0 1 0 2.681 +0 0 0 2.659 +0 1 0 2.639 +0 0 0 2.589 +0 1 0 2.575 +0 0 0 2.571 +0 1 0 2.563 +0 0 0 2.543 +0 1 0 2.525 +0 0 0 2.345 +0 1 0 2.245 +0 0 0 2.091 +0 1 0 2.075 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.857 +0 1 0 1.839 +0 0 0 1.767 +0 1 0 1.749 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.489 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.749 +0 1 1 1.765 +0 0 1 1.839 +0 1 1 1.855 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.075 +0 1 1 2.091 +0 0 1 2.213 +0 1 1 2.339 +0 0 1 2.523 +0 1 1 2.541 +0 0 1 2.565 +0 1 1 2.571 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.593 +0 1 1 2.657 +0 0 1 2.681 +0 1 1 2.699 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.701 +0 1 0 2.683 +0 0 0 2.655 +0 1 0 2.593 +0 0 0 2.589 +0 1 0 2.575 +0 0 0 2.571 +0 1 0 2.567 +0 0 0 2.539 +0 1 0 2.521 +0 0 0 2.331 +0 1 0 2.195 +0 0 0 2.091 +0 1 0 2.075 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.855 +0 1 0 1.837 +0 0 0 1.765 +0 1 0 1.747 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.489 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.747 +0 1 1 1.763 +0 0 1 1.835 +0 1 1 1.853 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.073 +0 1 1 2.089 +0 0 1 2.181 +0 1 1 2.325 +0 0 1 2.521 +0 1 1 2.537 +0 0 1 2.575 +0 1 1 2.589 +0 0 1 2.595 +0 1 1 2.653 +0 0 1 2.685 +0 1 1 2.703 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.703 +0 1 0 2.685 +0 0 0 2.651 +0 1 0 2.597 +0 0 0 2.591 +0 1 0 2.575 +0 0 0 2.537 +0 1 0 2.519 +0 0 0 2.313 +0 1 0 2.171 +0 0 0 2.089 +0 1 0 2.073 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.853 +0 1 0 1.835 +0 0 0 1.763 +0 1 0 1.745 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.489 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.745 +0 1 1 1.761 +0 0 1 1.835 +0 1 1 1.851 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.073 +0 1 1 2.089 +0 0 1 2.165 +0 1 1 2.301 +0 0 1 2.517 +0 1 1 2.535 +0 0 1 2.575 +0 1 1 2.593 +0 0 1 2.599 +0 1 1 2.649 +0 0 1 2.687 +0 1 1 2.705 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.707 +0 1 0 2.689 +0 0 0 2.647 +0 1 0 2.599 +0 0 0 2.595 +0 1 0 2.575 +0 0 0 2.533 +0 1 0 2.517 +0 0 0 2.289 +0 1 0 2.159 +0 0 0 2.089 +0 1 0 2.073 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.851 +0 1 0 1.833 +0 0 0 1.761 +0 1 0 1.743 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.475 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.475 +0 1 1 1.489 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.743 +0 1 1 1.759 +0 0 1 1.833 +0 1 1 1.849 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.087 +0 0 1 2.157 +0 1 1 2.265 +0 0 1 2.515 +0 1 1 2.533 +0 0 1 2.577 +0 1 1 2.597 +0 0 1 2.601 +0 1 1 2.645 +0 0 1 2.689 +0 1 1 2.707 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.709 +0 1 0 2.691 +0 0 0 2.641 +0 1 0 2.605 +0 0 0 2.597 +0 1 0 2.579 +0 0 0 2.531 +0 1 0 2.513 +0 0 0 2.233 +0 1 0 2.155 +0 0 0 2.087 +0 1 0 2.071 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.849 +0 1 0 1.831 +0 0 0 1.759 +0 1 0 1.741 +0 0 0 1.719 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.489 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.719 +0 0 1 1.741 +0 1 1 1.759 +0 0 1 1.829 +0 1 1 1.847 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.087 +0 0 1 2.153 +0 1 1 2.211 +0 0 1 2.511 +0 1 1 2.529 +0 0 1 2.579 +0 1 1 2.599 +0 0 1 2.693 +0 1 1 2.711 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.711 +0 1 0 2.693 +0 0 0 2.601 +0 1 0 2.581 +0 0 0 2.529 +0 1 0 2.511 +0 0 0 2.191 +0 1 0 2.151 +0 0 0 2.087 +0 1 0 2.071 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.847 +0 1 0 1.829 +0 0 0 1.757 +0 1 0 1.741 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.489 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.739 +0 1 1 1.757 +0 0 1 1.827 +0 1 1 1.845 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.087 +0 0 1 2.151 +0 1 1 2.179 +0 0 1 2.509 +0 1 1 2.527 +0 0 1 2.583 +0 1 1 2.603 +0 0 1 2.619 +0 1 1 2.639 +0 0 1 2.695 +0 1 1 2.713 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.715 +0 1 0 2.697 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.605 +0 1 0 2.585 +0 0 0 2.525 +0 1 0 2.507 +0 0 0 2.171 +0 1 0 2.149 +0 0 0 2.085 +0 1 0 2.071 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.845 +0 1 0 1.827 +0 0 0 1.755 +0 1 0 1.739 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.489 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.737 +0 1 1 1.755 +0 0 1 1.825 +0 1 1 1.843 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.085 +0 0 1 2.149 +0 1 1 2.167 +0 0 1 2.507 +0 1 1 2.525 +0 0 1 2.587 +0 1 1 2.607 +0 0 1 2.615 +0 1 1 2.635 +0 0 1 2.699 +0 1 1 2.717 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.717 +0 1 0 2.699 +0 0 0 2.633 +0 1 0 2.615 +0 0 0 2.609 +0 1 0 2.589 +0 0 0 2.523 +0 1 0 2.505 +0 0 0 2.165 +0 1 0 2.147 +0 0 0 2.085 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.843 +0 1 0 1.825 +0 0 0 1.753 +0 1 0 1.737 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.489 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.735 +0 1 1 1.753 +0 0 1 1.823 +0 1 1 1.841 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.085 +0 0 1 2.147 +0 1 1 2.163 +0 0 1 2.503 +0 1 1 2.521 +0 0 1 2.591 +0 1 1 2.611 +0 0 1 2.615 +0 1 1 2.633 +0 0 1 2.701 +0 1 1 2.719 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.721 +0 1 0 2.703 +0 0 0 2.631 +0 1 0 2.617 +0 0 0 2.611 +0 1 0 2.593 +0 0 0 2.519 +0 1 0 2.503 +0 0 0 2.163 +0 1 0 2.147 +0 0 0 2.085 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.841 +0 1 0 1.823 +0 0 0 1.751 +0 1 0 1.735 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.489 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.487 +0 0 1 1.549 +0 1 1 1.565 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.735 +0 1 1 1.751 +0 0 1 1.821 +0 1 1 1.839 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.085 +0 0 1 2.145 +0 1 1 2.161 +0 0 1 2.501 +0 1 1 2.519 +0 0 1 2.593 +0 1 1 2.613 +0 0 1 2.619 +0 1 1 2.629 +0 0 1 2.703 +0 1 1 2.721 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.723 +0 1 0 2.705 +0 0 0 2.627 +0 1 0 2.621 +0 0 0 2.615 +0 1 0 2.595 +0 0 0 2.517 +0 1 0 2.499 +0 0 0 2.161 +0 1 0 2.145 +0 0 0 2.085 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.839 +0 1 0 1.821 +0 0 0 1.749 +0 1 0 1.733 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.565 +0 1 0 1.549 +0 0 0 1.487 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.473 +0 1 1 1.487 +0 0 1 1.549 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.733 +0 1 1 1.749 +0 0 1 1.819 +0 1 1 1.837 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.085 +0 0 1 2.145 +0 1 1 2.161 +0 0 1 2.499 +0 1 1 2.515 +0 0 1 2.597 +0 1 1 2.617 +0 0 1 2.623 +0 1 1 2.625 +0 0 1 2.707 +0 1 1 2.725 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.725 +0 1 0 2.709 +0 0 0 2.619 +0 1 0 2.599 +0 0 0 2.515 +0 1 0 2.497 +0 0 0 2.161 +0 1 0 2.145 +0 0 0 2.085 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.835 +0 1 0 1.819 +0 0 0 1.747 +0 1 0 1.731 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.549 +0 0 0 1.487 +0 1 0 1.473 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.471 +0 1 1 1.487 +0 0 1 1.549 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.731 +0 1 1 1.747 +0 0 1 1.817 +0 1 1 1.835 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.083 +0 0 1 2.145 +0 1 1 2.159 +0 0 1 2.495 +0 1 1 2.513 +0 0 1 2.601 +0 1 1 2.621 +0 0 1 2.709 +0 1 1 2.727 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.729 +0 1 0 2.711 +0 0 0 2.623 +0 1 0 2.603 +0 0 0 2.511 +0 1 0 2.493 +0 0 0 2.159 +0 1 0 2.143 +0 0 0 2.083 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.835 +0 1 0 1.817 +0 0 0 1.747 +0 1 0 1.729 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.549 +0 0 0 1.487 +0 1 0 1.471 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.471 +0 1 1 1.487 +0 0 1 1.547 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.729 +0 1 1 1.745 +0 0 1 1.815 +0 1 1 1.833 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.083 +0 0 1 2.143 +0 1 1 2.159 +0 0 1 2.493 +0 1 1 2.511 +0 0 1 2.605 +0 1 1 2.625 +0 0 1 2.711 +0 1 1 2.729 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.731 +0 1 0 2.713 +0 0 0 2.627 +0 1 0 2.605 +0 0 0 2.601 +0 1 0 2.597 +0 0 0 2.509 +0 1 0 2.491 +0 0 0 2.159 +0 1 0 2.143 +0 0 0 2.083 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.833 +0 1 0 1.815 +0 0 0 1.745 +0 1 0 1.727 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.547 +0 0 0 1.487 +0 1 0 1.471 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.471 +0 1 1 1.487 +0 0 1 1.547 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.727 +0 1 1 1.743 +0 0 1 1.813 +0 1 1 1.831 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.083 +0 0 1 2.143 +0 1 1 2.159 +0 0 1 2.301 +0 1 1 2.383 +0 0 1 2.489 +0 1 1 2.507 +0 0 1 2.595 +0 1 1 2.601 +0 0 1 2.607 +0 1 1 2.627 +0 0 1 2.715 +0 1 1 2.733 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.735 +0 1 0 2.717 +0 0 0 2.629 +0 1 0 2.609 +0 0 0 2.603 +0 1 0 2.593 +0 0 0 2.507 +0 1 0 2.489 +0 0 0 2.385 +0 1 0 2.299 +0 0 0 2.159 +0 1 0 2.143 +0 0 0 2.083 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.829 +0 1 0 1.813 +0 0 0 1.743 +0 1 0 1.725 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.547 +0 0 0 1.487 +0 1 0 1.471 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.469 +0 1 1 1.485 +0 0 1 1.547 +0 1 1 1.563 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.725 +0 1 1 1.741 +0 0 1 1.811 +0 1 1 1.829 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.083 +0 0 1 2.143 +0 1 1 2.159 +0 0 1 2.299 +0 1 1 2.385 +0 0 1 2.487 +0 1 1 2.505 +0 0 1 2.591 +0 1 1 2.605 +0 0 1 2.611 +0 1 1 2.631 +0 0 1 2.717 +0 1 1 2.735 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.737 +0 1 0 2.719 +0 0 0 2.633 +0 1 0 2.613 +0 0 0 2.607 +0 1 0 2.589 +0 0 0 2.503 +0 1 0 2.485 +0 0 0 2.385 +0 1 0 2.299 +0 0 0 2.159 +0 1 0 2.143 +0 0 0 2.083 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.827 +0 1 0 1.811 +0 0 0 1.741 +0 1 0 1.723 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.563 +0 1 0 1.547 +0 0 0 1.485 +0 1 0 1.469 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.469 +0 1 1 1.485 +0 0 1 1.547 +0 1 1 1.561 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.723 +0 1 1 1.741 +0 0 1 1.809 +0 1 1 1.827 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.083 +0 0 1 2.143 +0 1 1 2.159 +0 0 1 2.297 +0 1 1 2.385 +0 0 1 2.485 +0 1 1 2.501 +0 0 1 2.587 +0 1 1 2.607 +0 0 1 2.615 +0 1 1 2.635 +0 0 1 2.721 +0 1 1 2.739 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.739 +0 1 0 2.721 +0 0 0 2.637 +0 1 0 2.617 +0 0 0 2.605 +0 1 0 2.585 +0 0 0 2.501 +0 1 0 2.483 +0 0 0 2.385 +0 1 0 2.297 +0 0 0 2.159 +0 1 0 2.143 +0 0 0 2.083 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.825 +0 1 0 1.809 +0 0 0 1.739 +0 1 0 1.723 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.561 +0 1 0 1.547 +0 0 0 1.485 +0 1 0 1.469 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.469 +0 1 1 1.485 +0 0 1 1.545 +0 1 1 1.561 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.721 +0 1 1 1.739 +0 0 1 1.807 +0 1 1 1.825 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.083 +0 0 1 2.143 +0 1 1 2.159 +0 0 1 2.297 +0 1 1 2.385 +0 0 1 2.481 +0 1 1 2.499 +0 0 1 2.583 +0 1 1 2.603 +0 0 1 2.619 +0 1 1 2.639 +0 0 1 2.723 +0 1 1 2.741 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.743 +0 1 0 2.725 +0 0 0 2.641 +0 1 0 2.621 +0 0 0 2.601 +0 1 0 2.581 +0 0 0 2.497 +0 1 0 2.481 +0 0 0 2.385 +0 1 0 2.369 +0 0 0 2.313 +0 1 0 2.297 +0 0 0 2.159 +0 1 0 2.143 +0 0 0 2.083 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.823 +0 1 0 1.807 +0 0 0 1.737 +0 1 0 1.721 +0 0 0 1.717 +0 1 0 1.703 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.561 +0 1 0 1.545 +0 0 0 1.483 +0 1 0 1.467 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.467 +0 1 1 1.483 +0 0 1 1.545 +0 1 1 1.561 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.719 +0 1 1 1.737 +0 0 1 1.805 +0 1 1 1.823 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.083 +0 0 1 2.143 +0 1 1 2.159 +0 0 1 2.297 +0 1 1 2.313 +0 0 1 2.369 +0 1 1 2.385 +0 0 1 2.479 +0 1 1 2.497 +0 0 1 2.579 +0 1 1 2.599 +0 0 1 2.623 +0 1 1 2.643 +0 0 1 2.725 +0 1 1 2.743 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.745 +0 1 0 2.727 +0 0 0 2.645 +0 1 0 2.623 +0 0 0 2.599 +0 1 0 2.579 +0 0 0 2.495 +0 1 0 2.477 +0 0 0 2.385 +0 1 0 2.369 +0 0 0 2.313 +0 1 0 2.297 +0 0 0 2.159 +0 1 0 2.143 +0 0 0 2.083 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.821 +0 1 0 1.805 +0 0 0 1.735 +0 1 0 1.719 +0 0 0 1.717 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.561 +0 1 0 1.545 +0 0 0 1.483 +0 1 0 1.467 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.467 +0 1 1 1.483 +0 0 1 1.545 +0 1 1 1.561 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.701 +0 1 1 1.735 +0 0 1 1.803 +0 1 1 1.821 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.083 +0 0 1 2.143 +0 1 1 2.159 +0 0 1 2.297 +0 1 1 2.313 +0 0 1 2.369 +0 1 1 2.385 +0 0 1 2.475 +0 1 1 2.493 +0 0 1 2.577 +0 1 1 2.597 +0 0 1 2.625 +0 1 1 2.647 +0 0 1 2.729 +0 1 1 2.747 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.747 +0 1 0 2.729 +0 0 0 2.647 +0 1 0 2.627 +0 0 0 2.595 +0 1 0 2.575 +0 0 0 2.493 +0 1 0 2.475 +0 0 0 2.385 +0 1 0 2.369 +0 0 0 2.313 +0 1 0 2.297 +0 0 0 2.159 +0 1 0 2.143 +0 0 0 2.083 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.819 +0 1 0 1.803 +0 0 0 1.733 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.559 +0 1 0 1.543 +0 0 0 1.481 +0 1 0 1.465 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.465 +0 1 1 1.481 +0 0 1 1.543 +0 1 1 1.559 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.701 +0 1 1 1.733 +0 0 1 1.801 +0 1 1 1.819 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.083 +0 0 1 2.143 +0 1 1 2.159 +0 0 1 2.297 +0 1 1 2.313 +0 0 1 2.369 +0 1 1 2.385 +0 0 1 2.473 +0 1 1 2.491 +0 0 1 2.573 +0 1 1 2.593 +0 0 1 2.629 +0 1 1 2.649 +0 0 1 2.731 +0 1 1 2.749 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.751 +0 1 0 2.733 +0 0 0 2.651 +0 1 0 2.631 +0 0 0 2.591 +0 1 0 2.571 +0 0 0 2.489 +0 1 0 2.471 +0 0 0 2.385 +0 1 0 2.369 +0 0 0 2.311 +0 1 0 2.295 +0 0 0 2.159 +0 1 0 2.143 +0 0 0 2.085 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.817 +0 1 0 1.801 +0 0 0 1.733 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.559 +0 1 0 1.543 +0 0 0 1.481 +0 1 0 1.463 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.463 +0 1 1 1.479 +0 0 1 1.543 +0 1 1 1.559 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.701 +0 1 1 1.731 +0 0 1 1.799 +0 1 1 1.817 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.085 +0 0 1 2.145 +0 1 1 2.159 +0 0 1 2.295 +0 1 1 2.311 +0 0 1 2.369 +0 1 1 2.385 +0 0 1 2.471 +0 1 1 2.489 +0 0 1 2.569 +0 1 1 2.589 +0 0 1 2.633 +0 1 1 2.653 +0 0 1 2.735 +0 1 1 2.753 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.753 +0 1 0 2.735 +0 0 0 2.655 +0 1 0 2.635 +0 0 0 2.587 +0 1 0 2.567 +0 0 0 2.487 +0 1 0 2.469 +0 0 0 2.385 +0 1 0 2.369 +0 0 0 2.311 +0 1 0 2.295 +0 0 0 2.159 +0 1 0 2.145 +0 0 0 2.085 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.815 +0 1 0 1.799 +0 0 0 1.731 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.559 +0 1 0 1.543 +0 0 0 1.479 +0 1 0 1.461 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.461 +0 1 1 1.479 +0 0 1 1.541 +0 1 1 1.557 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.701 +0 1 1 1.729 +0 0 1 1.797 +0 1 1 1.815 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.085 +0 0 1 2.145 +0 1 1 2.161 +0 0 1 2.295 +0 1 1 2.311 +0 0 1 2.369 +0 1 1 2.385 +0 0 1 2.467 +0 1 1 2.485 +0 0 1 2.565 +0 1 1 2.585 +0 0 1 2.637 +0 1 1 2.657 +0 0 1 2.737 +0 1 1 2.755 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.757 +0 1 0 2.739 +0 0 0 2.659 +0 1 0 2.639 +0 0 0 2.583 +0 1 0 2.563 +0 0 0 2.485 +0 1 0 2.467 +0 0 0 2.385 +0 1 0 2.369 +0 0 0 2.311 +0 1 0 2.295 +0 0 0 2.161 +0 1 0 2.145 +0 0 0 2.085 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.813 +0 1 0 1.797 +0 0 0 1.729 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.557 +0 1 0 1.541 +0 0 0 1.477 +0 1 0 1.459 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.457 +0 1 1 1.477 +0 0 1 1.541 +0 1 1 1.557 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.701 +0 1 1 1.727 +0 0 1 1.795 +0 1 1 1.813 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.069 +0 1 1 2.085 +0 0 1 2.145 +0 1 1 2.163 +0 0 1 2.293 +0 1 1 2.309 +0 0 1 2.369 +0 1 1 2.385 +0 0 1 2.465 +0 1 1 2.483 +0 0 1 2.561 +0 1 1 2.581 +0 0 1 2.641 +0 1 1 2.661 +0 0 1 2.739 +0 1 1 2.757 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.759 +0 1 0 2.741 +0 0 0 2.663 +0 1 0 2.643 +0 0 0 2.581 +0 1 0 2.561 +0 0 0 2.481 +0 1 0 2.463 +0 0 0 2.385 +0 1 0 2.369 +0 0 0 2.309 +0 1 0 2.293 +0 0 0 2.163 +0 1 0 2.147 +0 0 0 2.085 +0 1 0 2.069 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.811 +0 1 0 1.795 +0 0 0 1.727 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.555 +0 1 0 1.541 +0 0 0 1.475 +0 1 0 1.455 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.451 +0 1 1 1.473 +0 0 1 1.539 +0 1 1 1.555 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.701 +0 1 1 1.725 +0 0 1 1.793 +0 1 1 1.811 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.085 +0 0 1 2.147 +0 1 1 2.163 +0 0 1 2.293 +0 1 1 2.309 +0 0 1 2.369 +0 1 1 2.385 +0 0 1 2.463 +0 1 1 2.479 +0 0 1 2.559 +0 1 1 2.579 +0 0 1 2.645 +0 1 1 2.665 +0 0 1 2.743 +0 1 1 2.761 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.761 +0 1 0 2.743 +0 0 0 2.667 +0 1 0 2.645 +0 0 0 2.577 +0 1 0 2.557 +0 0 0 2.479 +0 1 0 2.461 +0 0 0 2.385 +0 1 0 2.369 +0 0 0 2.307 +0 1 0 2.291 +0 0 0 2.165 +0 1 0 2.147 +0 0 0 2.085 +0 1 0 2.071 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.809 +0 1 0 1.791 +0 0 0 1.725 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.555 +0 1 0 1.539 +0 0 0 1.473 +0 1 0 1.447 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.443 +0 1 1 1.471 +0 0 1 1.537 +0 1 1 1.555 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.701 +0 1 1 1.723 +0 0 1 1.791 +0 1 1 1.809 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.087 +0 0 1 2.149 +0 1 1 2.167 +0 0 1 2.291 +0 1 1 2.307 +0 0 1 2.369 +0 1 1 2.383 +0 0 1 2.459 +0 1 1 2.477 +0 0 1 2.555 +0 1 1 2.575 +0 0 1 2.647 +0 1 1 2.667 +0 0 1 2.745 +0 1 1 2.763 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.765 +0 1 0 2.747 +0 0 0 2.669 +0 1 0 2.649 +0 0 0 2.573 +0 1 0 2.553 +0 0 0 2.475 +0 1 0 2.457 +0 0 0 2.383 +0 1 0 2.369 +0 0 0 2.307 +0 1 0 2.289 +0 0 0 2.169 +0 1 0 2.149 +0 0 0 2.087 +0 1 0 2.071 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.807 +0 1 0 1.791 +0 0 0 1.723 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.553 +0 1 0 1.537 +0 0 0 1.469 +0 1 0 1.435 +0 0 0 1.303 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.303 +0 0 1 1.425 +0 1 1 1.467 +0 0 1 1.537 +0 1 1 1.553 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.701 +0 1 1 1.723 +0 0 1 1.789 +0 1 1 1.807 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.087 +0 0 1 2.151 +0 1 1 2.173 +0 0 1 2.287 +0 1 1 2.305 +0 0 1 2.367 +0 1 1 2.383 +0 0 1 2.457 +0 1 1 2.475 +0 0 1 2.551 +0 1 1 2.571 +0 0 1 2.651 +0 1 1 2.671 +0 0 1 2.747 +0 1 1 2.765 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.767 +0 1 0 2.749 +0 0 0 2.673 +0 1 0 2.653 +0 0 0 2.569 +0 1 0 2.549 +0 0 0 2.473 +0 1 0 2.455 +0 0 0 2.383 +0 1 0 2.367 +0 0 0 2.305 +0 1 0 2.283 +0 0 0 2.179 +0 1 0 2.153 +0 0 0 2.087 +0 1 0 2.071 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.805 +0 1 0 1.789 +0 0 0 1.721 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.553 +0 1 0 1.535 +0 0 0 1.465 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.461 +0 0 1 1.535 +0 1 1 1.551 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.701 +0 1 1 1.721 +0 0 1 1.787 +0 1 1 1.805 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.071 +0 1 1 2.087 +0 0 1 2.153 +0 1 1 2.189 +0 0 1 2.275 +0 1 1 2.303 +0 0 1 2.367 +0 1 1 2.383 +0 0 1 2.453 +0 1 1 2.471 +0 0 1 2.547 +0 1 1 2.567 +0 0 1 2.655 +0 1 1 2.675 +0 0 1 2.751 +0 1 1 2.769 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.771 +0 1 0 2.753 +0 0 0 2.677 +0 1 0 2.657 +0 0 0 2.565 +0 1 0 2.545 +0 0 0 2.471 +0 1 0 2.453 +0 0 0 2.383 +0 1 0 2.367 +0 0 0 2.301 +0 1 0 2.261 +0 0 0 2.205 +0 1 0 2.155 +0 0 0 2.089 +0 1 0 2.073 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.803 +0 1 0 1.785 +0 0 0 1.719 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.551 +0 1 0 1.535 +0 0 0 1.457 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.455 +0 0 1 1.533 +0 1 1 1.549 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.701 +0 1 1 1.719 +0 0 1 1.785 +0 1 1 1.803 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.073 +0 1 1 2.089 +0 0 1 2.157 +0 1 1 2.301 +0 0 1 2.367 +0 1 1 2.381 +0 0 1 2.451 +0 1 1 2.469 +0 0 1 2.543 +0 1 1 2.563 +0 0 1 2.659 +0 1 1 2.679 +0 0 1 2.753 +0 1 1 2.771 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.773 +0 1 0 2.755 +0 0 0 2.681 +0 1 0 2.661 +0 0 0 2.561 +0 1 0 2.541 +0 0 0 2.467 +0 1 0 2.449 +0 0 0 2.381 +0 1 0 2.365 +0 0 0 2.299 +0 1 0 2.161 +0 0 0 2.089 +0 1 0 2.073 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.801 +0 1 0 1.785 +0 0 0 1.717 +0 1 0 1.701 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.549 +0 1 0 1.533 +0 0 0 1.449 +0 1 0 1.287 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.287 +0 1 1 1.443 +0 0 1 1.531 +0 1 1 1.549 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.703 +0 1 1 1.717 +0 0 1 1.783 +0 1 1 1.801 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.073 +0 1 1 2.089 +0 0 1 2.163 +0 1 1 2.297 +0 0 1 2.365 +0 1 1 2.381 +0 0 1 2.449 +0 1 1 2.467 +0 0 1 2.541 +0 1 1 2.561 +0 0 1 2.663 +0 1 1 2.683 +0 0 1 2.757 +0 1 1 2.773 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.775 +0 1 0 2.757 +0 0 0 2.685 +0 1 0 2.663 +0 0 0 2.559 +0 1 0 2.539 +0 0 0 2.465 +0 1 0 2.447 +0 0 0 2.381 +0 1 0 2.365 +0 0 0 2.293 +0 1 0 2.167 +0 0 0 2.091 +0 1 0 2.075 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.799 +0 1 0 1.781 +0 0 0 1.715 +0 1 0 1.705 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.547 +0 1 0 1.531 +0 0 0 1.435 +0 1 0 1.289 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.291 +0 1 1 1.417 +0 0 1 1.529 +0 1 1 1.547 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.781 +0 1 1 1.799 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.075 +0 1 1 2.091 +0 0 1 2.173 +0 1 1 2.289 +0 0 1 2.363 +0 1 1 2.381 +0 0 1 2.445 +0 1 1 2.463 +0 0 1 2.537 +0 1 1 2.557 +0 0 1 2.665 +0 1 1 2.685 +0 0 1 2.759 +0 1 1 2.777 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.779 +0 1 0 2.761 +0 0 0 2.687 +0 1 0 2.667 +0 0 0 2.555 +0 1 0 2.535 +0 0 0 2.461 +0 1 0 2.443 +0 0 0 2.379 +0 1 0 2.363 +0 0 0 2.283 +0 1 0 2.179 +0 0 0 2.091 +0 1 0 2.075 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.797 +0 1 0 1.779 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.545 +0 1 0 1.529 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.527 +0 1 1 1.545 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.779 +0 1 1 1.797 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.077 +0 1 1 2.093 +0 0 1 2.189 +0 1 1 2.275 +0 0 1 2.363 +0 1 1 2.379 +0 0 1 2.443 +0 1 1 2.461 +0 0 1 2.533 +0 1 1 2.553 +0 0 1 2.669 +0 1 1 2.689 +0 0 1 2.761 +0 1 1 2.779 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.781 +0 1 0 2.763 +0 0 0 2.691 +0 1 0 2.671 +0 0 0 2.551 +0 1 0 2.531 +0 0 0 2.459 +0 1 0 2.441 +0 0 0 2.379 +0 1 0 2.361 +0 0 0 2.253 +0 1 0 2.213 +0 0 0 2.093 +0 1 0 2.077 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.795 +0 1 0 1.777 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.543 +0 1 0 1.525 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.523 +0 1 1 1.543 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.777 +0 1 1 1.795 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.077 +0 1 1 2.095 +0 0 1 2.361 +0 1 1 2.377 +0 0 1 2.439 +0 1 1 2.457 +0 0 1 2.529 +0 1 1 2.549 +0 0 1 2.673 +0 1 1 2.693 +0 0 1 2.765 +0 1 1 2.783 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.783 +0 1 0 2.767 +0 0 0 2.695 +0 1 0 2.675 +0 0 0 2.547 +0 1 0 2.527 +0 0 0 2.457 +0 1 0 2.439 +0 0 0 2.377 +0 1 0 2.361 +0 0 0 2.095 +0 1 0 2.079 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.793 +0 1 0 1.775 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.541 +0 1 0 1.523 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.521 +0 1 1 1.539 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.775 +0 1 1 1.791 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.079 +0 1 1 2.097 +0 0 1 2.359 +0 1 1 2.375 +0 0 1 2.437 +0 1 1 2.455 +0 0 1 2.525 +0 1 1 2.545 +0 0 1 2.677 +0 1 1 2.697 +0 0 1 2.767 +0 1 1 2.785 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.787 +0 1 0 2.769 +0 0 0 2.699 +0 1 0 2.679 +0 0 0 2.543 +0 1 0 2.523 +0 0 0 2.453 +0 1 0 2.435 +0 0 0 2.375 +0 1 0 2.357 +0 0 0 2.097 +0 1 0 2.081 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.791 +0 1 0 1.773 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.539 +0 1 0 1.519 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.517 +0 1 1 1.537 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.773 +0 1 1 1.791 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.081 +0 1 1 2.099 +0 0 1 2.357 +0 1 1 2.375 +0 0 1 2.435 +0 1 1 2.453 +0 0 1 2.523 +0 1 1 2.543 +0 0 1 2.681 +0 1 1 2.701 +0 0 1 2.771 +0 1 1 2.787 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.789 +0 1 0 2.771 +0 0 0 2.703 +0 1 0 2.681 +0 0 0 2.541 +0 1 0 2.521 +0 0 0 2.451 +0 1 0 2.433 +0 0 0 2.373 +0 1 0 2.355 +0 0 0 2.101 +0 1 0 2.083 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.789 +0 1 0 1.771 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.535 +0 1 0 1.515 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.513 +0 1 1 1.535 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.771 +0 1 1 1.787 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.083 +0 1 1 2.101 +0 0 1 2.355 +0 1 1 2.373 +0 0 1 2.431 +0 1 1 2.449 +0 0 1 2.519 +0 1 1 2.539 +0 0 1 2.683 +0 1 1 2.703 +0 0 1 2.773 +0 1 1 2.791 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.791 +0 1 0 2.775 +0 0 0 2.705 +0 1 0 2.685 +0 0 0 2.537 +0 1 0 2.517 +0 0 0 2.449 +0 1 0 2.431 +0 0 0 2.371 +0 1 0 2.353 +0 0 0 2.103 +0 1 0 2.085 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.787 +0 1 0 1.769 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.533 +0 1 0 1.511 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.507 +0 1 1 1.531 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.769 +0 1 1 1.785 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.085 +0 1 1 2.105 +0 0 1 2.351 +0 1 1 2.369 +0 0 1 2.429 +0 1 1 2.447 +0 0 1 2.515 +0 1 1 2.535 +0 0 1 2.687 +0 1 1 2.707 +0 0 1 2.775 +0 1 1 2.793 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.795 +0 1 0 2.777 +0 0 0 2.709 +0 1 0 2.689 +0 0 0 2.533 +0 1 0 2.513 +0 0 0 2.445 +0 1 0 2.427 +0 0 0 2.369 +0 1 0 2.349 +0 0 0 2.107 +0 1 0 2.087 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.785 +0 1 0 1.767 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.529 +0 1 0 1.505 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.501 +0 1 1 1.527 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.767 +0 1 1 1.783 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.089 +0 1 1 2.109 +0 0 1 2.347 +0 1 1 2.367 +0 0 1 2.425 +0 1 1 2.443 +0 0 1 2.511 +0 1 1 2.531 +0 0 1 2.691 +0 1 1 2.711 +0 0 1 2.779 +0 1 1 2.797 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.797 +0 1 0 2.779 +0 0 0 2.713 +0 1 0 2.693 +0 0 0 2.529 +0 1 0 2.509 +0 0 0 2.443 +0 1 0 2.425 +0 0 0 2.365 +0 1 0 2.343 +0 0 0 2.113 +0 1 0 2.091 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.783 +0 1 0 1.765 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.525 +0 1 0 1.499 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.493 +0 1 1 1.523 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.765 +0 1 1 1.781 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.091 +0 1 1 2.115 +0 0 1 2.341 +0 1 1 2.365 +0 0 1 2.423 +0 1 1 2.441 +0 0 1 2.507 +0 1 1 2.527 +0 0 1 2.695 +0 1 1 2.715 +0 0 1 2.781 +0 1 1 2.799 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.801 +0 1 0 2.783 +0 0 0 2.717 +0 1 0 2.697 +0 0 0 2.525 +0 1 0 2.505 +0 0 0 2.439 +0 1 0 2.423 +0 0 0 2.363 +0 1 0 2.337 +0 0 0 2.119 +0 1 0 2.093 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.781 +0 1 0 1.763 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.519 +0 1 0 1.489 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.485 +0 1 1 1.517 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.763 +0 1 1 1.779 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.095 +0 1 1 2.123 +0 0 1 2.333 +0 1 1 2.361 +0 0 1 2.421 +0 1 1 2.439 +0 0 1 2.503 +0 1 1 2.523 +0 0 1 2.699 +0 1 1 2.719 +0 0 1 2.783 +0 1 1 2.801 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.803 +0 1 0 2.783 +0 0 0 2.721 +0 1 0 2.701 +0 0 0 2.523 +0 1 0 2.501 +0 0 0 2.439 +0 1 0 2.419 +0 0 0 2.359 +0 1 0 2.329 +0 0 0 2.129 +0 1 0 2.097 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.779 +0 1 0 1.761 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.515 +0 1 0 1.479 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.471 +0 1 1 1.511 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.761 +0 1 1 1.777 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.101 +0 1 1 2.135 +0 0 1 2.323 +0 1 1 2.357 +0 0 1 2.417 +0 1 1 2.521 +0 0 1 2.703 +0 1 1 2.805 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.805 +0 1 0 2.703 +0 0 0 2.519 +0 1 0 2.417 +0 0 0 2.353 +0 1 0 2.317 +0 0 0 2.141 +0 1 0 2.103 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.777 +0 1 0 1.759 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.509 +0 1 0 1.465 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.229 +0 0 1 1.451 +0 1 1 1.505 +0 0 1 1.629 +0 1 1 1.645 +0 0 1 1.759 +0 1 1 1.775 +0 0 1 1.915 +0 1 1 1.931 +0 0 1 1.989 +0 1 1 2.003 +0 0 1 2.105 +0 1 1 2.151 +0 0 1 2.307 +0 1 1 2.351 +0 0 1 2.415 +0 1 1 2.517 +0 0 1 2.705 +0 1 1 2.807 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.807 +0 1 0 2.707 +0 0 0 2.515 +0 1 0 2.415 +0 0 0 2.347 +0 1 0 2.295 +0 0 0 2.163 +0 1 0 2.109 +0 0 0 2.003 +0 1 0 1.989 +0 0 0 1.931 +0 1 0 1.915 +0 0 0 1.775 +0 1 0 1.757 +0 0 0 1.645 +0 1 0 1.629 +0 0 0 1.501 +0 1 0 1.433 +0 0 0 1.229 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.497 +0 0 1 1.629 +0 1 1 1.773 +0 0 1 1.915 +0 1 1 2.003 +0 0 1 2.113 +0 1 1 2.177 +0 0 1 2.281 +0 1 1 2.345 +0 0 1 2.415 +0 1 1 2.513 +0 0 1 2.709 +0 1 1 2.809 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.807 +0 1 0 2.711 +0 0 0 2.511 +0 1 0 2.415 +0 0 0 2.339 +0 1 0 2.237 +0 0 0 2.223 +0 1 0 2.117 +0 0 0 2.003 +0 1 0 1.915 +0 0 0 1.773 +0 1 0 1.629 +0 0 0 1.491 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.485 +0 0 1 1.629 +0 1 1 1.771 +0 0 1 1.915 +0 1 1 2.003 +0 0 1 2.123 +0 1 1 2.335 +0 0 1 2.415 +0 1 1 2.509 +0 0 1 2.713 +0 1 1 2.807 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.805 +0 1 0 2.715 +0 0 0 2.507 +0 1 0 2.417 +0 0 0 2.329 +0 1 0 2.127 +0 0 0 2.003 +0 1 0 1.915 +0 0 0 1.771 +0 1 0 1.629 +0 0 0 1.479 +0 1 0 1.213 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.213 +0 1 1 1.471 +0 0 1 1.629 +0 1 1 1.769 +0 0 1 1.915 +0 1 1 2.003 +0 0 1 2.135 +0 1 1 2.323 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.315 +0 1 0 2.143 +0 0 0 2.003 +0 1 0 1.915 +0 0 0 1.769 +0 1 0 1.631 +0 0 0 1.461 +0 1 0 1.215 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 1.215 +0 1 1 1.451 +0 0 1 1.631 +0 1 1 1.767 +0 0 1 1.917 +0 1 1 2.001 +0 0 1 2.151 +0 1 1 2.307 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 2.293 +0 1 0 2.165 +0 0 0 1.997 +0 1 0 1.921 +0 0 0 1.763 +0 1 0 1.635 +0 0 0 1.423 +0 1 0 1.219 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.185 +0 1 1 2.273 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.089 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.089 +0 0 1 2.911 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.911 +0 0 0 1.091 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.091 +0 0 1 2.909 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.909 +0 0 0 1.091 +0 1 0 1.075 +0 0 0 1.075 +0 0 1 1.075 +0 1 1 1.091 +0 0 1 2.909 +0 1 1 2.925 +0 0 1 2.925 +0 0 0 2.925 +0 1 0 2.909 +0 0 0 1.091 +0 1 0 1.077 +0 0 0 1.077 +0 0 1 1.077 +0 1 1 1.093 +0 0 1 2.907 +0 1 1 2.923 +0 0 1 2.923 +0 0 0 2.923 +0 1 0 2.907 +0 0 0 1.093 +0 1 0 1.077 +0 0 0 1.077 +0 0 1 1.077 +0 1 1 1.095 +0 0 1 2.907 +0 1 1 2.923 +0 0 1 2.921 +0 0 0 2.921 +0 1 0 2.905 +0 0 0 1.095 +0 1 0 1.079 +0 0 0 1.079 +0 0 1 1.079 +0 1 1 1.097 +0 0 1 2.903 +0 1 1 2.921 +0 0 1 2.921 +0 0 0 2.921 +0 1 0 2.903 +0 0 0 1.099 +0 1 0 1.081 +0 0 0 1.081 +0 0 1 1.081 +0 1 1 1.099 +0 0 1 2.901 +0 1 1 2.919 +0 0 1 2.919 +0 0 0 2.919 +0 1 0 2.899 +0 0 0 1.101 +0 1 0 1.083 +0 0 0 1.083 +0 0 1 1.083 +0 1 1 1.103 +0 0 1 2.897 +0 1 1 2.917 +0 0 1 2.915 +0 0 0 2.915 +0 1 0 2.895 +0 0 0 1.105 +0 1 0 1.085 +0 0 0 1.087 +0 0 1 1.087 +0 1 1 1.109 +0 0 1 2.891 +0 1 1 2.915 +0 0 1 2.913 +0 0 0 2.913 +0 1 0 2.889 +0 0 0 1.111 +0 1 0 1.087 +0 0 0 1.089 +0 0 1 1.089 +0 1 1 1.115 +0 0 1 2.885 +0 1 1 2.911 +0 0 1 2.909 +0 0 0 2.909 +0 1 0 2.879 +0 0 0 1.121 +0 1 0 1.091 +0 0 0 1.093 +0 0 1 1.093 +0 1 1 2.907 +0 0 1 2.905 +0 0 0 2.905 +0 1 0 1.097 +0 0 0 1.099 +0 0 1 1.099 +0 1 1 2.901 +0 0 1 2.899 +0 0 0 2.899 +0 1 0 1.101 +0 0 0 1.105 +0 0 1 1.105 +0 1 1 2.895 +0 0 1 2.891 +0 0 0 2.891 +0 1 0 1.109 +0 0 0 1.113 +0 0 1 1.113 +0 1 1 2.887 +0 0 1 2.877 +0 0 0 2.877 +0 1 0 1.123 +0 0 0 0.999 +0 0 1 0.999 +0 1 1 2.999 diff -r ef7dbbd6452c -r f952052e37b7 graster/signer4laser2x1.png.raster.ngc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/graster/signer4laser2x1.png.raster.ngc Tue Aug 24 19:06:45 2010 -0400 @@ -0,0 +1,857 @@ +(raster gcode for job 3162202862410280766) +(image: signer4laser2x1.png [1000, 533]) +(config: {:feed=>120, :dpi=>[500, 500], :offset=>[1.0, 1.0], :cut_feed=>20, :on_range=>[0.0, 0.5], :corner_radius=>0, :overshoot=>0.5, :tile_size=>[2.0, 1.066], :repeat=>[1, 1], :tile_spacing=>[0.125, 0.125]}) +M63 P0 +G61 +F120 +M101 +M3 S1 +G0 X3.382 Y1.066 +G1 X0.644 Y1.066 +G0 X0.636 Y1.068 +G1 X3.382 Y1.068 +G0 X3.382 Y1.070 +G1 X0.630 Y1.070 +G0 X0.626 Y1.072 +G1 X3.382 Y1.072 +G0 X3.382 Y1.074 +G1 X0.624 Y1.074 +G0 X0.622 Y1.076 +G1 X3.382 Y1.076 +G0 X3.382 Y1.078 +G1 X0.620 Y1.078 +G0 X0.618 Y1.080 +G1 X3.382 Y1.080 +G0 X3.382 Y1.082 +G1 X0.618 Y1.082 +G0 X0.616 Y1.084 +G1 X3.382 Y1.084 +G0 X3.382 Y1.086 +G1 X0.616 Y1.086 +G0 X0.614 Y1.088 +G1 X3.382 Y1.088 +G0 X3.382 Y1.090 +G1 X0.614 Y1.090 +G0 X0.614 Y1.092 +G1 X3.382 Y1.092 +G0 X3.382 Y1.094 +G1 X0.614 Y1.094 +G0 X0.612 Y1.096 +G1 X3.382 Y1.096 +G0 X3.382 Y1.098 +G1 X0.612 Y1.098 +G0 X0.612 Y1.100 +G1 X3.382 Y1.100 +G0 X3.382 Y1.102 +G1 X0.612 Y1.102 +G0 X0.612 Y1.104 +G1 X3.382 Y1.104 +G0 X3.382 Y1.106 +G1 X0.612 Y1.106 +G0 X0.612 Y1.108 +G1 X3.382 Y1.108 +G0 X3.382 Y1.110 +G1 X0.612 Y1.110 +G0 X0.612 Y1.112 +G1 X3.382 Y1.112 +G0 X3.382 Y1.114 +G1 X0.612 Y1.114 +G0 X0.612 Y1.116 +G1 X3.382 Y1.116 +G0 X3.382 Y1.118 +G1 X0.612 Y1.118 +G0 X0.724 Y1.120 +G1 X3.382 Y1.120 +G0 X3.382 Y1.122 +G1 X0.724 Y1.122 +G0 X0.724 Y1.124 +G1 X3.380 Y1.124 +G0 X3.380 Y1.126 +G1 X0.722 Y1.126 +G0 X0.722 Y1.128 +G1 X3.380 Y1.128 +G0 X3.378 Y1.130 +G1 X0.722 Y1.130 +G0 X0.722 Y1.132 +G1 X3.378 Y1.132 +G0 X3.376 Y1.134 +G1 X0.720 Y1.134 +G0 X0.720 Y1.136 +G1 X3.374 Y1.136 +G0 X3.372 Y1.138 +G1 X0.718 Y1.138 +G0 X0.714 Y1.140 +G1 X3.368 Y1.140 +G0 X3.364 Y1.142 +G1 X0.710 Y1.142 +G0 X0.698 Y1.144 +G1 X3.358 Y1.144 +G0 X3.364 Y1.146 +G1 X0.656 Y1.146 +G0 X0.644 Y1.148 +G1 X3.368 Y1.148 +G0 X3.372 Y1.150 +G1 X0.638 Y1.150 +G0 X0.634 Y1.152 +G1 X3.374 Y1.152 +G0 X3.376 Y1.154 +G1 X0.630 Y1.154 +G0 X0.628 Y1.156 +G1 X3.378 Y1.156 +G0 X3.380 Y1.158 +G1 X0.624 Y1.158 +G0 X0.622 Y1.160 +G1 X3.380 Y1.160 +G0 X3.382 Y1.162 +G1 X0.622 Y1.162 +G0 X0.620 Y1.164 +G1 X3.382 Y1.164 +G0 X3.382 Y1.166 +G1 X0.618 Y1.166 +G0 X0.618 Y1.168 +G1 X3.382 Y1.168 +G0 X3.384 Y1.170 +G1 X0.616 Y1.170 +G0 X0.616 Y1.172 +G1 X3.384 Y1.172 +G0 X3.384 Y1.174 +G1 X0.616 Y1.174 +G0 X0.614 Y1.176 +G1 X3.384 Y1.176 +G0 X3.384 Y1.178 +G1 X0.614 Y1.178 +G0 X0.614 Y1.180 +G1 X3.384 Y1.180 +G0 X3.384 Y1.182 +G1 X0.614 Y1.182 +G0 X0.614 Y1.184 +G1 X3.384 Y1.184 +G0 X3.384 Y1.186 +G1 X0.614 Y1.186 +G0 X0.614 Y1.188 +G1 X3.384 Y1.188 +G0 X3.384 Y1.190 +G1 X0.612 Y1.190 +G0 X0.612 Y1.192 +G1 X3.384 Y1.192 +G0 X3.384 Y1.194 +G1 X0.612 Y1.194 +G0 X0.612 Y1.196 +G1 X3.384 Y1.196 +G0 X3.384 Y1.198 +G1 X0.612 Y1.198 +G0 X0.614 Y1.200 +G1 X3.384 Y1.200 +G0 X3.384 Y1.202 +G1 X0.614 Y1.202 +G0 X0.614 Y1.204 +G1 X3.384 Y1.204 +G0 X3.384 Y1.206 +G1 X0.614 Y1.206 +G0 X0.614 Y1.208 +G1 X3.384 Y1.208 +G0 X3.382 Y1.210 +G1 X0.614 Y1.210 +G0 X0.614 Y1.212 +G1 X3.382 Y1.212 +G0 X3.382 Y1.214 +G1 X0.616 Y1.214 +G0 X0.616 Y1.216 +G1 X3.380 Y1.216 +G0 X3.380 Y1.218 +G1 X0.616 Y1.218 +G0 X0.618 Y1.220 +G1 X3.380 Y1.220 +G0 X3.378 Y1.222 +G1 X0.618 Y1.222 +G0 X0.620 Y1.224 +G1 X3.378 Y1.224 +G0 X3.376 Y1.226 +G1 X0.620 Y1.226 +G0 X0.622 Y1.228 +G1 X3.374 Y1.228 +G0 X3.372 Y1.230 +G1 X0.624 Y1.230 +G0 X0.626 Y1.232 +G1 X3.368 Y1.232 +G0 X3.364 Y1.234 +G1 X0.630 Y1.234 +G0 X0.634 Y1.236 +G1 X3.360 Y1.236 +G0 X3.352 Y1.238 +G1 X0.640 Y1.238 +G0 X0.654 Y1.240 +G1 X2.880 Y1.240 +G0 X0.622 Y1.316 +G1 X3.380 Y1.316 +G0 X3.386 Y1.318 +G1 X0.616 Y1.318 +G0 X0.610 Y1.320 +G1 X3.392 Y1.320 +G0 X3.396 Y1.322 +G1 X0.606 Y1.322 +G0 X0.602 Y1.324 +G1 X3.400 Y1.324 +G0 X3.402 Y1.326 +G1 X0.600 Y1.326 +G0 X0.596 Y1.328 +G1 X3.406 Y1.328 +G0 X3.408 Y1.330 +G1 X0.594 Y1.330 +G0 X0.592 Y1.332 +G1 X3.410 Y1.332 +G0 X3.412 Y1.334 +G1 X0.590 Y1.334 +G0 X0.590 Y1.336 +G1 X3.414 Y1.336 +G0 X3.416 Y1.338 +G1 X0.588 Y1.338 +G0 X0.586 Y1.340 +G1 X3.416 Y1.340 +G0 X3.418 Y1.342 +G1 X0.584 Y1.342 +G0 X0.584 Y1.344 +G1 X3.420 Y1.344 +G0 X3.420 Y1.346 +G1 X0.582 Y1.346 +G0 X0.582 Y1.348 +G1 X3.422 Y1.348 +G0 X3.422 Y1.350 +G1 X0.580 Y1.350 +G0 X0.580 Y1.352 +G1 X3.422 Y1.352 +G0 X3.424 Y1.354 +G1 X0.578 Y1.354 +G0 X0.578 Y1.356 +G1 X3.424 Y1.356 +G0 X3.424 Y1.358 +G1 X0.578 Y1.358 +G0 X0.578 Y1.360 +G1 X3.426 Y1.360 +G0 X3.426 Y1.362 +G1 X0.576 Y1.362 +G0 X0.576 Y1.364 +G1 X3.426 Y1.364 +G0 X3.426 Y1.366 +G1 X0.576 Y1.366 +G0 X0.576 Y1.368 +G1 X3.426 Y1.368 +G0 X3.426 Y1.370 +G1 X0.576 Y1.370 +G0 X0.576 Y1.372 +G1 X3.426 Y1.372 +G0 X3.426 Y1.374 +G1 X0.576 Y1.374 +G0 X0.576 Y1.376 +G1 X3.426 Y1.376 +G0 X3.426 Y1.378 +G1 X0.576 Y1.378 +G0 X0.576 Y1.380 +G1 X3.426 Y1.380 +G0 X3.426 Y1.382 +G1 X0.576 Y1.382 +G0 X0.576 Y1.384 +G1 X3.426 Y1.384 +G0 X3.426 Y1.386 +G1 X0.576 Y1.386 +G0 X0.576 Y1.388 +G1 X3.426 Y1.388 +G0 X3.426 Y1.390 +G1 X0.576 Y1.390 +G0 X0.576 Y1.392 +G1 X3.426 Y1.392 +G0 X3.426 Y1.394 +G1 X0.576 Y1.394 +G0 X0.576 Y1.396 +G1 X3.426 Y1.396 +G0 X3.426 Y1.398 +G1 X0.576 Y1.398 +G0 X0.576 Y1.400 +G1 X3.426 Y1.400 +G0 X3.426 Y1.402 +G1 X0.576 Y1.402 +G0 X0.576 Y1.404 +G1 X3.426 Y1.404 +G0 X3.426 Y1.406 +G1 X0.576 Y1.406 +G0 X0.576 Y1.408 +G1 X3.426 Y1.408 +G0 X3.426 Y1.410 +G1 X0.576 Y1.410 +G0 X0.576 Y1.412 +G1 X3.426 Y1.412 +G0 X3.426 Y1.414 +G1 X0.576 Y1.414 +G0 X0.576 Y1.416 +G1 X3.426 Y1.416 +G0 X3.426 Y1.418 +G1 X0.576 Y1.418 +G0 X0.576 Y1.420 +G1 X3.426 Y1.420 +G0 X3.426 Y1.422 +G1 X0.576 Y1.422 +G0 X0.576 Y1.424 +G1 X3.426 Y1.424 +G0 X3.426 Y1.426 +G1 X0.576 Y1.426 +G0 X0.576 Y1.428 +G1 X3.426 Y1.428 +G0 X3.426 Y1.430 +G1 X0.576 Y1.430 +G0 X0.576 Y1.432 +G1 X3.426 Y1.432 +G0 X3.426 Y1.434 +G1 X0.576 Y1.434 +G0 X0.576 Y1.436 +G1 X3.426 Y1.436 +G0 X3.426 Y1.438 +G1 X0.576 Y1.438 +G0 X0.576 Y1.440 +G1 X3.426 Y1.440 +G0 X3.426 Y1.442 +G1 X0.576 Y1.442 +G0 X0.576 Y1.444 +G1 X3.426 Y1.444 +G0 X3.426 Y1.446 +G1 X0.576 Y1.446 +G0 X0.576 Y1.448 +G1 X3.426 Y1.448 +G0 X3.426 Y1.450 +G1 X0.576 Y1.450 +G0 X0.576 Y1.452 +G1 X3.426 Y1.452 +G0 X3.426 Y1.454 +G1 X0.576 Y1.454 +G0 X0.576 Y1.456 +G1 X3.426 Y1.456 +G0 X3.426 Y1.458 +G1 X0.576 Y1.458 +G0 X0.576 Y1.460 +G1 X3.426 Y1.460 +G0 X3.426 Y1.462 +G1 X0.576 Y1.462 +G0 X0.576 Y1.464 +G1 X3.426 Y1.464 +G0 X3.426 Y1.466 +G1 X0.576 Y1.466 +G0 X0.576 Y1.468 +G1 X3.426 Y1.468 +G0 X3.426 Y1.470 +G1 X0.576 Y1.470 +G0 X0.576 Y1.472 +G1 X3.426 Y1.472 +G0 X3.426 Y1.474 +G1 X0.576 Y1.474 +G0 X0.576 Y1.476 +G1 X3.426 Y1.476 +G0 X3.426 Y1.478 +G1 X0.576 Y1.478 +G0 X0.576 Y1.480 +G1 X3.426 Y1.480 +G0 X3.426 Y1.482 +G1 X0.576 Y1.482 +G0 X0.576 Y1.484 +G1 X3.426 Y1.484 +G0 X3.426 Y1.486 +G1 X0.576 Y1.486 +G0 X0.576 Y1.488 +G1 X3.426 Y1.488 +G0 X3.426 Y1.490 +G1 X0.576 Y1.490 +G0 X0.576 Y1.492 +G1 X3.426 Y1.492 +G0 X3.426 Y1.494 +G1 X0.576 Y1.494 +G0 X0.576 Y1.496 +G1 X3.426 Y1.496 +G0 X3.426 Y1.498 +G1 X0.576 Y1.498 +G0 X0.576 Y1.500 +G1 X3.426 Y1.500 +G0 X3.426 Y1.502 +G1 X0.576 Y1.502 +G0 X0.576 Y1.504 +G1 X3.426 Y1.504 +G0 X3.426 Y1.506 +G1 X0.576 Y1.506 +G0 X0.576 Y1.508 +G1 X3.426 Y1.508 +G0 X3.426 Y1.510 +G1 X0.576 Y1.510 +G0 X0.576 Y1.512 +G1 X3.426 Y1.512 +G0 X3.426 Y1.514 +G1 X0.576 Y1.514 +G0 X0.576 Y1.516 +G1 X3.426 Y1.516 +G0 X3.426 Y1.518 +G1 X0.576 Y1.518 +G0 X0.576 Y1.520 +G1 X3.426 Y1.520 +G0 X3.426 Y1.522 +G1 X0.576 Y1.522 +G0 X0.576 Y1.524 +G1 X3.426 Y1.524 +G0 X3.426 Y1.526 +G1 X0.576 Y1.526 +G0 X0.576 Y1.528 +G1 X3.426 Y1.528 +G0 X3.426 Y1.530 +G1 X0.576 Y1.530 +G0 X0.576 Y1.532 +G1 X3.426 Y1.532 +G0 X3.426 Y1.534 +G1 X0.576 Y1.534 +G0 X0.576 Y1.536 +G1 X3.426 Y1.536 +G0 X3.426 Y1.538 +G1 X0.576 Y1.538 +G0 X0.576 Y1.540 +G1 X3.426 Y1.540 +G0 X3.426 Y1.542 +G1 X0.576 Y1.542 +G0 X0.576 Y1.544 +G1 X3.426 Y1.544 +G0 X3.426 Y1.546 +G1 X0.576 Y1.546 +G0 X0.576 Y1.548 +G1 X3.426 Y1.548 +G0 X3.426 Y1.550 +G1 X0.576 Y1.550 +G0 X0.576 Y1.552 +G1 X3.426 Y1.552 +G0 X3.426 Y1.554 +G1 X0.576 Y1.554 +G0 X0.576 Y1.556 +G1 X3.426 Y1.556 +G0 X3.426 Y1.558 +G1 X0.576 Y1.558 +G0 X0.576 Y1.560 +G1 X3.426 Y1.560 +G0 X3.426 Y1.562 +G1 X0.576 Y1.562 +G0 X0.576 Y1.564 +G1 X3.426 Y1.564 +G0 X3.426 Y1.566 +G1 X0.576 Y1.566 +G0 X0.576 Y1.568 +G1 X3.426 Y1.568 +G0 X3.426 Y1.570 +G1 X0.576 Y1.570 +G0 X0.576 Y1.572 +G1 X3.426 Y1.572 +G0 X3.426 Y1.574 +G1 X0.576 Y1.574 +G0 X0.576 Y1.576 +G1 X3.426 Y1.576 +G0 X3.426 Y1.578 +G1 X0.576 Y1.578 +G0 X0.576 Y1.580 +G1 X3.426 Y1.580 +G0 X3.426 Y1.582 +G1 X0.576 Y1.582 +G0 X0.576 Y1.584 +G1 X3.426 Y1.584 +G0 X3.426 Y1.586 +G1 X0.576 Y1.586 +G0 X0.576 Y1.588 +G1 X3.426 Y1.588 +G0 X3.426 Y1.590 +G1 X0.576 Y1.590 +G0 X0.576 Y1.592 +G1 X3.426 Y1.592 +G0 X3.426 Y1.594 +G1 X0.576 Y1.594 +G0 X0.576 Y1.596 +G1 X3.426 Y1.596 +G0 X3.426 Y1.598 +G1 X0.576 Y1.598 +G0 X0.576 Y1.600 +G1 X3.426 Y1.600 +G0 X3.426 Y1.602 +G1 X0.576 Y1.602 +G0 X0.576 Y1.604 +G1 X3.426 Y1.604 +G0 X3.426 Y1.606 +G1 X0.576 Y1.606 +G0 X0.576 Y1.608 +G1 X3.426 Y1.608 +G0 X3.426 Y1.610 +G1 X0.576 Y1.610 +G0 X0.576 Y1.612 +G1 X3.426 Y1.612 +G0 X3.426 Y1.614 +G1 X0.576 Y1.614 +G0 X0.576 Y1.616 +G1 X3.426 Y1.616 +G0 X3.426 Y1.618 +G1 X0.576 Y1.618 +G0 X0.576 Y1.620 +G1 X3.426 Y1.620 +G0 X3.426 Y1.622 +G1 X0.576 Y1.622 +G0 X0.576 Y1.624 +G1 X3.426 Y1.624 +G0 X3.426 Y1.626 +G1 X0.576 Y1.626 +G0 X0.576 Y1.628 +G1 X3.426 Y1.628 +G0 X3.426 Y1.630 +G1 X0.576 Y1.630 +G0 X0.576 Y1.632 +G1 X3.426 Y1.632 +G0 X3.426 Y1.634 +G1 X0.576 Y1.634 +G0 X0.576 Y1.636 +G1 X3.426 Y1.636 +G0 X3.426 Y1.638 +G1 X0.576 Y1.638 +G0 X0.576 Y1.640 +G1 X3.426 Y1.640 +G0 X3.426 Y1.642 +G1 X0.576 Y1.642 +G0 X0.576 Y1.644 +G1 X3.426 Y1.644 +G0 X3.426 Y1.646 +G1 X0.576 Y1.646 +G0 X0.576 Y1.648 +G1 X3.426 Y1.648 +G0 X3.426 Y1.650 +G1 X0.576 Y1.650 +G0 X0.576 Y1.652 +G1 X3.426 Y1.652 +G0 X3.426 Y1.654 +G1 X0.576 Y1.654 +G0 X0.576 Y1.656 +G1 X3.426 Y1.656 +G0 X3.426 Y1.658 +G1 X0.576 Y1.658 +G0 X0.576 Y1.660 +G1 X3.426 Y1.660 +G0 X3.426 Y1.662 +G1 X0.576 Y1.662 +G0 X0.576 Y1.664 +G1 X3.426 Y1.664 +G0 X3.426 Y1.666 +G1 X0.576 Y1.666 +G0 X0.576 Y1.668 +G1 X3.426 Y1.668 +G0 X3.426 Y1.670 +G1 X0.576 Y1.670 +G0 X0.576 Y1.672 +G1 X3.426 Y1.672 +G0 X3.426 Y1.674 +G1 X0.576 Y1.674 +G0 X0.576 Y1.676 +G1 X3.426 Y1.676 +G0 X3.426 Y1.678 +G1 X0.576 Y1.678 +G0 X0.576 Y1.680 +G1 X3.426 Y1.680 +G0 X3.426 Y1.682 +G1 X0.576 Y1.682 +G0 X0.576 Y1.684 +G1 X3.426 Y1.684 +G0 X3.426 Y1.686 +G1 X0.576 Y1.686 +G0 X0.576 Y1.688 +G1 X3.426 Y1.688 +G0 X3.426 Y1.690 +G1 X0.576 Y1.690 +G0 X0.576 Y1.692 +G1 X3.426 Y1.692 +G0 X3.426 Y1.694 +G1 X0.576 Y1.694 +G0 X0.576 Y1.696 +G1 X3.426 Y1.696 +G0 X3.426 Y1.698 +G1 X0.576 Y1.698 +G0 X0.576 Y1.700 +G1 X3.426 Y1.700 +G0 X3.426 Y1.702 +G1 X0.576 Y1.702 +G0 X0.576 Y1.704 +G1 X3.426 Y1.704 +G0 X3.426 Y1.706 +G1 X0.576 Y1.706 +G0 X0.576 Y1.708 +G1 X3.426 Y1.708 +G0 X3.426 Y1.710 +G1 X0.576 Y1.710 +G0 X0.576 Y1.712 +G1 X3.426 Y1.712 +G0 X3.426 Y1.714 +G1 X0.576 Y1.714 +G0 X0.576 Y1.716 +G1 X3.426 Y1.716 +G0 X3.426 Y1.718 +G1 X0.576 Y1.718 +G0 X0.576 Y1.720 +G1 X3.426 Y1.720 +G0 X3.426 Y1.722 +G1 X0.576 Y1.722 +G0 X0.576 Y1.724 +G1 X3.426 Y1.724 +G0 X3.426 Y1.726 +G1 X0.576 Y1.726 +G0 X0.576 Y1.728 +G1 X3.426 Y1.728 +G0 X3.426 Y1.730 +G1 X0.576 Y1.730 +G0 X0.576 Y1.732 +G1 X3.426 Y1.732 +G0 X3.426 Y1.734 +G1 X0.576 Y1.734 +G0 X0.576 Y1.736 +G1 X3.426 Y1.736 +G0 X3.426 Y1.738 +G1 X0.576 Y1.738 +G0 X0.576 Y1.740 +G1 X3.426 Y1.740 +G0 X3.426 Y1.742 +G1 X0.576 Y1.742 +G0 X0.576 Y1.744 +G1 X3.426 Y1.744 +G0 X3.426 Y1.746 +G1 X0.576 Y1.746 +G0 X0.576 Y1.748 +G1 X3.426 Y1.748 +G0 X3.426 Y1.750 +G1 X0.576 Y1.750 +G0 X0.576 Y1.752 +G1 X3.426 Y1.752 +G0 X3.426 Y1.754 +G1 X0.576 Y1.754 +G0 X0.576 Y1.756 +G1 X3.426 Y1.756 +G0 X3.426 Y1.758 +G1 X0.576 Y1.758 +G0 X0.576 Y1.760 +G1 X3.426 Y1.760 +G0 X3.426 Y1.762 +G1 X0.576 Y1.762 +G0 X0.576 Y1.764 +G1 X3.426 Y1.764 +G0 X3.426 Y1.766 +G1 X0.576 Y1.766 +G0 X0.576 Y1.768 +G1 X3.426 Y1.768 +G0 X3.426 Y1.770 +G1 X0.576 Y1.770 +G0 X0.576 Y1.772 +G1 X3.426 Y1.772 +G0 X3.426 Y1.774 +G1 X0.576 Y1.774 +G0 X0.576 Y1.776 +G1 X3.426 Y1.776 +G0 X3.426 Y1.778 +G1 X0.576 Y1.778 +G0 X0.576 Y1.780 +G1 X3.426 Y1.780 +G0 X3.426 Y1.782 +G1 X0.576 Y1.782 +G0 X0.576 Y1.784 +G1 X3.426 Y1.784 +G0 X3.426 Y1.786 +G1 X0.576 Y1.786 +G0 X0.576 Y1.788 +G1 X3.426 Y1.788 +G0 X3.426 Y1.790 +G1 X0.576 Y1.790 +G0 X0.576 Y1.792 +G1 X3.426 Y1.792 +G0 X3.426 Y1.794 +G1 X0.576 Y1.794 +G0 X0.576 Y1.796 +G1 X3.426 Y1.796 +G0 X3.426 Y1.798 +G1 X0.576 Y1.798 +G0 X0.576 Y1.800 +G1 X3.426 Y1.800 +G0 X3.426 Y1.802 +G1 X0.576 Y1.802 +G0 X0.576 Y1.804 +G1 X3.426 Y1.804 +G0 X3.426 Y1.806 +G1 X0.576 Y1.806 +G0 X0.576 Y1.808 +G1 X3.426 Y1.808 +G0 X3.426 Y1.810 +G1 X0.576 Y1.810 +G0 X0.576 Y1.812 +G1 X3.426 Y1.812 +G0 X3.426 Y1.814 +G1 X0.576 Y1.814 +G0 X0.576 Y1.816 +G1 X3.426 Y1.816 +G0 X3.426 Y1.818 +G1 X0.576 Y1.818 +G0 X0.576 Y1.820 +G1 X3.426 Y1.820 +G0 X3.426 Y1.822 +G1 X0.576 Y1.822 +G0 X0.576 Y1.824 +G1 X3.426 Y1.824 +G0 X3.426 Y1.826 +G1 X0.576 Y1.826 +G0 X0.576 Y1.828 +G1 X3.426 Y1.828 +G0 X3.426 Y1.830 +G1 X0.576 Y1.830 +G0 X0.576 Y1.832 +G1 X3.426 Y1.832 +G0 X3.426 Y1.834 +G1 X0.576 Y1.834 +G0 X0.576 Y1.836 +G1 X3.426 Y1.836 +G0 X3.426 Y1.838 +G1 X0.576 Y1.838 +G0 X0.576 Y1.840 +G1 X3.426 Y1.840 +G0 X3.426 Y1.842 +G1 X0.576 Y1.842 +G0 X0.576 Y1.844 +G1 X3.426 Y1.844 +G0 X3.426 Y1.846 +G1 X0.576 Y1.846 +G0 X0.576 Y1.848 +G1 X3.426 Y1.848 +G0 X3.426 Y1.850 +G1 X0.576 Y1.850 +G0 X0.576 Y1.852 +G1 X3.426 Y1.852 +G0 X3.426 Y1.854 +G1 X0.576 Y1.854 +G0 X0.576 Y1.856 +G1 X3.426 Y1.856 +G0 X3.426 Y1.858 +G1 X0.576 Y1.858 +G0 X0.576 Y1.860 +G1 X3.426 Y1.860 +G0 X3.426 Y1.862 +G1 X0.576 Y1.862 +G0 X0.576 Y1.864 +G1 X3.426 Y1.864 +G0 X3.426 Y1.866 +G1 X0.576 Y1.866 +G0 X0.576 Y1.868 +G1 X3.426 Y1.868 +G0 X3.426 Y1.870 +G1 X0.576 Y1.870 +G0 X0.576 Y1.872 +G1 X3.426 Y1.872 +G0 X3.426 Y1.874 +G1 X0.576 Y1.874 +G0 X0.576 Y1.876 +G1 X3.426 Y1.876 +G0 X3.426 Y1.878 +G1 X0.576 Y1.878 +G0 X0.576 Y1.880 +G1 X3.426 Y1.880 +G0 X3.426 Y1.882 +G1 X0.576 Y1.882 +G0 X0.576 Y1.884 +G1 X3.426 Y1.884 +G0 X3.426 Y1.886 +G1 X0.576 Y1.886 +G0 X0.576 Y1.888 +G1 X3.426 Y1.888 +G0 X3.426 Y1.890 +G1 X0.576 Y1.890 +G0 X0.576 Y1.892 +G1 X3.426 Y1.892 +G0 X3.426 Y1.894 +G1 X0.576 Y1.894 +G0 X0.576 Y1.896 +G1 X3.426 Y1.896 +G0 X3.426 Y1.898 +G1 X0.576 Y1.898 +G0 X0.576 Y1.900 +G1 X3.426 Y1.900 +G0 X3.426 Y1.902 +G1 X0.576 Y1.902 +G0 X0.576 Y1.904 +G1 X3.426 Y1.904 +G0 X3.426 Y1.906 +G1 X0.576 Y1.906 +G0 X0.576 Y1.908 +G1 X3.426 Y1.908 +G0 X3.426 Y1.910 +G1 X0.576 Y1.910 +G0 X0.576 Y1.912 +G1 X3.426 Y1.912 +G0 X3.426 Y1.914 +G1 X0.576 Y1.914 +G0 X0.576 Y1.916 +G1 X3.426 Y1.916 +G0 X3.426 Y1.918 +G1 X0.576 Y1.918 +G0 X0.576 Y1.920 +G1 X3.426 Y1.920 +G0 X3.426 Y1.922 +G1 X0.576 Y1.922 +G0 X0.576 Y1.924 +G1 X3.426 Y1.924 +G0 X3.426 Y1.926 +G1 X0.576 Y1.926 +G0 X0.576 Y1.928 +G1 X3.426 Y1.928 +G0 X3.426 Y1.930 +G1 X0.576 Y1.930 +G0 X0.576 Y1.932 +G1 X3.426 Y1.932 +G0 X3.426 Y1.934 +G1 X0.576 Y1.934 +G0 X0.576 Y1.936 +G1 X3.426 Y1.936 +G0 X3.426 Y1.938 +G1 X0.578 Y1.938 +G0 X0.578 Y1.940 +G1 X3.424 Y1.940 +G0 X3.424 Y1.942 +G1 X0.578 Y1.942 +G0 X0.578 Y1.944 +G1 X3.424 Y1.944 +G0 X3.422 Y1.946 +G1 X0.580 Y1.946 +G0 X0.580 Y1.948 +G1 X3.422 Y1.948 +G0 X3.422 Y1.950 +G1 X0.582 Y1.950 +G0 X0.582 Y1.952 +G1 X3.420 Y1.952 +G0 X3.420 Y1.954 +G1 X0.584 Y1.954 +G0 X0.584 Y1.956 +G1 X3.418 Y1.956 +G0 X3.416 Y1.958 +G1 X0.586 Y1.958 +G0 X0.588 Y1.960 +G1 X3.416 Y1.960 +G0 X3.414 Y1.962 +G1 X0.588 Y1.962 +G0 X0.590 Y1.964 +G1 X3.412 Y1.964 +G0 X3.410 Y1.966 +G1 X0.592 Y1.966 +G0 X0.594 Y1.968 +G1 X3.408 Y1.968 +G0 X3.406 Y1.970 +G1 X0.598 Y1.970 +G0 X0.600 Y1.972 +G1 X3.402 Y1.972 +G0 X3.400 Y1.974 +G1 X0.602 Y1.974 +G0 X0.606 Y1.976 +G1 X3.396 Y1.976 +G0 X3.392 Y1.978 +G1 X0.610 Y1.978 +G0 X0.614 Y1.980 +G1 X3.388 Y1.980 +G0 X3.378 Y1.982 +G1 X0.624 Y1.982 +G0 X0.500 Y2.064 +G1 X3.500 Y2.064 +M63 P0 +M5 +M2 diff -r ef7dbbd6452c -r f952052e37b7 graster/test.png Binary file graster/test.png has changed diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/AnnotationVisitor.java --- a/src/clojure/asm/AnnotationVisitor.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,97 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * A visitor to visit a Java annotation. The methods of this interface must be - * called in the following order: (visit | visitEnum | - * visitAnnotation | visitArray)* visitEnd. - * - * @author Eric Bruneton - * @author Eugene Kuleshov - */ -public interface AnnotationVisitor{ - -/** - * Visits a primitive value of the annotation. - * - * @param name the value name. - * @param value the actual value, whose type must be {@link Byte}, - * {@link Boolean}, {@link Character}, {@link Short}, - * {@link Integer}, {@link Long}, {@link Float}, {@link Double}, - * {@link String} or {@link Type}. This value can also be an array - * of byte, boolean, short, char, int, long, float or double values - * (this is equivalent to using {@link #visitArray visitArray} and - * visiting each array element in turn, but is more convenient). - */ -void visit(String name, Object value); - -/** - * Visits an enumeration value of the annotation. - * - * @param name the value name. - * @param desc the class descriptor of the enumeration class. - * @param value the actual enumeration value. - */ -void visitEnum(String name, String desc, String value); - -/** - * Visits a nested annotation value of the annotation. - * - * @param name the value name. - * @param desc the class descriptor of the nested annotation class. - * @return a visitor to visit the actual nested annotation value, or - * null if this visitor is not interested in visiting - * this nested annotation. The nested annotation value must be - * fully visited before calling other methods on this annotation - * visitor. - */ -AnnotationVisitor visitAnnotation(String name, String desc); - -/** - * Visits an array value of the annotation. Note that arrays of primitive - * types (such as byte, boolean, short, char, int, long, float or double) - * can be passed as value to {@link #visit visit}. This is what - * {@link ClassReader} does. - * - * @param name the value name. - * @return a visitor to visit the actual array value elements, or - * null if this visitor is not interested in visiting - * these values. The 'name' parameters passed to the methods of this - * visitor are ignored. All the array values must be visited - * before calling other methods on this annotation visitor. - */ -AnnotationVisitor visitArray(String name); - -/** - * Visits the end of the annotation. - */ -void visitEnd(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/AnnotationWriter.java --- a/src/clojure/asm/AnnotationWriter.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,357 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * An {@link AnnotationVisitor} that generates annotations in bytecode form. - * - * @author Eric Bruneton - * @author Eugene Kuleshov - */ -final class AnnotationWriter implements AnnotationVisitor{ - -/** - * The class writer to which this annotation must be added. - */ -private final ClassWriter cw; - -/** - * The number of values in this annotation. - */ -private int size; - -/** - * true if values are named, false otherwise. Annotation - * writers used for annotation default and annotation arrays use unnamed - * values. - */ -private final boolean named; - -/** - * The annotation values in bytecode form. This byte vector only contains - * the values themselves, i.e. the number of values must be stored as a - * unsigned short just before these bytes. - */ -private final ByteVector bv; - -/** - * The byte vector to be used to store the number of values of this - * annotation. See {@link #bv}. - */ -private final ByteVector parent; - -/** - * Where the number of values of this annotation must be stored in - * {@link #parent}. - */ -private final int offset; - -/** - * Next annotation writer. This field is used to store annotation lists. - */ -AnnotationWriter next; - -/** - * Previous annotation writer. This field is used to store annotation lists. - */ -AnnotationWriter prev; - -// ------------------------------------------------------------------------ -// Constructor -// ------------------------------------------------------------------------ - -/** - * Constructs a new {@link AnnotationWriter}. - * - * @param cw the class writer to which this annotation must be added. - * @param named true if values are named, false otherwise. - * @param bv where the annotation values must be stored. - * @param parent where the number of annotation values must be stored. - * @param offset where in parent the number of annotation values must - * be stored. - */ -AnnotationWriter( - final ClassWriter cw, - final boolean named, - final ByteVector bv, - final ByteVector parent, - final int offset){ - this.cw = cw; - this.named = named; - this.bv = bv; - this.parent = parent; - this.offset = offset; -} - -// ------------------------------------------------------------------------ -// Implementation of the AnnotationVisitor interface -// ------------------------------------------------------------------------ - -public void visit(final String name, final Object value){ - ++size; - if(named) - { - bv.putShort(cw.newUTF8(name)); - } - if(value instanceof String) - { - bv.put12('s', cw.newUTF8((String) value)); - } - else if(value instanceof Byte) - { - bv.put12('B', cw.newInteger(((Byte) value).byteValue()).index); - } - else if(value instanceof Boolean) - { - int v = ((Boolean) value).booleanValue() ? 1 : 0; - bv.put12('Z', cw.newInteger(v).index); - } - else if(value instanceof Character) - { - bv.put12('C', cw.newInteger(((Character) value).charValue()).index); - } - else if(value instanceof Short) - { - bv.put12('S', cw.newInteger(((Short) value).shortValue()).index); - } - else if(value instanceof Type) - { - bv.put12('c', cw.newUTF8(((Type) value).getDescriptor())); - } - else if(value instanceof byte[]) - { - byte[] v = (byte[]) value; - bv.put12('[', v.length); - for(int i = 0; i < v.length; i++) - { - bv.put12('B', cw.newInteger(v[i]).index); - } - } - else if(value instanceof boolean[]) - { - boolean[] v = (boolean[]) value; - bv.put12('[', v.length); - for(int i = 0; i < v.length; i++) - { - bv.put12('Z', cw.newInteger(v[i] ? 1 : 0).index); - } - } - else if(value instanceof short[]) - { - short[] v = (short[]) value; - bv.put12('[', v.length); - for(int i = 0; i < v.length; i++) - { - bv.put12('S', cw.newInteger(v[i]).index); - } - } - else if(value instanceof char[]) - { - char[] v = (char[]) value; - bv.put12('[', v.length); - for(int i = 0; i < v.length; i++) - { - bv.put12('C', cw.newInteger(v[i]).index); - } - } - else if(value instanceof int[]) - { - int[] v = (int[]) value; - bv.put12('[', v.length); - for(int i = 0; i < v.length; i++) - { - bv.put12('I', cw.newInteger(v[i]).index); - } - } - else if(value instanceof long[]) - { - long[] v = (long[]) value; - bv.put12('[', v.length); - for(int i = 0; i < v.length; i++) - { - bv.put12('J', cw.newLong(v[i]).index); - } - } - else if(value instanceof float[]) - { - float[] v = (float[]) value; - bv.put12('[', v.length); - for(int i = 0; i < v.length; i++) - { - bv.put12('F', cw.newFloat(v[i]).index); - } - } - else if(value instanceof double[]) - { - double[] v = (double[]) value; - bv.put12('[', v.length); - for(int i = 0; i < v.length; i++) - { - bv.put12('D', cw.newDouble(v[i]).index); - } - } - else - { - Item i = cw.newConstItem(value); - bv.put12(".s.IFJDCS".charAt(i.type), i.index); - } -} - -public void visitEnum( - final String name, - final String desc, - final String value){ - ++size; - if(named) - { - bv.putShort(cw.newUTF8(name)); - } - bv.put12('e', cw.newUTF8(desc)).putShort(cw.newUTF8(value)); -} - -public AnnotationVisitor visitAnnotation( - final String name, - final String desc){ - ++size; - if(named) - { - bv.putShort(cw.newUTF8(name)); - } - // write tag and type, and reserve space for values count - bv.put12('@', cw.newUTF8(desc)).putShort(0); - return new AnnotationWriter(cw, true, bv, bv, bv.length - 2); -} - -public AnnotationVisitor visitArray(final String name){ - ++size; - if(named) - { - bv.putShort(cw.newUTF8(name)); - } - // write tag, and reserve space for array size - bv.put12('[', 0); - return new AnnotationWriter(cw, false, bv, bv, bv.length - 2); -} - -public void visitEnd(){ - if(parent != null) - { - byte[] data = parent.data; - data[offset] = (byte) (size >>> 8); - data[offset + 1] = (byte) size; - } -} - -// ------------------------------------------------------------------------ -// Utility methods -// ------------------------------------------------------------------------ - -/** - * Returns the size of this annotation writer list. - * - * @return the size of this annotation writer list. - */ -int getSize(){ - int size = 0; - AnnotationWriter aw = this; - while(aw != null) - { - size += aw.bv.length; - aw = aw.next; - } - return size; -} - -/** - * Puts the annotations of this annotation writer list into the given byte - * vector. - * - * @param out where the annotations must be put. - */ -void put(final ByteVector out){ - int n = 0; - int size = 2; - AnnotationWriter aw = this; - AnnotationWriter last = null; - while(aw != null) - { - ++n; - size += aw.bv.length; - aw.visitEnd(); // in case user forgot to call visitEnd - aw.prev = last; - last = aw; - aw = aw.next; - } - out.putInt(size); - out.putShort(n); - aw = last; - while(aw != null) - { - out.putByteArray(aw.bv.data, 0, aw.bv.length); - aw = aw.prev; - } -} - -/** - * Puts the given annotation lists into the given byte vector. - * - * @param panns an array of annotation writer lists. - * @param out where the annotations must be put. - */ -static void put(final AnnotationWriter[] panns, final ByteVector out){ - int size = 1 + 2 * panns.length; - for(int i = 0; i < panns.length; ++i) - { - size += panns[i] == null ? 0 : panns[i].getSize(); - } - out.putInt(size).putByte(panns.length); - for(int i = 0; i < panns.length; ++i) - { - AnnotationWriter aw = panns[i]; - AnnotationWriter last = null; - int n = 0; - while(aw != null) - { - ++n; - aw.visitEnd(); // in case user forgot to call visitEnd - aw.prev = last; - last = aw; - aw = aw.next; - } - out.putShort(n); - aw = last; - while(aw != null) - { - out.putByteArray(aw.bv.data, 0, aw.bv.length); - aw = aw.prev; - } - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/Attribute.java --- a/src/clojure/asm/Attribute.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,253 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * A non standard class, field, method or code attribute. - * - * @author Eric Bruneton - * @author Eugene Kuleshov - */ -public class Attribute{ - -/** - * The type of this attribute. - */ -public final String type; - -/** - * The raw value of this attribute, used only for unknown attributes. - */ -byte[] value; - -/** - * The next attribute in this attribute list. May be null. - */ -Attribute next; - -/** - * Constructs a new empty attribute. - * - * @param type the type of the attribute. - */ -protected Attribute(final String type){ - this.type = type; -} - -/** - * Returns true if this type of attribute is unknown. The default - * implementation of this method always returns true. - * - * @return true if this type of attribute is unknown. - */ -public boolean isUnknown(){ - return true; -} - -/** - * Returns true if this type of attribute is a code attribute. - * - * @return true if this type of attribute is a code attribute. - */ -public boolean isCodeAttribute(){ - return false; -} - -/** - * Returns the labels corresponding to this attribute. - * - * @return the labels corresponding to this attribute, or null if - * this attribute is not a code attribute that contains labels. - */ -protected Label[] getLabels(){ - return null; -} - -/** - * Reads a {@link #type type} attribute. This method must return a new - * {@link Attribute} object, of type {@link #type type}, corresponding to - * the len bytes starting at the given offset, in the given class - * reader. - * - * @param cr the class that contains the attribute to be read. - * @param off index of the first byte of the attribute's content in {@link - * ClassReader#b cr.b}. The 6 attribute header bytes, containing the - * type and the length of the attribute, are not taken into account - * here. - * @param len the length of the attribute's content. - * @param buf buffer to be used to call - * {@link ClassReader#readUTF8 readUTF8}, - * {@link ClassReader#readClass(int,char[]) readClass} or - * {@link ClassReader#readConst readConst}. - * @param codeOff index of the first byte of code's attribute content in - * {@link ClassReader#b cr.b}, or -1 if the attribute to be read is - * not a code attribute. The 6 attribute header bytes, containing the - * type and the length of the attribute, are not taken into account - * here. - * @param labels the labels of the method's code, or null if the - * attribute to be read is not a code attribute. - * @return a new {@link Attribute} object corresponding to the given - * bytes. - */ -protected Attribute read( - final ClassReader cr, - final int off, - final int len, - final char[] buf, - final int codeOff, - final Label[] labels){ - Attribute attr = new Attribute(type); - attr.value = new byte[len]; - System.arraycopy(cr.b, off, attr.value, 0, len); - return attr; -} - -/** - * Returns the byte array form of this attribute. - * - * @param cw the class to which this attribute must be added. This parameter - * can be used to add to the constant pool of this class the items - * that corresponds to this attribute. - * @param code the bytecode of the method corresponding to this code - * attribute, or null if this attribute is not a code - * attributes. - * @param len the length of the bytecode of the method corresponding to this - * code attribute, or null if this attribute is not a code - * attribute. - * @param maxStack the maximum stack size of the method corresponding to - * this code attribute, or -1 if this attribute is not a code - * attribute. - * @param maxLocals the maximum number of local variables of the method - * corresponding to this code attribute, or -1 if this attribute is - * not a code attribute. - * @return the byte array form of this attribute. - */ -protected ByteVector write( - final ClassWriter cw, - final byte[] code, - final int len, - final int maxStack, - final int maxLocals){ - ByteVector v = new ByteVector(); - v.data = value; - v.length = value.length; - return v; -} - -/** - * Returns the length of the attribute list that begins with this attribute. - * - * @return the length of the attribute list that begins with this attribute. - */ -final int getCount(){ - int count = 0; - Attribute attr = this; - while(attr != null) - { - count += 1; - attr = attr.next; - } - return count; -} - -/** - * Returns the size of all the attributes in this attribute list. - * - * @param cw the class writer to be used to convert the attributes into byte - * arrays, with the {@link #write write} method. - * @param code the bytecode of the method corresponding to these code - * attributes, or null if these attributes are not code - * attributes. - * @param len the length of the bytecode of the method corresponding to - * these code attributes, or null if these attributes are - * not code attributes. - * @param maxStack the maximum stack size of the method corresponding to - * these code attributes, or -1 if these attributes are not code - * attributes. - * @param maxLocals the maximum number of local variables of the method - * corresponding to these code attributes, or -1 if these attributes - * are not code attributes. - * @return the size of all the attributes in this attribute list. This size - * includes the size of the attribute headers. - */ -final int getSize( - final ClassWriter cw, - final byte[] code, - final int len, - final int maxStack, - final int maxLocals){ - Attribute attr = this; - int size = 0; - while(attr != null) - { - cw.newUTF8(attr.type); - size += attr.write(cw, code, len, maxStack, maxLocals).length + 6; - attr = attr.next; - } - return size; -} - -/** - * Writes all the attributes of this attribute list in the given byte - * vector. - * - * @param cw the class writer to be used to convert the attributes into byte - * arrays, with the {@link #write write} method. - * @param code the bytecode of the method corresponding to these code - * attributes, or null if these attributes are not code - * attributes. - * @param len the length of the bytecode of the method corresponding to - * these code attributes, or null if these attributes are - * not code attributes. - * @param maxStack the maximum stack size of the method corresponding to - * these code attributes, or -1 if these attributes are not code - * attributes. - * @param maxLocals the maximum number of local variables of the method - * corresponding to these code attributes, or -1 if these attributes - * are not code attributes. - * @param out where the attributes must be written. - */ -final void put( - final ClassWriter cw, - final byte[] code, - final int len, - final int maxStack, - final int maxLocals, - final ByteVector out){ - Attribute attr = this; - while(attr != null) - { - ByteVector b = attr.write(cw, code, len, maxStack, maxLocals); - out.putShort(cw.newUTF8(attr.type)).putInt(b.length); - out.putByteArray(b.data, 0, b.length); - attr = attr.next; - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/ByteVector.java --- a/src/clojure/asm/ByteVector.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,318 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * A dynamically extensible vector of bytes. This class is roughly equivalent to - * a DataOutputStream on top of a ByteArrayOutputStream, but is more efficient. - * - * @author Eric Bruneton - */ -public class ByteVector{ - -/** - * The content of this vector. - */ -byte[] data; - -/** - * Actual number of bytes in this vector. - */ -int length; - -/** - * Constructs a new {@link ByteVector ByteVector} with a default initial - * size. - */ -public ByteVector(){ - data = new byte[64]; -} - -/** - * Constructs a new {@link ByteVector ByteVector} with the given initial - * size. - * - * @param initialSize the initial size of the byte vector to be constructed. - */ -public ByteVector(final int initialSize){ - data = new byte[initialSize]; -} - -/** - * Puts a byte into this byte vector. The byte vector is automatically - * enlarged if necessary. - * - * @param b a byte. - * @return this byte vector. - */ -public ByteVector putByte(final int b){ - int length = this.length; - if(length + 1 > data.length) - { - enlarge(1); - } - data[length++] = (byte) b; - this.length = length; - return this; -} - -/** - * Puts two bytes into this byte vector. The byte vector is automatically - * enlarged if necessary. - * - * @param b1 a byte. - * @param b2 another byte. - * @return this byte vector. - */ -ByteVector put11(final int b1, final int b2){ - int length = this.length; - if(length + 2 > data.length) - { - enlarge(2); - } - byte[] data = this.data; - data[length++] = (byte) b1; - data[length++] = (byte) b2; - this.length = length; - return this; -} - -/** - * Puts a short into this byte vector. The byte vector is automatically - * enlarged if necessary. - * - * @param s a short. - * @return this byte vector. - */ -public ByteVector putShort(final int s){ - int length = this.length; - if(length + 2 > data.length) - { - enlarge(2); - } - byte[] data = this.data; - data[length++] = (byte) (s >>> 8); - data[length++] = (byte) s; - this.length = length; - return this; -} - -/** - * Puts a byte and a short into this byte vector. The byte vector is - * automatically enlarged if necessary. - * - * @param b a byte. - * @param s a short. - * @return this byte vector. - */ -ByteVector put12(final int b, final int s){ - int length = this.length; - if(length + 3 > data.length) - { - enlarge(3); - } - byte[] data = this.data; - data[length++] = (byte) b; - data[length++] = (byte) (s >>> 8); - data[length++] = (byte) s; - this.length = length; - return this; -} - -/** - * Puts an int into this byte vector. The byte vector is automatically - * enlarged if necessary. - * - * @param i an int. - * @return this byte vector. - */ -public ByteVector putInt(final int i){ - int length = this.length; - if(length + 4 > data.length) - { - enlarge(4); - } - byte[] data = this.data; - data[length++] = (byte) (i >>> 24); - data[length++] = (byte) (i >>> 16); - data[length++] = (byte) (i >>> 8); - data[length++] = (byte) i; - this.length = length; - return this; -} - -/** - * Puts a long into this byte vector. The byte vector is automatically - * enlarged if necessary. - * - * @param l a long. - * @return this byte vector. - */ -public ByteVector putLong(final long l){ - int length = this.length; - if(length + 8 > data.length) - { - enlarge(8); - } - byte[] data = this.data; - int i = (int) (l >>> 32); - data[length++] = (byte) (i >>> 24); - data[length++] = (byte) (i >>> 16); - data[length++] = (byte) (i >>> 8); - data[length++] = (byte) i; - i = (int) l; - data[length++] = (byte) (i >>> 24); - data[length++] = (byte) (i >>> 16); - data[length++] = (byte) (i >>> 8); - data[length++] = (byte) i; - this.length = length; - return this; -} - -/** - * Puts an UTF8 string into this byte vector. The byte vector is - * automatically enlarged if necessary. - * - * @param s a String. - * @return this byte vector. - */ -public ByteVector putUTF8(final String s){ - int charLength = s.length(); - if(length + 2 + charLength > data.length) - { - enlarge(2 + charLength); - } - int len = length; - byte[] data = this.data; - // optimistic algorithm: instead of computing the byte length and then - // serializing the string (which requires two loops), we assume the byte - // length is equal to char length (which is the most frequent case), and - // we start serializing the string right away. During the serialization, - // if we find that this assumption is wrong, we continue with the - // general method. - data[len++] = (byte) (charLength >>> 8); - data[len++] = (byte) charLength; - for(int i = 0; i < charLength; ++i) - { - char c = s.charAt(i); - if(c >= '\001' && c <= '\177') - { - data[len++] = (byte) c; - } - else - { - int byteLength = i; - for(int j = i; j < charLength; ++j) - { - c = s.charAt(j); - if(c >= '\001' && c <= '\177') - { - byteLength++; - } - else if(c > '\u07FF') - { - byteLength += 3; - } - else - { - byteLength += 2; - } - } - data[length] = (byte) (byteLength >>> 8); - data[length + 1] = (byte) byteLength; - if(length + 2 + byteLength > data.length) - { - length = len; - enlarge(2 + byteLength); - data = this.data; - } - for(int j = i; j < charLength; ++j) - { - c = s.charAt(j); - if(c >= '\001' && c <= '\177') - { - data[len++] = (byte) c; - } - else if(c > '\u07FF') - { - data[len++] = (byte) (0xE0 | c >> 12 & 0xF); - data[len++] = (byte) (0x80 | c >> 6 & 0x3F); - data[len++] = (byte) (0x80 | c & 0x3F); - } - else - { - data[len++] = (byte) (0xC0 | c >> 6 & 0x1F); - data[len++] = (byte) (0x80 | c & 0x3F); - } - } - break; - } - } - length = len; - return this; -} - -/** - * Puts an array of bytes into this byte vector. The byte vector is - * automatically enlarged if necessary. - * - * @param b an array of bytes. May be null to put len - * null bytes into this byte vector. - * @param off index of the fist byte of b that must be copied. - * @param len number of bytes of b that must be copied. - * @return this byte vector. - */ -public ByteVector putByteArray(final byte[] b, final int off, final int len){ - if(length + len > data.length) - { - enlarge(len); - } - if(b != null) - { - System.arraycopy(b, off, data, length, len); - } - length += len; - return this; -} - -/** - * Enlarge this byte vector so that it can receive n more bytes. - * - * @param size number of additional bytes that this byte vector should be - * able to receive. - */ -private void enlarge(final int size){ - int length1 = 2 * data.length; - int length2 = length + size; - byte[] newData = new byte[length1 > length2 ? length1 : length2]; - System.arraycopy(data, 0, newData, 0, length); - data = newData; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/ClassAdapter.java --- a/src/clojure/asm/ClassAdapter.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,115 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * An empty {@link ClassVisitor} that delegates to another {@link ClassVisitor}. - * This class can be used as a super class to quickly implement usefull class - * adapter classes, just by overriding the necessary methods. - * - * @author Eric Bruneton - */ -public class ClassAdapter implements ClassVisitor{ - -/** - * The {@link ClassVisitor} to which this adapter delegates calls. - */ -protected ClassVisitor cv; - -/** - * Constructs a new {@link ClassAdapter} object. - * - * @param cv the class visitor to which this adapter must delegate calls. - */ -public ClassAdapter(final ClassVisitor cv){ - this.cv = cv; -} - -public void visit( - final int version, - final int access, - final String name, - final String signature, - final String superName, - final String[] interfaces){ - cv.visit(version, access, name, signature, superName, interfaces); -} - -public void visitSource(final String source, final String debug){ - cv.visitSource(source, debug); -} - -public void visitOuterClass( - final String owner, - final String name, - final String desc){ - cv.visitOuterClass(owner, name, desc); -} - -public AnnotationVisitor visitAnnotation( - final String desc, - final boolean visible){ - return cv.visitAnnotation(desc, visible); -} - -public void visitAttribute(final Attribute attr){ - cv.visitAttribute(attr); -} - -public void visitInnerClass( - final String name, - final String outerName, - final String innerName, - final int access){ - cv.visitInnerClass(name, outerName, innerName, access); -} - -public FieldVisitor visitField( - final int access, - final String name, - final String desc, - final String signature, - final Object value){ - return cv.visitField(access, name, desc, signature, value); -} - -public MethodVisitor visitMethod( - final int access, - final String name, - final String desc, - final String signature, - final String[] exceptions){ - return cv.visitMethod(access, name, desc, signature, exceptions); -} - -public void visitEnd(){ - cv.visitEnd(); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/ClassReader.java --- a/src/clojure/asm/ClassReader.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2224 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -import java.io.InputStream; -import java.io.IOException; - -/** - * A Java class parser to make a {@link ClassVisitor} visit an existing class. - * This class parses a byte array conforming to the Java class file format and - * calls the appropriate visit methods of a given class visitor for each field, - * method and bytecode instruction encountered. - * - * @author Eric Bruneton - * @author Eugene Kuleshov - */ -public class ClassReader{ - -/** - * Flag to skip method code. If this class is set CODE - * attribute won't be visited. This can be used, for example, to retrieve - * annotations for methods and method parameters. - */ -public final static int SKIP_CODE = 1; - -/** - * Flag to skip the debug information in the class. If this flag is set the - * debug information of the class is not visited, i.e. the - * {@link MethodVisitor#visitLocalVariable visitLocalVariable} and - * {@link MethodVisitor#visitLineNumber visitLineNumber} methods will not be - * called. - */ -public final static int SKIP_DEBUG = 2; - -/** - * Flag to skip the stack map frames in the class. If this flag is set the - * stack map frames of the class is not visited, i.e. the - * {@link MethodVisitor#visitFrame visitFrame} method will not be called. - * This flag is useful when the {@link ClassWriter#COMPUTE_FRAMES} option is - * used: it avoids visiting frames that will be ignored and recomputed from - * scratch in the class writer. - */ -public final static int SKIP_FRAMES = 4; - -/** - * Flag to expand the stack map frames. By default stack map frames are - * visited in their original format (i.e. "expanded" for classes whose - * version is less than V1_6, and "compressed" for the other classes). If - * this flag is set, stack map frames are always visited in expanded format - * (this option adds a decompression/recompression step in ClassReader and - * ClassWriter which degrades performances quite a lot). - */ -public final static int EXPAND_FRAMES = 8; - -/** - * The class to be parsed. The content of this array must not be - * modified. This field is intended for {@link Attribute} sub classes, and - * is normally not needed by class generators or adapters. - */ -public final byte[] b; - -/** - * The start index of each constant pool item in {@link #b b}, plus one. - * The one byte offset skips the constant pool item tag that indicates its - * type. - */ -private final int[] items; - -/** - * The String objects corresponding to the CONSTANT_Utf8 items. This cache - * avoids multiple parsing of a given CONSTANT_Utf8 constant pool item, - * which GREATLY improves performances (by a factor 2 to 3). This caching - * strategy could be extended to all constant pool items, but its benefit - * would not be so great for these items (because they are much less - * expensive to parse than CONSTANT_Utf8 items). - */ -private final String[] strings; - -/** - * Maximum length of the strings contained in the constant pool of the - * class. - */ -private final int maxStringLength; - -/** - * Start index of the class header information (access, name...) in - * {@link #b b}. - */ -public final int header; - -// ------------------------------------------------------------------------ -// Constructors -// ------------------------------------------------------------------------ - -/** - * Constructs a new {@link ClassReader} object. - * - * @param b the bytecode of the class to be read. - */ -public ClassReader(final byte[] b){ - this(b, 0, b.length); -} - -/** - * Constructs a new {@link ClassReader} object. - * - * @param b the bytecode of the class to be read. - * @param off the start offset of the class data. - * @param len the length of the class data. - */ -public ClassReader(final byte[] b, final int off, final int len){ - this.b = b; - // parses the constant pool - items = new int[readUnsignedShort(off + 8)]; - int n = items.length; - strings = new String[n]; - int max = 0; - int index = off + 10; - for(int i = 1; i < n; ++i) - { - items[i] = index + 1; - int size; - switch(b[index]) - { - case ClassWriter.FIELD: - case ClassWriter.METH: - case ClassWriter.IMETH: - case ClassWriter.INT: - case ClassWriter.FLOAT: - case ClassWriter.NAME_TYPE: - size = 5; - break; - case ClassWriter.LONG: - case ClassWriter.DOUBLE: - size = 9; - ++i; - break; - case ClassWriter.UTF8: - size = 3 + readUnsignedShort(index + 1); - if(size > max) - { - max = size; - } - break; - // case ClassWriter.CLASS: - // case ClassWriter.STR: - default: - size = 3; - break; - } - index += size; - } - maxStringLength = max; - // the class header information starts just after the constant pool - header = index; -} - -/** - * Returns the class's access flags (see {@link Opcodes}). This value may - * not reflect Deprecated and Synthetic flags when bytecode is before 1.5 - * and those flags are represented by attributes. - * - * @return the class access flags - * @see ClassVisitor#visit(int,int,String,String,String,String[]) - */ -public int getAccess(){ - return readUnsignedShort(header); -} - -/** - * Returns the internal name of the class (see - * {@link Type#getInternalName() getInternalName}). - * - * @return the internal class name - * @see ClassVisitor#visit(int,int,String,String,String,String[]) - */ -public String getClassName(){ - return readClass(header + 2, new char[maxStringLength]); -} - -/** - * Returns the internal of name of the super class (see - * {@link Type#getInternalName() getInternalName}). For interfaces, the - * super class is {@link Object}. - * - * @return the internal name of super class, or null for - * {@link Object} class. - * @see ClassVisitor#visit(int,int,String,String,String,String[]) - */ -public String getSuperName(){ - int n = items[readUnsignedShort(header + 4)]; - return n == 0 ? null : readUTF8(n, new char[maxStringLength]); -} - -/** - * Returns the internal names of the class's interfaces (see - * {@link Type#getInternalName() getInternalName}). - * - * @return the array of internal names for all implemented interfaces or - * null. - * @see ClassVisitor#visit(int,int,String,String,String,String[]) - */ -public String[] getInterfaces(){ - int index = header + 6; - int n = readUnsignedShort(index); - String[] interfaces = new String[n]; - if(n > 0) - { - char[] buf = new char[maxStringLength]; - for(int i = 0; i < n; ++i) - { - index += 2; - interfaces[i] = readClass(index, buf); - } - } - return interfaces; -} - -/** - * Copies the constant pool data into the given {@link ClassWriter}. Should - * be called before the {@link #accept(ClassVisitor,int)} method. - * - * @param classWriter the {@link ClassWriter} to copy constant pool into. - */ -void copyPool(final ClassWriter classWriter){ - char[] buf = new char[maxStringLength]; - int ll = items.length; - Item[] items2 = new Item[ll]; - for(int i = 1; i < ll; i++) - { - int index = items[i]; - int tag = b[index - 1]; - Item item = new Item(i); - int nameType; - switch(tag) - { - case ClassWriter.FIELD: - case ClassWriter.METH: - case ClassWriter.IMETH: - nameType = items[readUnsignedShort(index + 2)]; - item.set(tag, - readClass(index, buf), - readUTF8(nameType, buf), - readUTF8(nameType + 2, buf)); - break; - - case ClassWriter.INT: - item.set(readInt(index)); - break; - - case ClassWriter.FLOAT: - item.set(Float.intBitsToFloat(readInt(index))); - break; - - case ClassWriter.NAME_TYPE: - item.set(tag, - readUTF8(index, buf), - readUTF8(index + 2, buf), - null); - break; - - case ClassWriter.LONG: - item.set(readLong(index)); - ++i; - break; - - case ClassWriter.DOUBLE: - item.set(Double.longBitsToDouble(readLong(index))); - ++i; - break; - - case ClassWriter.UTF8: - { - String s = strings[i]; - if(s == null) - { - index = items[i]; - s = strings[i] = readUTF(index + 2, - readUnsignedShort(index), - buf); - } - item.set(tag, s, null, null); - } - break; - - // case ClassWriter.STR: - // case ClassWriter.CLASS: - default: - item.set(tag, readUTF8(index, buf), null, null); - break; - } - - int index2 = item.hashCode % items2.length; - item.next = items2[index2]; - items2[index2] = item; - } - - int off = items[1] - 1; - classWriter.pool.putByteArray(b, off, header - off); - classWriter.items = items2; - classWriter.threshold = (int) (0.75d * ll); - classWriter.index = ll; -} - -/** - * Constructs a new {@link ClassReader} object. - * - * @param is an input stream from which to read the class. - * @throws IOException if a problem occurs during reading. - */ -public ClassReader(final InputStream is) throws IOException{ - this(readClass(is)); -} - -/** - * Constructs a new {@link ClassReader} object. - * - * @param name the fully qualified name of the class to be read. - * @throws IOException if an exception occurs during reading. - */ -public ClassReader(final String name) throws IOException{ - this(ClassLoader.getSystemResourceAsStream(name.replace('.', '/') - + ".class")); -} - -/** - * Reads the bytecode of a class. - * - * @param is an input stream from which to read the class. - * @return the bytecode read from the given input stream. - * @throws IOException if a problem occurs during reading. - */ -private static byte[] readClass(final InputStream is) throws IOException{ - if(is == null) - { - throw new IOException("Class not found"); - } - byte[] b = new byte[is.available()]; - int len = 0; - while(true) - { - int n = is.read(b, len, b.length - len); - if(n == -1) - { - if(len < b.length) - { - byte[] c = new byte[len]; - System.arraycopy(b, 0, c, 0, len); - b = c; - } - return b; - } - len += n; - if(len == b.length) - { - byte[] c = new byte[b.length + 1000]; - System.arraycopy(b, 0, c, 0, len); - b = c; - } - } -} - -// ------------------------------------------------------------------------ -// Public methods -// ------------------------------------------------------------------------ - -/** - * Makes the given visitor visit the Java class of this {@link ClassReader}. - * This class is the one specified in the constructor (see - * {@link #ClassReader(byte[]) ClassReader}). - * - * @param classVisitor the visitor that must visit this class. - * @param flags option flags that can be used to modify the default behavior - * of this class. See {@link #SKIP_DEBUG}, {@link #EXPAND_FRAMES}. - */ -public void accept(final ClassVisitor classVisitor, final int flags){ - accept(classVisitor, new Attribute[0], flags); -} - -/** - * Makes the given visitor visit the Java class of this {@link ClassReader}. - * This class is the one specified in the constructor (see - * {@link #ClassReader(byte[]) ClassReader}). - * - * @param classVisitor the visitor that must visit this class. - * @param attrs prototypes of the attributes that must be parsed during the - * visit of the class. Any attribute whose type is not equal to the - * type of one the prototypes will not be parsed: its byte array - * value will be passed unchanged to the ClassWriter. This may - * corrupt it if this value contains references to the constant pool, - * or has syntactic or semantic links with a class element that has - * been transformed by a class adapter between the reader and the - * writer. - * @param flags option flags that can be used to modify the default behavior - * of this class. See {@link #SKIP_DEBUG}, {@link #EXPAND_FRAMES}. - */ -public void accept( - final ClassVisitor classVisitor, - final Attribute[] attrs, - final int flags){ - byte[] b = this.b; // the bytecode array - char[] c = new char[maxStringLength]; // buffer used to read strings - int i, j, k; // loop variables - int u, v, w; // indexes in b - Attribute attr; - - int access; - String name; - String desc; - String attrName; - String signature; - int anns = 0; - int ianns = 0; - Attribute cattrs = null; - - // visits the header - u = header; - access = readUnsignedShort(u); - name = readClass(u + 2, c); - v = items[readUnsignedShort(u + 4)]; - String superClassName = v == 0 ? null : readUTF8(v, c); - String[] implementedItfs = new String[readUnsignedShort(u + 6)]; - w = 0; - u += 8; - for(i = 0; i < implementedItfs.length; ++i) - { - implementedItfs[i] = readClass(u, c); - u += 2; - } - - boolean skipCode = (flags & SKIP_CODE) != 0; - boolean skipDebug = (flags & SKIP_DEBUG) != 0; - boolean unzip = (flags & EXPAND_FRAMES) != 0; - - // skips fields and methods - v = u; - i = readUnsignedShort(v); - v += 2; - for(; i > 0; --i) - { - j = readUnsignedShort(v + 6); - v += 8; - for(; j > 0; --j) - { - v += 6 + readInt(v + 2); - } - } - i = readUnsignedShort(v); - v += 2; - for(; i > 0; --i) - { - j = readUnsignedShort(v + 6); - v += 8; - for(; j > 0; --j) - { - v += 6 + readInt(v + 2); - } - } - // reads the class's attributes - signature = null; - String sourceFile = null; - String sourceDebug = null; - String enclosingOwner = null; - String enclosingName = null; - String enclosingDesc = null; - - i = readUnsignedShort(v); - v += 2; - for(; i > 0; --i) - { - attrName = readUTF8(v, c); - // tests are sorted in decreasing frequency order - // (based on frequencies observed on typical classes) - if(attrName.equals("SourceFile")) - { - sourceFile = readUTF8(v + 6, c); - } - else if(attrName.equals("InnerClasses")) - { - w = v + 6; - } - else if(attrName.equals("EnclosingMethod")) - { - enclosingOwner = readClass(v + 6, c); - int item = readUnsignedShort(v + 8); - if(item != 0) - { - enclosingName = readUTF8(items[item], c); - enclosingDesc = readUTF8(items[item] + 2, c); - } - } - else if(attrName.equals("Signature")) - { - signature = readUTF8(v + 6, c); - } - else if(attrName.equals("RuntimeVisibleAnnotations")) - { - anns = v + 6; - } - else if(attrName.equals("Deprecated")) - { - access |= Opcodes.ACC_DEPRECATED; - } - else if(attrName.equals("Synthetic")) - { - access |= Opcodes.ACC_SYNTHETIC; - } - else if(attrName.equals("SourceDebugExtension")) - { - int len = readInt(v + 2); - sourceDebug = readUTF(v + 6, len, new char[len]); - } - else if(attrName.equals("RuntimeInvisibleAnnotations")) - { - ianns = v + 6; - } - else - { - attr = readAttribute(attrs, - attrName, - v + 6, - readInt(v + 2), - c, - -1, - null); - if(attr != null) - { - attr.next = cattrs; - cattrs = attr; - } - } - v += 6 + readInt(v + 2); - } - // calls the visit method - classVisitor.visit(readInt(4), - access, - name, - signature, - superClassName, - implementedItfs); - - // calls the visitSource method - if(!skipDebug && (sourceFile != null || sourceDebug != null)) - { - classVisitor.visitSource(sourceFile, sourceDebug); - } - - // calls the visitOuterClass method - if(enclosingOwner != null) - { - classVisitor.visitOuterClass(enclosingOwner, - enclosingName, - enclosingDesc); - } - - // visits the class annotations - for(i = 1; i >= 0; --i) - { - v = i == 0 ? ianns : anns; - if(v != 0) - { - j = readUnsignedShort(v); - v += 2; - for(; j > 0; --j) - { - v = readAnnotationValues(v + 2, - c, - true, - classVisitor.visitAnnotation(readUTF8(v, c), i != 0)); - } - } - } - - // visits the class attributes - while(cattrs != null) - { - attr = cattrs.next; - cattrs.next = null; - classVisitor.visitAttribute(cattrs); - cattrs = attr; - } - - // calls the visitInnerClass method - if(w != 0) - { - i = readUnsignedShort(w); - w += 2; - for(; i > 0; --i) - { - classVisitor.visitInnerClass(readUnsignedShort(w) == 0 - ? null - : readClass(w, c), readUnsignedShort(w + 2) == 0 - ? null - : readClass(w + 2, c), readUnsignedShort(w + 4) == 0 - ? null - : readUTF8(w + 4, c), - readUnsignedShort(w + 6)); - w += 8; - } - } - - // visits the fields - i = readUnsignedShort(u); - u += 2; - for(; i > 0; --i) - { - access = readUnsignedShort(u); - name = readUTF8(u + 2, c); - desc = readUTF8(u + 4, c); - // visits the field's attributes and looks for a ConstantValue - // attribute - int fieldValueItem = 0; - signature = null; - anns = 0; - ianns = 0; - cattrs = null; - - j = readUnsignedShort(u + 6); - u += 8; - for(; j > 0; --j) - { - attrName = readUTF8(u, c); - // tests are sorted in decreasing frequency order - // (based on frequencies observed on typical classes) - if(attrName.equals("ConstantValue")) - { - fieldValueItem = readUnsignedShort(u + 6); - } - else if(attrName.equals("Signature")) - { - signature = readUTF8(u + 6, c); - } - else if(attrName.equals("Deprecated")) - { - access |= Opcodes.ACC_DEPRECATED; - } - else if(attrName.equals("Synthetic")) - { - access |= Opcodes.ACC_SYNTHETIC; - } - else if(attrName.equals("RuntimeVisibleAnnotations")) - { - anns = u + 6; - } - else if(attrName.equals("RuntimeInvisibleAnnotations")) - { - ianns = u + 6; - } - else - { - attr = readAttribute(attrs, - attrName, - u + 6, - readInt(u + 2), - c, - -1, - null); - if(attr != null) - { - attr.next = cattrs; - cattrs = attr; - } - } - u += 6 + readInt(u + 2); - } - // visits the field - FieldVisitor fv = classVisitor.visitField(access, - name, - desc, - signature, - fieldValueItem == 0 ? null : readConst(fieldValueItem, c)); - // visits the field annotations and attributes - if(fv != null) - { - for(j = 1; j >= 0; --j) - { - v = j == 0 ? ianns : anns; - if(v != 0) - { - k = readUnsignedShort(v); - v += 2; - for(; k > 0; --k) - { - v = readAnnotationValues(v + 2, - c, - true, - fv.visitAnnotation(readUTF8(v, c), j != 0)); - } - } - } - while(cattrs != null) - { - attr = cattrs.next; - cattrs.next = null; - fv.visitAttribute(cattrs); - cattrs = attr; - } - fv.visitEnd(); - } - } - - // visits the methods - i = readUnsignedShort(u); - u += 2; - for(; i > 0; --i) - { - int u0 = u + 6; - access = readUnsignedShort(u); - name = readUTF8(u + 2, c); - desc = readUTF8(u + 4, c); - signature = null; - anns = 0; - ianns = 0; - int dann = 0; - int mpanns = 0; - int impanns = 0; - cattrs = null; - v = 0; - w = 0; - - // looks for Code and Exceptions attributes - j = readUnsignedShort(u + 6); - u += 8; - for(; j > 0; --j) - { - attrName = readUTF8(u, c); - int attrSize = readInt(u + 2); - u += 6; - // tests are sorted in decreasing frequency order - // (based on frequencies observed on typical classes) - if(attrName.equals("Code")) - { - if(!skipCode) - { - v = u; - } - } - else if(attrName.equals("Exceptions")) - { - w = u; - } - else if(attrName.equals("Signature")) - { - signature = readUTF8(u, c); - } - else if(attrName.equals("Deprecated")) - { - access |= Opcodes.ACC_DEPRECATED; - } - else if(attrName.equals("RuntimeVisibleAnnotations")) - { - anns = u; - } - else if(attrName.equals("AnnotationDefault")) - { - dann = u; - } - else if(attrName.equals("Synthetic")) - { - access |= Opcodes.ACC_SYNTHETIC; - } - else if(attrName.equals("RuntimeInvisibleAnnotations")) - { - ianns = u; - } - else if(attrName.equals("RuntimeVisibleParameterAnnotations")) - { - mpanns = u; - } - else if(attrName.equals("RuntimeInvisibleParameterAnnotations")) - { - impanns = u; - } - else - { - attr = readAttribute(attrs, - attrName, - u, - attrSize, - c, - -1, - null); - if(attr != null) - { - attr.next = cattrs; - cattrs = attr; - } - } - u += attrSize; - } - // reads declared exceptions - String[] exceptions; - if(w == 0) - { - exceptions = null; - } - else - { - exceptions = new String[readUnsignedShort(w)]; - w += 2; - for(j = 0; j < exceptions.length; ++j) - { - exceptions[j] = readClass(w, c); - w += 2; - } - } - - // visits the method's code, if any - MethodVisitor mv = classVisitor.visitMethod(access, - name, - desc, - signature, - exceptions); - - if(mv != null) - { - /* - * if the returned MethodVisitor is in fact a MethodWriter, it - * means there is no method adapter between the reader and the - * writer. If, in addition, the writer's constant pool was - * copied from this reader (mw.cw.cr == this), and the signature - * and exceptions of the method have not been changed, then it - * is possible to skip all visit events and just copy the - * original code of the method to the writer (the access, name - * and descriptor can have been changed, this is not important - * since they are not copied as is from the reader). - */ - if(mv instanceof MethodWriter) - { - MethodWriter mw = (MethodWriter) mv; - if(mw.cw.cr == this) - { - if(signature == mw.signature) - { - boolean sameExceptions = false; - if(exceptions == null) - { - sameExceptions = mw.exceptionCount == 0; - } - else - { - if(exceptions.length == mw.exceptionCount) - { - sameExceptions = true; - for(j = exceptions.length - 1; j >= 0; --j) - { - w -= 2; - if(mw.exceptions[j] != readUnsignedShort(w)) - { - sameExceptions = false; - break; - } - } - } - } - if(sameExceptions) - { - /* - * we do not copy directly the code into - * MethodWriter to save a byte array copy - * operation. The real copy will be done in - * ClassWriter.toByteArray(). - */ - mw.classReaderOffset = u0; - mw.classReaderLength = u - u0; - continue; - } - } - } - } - - if(dann != 0) - { - AnnotationVisitor dv = mv.visitAnnotationDefault(); - readAnnotationValue(dann, c, null, dv); - if(dv != null) - { - dv.visitEnd(); - } - } - for(j = 1; j >= 0; --j) - { - w = j == 0 ? ianns : anns; - if(w != 0) - { - k = readUnsignedShort(w); - w += 2; - for(; k > 0; --k) - { - w = readAnnotationValues(w + 2, - c, - true, - mv.visitAnnotation(readUTF8(w, c), j != 0)); - } - } - } - if(mpanns != 0) - { - readParameterAnnotations(mpanns, c, true, mv); - } - if(impanns != 0) - { - readParameterAnnotations(impanns, c, false, mv); - } - while(cattrs != null) - { - attr = cattrs.next; - cattrs.next = null; - mv.visitAttribute(cattrs); - cattrs = attr; - } - } - - if(mv != null && v != 0) - { - int maxStack = readUnsignedShort(v); - int maxLocals = readUnsignedShort(v + 2); - int codeLength = readInt(v + 4); - v += 8; - - int codeStart = v; - int codeEnd = v + codeLength; - - mv.visitCode(); - - // 1st phase: finds the labels - int label; - Label[] labels = new Label[codeLength + 1]; - while(v < codeEnd) - { - int opcode = b[v] & 0xFF; - switch(ClassWriter.TYPE[opcode]) - { - case ClassWriter.NOARG_INSN: - case ClassWriter.IMPLVAR_INSN: - v += 1; - break; - case ClassWriter.LABEL_INSN: - label = v - codeStart + readShort(v + 1); - if(labels[label] == null) - { - labels[label] = new Label(); - } - v += 3; - break; - case ClassWriter.LABELW_INSN: - label = v - codeStart + readInt(v + 1); - if(labels[label] == null) - { - labels[label] = new Label(); - } - v += 5; - break; - case ClassWriter.WIDE_INSN: - opcode = b[v + 1] & 0xFF; - if(opcode == Opcodes.IINC) - { - v += 6; - } - else - { - v += 4; - } - break; - case ClassWriter.TABL_INSN: - // skips 0 to 3 padding bytes - w = v - codeStart; - v = v + 4 - (w & 3); - // reads instruction - label = w + readInt(v); - if(labels[label] == null) - { - labels[label] = new Label(); - } - j = readInt(v + 8) - readInt(v + 4) + 1; - v += 12; - for(; j > 0; --j) - { - label = w + readInt(v); - v += 4; - if(labels[label] == null) - { - labels[label] = new Label(); - } - } - break; - case ClassWriter.LOOK_INSN: - // skips 0 to 3 padding bytes - w = v - codeStart; - v = v + 4 - (w & 3); - // reads instruction - label = w + readInt(v); - if(labels[label] == null) - { - labels[label] = new Label(); - } - j = readInt(v + 4); - v += 8; - for(; j > 0; --j) - { - label = w + readInt(v + 4); - v += 8; - if(labels[label] == null) - { - labels[label] = new Label(); - } - } - break; - case ClassWriter.VAR_INSN: - case ClassWriter.SBYTE_INSN: - case ClassWriter.LDC_INSN: - v += 2; - break; - case ClassWriter.SHORT_INSN: - case ClassWriter.LDCW_INSN: - case ClassWriter.FIELDORMETH_INSN: - case ClassWriter.TYPE_INSN: - case ClassWriter.IINC_INSN: - v += 3; - break; - case ClassWriter.ITFMETH_INSN: - v += 5; - break; - // case MANA_INSN: - default: - v += 4; - break; - } - } - // parses the try catch entries - j = readUnsignedShort(v); - v += 2; - for(; j > 0; --j) - { - label = readUnsignedShort(v); - Label start = labels[label]; - if(start == null) - { - labels[label] = start = new Label(); - } - label = readUnsignedShort(v + 2); - Label end = labels[label]; - if(end == null) - { - labels[label] = end = new Label(); - } - label = readUnsignedShort(v + 4); - Label handler = labels[label]; - if(handler == null) - { - labels[label] = handler = new Label(); - } - int type = readUnsignedShort(v + 6); - if(type == 0) - { - mv.visitTryCatchBlock(start, end, handler, null); - } - else - { - mv.visitTryCatchBlock(start, - end, - handler, - readUTF8(items[type], c)); - } - v += 8; - } - // parses the local variable, line number tables, and code - // attributes - int varTable = 0; - int varTypeTable = 0; - int stackMap = 0; - int frameCount = 0; - int frameMode = 0; - int frameOffset = 0; - int frameLocalCount = 0; - int frameLocalDiff = 0; - int frameStackCount = 0; - Object[] frameLocal = null; - Object[] frameStack = null; - boolean zip = true; - cattrs = null; - j = readUnsignedShort(v); - v += 2; - for(; j > 0; --j) - { - attrName = readUTF8(v, c); - if(attrName.equals("LocalVariableTable")) - { - if(!skipDebug) - { - varTable = v + 6; - k = readUnsignedShort(v + 6); - w = v + 8; - for(; k > 0; --k) - { - label = readUnsignedShort(w); - if(labels[label] == null) - { - labels[label] = new Label(true); - } - label += readUnsignedShort(w + 2); - if(labels[label] == null) - { - labels[label] = new Label(true); - } - w += 10; - } - } - } - else if(attrName.equals("LocalVariableTypeTable")) - { - varTypeTable = v + 6; - } - else if(attrName.equals("LineNumberTable")) - { - if(!skipDebug) - { - k = readUnsignedShort(v + 6); - w = v + 8; - for(; k > 0; --k) - { - label = readUnsignedShort(w); - if(labels[label] == null) - { - labels[label] = new Label(true); - } - labels[label].line = readUnsignedShort(w + 2); - w += 4; - } - } - } - else if(attrName.equals("StackMapTable")) - { - if((flags & SKIP_FRAMES) == 0) - { - stackMap = v + 8; - frameCount = readUnsignedShort(v + 6); - } - /* - * here we do not extract the labels corresponding to - * the attribute content. This would require a full - * parsing of the attribute, which would need to be - * repeated in the second phase (see below). Instead the - * content of the attribute is read one frame at a time - * (i.e. after a frame has been visited, the next frame - * is read), and the labels it contains are also - * extracted one frame at a time. Thanks to the ordering - * of frames, having only a "one frame lookahead" is not - * a problem, i.e. it is not possible to see an offset - * smaller than the offset of the current insn and for - * which no Label exist. - */ - // TODO true for frame offsets, - // but for UNINITIALIZED type offsets? - } - else if(attrName.equals("StackMap")) - { - if((flags & SKIP_FRAMES) == 0) - { - stackMap = v + 8; - frameCount = readUnsignedShort(v + 6); - zip = false; - } - /* - * IMPORTANT! here we assume that the frames are - * ordered, as in the StackMapTable attribute, although - * this is not guaranteed by the attribute format. - */ - } - else - { - for(k = 0; k < attrs.length; ++k) - { - if(attrs[k].type.equals(attrName)) - { - attr = attrs[k].read(this, - v + 6, - readInt(v + 2), - c, - codeStart - 8, - labels); - if(attr != null) - { - attr.next = cattrs; - cattrs = attr; - } - } - } - } - v += 6 + readInt(v + 2); - } - - // 2nd phase: visits each instruction - if(stackMap != 0) - { - // creates the very first (implicit) frame from the method - // descriptor - frameLocal = new Object[maxLocals]; - frameStack = new Object[maxStack]; - if(unzip) - { - int local = 0; - if((access & Opcodes.ACC_STATIC) == 0) - { - if(name.equals("")) - { - frameLocal[local++] = Opcodes.UNINITIALIZED_THIS; - } - else - { - frameLocal[local++] = readClass(header + 2, c); - } - } - j = 1; - loop: - while(true) - { - k = j; - switch(desc.charAt(j++)) - { - case'Z': - case'C': - case'B': - case'S': - case'I': - frameLocal[local++] = Opcodes.INTEGER; - break; - case'F': - frameLocal[local++] = Opcodes.FLOAT; - break; - case'J': - frameLocal[local++] = Opcodes.LONG; - break; - case'D': - frameLocal[local++] = Opcodes.DOUBLE; - break; - case'[': - while(desc.charAt(j) == '[') - { - ++j; - } - if(desc.charAt(j) == 'L') - { - ++j; - while(desc.charAt(j) != ';') - { - ++j; - } - } - frameLocal[local++] = desc.substring(k, ++j); - break; - case'L': - while(desc.charAt(j) != ';') - { - ++j; - } - frameLocal[local++] = desc.substring(k + 1, - j++); - break; - default: - break loop; - } - } - frameLocalCount = local; - } - /* - * for the first explicit frame the offset is not - * offset_delta + 1 but only offset_delta; setting the - * implicit frame offset to -1 allow the use of the - * "offset_delta + 1" rule in all cases - */ - frameOffset = -1; - } - v = codeStart; - Label l; - while(v < codeEnd) - { - w = v - codeStart; - - l = labels[w]; - if(l != null) - { - mv.visitLabel(l); - if(!skipDebug && l.line > 0) - { - mv.visitLineNumber(l.line, l); - } - } - - while(frameLocal != null - && (frameOffset == w || frameOffset == -1)) - { - // if there is a frame for this offset, - // makes the visitor visit it, - // and reads the next frame if there is one. - if(!zip || unzip) - { - mv.visitFrame(Opcodes.F_NEW, - frameLocalCount, - frameLocal, - frameStackCount, - frameStack); - } - else if(frameOffset != -1) - { - mv.visitFrame(frameMode, - frameLocalDiff, - frameLocal, - frameStackCount, - frameStack); - } - - if(frameCount > 0) - { - int tag, delta, n; - if(zip) - { - tag = b[stackMap++] & 0xFF; - } - else - { - tag = MethodWriter.FULL_FRAME; - frameOffset = -1; - } - frameLocalDiff = 0; - if(tag < MethodWriter.SAME_LOCALS_1_STACK_ITEM_FRAME) - { - delta = tag; - frameMode = Opcodes.F_SAME; - frameStackCount = 0; - } - else if(tag < MethodWriter.RESERVED) - { - delta = tag - - MethodWriter.SAME_LOCALS_1_STACK_ITEM_FRAME; - stackMap = readFrameType(frameStack, - 0, - stackMap, - c, - labels); - frameMode = Opcodes.F_SAME1; - frameStackCount = 1; - } - else - { - delta = readUnsignedShort(stackMap); - stackMap += 2; - if(tag == MethodWriter.SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED) - { - stackMap = readFrameType(frameStack, - 0, - stackMap, - c, - labels); - frameMode = Opcodes.F_SAME1; - frameStackCount = 1; - } - else if(tag >= MethodWriter.CHOP_FRAME - && tag < MethodWriter.SAME_FRAME_EXTENDED) - { - frameMode = Opcodes.F_CHOP; - frameLocalDiff = MethodWriter.SAME_FRAME_EXTENDED - - tag; - frameLocalCount -= frameLocalDiff; - frameStackCount = 0; - } - else if(tag == MethodWriter.SAME_FRAME_EXTENDED) - { - frameMode = Opcodes.F_SAME; - frameStackCount = 0; - } - else if(tag < MethodWriter.FULL_FRAME) - { - j = unzip ? frameLocalCount : 0; - for(k = tag - - MethodWriter.SAME_FRAME_EXTENDED; k > 0; k--) - { - stackMap = readFrameType(frameLocal, - j++, - stackMap, - c, - labels); - } - frameMode = Opcodes.F_APPEND; - frameLocalDiff = tag - - MethodWriter.SAME_FRAME_EXTENDED; - frameLocalCount += frameLocalDiff; - frameStackCount = 0; - } - else - { // if (tag == FULL_FRAME) { - frameMode = Opcodes.F_FULL; - n = frameLocalDiff = frameLocalCount = readUnsignedShort(stackMap); - stackMap += 2; - for(j = 0; n > 0; n--) - { - stackMap = readFrameType(frameLocal, - j++, - stackMap, - c, - labels); - } - n = frameStackCount = readUnsignedShort(stackMap); - stackMap += 2; - for(j = 0; n > 0; n--) - { - stackMap = readFrameType(frameStack, - j++, - stackMap, - c, - labels); - } - } - } - frameOffset += delta + 1; - if(labels[frameOffset] == null) - { - labels[frameOffset] = new Label(); - } - - --frameCount; - } - else - { - frameLocal = null; - } - } - - int opcode = b[v] & 0xFF; - switch(ClassWriter.TYPE[opcode]) - { - case ClassWriter.NOARG_INSN: - mv.visitInsn(opcode); - v += 1; - break; - case ClassWriter.IMPLVAR_INSN: - if(opcode > Opcodes.ISTORE) - { - opcode -= 59; // ISTORE_0 - mv.visitVarInsn(Opcodes.ISTORE + (opcode >> 2), - opcode & 0x3); - } - else - { - opcode -= 26; // ILOAD_0 - mv.visitVarInsn(Opcodes.ILOAD + (opcode >> 2), - opcode & 0x3); - } - v += 1; - break; - case ClassWriter.LABEL_INSN: - mv.visitJumpInsn(opcode, labels[w - + readShort(v + 1)]); - v += 3; - break; - case ClassWriter.LABELW_INSN: - mv.visitJumpInsn(opcode - 33, labels[w - + readInt(v + 1)]); - v += 5; - break; - case ClassWriter.WIDE_INSN: - opcode = b[v + 1] & 0xFF; - if(opcode == Opcodes.IINC) - { - mv.visitIincInsn(readUnsignedShort(v + 2), - readShort(v + 4)); - v += 6; - } - else - { - mv.visitVarInsn(opcode, - readUnsignedShort(v + 2)); - v += 4; - } - break; - case ClassWriter.TABL_INSN: - // skips 0 to 3 padding bytes - v = v + 4 - (w & 3); - // reads instruction - label = w + readInt(v); - int min = readInt(v + 4); - int max = readInt(v + 8); - v += 12; - Label[] table = new Label[max - min + 1]; - for(j = 0; j < table.length; ++j) - { - table[j] = labels[w + readInt(v)]; - v += 4; - } - mv.visitTableSwitchInsn(min, - max, - labels[label], - table); - break; - case ClassWriter.LOOK_INSN: - // skips 0 to 3 padding bytes - v = v + 4 - (w & 3); - // reads instruction - label = w + readInt(v); - j = readInt(v + 4); - v += 8; - int[] keys = new int[j]; - Label[] values = new Label[j]; - for(j = 0; j < keys.length; ++j) - { - keys[j] = readInt(v); - values[j] = labels[w + readInt(v + 4)]; - v += 8; - } - mv.visitLookupSwitchInsn(labels[label], - keys, - values); - break; - case ClassWriter.VAR_INSN: - mv.visitVarInsn(opcode, b[v + 1] & 0xFF); - v += 2; - break; - case ClassWriter.SBYTE_INSN: - mv.visitIntInsn(opcode, b[v + 1]); - v += 2; - break; - case ClassWriter.SHORT_INSN: - mv.visitIntInsn(opcode, readShort(v + 1)); - v += 3; - break; - case ClassWriter.LDC_INSN: - mv.visitLdcInsn(readConst(b[v + 1] & 0xFF, c)); - v += 2; - break; - case ClassWriter.LDCW_INSN: - mv.visitLdcInsn(readConst(readUnsignedShort(v + 1), - c)); - v += 3; - break; - case ClassWriter.FIELDORMETH_INSN: - case ClassWriter.ITFMETH_INSN: - int cpIndex = items[readUnsignedShort(v + 1)]; - String iowner = readClass(cpIndex, c); - cpIndex = items[readUnsignedShort(cpIndex + 2)]; - String iname = readUTF8(cpIndex, c); - String idesc = readUTF8(cpIndex + 2, c); - if(opcode < Opcodes.INVOKEVIRTUAL) - { - mv.visitFieldInsn(opcode, iowner, iname, idesc); - } - else - { - mv.visitMethodInsn(opcode, iowner, iname, idesc); - } - if(opcode == Opcodes.INVOKEINTERFACE) - { - v += 5; - } - else - { - v += 3; - } - break; - case ClassWriter.TYPE_INSN: - mv.visitTypeInsn(opcode, readClass(v + 1, c)); - v += 3; - break; - case ClassWriter.IINC_INSN: - mv.visitIincInsn(b[v + 1] & 0xFF, b[v + 2]); - v += 3; - break; - // case MANA_INSN: - default: - mv.visitMultiANewArrayInsn(readClass(v + 1, c), - b[v + 3] & 0xFF); - v += 4; - break; - } - } - l = labels[codeEnd - codeStart]; - if(l != null) - { - mv.visitLabel(l); - } - // visits the local variable tables - if(!skipDebug && varTable != 0) - { - int[] typeTable = null; - if(varTypeTable != 0) - { - k = readUnsignedShort(varTypeTable) * 3; - w = varTypeTable + 2; - typeTable = new int[k]; - while(k > 0) - { - typeTable[--k] = w + 6; // signature - typeTable[--k] = readUnsignedShort(w + 8); // index - typeTable[--k] = readUnsignedShort(w); // start - w += 10; - } - } - k = readUnsignedShort(varTable); - w = varTable + 2; - for(; k > 0; --k) - { - int start = readUnsignedShort(w); - int length = readUnsignedShort(w + 2); - int index = readUnsignedShort(w + 8); - String vsignature = null; - if(typeTable != null) - { - for(int a = 0; a < typeTable.length; a += 3) - { - if(typeTable[a] == start - && typeTable[a + 1] == index) - { - vsignature = readUTF8(typeTable[a + 2], c); - break; - } - } - } - mv.visitLocalVariable(readUTF8(w + 4, c), - readUTF8(w + 6, c), - vsignature, - labels[start], - labels[start + length], - index); - w += 10; - } - } - // visits the other attributes - while(cattrs != null) - { - attr = cattrs.next; - cattrs.next = null; - mv.visitAttribute(cattrs); - cattrs = attr; - } - // visits the max stack and max locals values - mv.visitMaxs(maxStack, maxLocals); - } - - if(mv != null) - { - mv.visitEnd(); - } - } - - // visits the end of the class - classVisitor.visitEnd(); -} - -/** - * Reads parameter annotations and makes the given visitor visit them. - * - * @param v start offset in {@link #b b} of the annotations to be read. - * @param buf buffer to be used to call {@link #readUTF8 readUTF8}, - * {@link #readClass(int,char[]) readClass} or - * {@link #readConst readConst}. - * @param visible true if the annotations to be read are visible - * at runtime. - * @param mv the visitor that must visit the annotations. - */ -private void readParameterAnnotations( - int v, - final char[] buf, - final boolean visible, - final MethodVisitor mv){ - int n = b[v++] & 0xFF; - for(int i = 0; i < n; ++i) - { - int j = readUnsignedShort(v); - v += 2; - for(; j > 0; --j) - { - v = readAnnotationValues(v + 2, - buf, - true, - mv.visitParameterAnnotation(i, - readUTF8(v, buf), - visible)); - } - } -} - -/** - * Reads the values of an annotation and makes the given visitor visit them. - * - * @param v the start offset in {@link #b b} of the values to be read - * (including the unsigned short that gives the number of values). - * @param buf buffer to be used to call {@link #readUTF8 readUTF8}, - * {@link #readClass(int,char[]) readClass} or - * {@link #readConst readConst}. - * @param named if the annotation values are named or not. - * @param av the visitor that must visit the values. - * @return the end offset of the annotation values. - */ -private int readAnnotationValues( - int v, - final char[] buf, - final boolean named, - final AnnotationVisitor av){ - int i = readUnsignedShort(v); - v += 2; - if(named) - { - for(; i > 0; --i) - { - v = readAnnotationValue(v + 2, buf, readUTF8(v, buf), av); - } - } - else - { - for(; i > 0; --i) - { - v = readAnnotationValue(v, buf, null, av); - } - } - if(av != null) - { - av.visitEnd(); - } - return v; -} - -/** - * Reads a value of an annotation and makes the given visitor visit it. - * - * @param v the start offset in {@link #b b} of the value to be read (not - * including the value name constant pool index). - * @param buf buffer to be used to call {@link #readUTF8 readUTF8}, - * {@link #readClass(int,char[]) readClass} or - * {@link #readConst readConst}. - * @param name the name of the value to be read. - * @param av the visitor that must visit the value. - * @return the end offset of the annotation value. - */ -private int readAnnotationValue( - int v, - final char[] buf, - final String name, - final AnnotationVisitor av){ - int i; - if(av == null) - { - switch(b[v] & 0xFF) - { - case'e': // enum_const_value - return v + 5; - case'@': // annotation_value - return readAnnotationValues(v + 3, buf, true, null); - case'[': // array_value - return readAnnotationValues(v + 1, buf, false, null); - default: - return v + 3; - } - } - switch(b[v++] & 0xFF) - { - case'I': // pointer to CONSTANT_Integer - case'J': // pointer to CONSTANT_Long - case'F': // pointer to CONSTANT_Float - case'D': // pointer to CONSTANT_Double - av.visit(name, readConst(readUnsignedShort(v), buf)); - v += 2; - break; - case'B': // pointer to CONSTANT_Byte - av.visit(name, - new Byte((byte) readInt(items[readUnsignedShort(v)]))); - v += 2; - break; - case'Z': // pointer to CONSTANT_Boolean - av.visit(name, readInt(items[readUnsignedShort(v)]) == 0 - ? Boolean.FALSE - : Boolean.TRUE); - v += 2; - break; - case'S': // pointer to CONSTANT_Short - av.visit(name, - new Short((short) readInt(items[readUnsignedShort(v)]))); - v += 2; - break; - case'C': // pointer to CONSTANT_Char - av.visit(name, - new Character((char) readInt(items[readUnsignedShort(v)]))); - v += 2; - break; - case's': // pointer to CONSTANT_Utf8 - av.visit(name, readUTF8(v, buf)); - v += 2; - break; - case'e': // enum_const_value - av.visitEnum(name, readUTF8(v, buf), readUTF8(v + 2, buf)); - v += 4; - break; - case'c': // class_info - av.visit(name, Type.getType(readUTF8(v, buf))); - v += 2; - break; - case'@': // annotation_value - v = readAnnotationValues(v + 2, - buf, - true, - av.visitAnnotation(name, readUTF8(v, buf))); - break; - case'[': // array_value - int size = readUnsignedShort(v); - v += 2; - if(size == 0) - { - return readAnnotationValues(v - 2, - buf, - false, - av.visitArray(name)); - } - switch(this.b[v++] & 0xFF) - { - case'B': - byte[] bv = new byte[size]; - for(i = 0; i < size; i++) - { - bv[i] = (byte) readInt(items[readUnsignedShort(v)]); - v += 3; - } - av.visit(name, bv); - --v; - break; - case'Z': - boolean[] zv = new boolean[size]; - for(i = 0; i < size; i++) - { - zv[i] = readInt(items[readUnsignedShort(v)]) != 0; - v += 3; - } - av.visit(name, zv); - --v; - break; - case'S': - short[] sv = new short[size]; - for(i = 0; i < size; i++) - { - sv[i] = (short) readInt(items[readUnsignedShort(v)]); - v += 3; - } - av.visit(name, sv); - --v; - break; - case'C': - char[] cv = new char[size]; - for(i = 0; i < size; i++) - { - cv[i] = (char) readInt(items[readUnsignedShort(v)]); - v += 3; - } - av.visit(name, cv); - --v; - break; - case'I': - int[] iv = new int[size]; - for(i = 0; i < size; i++) - { - iv[i] = readInt(items[readUnsignedShort(v)]); - v += 3; - } - av.visit(name, iv); - --v; - break; - case'J': - long[] lv = new long[size]; - for(i = 0; i < size; i++) - { - lv[i] = readLong(items[readUnsignedShort(v)]); - v += 3; - } - av.visit(name, lv); - --v; - break; - case'F': - float[] fv = new float[size]; - for(i = 0; i < size; i++) - { - fv[i] = Float.intBitsToFloat(readInt(items[readUnsignedShort(v)])); - v += 3; - } - av.visit(name, fv); - --v; - break; - case'D': - double[] dv = new double[size]; - for(i = 0; i < size; i++) - { - dv[i] = Double.longBitsToDouble(readLong(items[readUnsignedShort(v)])); - v += 3; - } - av.visit(name, dv); - --v; - break; - default: - v = readAnnotationValues(v - 3, - buf, - false, - av.visitArray(name)); - } - } - return v; -} - -private int readFrameType( - final Object[] frame, - final int index, - int v, - final char[] buf, - final Label[] labels){ - int type = b[v++] & 0xFF; - switch(type) - { - case 0: - frame[index] = Opcodes.TOP; - break; - case 1: - frame[index] = Opcodes.INTEGER; - break; - case 2: - frame[index] = Opcodes.FLOAT; - break; - case 3: - frame[index] = Opcodes.DOUBLE; - break; - case 4: - frame[index] = Opcodes.LONG; - break; - case 5: - frame[index] = Opcodes.NULL; - break; - case 6: - frame[index] = Opcodes.UNINITIALIZED_THIS; - break; - case 7: // Object - frame[index] = readClass(v, buf); - v += 2; - break; - default: // Uninitialized - int offset = readUnsignedShort(v); - if(labels[offset] == null) - { - labels[offset] = new Label(); - } - frame[index] = labels[offset]; - v += 2; - } - return v; -} - -/** - * Reads an attribute in {@link #b b}. - * - * @param attrs prototypes of the attributes that must be parsed during the - * visit of the class. Any attribute whose type is not equal to the - * type of one the prototypes is ignored (i.e. an empty - * {@link Attribute} instance is returned). - * @param type the type of the attribute. - * @param off index of the first byte of the attribute's content in - * {@link #b b}. The 6 attribute header bytes, containing the type - * and the length of the attribute, are not taken into account here - * (they have already been read). - * @param len the length of the attribute's content. - * @param buf buffer to be used to call {@link #readUTF8 readUTF8}, - * {@link #readClass(int,char[]) readClass} or - * {@link #readConst readConst}. - * @param codeOff index of the first byte of code's attribute content in - * {@link #b b}, or -1 if the attribute to be read is not a code - * attribute. The 6 attribute header bytes, containing the type and - * the length of the attribute, are not taken into account here. - * @param labels the labels of the method's code, or null if the - * attribute to be read is not a code attribute. - * @return the attribute that has been read, or null to skip this - * attribute. - */ -private Attribute readAttribute( - final Attribute[] attrs, - final String type, - final int off, - final int len, - final char[] buf, - final int codeOff, - final Label[] labels){ - for(int i = 0; i < attrs.length; ++i) - { - if(attrs[i].type.equals(type)) - { - return attrs[i].read(this, off, len, buf, codeOff, labels); - } - } - return new Attribute(type).read(this, off, len, null, -1, null); -} - -// ------------------------------------------------------------------------ -// Utility methods: low level parsing -// ------------------------------------------------------------------------ - -/** - * Returns the start index of the constant pool item in {@link #b b}, plus - * one. This method is intended for {@link Attribute} sub classes, and is - * normally not needed by class generators or adapters. - * - * @param item the index a constant pool item. - * @return the start index of the constant pool item in {@link #b b}, plus - * one. - */ -public int getItem(final int item){ - return items[item]; -} - -/** - * Reads a byte value in {@link #b b}. This method is intended for - * {@link Attribute} sub classes, and is normally not needed by class - * generators or adapters. - * - * @param index the start index of the value to be read in {@link #b b}. - * @return the read value. - */ -public int readByte(final int index){ - return b[index] & 0xFF; -} - -/** - * Reads an unsigned short value in {@link #b b}. This method is - * intended for {@link Attribute} sub classes, and is normally not needed by - * class generators or adapters. - * - * @param index the start index of the value to be read in {@link #b b}. - * @return the read value. - */ -public int readUnsignedShort(final int index){ - byte[] b = this.b; - return ((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF); -} - -/** - * Reads a signed short value in {@link #b b}. This method is intended - * for {@link Attribute} sub classes, and is normally not needed by class - * generators or adapters. - * - * @param index the start index of the value to be read in {@link #b b}. - * @return the read value. - */ -public short readShort(final int index){ - byte[] b = this.b; - return (short) (((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF)); -} - -/** - * Reads a signed int value in {@link #b b}. This method is intended for - * {@link Attribute} sub classes, and is normally not needed by class - * generators or adapters. - * - * @param index the start index of the value to be read in {@link #b b}. - * @return the read value. - */ -public int readInt(final int index){ - byte[] b = this.b; - return ((b[index] & 0xFF) << 24) | ((b[index + 1] & 0xFF) << 16) - | ((b[index + 2] & 0xFF) << 8) | (b[index + 3] & 0xFF); -} - -/** - * Reads a signed long value in {@link #b b}. This method is intended - * for {@link Attribute} sub classes, and is normally not needed by class - * generators or adapters. - * - * @param index the start index of the value to be read in {@link #b b}. - * @return the read value. - */ -public long readLong(final int index){ - long l1 = readInt(index); - long l0 = readInt(index + 4) & 0xFFFFFFFFL; - return (l1 << 32) | l0; -} - -/** - * Reads an UTF8 string constant pool item in {@link #b b}. This method - * is intended for {@link Attribute} sub classes, and is normally not needed - * by class generators or adapters. - * - * @param index the start index of an unsigned short value in {@link #b b}, - * whose value is the index of an UTF8 constant pool item. - * @param buf buffer to be used to read the item. This buffer must be - * sufficiently large. It is not automatically resized. - * @return the String corresponding to the specified UTF8 item. - */ -public String readUTF8(int index, final char[] buf){ - int item = readUnsignedShort(index); - String s = strings[item]; - if(s != null) - { - return s; - } - index = items[item]; - return strings[item] = readUTF(index + 2, readUnsignedShort(index), buf); -} - -/** - * Reads UTF8 string in {@link #b b}. - * - * @param index start offset of the UTF8 string to be read. - * @param utfLen length of the UTF8 string to be read. - * @param buf buffer to be used to read the string. This buffer must be - * sufficiently large. It is not automatically resized. - * @return the String corresponding to the specified UTF8 string. - */ -private String readUTF(int index, final int utfLen, final char[] buf){ - int endIndex = index + utfLen; - byte[] b = this.b; - int strLen = 0; - int c, d, e; - while(index < endIndex) - { - c = b[index++] & 0xFF; - switch(c >> 4) - { - case 0: - case 1: - case 2: - case 3: - case 4: - case 5: - case 6: - case 7: - // 0xxxxxxx - buf[strLen++] = (char) c; - break; - case 12: - case 13: - // 110x xxxx 10xx xxxx - d = b[index++]; - buf[strLen++] = (char) (((c & 0x1F) << 6) | (d & 0x3F)); - break; - default: - // 1110 xxxx 10xx xxxx 10xx xxxx - d = b[index++]; - e = b[index++]; - buf[strLen++] = (char) (((c & 0x0F) << 12) - | ((d & 0x3F) << 6) | (e & 0x3F)); - break; - } - } - return new String(buf, 0, strLen); -} - -/** - * Reads a class constant pool item in {@link #b b}. This method is - * intended for {@link Attribute} sub classes, and is normally not needed by - * class generators or adapters. - * - * @param index the start index of an unsigned short value in {@link #b b}, - * whose value is the index of a class constant pool item. - * @param buf buffer to be used to read the item. This buffer must be - * sufficiently large. It is not automatically resized. - * @return the String corresponding to the specified class item. - */ -public String readClass(final int index, final char[] buf){ - // computes the start index of the CONSTANT_Class item in b - // and reads the CONSTANT_Utf8 item designated by - // the first two bytes of this CONSTANT_Class item - return readUTF8(items[readUnsignedShort(index)], buf); -} - -/** - * Reads a numeric or string constant pool item in {@link #b b}. This - * method is intended for {@link Attribute} sub classes, and is normally not - * needed by class generators or adapters. - * - * @param item the index of a constant pool item. - * @param buf buffer to be used to read the item. This buffer must be - * sufficiently large. It is not automatically resized. - * @return the {@link Integer}, {@link Float}, {@link Long}, - * {@link Double}, {@link String} or {@link Type} corresponding to - * the given constant pool item. - */ -public Object readConst(final int item, final char[] buf){ - int index = items[item]; - switch(b[index - 1]) - { - case ClassWriter.INT: - return new Integer(readInt(index)); - case ClassWriter.FLOAT: - return new Float(Float.intBitsToFloat(readInt(index))); - case ClassWriter.LONG: - return new Long(readLong(index)); - case ClassWriter.DOUBLE: - return new Double(Double.longBitsToDouble(readLong(index))); - case ClassWriter.CLASS: - String s = readUTF8(index, buf); - return s.charAt(0) == '[' - ? Type.getType(s) - : Type.getObjectType(s); - // case ClassWriter.STR: - default: - return readUTF8(index, buf); - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/ClassVisitor.java --- a/src/clojure/asm/ClassVisitor.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,196 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * A visitor to visit a Java class. The methods of this interface must be called - * in the following order: visit [ visitSource ] [ - * visitOuterClass ] ( visitAnnotation | - * visitAttribute )* (visitInnerClass | - * visitField | visitMethod )* visitEnd. - * - * @author Eric Bruneton - */ -public interface ClassVisitor{ - -/** - * Visits the header of the class. - * - * @param version the class version. - * @param access the class's access flags (see {@link Opcodes}). This - * parameter also indicates if the class is deprecated. - * @param name the internal name of the class (see - * {@link Type#getInternalName() getInternalName}). - * @param signature the signature of this class. May be null if - * the class is not a generic one, and does not extend or implement - * generic classes or interfaces. - * @param superName the internal of name of the super class (see - * {@link Type#getInternalName() getInternalName}). For interfaces, - * the super class is {@link Object}. May be null, but - * only for the {@link Object} class. - * @param interfaces the internal names of the class's interfaces (see - * {@link Type#getInternalName() getInternalName}). May be - * null. - */ -void visit( - int version, - int access, - String name, - String signature, - String superName, - String[] interfaces); - -/** - * Visits the source of the class. - * - * @param source the name of the source file from which the class was - * compiled. May be null. - * @param debug additional debug information to compute the correspondance - * between source and compiled elements of the class. May be - * null. - */ -void visitSource(String source, String debug); - -/** - * Visits the enclosing class of the class. This method must be called only - * if the class has an enclosing class. - * - * @param owner internal name of the enclosing class of the class. - * @param name the name of the method that contains the class, or - * null if the class is not enclosed in a method of its - * enclosing class. - * @param desc the descriptor of the method that contains the class, or - * null if the class is not enclosed in a method of its - * enclosing class. - */ -void visitOuterClass(String owner, String name, String desc); - -/** - * Visits an annotation of the class. - * - * @param desc the class descriptor of the annotation class. - * @param visible true if the annotation is visible at runtime. - * @return a visitor to visit the annotation values, or null if - * this visitor is not interested in visiting this annotation. - */ -AnnotationVisitor visitAnnotation(String desc, boolean visible); - -/** - * Visits a non standard attribute of the class. - * - * @param attr an attribute. - */ -void visitAttribute(Attribute attr); - -/** - * Visits information about an inner class. This inner class is not - * necessarily a member of the class being visited. - * - * @param name the internal name of an inner class (see - * {@link Type#getInternalName() getInternalName}). - * @param outerName the internal name of the class to which the inner class - * belongs (see {@link Type#getInternalName() getInternalName}). May - * be null for not member classes. - * @param innerName the (simple) name of the inner class inside its - * enclosing class. May be null for anonymous inner - * classes. - * @param access the access flags of the inner class as originally declared - * in the enclosing class. - */ -void visitInnerClass( - String name, - String outerName, - String innerName, - int access); - -/** - * Visits a field of the class. - * - * @param access the field's access flags (see {@link Opcodes}). This - * parameter also indicates if the field is synthetic and/or - * deprecated. - * @param name the field's name. - * @param desc the field's descriptor (see {@link Type Type}). - * @param signature the field's signature. May be null if the - * field's type does not use generic types. - * @param value the field's initial value. This parameter, which may be - * null if the field does not have an initial value, must - * be an {@link Integer}, a {@link Float}, a {@link Long}, a - * {@link Double} or a {@link String} (for int, - * float, long or String fields - * respectively). This parameter is only used for static fields. - * Its value is ignored for non static fields, which must be - * initialized through bytecode instructions in constructors or - * methods. - * @return a visitor to visit field annotations and attributes, or - * null if this class visitor is not interested in - * visiting these annotations and attributes. - */ -FieldVisitor visitField( - int access, - String name, - String desc, - String signature, - Object value); - -/** - * Visits a method of the class. This method must return a new - * {@link MethodVisitor} instance (or null) each time it is - * called, i.e., it should not return a previously returned visitor. - * - * @param access the method's access flags (see {@link Opcodes}). This - * parameter also indicates if the method is synthetic and/or - * deprecated. - * @param name the method's name. - * @param desc the method's descriptor (see {@link Type Type}). - * @param signature the method's signature. May be null if the - * method parameters, return type and exceptions do not use generic - * types. - * @param exceptions the internal names of the method's exception classes - * (see {@link Type#getInternalName() getInternalName}). May be - * null. - * @return an object to visit the byte code of the method, or null - * if this class visitor is not interested in visiting the code of - * this method. - */ -MethodVisitor visitMethod( - int access, - String name, - String desc, - String signature, - String[] exceptions); - -/** - * Visits the end of the class. This method, which is the last one to be - * called, is used to inform the visitor that all the fields and methods of - * the class have been visited. - */ -void visitEnd(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/ClassWriter.java --- a/src/clojure/asm/ClassWriter.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1415 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * A {@link ClassVisitor} that generates classes in bytecode form. More - * precisely this visitor generates a byte array conforming to the Java class - * file format. It can be used alone, to generate a Java class "from scratch", - * or with one or more {@link ClassReader ClassReader} and adapter class visitor - * to generate a modified class from one or more existing Java classes. - * - * @author Eric Bruneton - */ -public class ClassWriter implements ClassVisitor{ - -/** - * Flag to automatically compute the maximum stack size and the maximum - * number of local variables of methods. If this flag is set, then the - * arguments of the {@link MethodVisitor#visitMaxs visitMaxs} method of the - * {@link MethodVisitor} returned by the {@link #visitMethod visitMethod} - * method will be ignored, and computed automatically from the signature and - * the bytecode of each method. - * - * @see #ClassWriter(int) - */ -public final static int COMPUTE_MAXS = 1; - -/** - * Flag to automatically compute the stack map frames of methods from - * scratch. If this flag is set, then the calls to the - * {@link MethodVisitor#visitFrame} method are ignored, and the stack map - * frames are recomputed from the methods bytecode. The arguments of the - * {@link MethodVisitor#visitMaxs visitMaxs} method are also ignored and - * recomputed from the bytecode. In other words, computeFrames implies - * computeMaxs. - * - * @see #ClassWriter(int) - */ -public final static int COMPUTE_FRAMES = 2; - -/** - * The type of instructions without any argument. - */ -final static int NOARG_INSN = 0; - -/** - * The type of instructions with an signed byte argument. - */ -final static int SBYTE_INSN = 1; - -/** - * The type of instructions with an signed short argument. - */ -final static int SHORT_INSN = 2; - -/** - * The type of instructions with a local variable index argument. - */ -final static int VAR_INSN = 3; - -/** - * The type of instructions with an implicit local variable index argument. - */ -final static int IMPLVAR_INSN = 4; - -/** - * The type of instructions with a type descriptor argument. - */ -final static int TYPE_INSN = 5; - -/** - * The type of field and method invocations instructions. - */ -final static int FIELDORMETH_INSN = 6; - -/** - * The type of the INVOKEINTERFACE instruction. - */ -final static int ITFMETH_INSN = 7; - -/** - * The type of instructions with a 2 bytes bytecode offset label. - */ -final static int LABEL_INSN = 8; - -/** - * The type of instructions with a 4 bytes bytecode offset label. - */ -final static int LABELW_INSN = 9; - -/** - * The type of the LDC instruction. - */ -final static int LDC_INSN = 10; - -/** - * The type of the LDC_W and LDC2_W instructions. - */ -final static int LDCW_INSN = 11; - -/** - * The type of the IINC instruction. - */ -final static int IINC_INSN = 12; - -/** - * The type of the TABLESWITCH instruction. - */ -final static int TABL_INSN = 13; - -/** - * The type of the LOOKUPSWITCH instruction. - */ -final static int LOOK_INSN = 14; - -/** - * The type of the MULTIANEWARRAY instruction. - */ -final static int MANA_INSN = 15; - -/** - * The type of the WIDE instruction. - */ -final static int WIDE_INSN = 16; - -/** - * The instruction types of all JVM opcodes. - */ -static byte[] TYPE; - -/** - * The type of CONSTANT_Class constant pool items. - */ -final static int CLASS = 7; - -/** - * The type of CONSTANT_Fieldref constant pool items. - */ -final static int FIELD = 9; - -/** - * The type of CONSTANT_Methodref constant pool items. - */ -final static int METH = 10; - -/** - * The type of CONSTANT_InterfaceMethodref constant pool items. - */ -final static int IMETH = 11; - -/** - * The type of CONSTANT_String constant pool items. - */ -final static int STR = 8; - -/** - * The type of CONSTANT_Integer constant pool items. - */ -final static int INT = 3; - -/** - * The type of CONSTANT_Float constant pool items. - */ -final static int FLOAT = 4; - -/** - * The type of CONSTANT_Long constant pool items. - */ -final static int LONG = 5; - -/** - * The type of CONSTANT_Double constant pool items. - */ -final static int DOUBLE = 6; - -/** - * The type of CONSTANT_NameAndType constant pool items. - */ -final static int NAME_TYPE = 12; - -/** - * The type of CONSTANT_Utf8 constant pool items. - */ -final static int UTF8 = 1; - -/** - * Normal type Item stored in the ClassWriter {@link ClassWriter#typeTable}, - * instead of the constant pool, in order to avoid clashes with normal - * constant pool items in the ClassWriter constant pool's hash table. - */ -final static int TYPE_NORMAL = 13; - -/** - * Uninitialized type Item stored in the ClassWriter - * {@link ClassWriter#typeTable}, instead of the constant pool, in order to - * avoid clashes with normal constant pool items in the ClassWriter constant - * pool's hash table. - */ -final static int TYPE_UNINIT = 14; - -/** - * Merged type Item stored in the ClassWriter {@link ClassWriter#typeTable}, - * instead of the constant pool, in order to avoid clashes with normal - * constant pool items in the ClassWriter constant pool's hash table. - */ -final static int TYPE_MERGED = 15; - -/** - * The class reader from which this class writer was constructed, if any. - */ -ClassReader cr; - -/** - * Minor and major version numbers of the class to be generated. - */ -int version; - -/** - * Index of the next item to be added in the constant pool. - */ -int index; - -/** - * The constant pool of this class. - */ -ByteVector pool; - -/** - * The constant pool's hash table data. - */ -Item[] items; - -/** - * The threshold of the constant pool's hash table. - */ -int threshold; - -/** - * A reusable key used to look for items in the {@link #items} hash table. - */ -Item key; - -/** - * A reusable key used to look for items in the {@link #items} hash table. - */ -Item key2; - -/** - * A reusable key used to look for items in the {@link #items} hash table. - */ -Item key3; - -/** - * A type table used to temporarily store internal names that will not - * necessarily be stored in the constant pool. This type table is used by - * the control flow and data flow analysis algorithm used to compute stack - * map frames from scratch. This array associates to each index i - * the Item whose index is i. All Item objects stored in this - * array are also stored in the {@link #items} hash table. These two arrays - * allow to retrieve an Item from its index or, conversly, to get the index - * of an Item from its value. Each Item stores an internal name in its - * {@link Item#strVal1} field. - */ -Item[] typeTable; - -/** - * Number of elements in the {@link #typeTable} array. - */ -private short typeCount; // TODO int? - -/** - * The access flags of this class. - */ -private int access; - -/** - * The constant pool item that contains the internal name of this class. - */ -private int name; - -/** - * The internal name of this class. - */ -String thisName; - -/** - * The constant pool item that contains the signature of this class. - */ -private int signature; - -/** - * The constant pool item that contains the internal name of the super class - * of this class. - */ -private int superName; - -/** - * Number of interfaces implemented or extended by this class or interface. - */ -private int interfaceCount; - -/** - * The interfaces implemented or extended by this class or interface. More - * precisely, this array contains the indexes of the constant pool items - * that contain the internal names of these interfaces. - */ -private int[] interfaces; - -/** - * The index of the constant pool item that contains the name of the source - * file from which this class was compiled. - */ -private int sourceFile; - -/** - * The SourceDebug attribute of this class. - */ -private ByteVector sourceDebug; - -/** - * The constant pool item that contains the name of the enclosing class of - * this class. - */ -private int enclosingMethodOwner; - -/** - * The constant pool item that contains the name and descriptor of the - * enclosing method of this class. - */ -private int enclosingMethod; - -/** - * The runtime visible annotations of this class. - */ -private AnnotationWriter anns; - -/** - * The runtime invisible annotations of this class. - */ -private AnnotationWriter ianns; - -/** - * The non standard attributes of this class. - */ -private Attribute attrs; - -/** - * The number of entries in the InnerClasses attribute. - */ -private int innerClassesCount; - -/** - * The InnerClasses attribute. - */ -private ByteVector innerClasses; - -/** - * The fields of this class. These fields are stored in a linked list of - * {@link FieldWriter} objects, linked to each other by their - * {@link FieldWriter#next} field. This field stores the first element of - * this list. - */ -FieldWriter firstField; - -/** - * The fields of this class. These fields are stored in a linked list of - * {@link FieldWriter} objects, linked to each other by their - * {@link FieldWriter#next} field. This field stores the last element of - * this list. - */ -FieldWriter lastField; - -/** - * The methods of this class. These methods are stored in a linked list of - * {@link MethodWriter} objects, linked to each other by their - * {@link MethodWriter#next} field. This field stores the first element of - * this list. - */ -MethodWriter firstMethod; - -/** - * The methods of this class. These methods are stored in a linked list of - * {@link MethodWriter} objects, linked to each other by their - * {@link MethodWriter#next} field. This field stores the last element of - * this list. - */ -MethodWriter lastMethod; - -/** - * true if the maximum stack size and number of local variables - * must be automatically computed. - */ -private boolean computeMaxs; - -/** - * true if the stack map frames must be recomputed from scratch. - */ -private boolean computeFrames; - -/** - * true if the stack map tables of this class are invalid. The - * {@link MethodWriter#resizeInstructions} method cannot transform existing - * stack map tables, and so produces potentially invalid classes when it is - * executed. In this case the class is reread and rewritten with the - * {@link #COMPUTE_FRAMES} option (the resizeInstructions method can resize - * stack map tables when this option is used). - */ -boolean invalidFrames; - -// ------------------------------------------------------------------------ -// Static initializer -// ------------------------------------------------------------------------ - -/** - * Computes the instruction types of JVM opcodes. - */ -static - { - int i; - byte[] b = new byte[220]; - String s = "AAAAAAAAAAAAAAAABCKLLDDDDDEEEEEEEEEEEEEEEEEEEEAAAAAAAADD" - + "DDDEEEEEEEEEEEEEEEEEEEEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" - + "AAAAAAAAAAAAAAAAAMAAAAAAAAAAAAAAAAAAAAIIIIIIIIIIIIIIIIDNOAA" - + "AAAAGGGGGGGHAFBFAAFFAAQPIIJJIIIIIIIIIIIIIIIIII"; - for(i = 0; i < b.length; ++i) - { - b[i] = (byte) (s.charAt(i) - 'A'); - } - TYPE = b; - - // code to generate the above string - // - // // SBYTE_INSN instructions - // b[Constants.NEWARRAY] = SBYTE_INSN; - // b[Constants.BIPUSH] = SBYTE_INSN; - // - // // SHORT_INSN instructions - // b[Constants.SIPUSH] = SHORT_INSN; - // - // // (IMPL)VAR_INSN instructions - // b[Constants.RET] = VAR_INSN; - // for (i = Constants.ILOAD; i <= Constants.ALOAD; ++i) { - // b[i] = VAR_INSN; - // } - // for (i = Constants.ISTORE; i <= Constants.ASTORE; ++i) { - // b[i] = VAR_INSN; - // } - // for (i = 26; i <= 45; ++i) { // ILOAD_0 to ALOAD_3 - // b[i] = IMPLVAR_INSN; - // } - // for (i = 59; i <= 78; ++i) { // ISTORE_0 to ASTORE_3 - // b[i] = IMPLVAR_INSN; - // } - // - // // TYPE_INSN instructions - // b[Constants.NEW] = TYPE_INSN; - // b[Constants.ANEWARRAY] = TYPE_INSN; - // b[Constants.CHECKCAST] = TYPE_INSN; - // b[Constants.INSTANCEOF] = TYPE_INSN; - // - // // (Set)FIELDORMETH_INSN instructions - // for (i = Constants.GETSTATIC; i <= Constants.INVOKESTATIC; ++i) { - // b[i] = FIELDORMETH_INSN; - // } - // b[Constants.INVOKEINTERFACE] = ITFMETH_INSN; - // - // // LABEL(W)_INSN instructions - // for (i = Constants.IFEQ; i <= Constants.JSR; ++i) { - // b[i] = LABEL_INSN; - // } - // b[Constants.IFNULL] = LABEL_INSN; - // b[Constants.IFNONNULL] = LABEL_INSN; - // b[200] = LABELW_INSN; // GOTO_W - // b[201] = LABELW_INSN; // JSR_W - // // temporary opcodes used internally by ASM - see Label and - // MethodWriter - // for (i = 202; i < 220; ++i) { - // b[i] = LABEL_INSN; - // } - // - // // LDC(_W) instructions - // b[Constants.LDC] = LDC_INSN; - // b[19] = LDCW_INSN; // LDC_W - // b[20] = LDCW_INSN; // LDC2_W - // - // // special instructions - // b[Constants.IINC] = IINC_INSN; - // b[Constants.TABLESWITCH] = TABL_INSN; - // b[Constants.LOOKUPSWITCH] = LOOK_INSN; - // b[Constants.MULTIANEWARRAY] = MANA_INSN; - // b[196] = WIDE_INSN; // WIDE - // - // for (i = 0; i < b.length; ++i) { - // System.err.print((char)('A' + b[i])); - // } - // System.err.println(); - } - -// ------------------------------------------------------------------------ -// Constructor -// ------------------------------------------------------------------------ - -/** - * Constructs a new {@link ClassWriter} object. - * - * @param flags option flags that can be used to modify the default behavior - * of this class. See {@link #COMPUTE_MAXS}, {@link #COMPUTE_FRAMES}. - */ -public ClassWriter(final int flags){ - index = 1; - pool = new ByteVector(); - items = new Item[256]; - threshold = (int) (0.75d * items.length); - key = new Item(); - key2 = new Item(); - key3 = new Item(); - this.computeMaxs = (flags & COMPUTE_MAXS) != 0; - this.computeFrames = (flags & COMPUTE_FRAMES) != 0; -} - -/** - * Constructs a new {@link ClassWriter} object and enables optimizations for - * "mostly add" bytecode transformations. These optimizations are the - * following: - *

- *

  • The constant pool from the original class is copied as is in - * the new class, which saves time. New constant pool entries will be added - * at the end if necessary, but unused constant pool entries won't be - * removed.
  • Methods that are not transformed are copied as - * is in the new class, directly from the original class bytecode (i.e. - * without emitting visit events for all the method instructions), which - * saves a lot of time. Untransformed methods are detected by the - * fact that the {@link ClassReader} receives {@link MethodVisitor} objects - * that come from a {@link ClassWriter} (and not from a custom - * {@link ClassAdapter} or any other {@link ClassVisitor} instance).
    • - *
- * - * @param classReader the {@link ClassReader} used to read the original - * class. It will be used to copy the entire constant pool from the - * original class and also to copy other fragments of original - * bytecode where applicable. - * @param flags option flags that can be used to modify the default behavior - * of this class. See {@link #COMPUTE_MAXS}, {@link #COMPUTE_FRAMES}. - */ -public ClassWriter(final ClassReader classReader, final int flags){ - this(flags); - classReader.copyPool(this); - this.cr = classReader; -} - -// ------------------------------------------------------------------------ -// Implementation of the ClassVisitor interface -// ------------------------------------------------------------------------ - -public void visit( - final int version, - final int access, - final String name, - final String signature, - final String superName, - final String[] interfaces){ - this.version = version; - this.access = access; - this.name = newClass(name); - thisName = name; - if(signature != null) - { - this.signature = newUTF8(signature); - } - this.superName = superName == null ? 0 : newClass(superName); - if(interfaces != null && interfaces.length > 0) - { - interfaceCount = interfaces.length; - this.interfaces = new int[interfaceCount]; - for(int i = 0; i < interfaceCount; ++i) - { - this.interfaces[i] = newClass(interfaces[i]); - } - } -} - -public void visitSource(final String file, final String debug){ - if(file != null) - { - sourceFile = newUTF8(file); - } - if(debug != null) - { - sourceDebug = new ByteVector().putUTF8(debug); - } -} - -public void visitOuterClass( - final String owner, - final String name, - final String desc){ - enclosingMethodOwner = newClass(owner); - if(name != null && desc != null) - { - enclosingMethod = newNameType(name, desc); - } -} - -public AnnotationVisitor visitAnnotation( - final String desc, - final boolean visible){ - ByteVector bv = new ByteVector(); - // write type, and reserve space for values count - bv.putShort(newUTF8(desc)).putShort(0); - AnnotationWriter aw = new AnnotationWriter(this, true, bv, bv, 2); - if(visible) - { - aw.next = anns; - anns = aw; - } - else - { - aw.next = ianns; - ianns = aw; - } - return aw; -} - -public void visitAttribute(final Attribute attr){ - attr.next = attrs; - attrs = attr; -} - -public void visitInnerClass( - final String name, - final String outerName, - final String innerName, - final int access){ - if(innerClasses == null) - { - innerClasses = new ByteVector(); - } - ++innerClassesCount; - innerClasses.putShort(name == null ? 0 : newClass(name)); - innerClasses.putShort(outerName == null ? 0 : newClass(outerName)); - innerClasses.putShort(innerName == null ? 0 : newUTF8(innerName)); - innerClasses.putShort(access); -} - -public FieldVisitor visitField( - final int access, - final String name, - final String desc, - final String signature, - final Object value){ - return new FieldWriter(this, access, name, desc, signature, value); -} - -public MethodVisitor visitMethod( - final int access, - final String name, - final String desc, - final String signature, - final String[] exceptions){ - return new MethodWriter(this, - access, - name, - desc, - signature, - exceptions, - computeMaxs, - computeFrames); -} - -public void visitEnd(){ -} - -// ------------------------------------------------------------------------ -// Other public methods -// ------------------------------------------------------------------------ - -/** - * Returns the bytecode of the class that was build with this class writer. - * - * @return the bytecode of the class that was build with this class writer. - */ -public byte[] toByteArray(){ - // computes the real size of the bytecode of this class - int size = 24 + 2 * interfaceCount; - int nbFields = 0; - FieldWriter fb = firstField; - while(fb != null) - { - ++nbFields; - size += fb.getSize(); - fb = fb.next; - } - int nbMethods = 0; - MethodWriter mb = firstMethod; - while(mb != null) - { - ++nbMethods; - size += mb.getSize(); - mb = mb.next; - } - int attributeCount = 0; - if(signature != 0) - { - ++attributeCount; - size += 8; - newUTF8("Signature"); - } - if(sourceFile != 0) - { - ++attributeCount; - size += 8; - newUTF8("SourceFile"); - } - if(sourceDebug != null) - { - ++attributeCount; - size += sourceDebug.length + 4; - newUTF8("SourceDebugExtension"); - } - if(enclosingMethodOwner != 0) - { - ++attributeCount; - size += 10; - newUTF8("EnclosingMethod"); - } - if((access & Opcodes.ACC_DEPRECATED) != 0) - { - ++attributeCount; - size += 6; - newUTF8("Deprecated"); - } - if((access & Opcodes.ACC_SYNTHETIC) != 0 - && (version & 0xffff) < Opcodes.V1_5) - { - ++attributeCount; - size += 6; - newUTF8("Synthetic"); - } - if(innerClasses != null) - { - ++attributeCount; - size += 8 + innerClasses.length; - newUTF8("InnerClasses"); - } - if(anns != null) - { - ++attributeCount; - size += 8 + anns.getSize(); - newUTF8("RuntimeVisibleAnnotations"); - } - if(ianns != null) - { - ++attributeCount; - size += 8 + ianns.getSize(); - newUTF8("RuntimeInvisibleAnnotations"); - } - if(attrs != null) - { - attributeCount += attrs.getCount(); - size += attrs.getSize(this, null, 0, -1, -1); - } - size += pool.length; - // allocates a byte vector of this size, in order to avoid unnecessary - // arraycopy operations in the ByteVector.enlarge() method - ByteVector out = new ByteVector(size); - out.putInt(0xCAFEBABE).putInt(version); - out.putShort(index).putByteArray(pool.data, 0, pool.length); - out.putShort(access).putShort(name).putShort(superName); - out.putShort(interfaceCount); - for(int i = 0; i < interfaceCount; ++i) - { - out.putShort(interfaces[i]); - } - out.putShort(nbFields); - fb = firstField; - while(fb != null) - { - fb.put(out); - fb = fb.next; - } - out.putShort(nbMethods); - mb = firstMethod; - while(mb != null) - { - mb.put(out); - mb = mb.next; - } - out.putShort(attributeCount); - if(signature != 0) - { - out.putShort(newUTF8("Signature")).putInt(2).putShort(signature); - } - if(sourceFile != 0) - { - out.putShort(newUTF8("SourceFile")).putInt(2).putShort(sourceFile); - } - if(sourceDebug != null) - { - int len = sourceDebug.length - 2; - out.putShort(newUTF8("SourceDebugExtension")).putInt(len); - out.putByteArray(sourceDebug.data, 2, len); - } - if(enclosingMethodOwner != 0) - { - out.putShort(newUTF8("EnclosingMethod")).putInt(4); - out.putShort(enclosingMethodOwner).putShort(enclosingMethod); - } - if((access & Opcodes.ACC_DEPRECATED) != 0) - { - out.putShort(newUTF8("Deprecated")).putInt(0); - } - if((access & Opcodes.ACC_SYNTHETIC) != 0 - && (version & 0xffff) < Opcodes.V1_5) - { - out.putShort(newUTF8("Synthetic")).putInt(0); - } - if(innerClasses != null) - { - out.putShort(newUTF8("InnerClasses")); - out.putInt(innerClasses.length + 2).putShort(innerClassesCount); - out.putByteArray(innerClasses.data, 0, innerClasses.length); - } - if(anns != null) - { - out.putShort(newUTF8("RuntimeVisibleAnnotations")); - anns.put(out); - } - if(ianns != null) - { - out.putShort(newUTF8("RuntimeInvisibleAnnotations")); - ianns.put(out); - } - if(attrs != null) - { - attrs.put(this, null, 0, -1, -1, out); - } - if(invalidFrames) - { - ClassWriter cw = new ClassWriter(COMPUTE_FRAMES); - new ClassReader(out.data).accept(cw, ClassReader.SKIP_FRAMES); - return cw.toByteArray(); - } - return out.data; -} - -// ------------------------------------------------------------------------ -// Utility methods: constant pool management -// ------------------------------------------------------------------------ - -/** - * Adds a number or string constant to the constant pool of the class being - * build. Does nothing if the constant pool already contains a similar item. - * - * @param cst the value of the constant to be added to the constant pool. - * This parameter must be an {@link Integer}, a {@link Float}, a - * {@link Long}, a {@link Double}, a {@link String} or a - * {@link Type}. - * @return a new or already existing constant item with the given value. - */ -Item newConstItem(final Object cst){ - if(cst instanceof Integer) - { - int val = ((Integer) cst).intValue(); - return newInteger(val); - } - else if(cst instanceof Byte) - { - int val = ((Byte) cst).intValue(); - return newInteger(val); - } - else if(cst instanceof Character) - { - int val = ((Character) cst).charValue(); - return newInteger(val); - } - else if(cst instanceof Short) - { - int val = ((Short) cst).intValue(); - return newInteger(val); - } - else if(cst instanceof Boolean) - { - int val = ((Boolean) cst).booleanValue() ? 1 : 0; - return newInteger(val); - } - else if(cst instanceof Float) - { - float val = ((Float) cst).floatValue(); - return newFloat(val); - } - else if(cst instanceof Long) - { - long val = ((Long) cst).longValue(); - return newLong(val); - } - else if(cst instanceof Double) - { - double val = ((Double) cst).doubleValue(); - return newDouble(val); - } - else if(cst instanceof String) - { - return newString((String) cst); - } - else if(cst instanceof Type) - { - Type t = (Type) cst; - return newClassItem(t.getSort() == Type.OBJECT - ? t.getInternalName() - : t.getDescriptor()); - } - else - { - throw new IllegalArgumentException("value " + cst); - } -} - -/** - * Adds a number or string constant to the constant pool of the class being - * build. Does nothing if the constant pool already contains a similar item. - * This method is intended for {@link Attribute} sub classes, and is - * normally not needed by class generators or adapters. - * - * @param cst the value of the constant to be added to the constant pool. - * This parameter must be an {@link Integer}, a {@link Float}, a - * {@link Long}, a {@link Double} or a {@link String}. - * @return the index of a new or already existing constant item with the - * given value. - */ -public int newConst(final Object cst){ - return newConstItem(cst).index; -} - -/** - * Adds an UTF8 string to the constant pool of the class being build. Does - * nothing if the constant pool already contains a similar item. This - * method is intended for {@link Attribute} sub classes, and is normally not - * needed by class generators or adapters. - * - * @param value the String value. - * @return the index of a new or already existing UTF8 item. - */ -public int newUTF8(final String value){ - key.set(UTF8, value, null, null); - Item result = get(key); - if(result == null) - { - pool.putByte(UTF8).putUTF8(value); - result = new Item(index++, key); - put(result); - } - return result.index; -} - -/** - * Adds a class reference to the constant pool of the class being build. - * Does nothing if the constant pool already contains a similar item. - * This method is intended for {@link Attribute} sub classes, and is - * normally not needed by class generators or adapters. - * - * @param value the internal name of the class. - * @return a new or already existing class reference item. - */ -Item newClassItem(final String value){ - key2.set(CLASS, value, null, null); - Item result = get(key2); - if(result == null) - { - pool.put12(CLASS, newUTF8(value)); - result = new Item(index++, key2); - put(result); - } - return result; -} - -/** - * Adds a class reference to the constant pool of the class being build. - * Does nothing if the constant pool already contains a similar item. - * This method is intended for {@link Attribute} sub classes, and is - * normally not needed by class generators or adapters. - * - * @param value the internal name of the class. - * @return the index of a new or already existing class reference item. - */ -public int newClass(final String value){ - return newClassItem(value).index; -} - -/** - * Adds a field reference to the constant pool of the class being build. - * Does nothing if the constant pool already contains a similar item. - * - * @param owner the internal name of the field's owner class. - * @param name the field's name. - * @param desc the field's descriptor. - * @return a new or already existing field reference item. - */ -Item newFieldItem(final String owner, final String name, final String desc){ - key3.set(FIELD, owner, name, desc); - Item result = get(key3); - if(result == null) - { - put122(FIELD, newClass(owner), newNameType(name, desc)); - result = new Item(index++, key3); - put(result); - } - return result; -} - -/** - * Adds a field reference to the constant pool of the class being build. - * Does nothing if the constant pool already contains a similar item. - * This method is intended for {@link Attribute} sub classes, and is - * normally not needed by class generators or adapters. - * - * @param owner the internal name of the field's owner class. - * @param name the field's name. - * @param desc the field's descriptor. - * @return the index of a new or already existing field reference item. - */ -public int newField(final String owner, final String name, final String desc){ - return newFieldItem(owner, name, desc).index; -} - -/** - * Adds a method reference to the constant pool of the class being build. - * Does nothing if the constant pool already contains a similar item. - * - * @param owner the internal name of the method's owner class. - * @param name the method's name. - * @param desc the method's descriptor. - * @param itf true if owner is an interface. - * @return a new or already existing method reference item. - */ -Item newMethodItem( - final String owner, - final String name, - final String desc, - final boolean itf){ - int type = itf ? IMETH : METH; - key3.set(type, owner, name, desc); - Item result = get(key3); - if(result == null) - { - put122(type, newClass(owner), newNameType(name, desc)); - result = new Item(index++, key3); - put(result); - } - return result; -} - -/** - * Adds a method reference to the constant pool of the class being build. - * Does nothing if the constant pool already contains a similar item. - * This method is intended for {@link Attribute} sub classes, and is - * normally not needed by class generators or adapters. - * - * @param owner the internal name of the method's owner class. - * @param name the method's name. - * @param desc the method's descriptor. - * @param itf true if owner is an interface. - * @return the index of a new or already existing method reference item. - */ -public int newMethod( - final String owner, - final String name, - final String desc, - final boolean itf){ - return newMethodItem(owner, name, desc, itf).index; -} - -/** - * Adds an integer to the constant pool of the class being build. Does - * nothing if the constant pool already contains a similar item. - * - * @param value the int value. - * @return a new or already existing int item. - */ -Item newInteger(final int value){ - key.set(value); - Item result = get(key); - if(result == null) - { - pool.putByte(INT).putInt(value); - result = new Item(index++, key); - put(result); - } - return result; -} - -/** - * Adds a float to the constant pool of the class being build. Does nothing - * if the constant pool already contains a similar item. - * - * @param value the float value. - * @return a new or already existing float item. - */ -Item newFloat(final float value){ - key.set(value); - Item result = get(key); - if(result == null) - { - pool.putByte(FLOAT).putInt(key.intVal); - result = new Item(index++, key); - put(result); - } - return result; -} - -/** - * Adds a long to the constant pool of the class being build. Does nothing - * if the constant pool already contains a similar item. - * - * @param value the long value. - * @return a new or already existing long item. - */ -Item newLong(final long value){ - key.set(value); - Item result = get(key); - if(result == null) - { - pool.putByte(LONG).putLong(value); - result = new Item(index, key); - put(result); - index += 2; - } - return result; -} - -/** - * Adds a double to the constant pool of the class being build. Does nothing - * if the constant pool already contains a similar item. - * - * @param value the double value. - * @return a new or already existing double item. - */ -Item newDouble(final double value){ - key.set(value); - Item result = get(key); - if(result == null) - { - pool.putByte(DOUBLE).putLong(key.longVal); - result = new Item(index, key); - put(result); - index += 2; - } - return result; -} - -/** - * Adds a string to the constant pool of the class being build. Does nothing - * if the constant pool already contains a similar item. - * - * @param value the String value. - * @return a new or already existing string item. - */ -private Item newString(final String value){ - key2.set(STR, value, null, null); - Item result = get(key2); - if(result == null) - { - pool.put12(STR, newUTF8(value)); - result = new Item(index++, key2); - put(result); - } - return result; -} - -/** - * Adds a name and type to the constant pool of the class being build. Does - * nothing if the constant pool already contains a similar item. This - * method is intended for {@link Attribute} sub classes, and is normally not - * needed by class generators or adapters. - * - * @param name a name. - * @param desc a type descriptor. - * @return the index of a new or already existing name and type item. - */ -public int newNameType(final String name, final String desc){ - key2.set(NAME_TYPE, name, desc, null); - Item result = get(key2); - if(result == null) - { - put122(NAME_TYPE, newUTF8(name), newUTF8(desc)); - result = new Item(index++, key2); - put(result); - } - return result.index; -} - -/** - * Adds the given internal name to {@link #typeTable} and returns its index. - * Does nothing if the type table already contains this internal name. - * - * @param type the internal name to be added to the type table. - * @return the index of this internal name in the type table. - */ -int addType(final String type){ - key.set(TYPE_NORMAL, type, null, null); - Item result = get(key); - if(result == null) - { - result = addType(key); - } - return result.index; -} - -/** - * Adds the given "uninitialized" type to {@link #typeTable} and returns its - * index. This method is used for UNINITIALIZED types, made of an internal - * name and a bytecode offset. - * - * @param type the internal name to be added to the type table. - * @param offset the bytecode offset of the NEW instruction that created - * this UNINITIALIZED type value. - * @return the index of this internal name in the type table. - */ -int addUninitializedType(final String type, final int offset){ - key.type = TYPE_UNINIT; - key.intVal = offset; - key.strVal1 = type; - key.hashCode = 0x7FFFFFFF & (TYPE_UNINIT + type.hashCode() + offset); - Item result = get(key); - if(result == null) - { - result = addType(key); - } - return result.index; -} - -/** - * Adds the given Item to {@link #typeTable}. - * - * @param item the value to be added to the type table. - * @return the added Item, which a new Item instance with the same value as - * the given Item. - */ -private Item addType(final Item item){ - ++typeCount; - Item result = new Item(typeCount, key); - put(result); - if(typeTable == null) - { - typeTable = new Item[16]; - } - if(typeCount == typeTable.length) - { - Item[] newTable = new Item[2 * typeTable.length]; - System.arraycopy(typeTable, 0, newTable, 0, typeTable.length); - typeTable = newTable; - } - typeTable[typeCount] = result; - return result; -} - -/** - * Returns the index of the common super type of the two given types. This - * method calls {@link #getCommonSuperClass} and caches the result in the - * {@link #items} hash table to speedup future calls with the same - * parameters. - * - * @param type1 index of an internal name in {@link #typeTable}. - * @param type2 index of an internal name in {@link #typeTable}. - * @return the index of the common super type of the two given types. - */ -int getMergedType(final int type1, final int type2){ - key2.type = TYPE_MERGED; - key2.longVal = type1 | (((long) type2) << 32); - key2.hashCode = 0x7FFFFFFF & (TYPE_MERGED + type1 + type2); - Item result = get(key2); - if(result == null) - { - String t = typeTable[type1].strVal1; - String u = typeTable[type2].strVal1; - key2.intVal = addType(getCommonSuperClass(t, u)); - result = new Item((short) 0, key2); - put(result); - } - return result.intVal; -} - -/** - * Returns the common super type of the two given types. The default - * implementation of this method loads the two given classes and uses - * the java.lang.Class methods to find the common super class. It can be - * overriden to compute this common super type in other ways, in particular - * without actually loading any class, or to take into account the class - * that is currently being generated by this ClassWriter, which can of - * course not be loaded since it is under construction. - * - * @param type1 the internal name of a class. - * @param type2 the internal name of another class. - * @return the internal name of the common super class of the two given - * classes. - */ -protected String getCommonSuperClass(final String type1, final String type2){ - Class c, d; - try - { - c = Class.forName(type1.replace('/', '.')); - d = Class.forName(type2.replace('/', '.')); - } - catch(ClassNotFoundException e) - { - throw new RuntimeException(e); - } - if(c.isAssignableFrom(d)) - { - return type1; - } - if(d.isAssignableFrom(c)) - { - return type2; - } - if(c.isInterface() || d.isInterface()) - { - return "java/lang/Object"; - } - else - { - do - { - c = c.getSuperclass(); - } while(!c.isAssignableFrom(d)); - return c.getName().replace('.', '/'); - } -} - -/** - * Returns the constant pool's hash table item which is equal to the given - * item. - * - * @param key a constant pool item. - * @return the constant pool's hash table item which is equal to the given - * item, or null if there is no such item. - */ -private Item get(final Item key){ - Item i = items[key.hashCode % items.length]; - while(i != null && !key.isEqualTo(i)) - { - i = i.next; - } - return i; -} - -/** - * Puts the given item in the constant pool's hash table. The hash table - * must not already contains this item. - * - * @param i the item to be added to the constant pool's hash table. - */ -private void put(final Item i){ - if(index > threshold) - { - int ll = items.length; - int nl = ll * 2 + 1; - Item[] newItems = new Item[nl]; - for(int l = ll - 1; l >= 0; --l) - { - Item j = items[l]; - while(j != null) - { - int index = j.hashCode % newItems.length; - Item k = j.next; - j.next = newItems[index]; - newItems[index] = j; - j = k; - } - } - items = newItems; - threshold = (int) (nl * 0.75); - } - int index = i.hashCode % items.length; - i.next = items[index]; - items[index] = i; -} - -/** - * Puts one byte and two shorts into the constant pool. - * - * @param b a byte. - * @param s1 a short. - * @param s2 another short. - */ -private void put122(final int b, final int s1, final int s2){ - pool.put12(b, s1).putShort(s2); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/Edge.java --- a/src/clojure/asm/Edge.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,75 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * An edge in the control flow graph of a method body. See {@link Label Label}. - * - * @author Eric Bruneton - */ -class Edge{ - -/** - * Denotes a normal control flow graph edge. - */ -final static int NORMAL = 0; - -/** - * Denotes a control flow graph edge corresponding to an exception handler. - * More precisely any {@link Edge} whose {@link #info} is strictly positive - * corresponds to an exception handler. The actual value of {@link #info} is - * the index, in the {@link ClassWriter} type table, of the exception that - * is catched. - */ -final static int EXCEPTION = 0x7FFFFFFF; - -/** - * Information about this control flow graph edge. If - * {@link ClassWriter#COMPUTE_MAXS} is used this field is the (relative) - * stack size in the basic block from which this edge originates. This size - * is equal to the stack size at the "jump" instruction to which this edge - * corresponds, relatively to the stack size at the beginning of the - * originating basic block. If {@link ClassWriter#COMPUTE_FRAMES} is used, - * this field is the kind of this control flow graph edge (i.e. NORMAL or - * EXCEPTION). - */ -int info; - -/** - * The successor block of the basic block from which this edge originates. - */ -Label successor; - -/** - * The next edge in the list of successors of the originating basic block. - * See {@link Label#successors successors}. - */ -Edge next; -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/FieldVisitor.java --- a/src/clojure/asm/FieldVisitor.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * A visitor to visit a Java field. The methods of this interface must be called - * in the following order: ( visitAnnotation | - * visitAttribute )* visitEnd. - * - * @author Eric Bruneton - */ -public interface FieldVisitor{ - -/** - * Visits an annotation of the field. - * - * @param desc the class descriptor of the annotation class. - * @param visible true if the annotation is visible at runtime. - * @return a visitor to visit the annotation values, or null if - * this visitor is not interested in visiting this annotation. - */ -AnnotationVisitor visitAnnotation(String desc, boolean visible); - -/** - * Visits a non standard attribute of the field. - * - * @param attr an attribute. - */ -void visitAttribute(Attribute attr); - -/** - * Visits the end of the field. This method, which is the last one to be - * called, is used to inform the visitor that all the annotations and - * attributes of the field have been visited. - */ -void visitEnd(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/FieldWriter.java --- a/src/clojure/asm/FieldWriter.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,290 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * An {@link FieldVisitor} that generates Java fields in bytecode form. - * - * @author Eric Bruneton - */ -final class FieldWriter implements FieldVisitor{ - -/** - * Next field writer (see {@link ClassWriter#firstField firstField}). - */ -FieldWriter next; - -/** - * The class writer to which this field must be added. - */ -private ClassWriter cw; - -/** - * Access flags of this field. - */ -private int access; - -/** - * The index of the constant pool item that contains the name of this - * method. - */ -private int name; - -/** - * The index of the constant pool item that contains the descriptor of this - * field. - */ -private int desc; - -/** - * The index of the constant pool item that contains the signature of this - * field. - */ -private int signature; - -/** - * The index of the constant pool item that contains the constant value of - * this field. - */ -private int value; - -/** - * The runtime visible annotations of this field. May be null. - */ -private AnnotationWriter anns; - -/** - * The runtime invisible annotations of this field. May be null. - */ -private AnnotationWriter ianns; - -/** - * The non standard attributes of this field. May be null. - */ -private Attribute attrs; - -// ------------------------------------------------------------------------ -// Constructor -// ------------------------------------------------------------------------ - -/** - * Constructs a new {@link FieldWriter}. - * - * @param cw the class writer to which this field must be added. - * @param access the field's access flags (see {@link Opcodes}). - * @param name the field's name. - * @param desc the field's descriptor (see {@link Type}). - * @param signature the field's signature. May be null. - * @param value the field's constant value. May be null. - */ -protected FieldWriter( - final ClassWriter cw, - final int access, - final String name, - final String desc, - final String signature, - final Object value){ - if(cw.firstField == null) - { - cw.firstField = this; - } - else - { - cw.lastField.next = this; - } - cw.lastField = this; - this.cw = cw; - this.access = access; - this.name = cw.newUTF8(name); - this.desc = cw.newUTF8(desc); - if(signature != null) - { - this.signature = cw.newUTF8(signature); - } - if(value != null) - { - this.value = cw.newConstItem(value).index; - } -} - -// ------------------------------------------------------------------------ -// Implementation of the FieldVisitor interface -// ------------------------------------------------------------------------ - -public AnnotationVisitor visitAnnotation( - final String desc, - final boolean visible){ - ByteVector bv = new ByteVector(); - // write type, and reserve space for values count - bv.putShort(cw.newUTF8(desc)).putShort(0); - AnnotationWriter aw = new AnnotationWriter(cw, true, bv, bv, 2); - if(visible) - { - aw.next = anns; - anns = aw; - } - else - { - aw.next = ianns; - ianns = aw; - } - return aw; -} - -public void visitAttribute(final Attribute attr){ - attr.next = attrs; - attrs = attr; -} - -public void visitEnd(){ -} - -// ------------------------------------------------------------------------ -// Utility methods -// ------------------------------------------------------------------------ - -/** - * Returns the size of this field. - * - * @return the size of this field. - */ -int getSize(){ - int size = 8; - if(value != 0) - { - cw.newUTF8("ConstantValue"); - size += 8; - } - if((access & Opcodes.ACC_SYNTHETIC) != 0 - && (cw.version & 0xffff) < Opcodes.V1_5) - { - cw.newUTF8("Synthetic"); - size += 6; - } - if((access & Opcodes.ACC_DEPRECATED) != 0) - { - cw.newUTF8("Deprecated"); - size += 6; - } - if(signature != 0) - { - cw.newUTF8("Signature"); - size += 8; - } - if(anns != null) - { - cw.newUTF8("RuntimeVisibleAnnotations"); - size += 8 + anns.getSize(); - } - if(ianns != null) - { - cw.newUTF8("RuntimeInvisibleAnnotations"); - size += 8 + ianns.getSize(); - } - if(attrs != null) - { - size += attrs.getSize(cw, null, 0, -1, -1); - } - return size; -} - -/** - * Puts the content of this field into the given byte vector. - * - * @param out where the content of this field must be put. - */ -void put(final ByteVector out){ - out.putShort(access).putShort(name).putShort(desc); - int attributeCount = 0; - if(value != 0) - { - ++attributeCount; - } - if((access & Opcodes.ACC_SYNTHETIC) != 0 - && (cw.version & 0xffff) < Opcodes.V1_5) - { - ++attributeCount; - } - if((access & Opcodes.ACC_DEPRECATED) != 0) - { - ++attributeCount; - } - if(signature != 0) - { - ++attributeCount; - } - if(anns != null) - { - ++attributeCount; - } - if(ianns != null) - { - ++attributeCount; - } - if(attrs != null) - { - attributeCount += attrs.getCount(); - } - out.putShort(attributeCount); - if(value != 0) - { - out.putShort(cw.newUTF8("ConstantValue")); - out.putInt(2).putShort(value); - } - if((access & Opcodes.ACC_SYNTHETIC) != 0 - && (cw.version & 0xffff) < Opcodes.V1_5) - { - out.putShort(cw.newUTF8("Synthetic")).putInt(0); - } - if((access & Opcodes.ACC_DEPRECATED) != 0) - { - out.putShort(cw.newUTF8("Deprecated")).putInt(0); - } - if(signature != 0) - { - out.putShort(cw.newUTF8("Signature")); - out.putInt(2).putShort(signature); - } - if(anns != null) - { - out.putShort(cw.newUTF8("RuntimeVisibleAnnotations")); - anns.put(out); - } - if(ianns != null) - { - out.putShort(cw.newUTF8("RuntimeInvisibleAnnotations")); - ianns.put(out); - } - if(attrs != null) - { - attrs.put(cw, null, 0, -1, -1, out); - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/Frame.java --- a/src/clojure/asm/Frame.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1506 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * Information about the input and output stack map frames of a basic block. - * - * @author Eric Bruneton - */ -final class Frame{ - -/* - * Frames are computed in a two steps process: during the visit of each - * instruction, the state of the frame at the end of current basic block is - * updated by simulating the action of the instruction on the previous state - * of this so called "output frame". In visitMaxs, a fix point algorithm is - * used to compute the "input frame" of each basic block, i.e. the stack map - * frame at the begining of the basic block, starting from the input frame - * of the first basic block (which is computed from the method descriptor), - * and by using the previously computed output frames to compute the input - * state of the other blocks. - * - * All output and input frames are stored as arrays of integers. Reference - * and array types are represented by an index into a type table (which is - * not the same as the constant pool of the class, in order to avoid adding - * unnecessary constants in the pool - not all computed frames will end up - * being stored in the stack map table). This allows very fast type - * comparisons. - * - * Output stack map frames are computed relatively to the input frame of the - * basic block, which is not yet known when output frames are computed. It - * is therefore necessary to be able to represent abstract types such as - * "the type at position x in the input frame locals" or "the type at - * position x from the top of the input frame stack" or even "the type at - * position x in the input frame, with y more (or less) array dimensions". - * This explains the rather complicated type format used in output frames. - * - * This format is the following: DIM KIND VALUE (4, 4 and 24 bits). DIM is a - * signed number of array dimensions (from -8 to 7). KIND is either BASE, - * LOCAL or STACK. BASE is used for types that are not relative to the input - * frame. LOCAL is used for types that are relative to the input local - * variable types. STACK is used for types that are relative to the input - * stack types. VALUE depends on KIND. For LOCAL types, it is an index in - * the input local variable types. For STACK types, it is a position - * relatively to the top of input frame stack. For BASE types, it is either - * one of the constants defined in FrameVisitor, or for OBJECT and - * UNINITIALIZED types, a tag and an index in the type table. - * - * Output frames can contain types of any kind and with a positive or - * negative dimension (and even unassigned types, represented by 0 - which - * does not correspond to any valid type value). Input frames can only - * contain BASE types of positive or null dimension. In all cases the type - * table contains only internal type names (array type descriptors are - * forbidden - dimensions must be represented through the DIM field). - * - * The LONG and DOUBLE types are always represented by using two slots (LONG + - * TOP or DOUBLE + TOP), for local variable types as well as in the operand - * stack. This is necessary to be able to simulate DUPx_y instructions, - * whose effect would be dependent on the actual type values if types were - * always represented by a single slot in the stack (and this is not - * possible, since actual type values are not always known - cf LOCAL and - * STACK type kinds). - */ - -/** - * Mask to get the dimension of a frame type. This dimension is a signed - * integer between -8 and 7. - */ -final static int DIM = 0xF0000000; - -/** - * Constant to be added to a type to get a type with one more dimension. - */ -final static int ARRAY_OF = 0x10000000; - -/** - * Constant to be added to a type to get a type with one less dimension. - */ -final static int ELEMENT_OF = 0xF0000000; - -/** - * Mask to get the kind of a frame type. - * - * @see #BASE - * @see #LOCAL - * @see #STACK - */ -final static int KIND = 0xF000000; - -/** - * Mask to get the value of a frame type. - */ -final static int VALUE = 0xFFFFFF; - -/** - * Mask to get the kind of base types. - */ -final static int BASE_KIND = 0xFF00000; - -/** - * Mask to get the value of base types. - */ -final static int BASE_VALUE = 0xFFFFF; - -/** - * Kind of the types that are not relative to an input stack map frame. - */ -final static int BASE = 0x1000000; - -/** - * Base kind of the base reference types. The BASE_VALUE of such types is an - * index into the type table. - */ -final static int OBJECT = BASE | 0x700000; - -/** - * Base kind of the uninitialized base types. The BASE_VALUE of such types - * in an index into the type table (the Item at that index contains both an - * instruction offset and an internal class name). - */ -final static int UNINITIALIZED = BASE | 0x800000; - -/** - * Kind of the types that are relative to the local variable types of an - * input stack map frame. The value of such types is a local variable index. - */ -private final static int LOCAL = 0x2000000; - -/** - * Kind of the the types that are relative to the stack of an input stack - * map frame. The value of such types is a position relatively to the top of - * this stack. - */ -private final static int STACK = 0x3000000; - -/** - * The TOP type. This is a BASE type. - */ -final static int TOP = BASE | 0; - -/** - * The BOOLEAN type. This is a BASE type mainly used for array types. - */ -final static int BOOLEAN = BASE | 9; - -/** - * The BYTE type. This is a BASE type mainly used for array types. - */ -final static int BYTE = BASE | 10; - -/** - * The CHAR type. This is a BASE type mainly used for array types. - */ -final static int CHAR = BASE | 11; - -/** - * The SHORT type. This is a BASE type mainly used for array types. - */ -final static int SHORT = BASE | 12; - -/** - * The INTEGER type. This is a BASE type. - */ -final static int INTEGER = BASE | 1; - -/** - * The FLOAT type. This is a BASE type. - */ -final static int FLOAT = BASE | 2; - -/** - * The DOUBLE type. This is a BASE type. - */ -final static int DOUBLE = BASE | 3; - -/** - * The LONG type. This is a BASE type. - */ -final static int LONG = BASE | 4; - -/** - * The NULL type. This is a BASE type. - */ -final static int NULL = BASE | 5; - -/** - * The UNINITIALIZED_THIS type. This is a BASE type. - */ -final static int UNINITIALIZED_THIS = BASE | 6; - -/** - * The stack size variation corresponding to each JVM instruction. This - * stack variation is equal to the size of the values produced by an - * instruction, minus the size of the values consumed by this instruction. - */ -final static int[] SIZE; - -/** - * Computes the stack size variation corresponding to each JVM instruction. - */ -static - { - int i; - int[] b = new int[202]; - String s = "EFFFFFFFFGGFFFGGFFFEEFGFGFEEEEEEEEEEEEEEEEEEEEDEDEDDDDD" - + "CDCDEEEEEEEEEEEEEEEEEEEEBABABBBBDCFFFGGGEDCDCDCDCDCDCDCDCD" - + "CDCEEEEDDDDDDDCDCDCEFEFDDEEFFDEDEEEBDDBBDDDDDDCCCCCCCCEFED" - + "DDCDCDEEEEEEEEEEFEEEEEEDDEEDDEE"; - for(i = 0; i < b.length; ++i) - { - b[i] = s.charAt(i) - 'E'; - } - SIZE = b; - - // code to generate the above string - // - // int NA = 0; // not applicable (unused opcode or variable size opcode) - // - // b = new int[] { - // 0, //NOP, // visitInsn - // 1, //ACONST_NULL, // - - // 1, //ICONST_M1, // - - // 1, //ICONST_0, // - - // 1, //ICONST_1, // - - // 1, //ICONST_2, // - - // 1, //ICONST_3, // - - // 1, //ICONST_4, // - - // 1, //ICONST_5, // - - // 2, //LCONST_0, // - - // 2, //LCONST_1, // - - // 1, //FCONST_0, // - - // 1, //FCONST_1, // - - // 1, //FCONST_2, // - - // 2, //DCONST_0, // - - // 2, //DCONST_1, // - - // 1, //BIPUSH, // visitIntInsn - // 1, //SIPUSH, // - - // 1, //LDC, // visitLdcInsn - // NA, //LDC_W, // - - // NA, //LDC2_W, // - - // 1, //ILOAD, // visitVarInsn - // 2, //LLOAD, // - - // 1, //FLOAD, // - - // 2, //DLOAD, // - - // 1, //ALOAD, // - - // NA, //ILOAD_0, // - - // NA, //ILOAD_1, // - - // NA, //ILOAD_2, // - - // NA, //ILOAD_3, // - - // NA, //LLOAD_0, // - - // NA, //LLOAD_1, // - - // NA, //LLOAD_2, // - - // NA, //LLOAD_3, // - - // NA, //FLOAD_0, // - - // NA, //FLOAD_1, // - - // NA, //FLOAD_2, // - - // NA, //FLOAD_3, // - - // NA, //DLOAD_0, // - - // NA, //DLOAD_1, // - - // NA, //DLOAD_2, // - - // NA, //DLOAD_3, // - - // NA, //ALOAD_0, // - - // NA, //ALOAD_1, // - - // NA, //ALOAD_2, // - - // NA, //ALOAD_3, // - - // -1, //IALOAD, // visitInsn - // 0, //LALOAD, // - - // -1, //FALOAD, // - - // 0, //DALOAD, // - - // -1, //AALOAD, // - - // -1, //BALOAD, // - - // -1, //CALOAD, // - - // -1, //SALOAD, // - - // -1, //ISTORE, // visitVarInsn - // -2, //LSTORE, // - - // -1, //FSTORE, // - - // -2, //DSTORE, // - - // -1, //ASTORE, // - - // NA, //ISTORE_0, // - - // NA, //ISTORE_1, // - - // NA, //ISTORE_2, // - - // NA, //ISTORE_3, // - - // NA, //LSTORE_0, // - - // NA, //LSTORE_1, // - - // NA, //LSTORE_2, // - - // NA, //LSTORE_3, // - - // NA, //FSTORE_0, // - - // NA, //FSTORE_1, // - - // NA, //FSTORE_2, // - - // NA, //FSTORE_3, // - - // NA, //DSTORE_0, // - - // NA, //DSTORE_1, // - - // NA, //DSTORE_2, // - - // NA, //DSTORE_3, // - - // NA, //ASTORE_0, // - - // NA, //ASTORE_1, // - - // NA, //ASTORE_2, // - - // NA, //ASTORE_3, // - - // -3, //IASTORE, // visitInsn - // -4, //LASTORE, // - - // -3, //FASTORE, // - - // -4, //DASTORE, // - - // -3, //AASTORE, // - - // -3, //BASTORE, // - - // -3, //CASTORE, // - - // -3, //SASTORE, // - - // -1, //POP, // - - // -2, //POP2, // - - // 1, //DUP, // - - // 1, //DUP_X1, // - - // 1, //DUP_X2, // - - // 2, //DUP2, // - - // 2, //DUP2_X1, // - - // 2, //DUP2_X2, // - - // 0, //SWAP, // - - // -1, //IADD, // - - // -2, //LADD, // - - // -1, //FADD, // - - // -2, //DADD, // - - // -1, //ISUB, // - - // -2, //LSUB, // - - // -1, //FSUB, // - - // -2, //DSUB, // - - // -1, //IMUL, // - - // -2, //LMUL, // - - // -1, //FMUL, // - - // -2, //DMUL, // - - // -1, //IDIV, // - - // -2, //LDIV, // - - // -1, //FDIV, // - - // -2, //DDIV, // - - // -1, //IREM, // - - // -2, //LREM, // - - // -1, //FREM, // - - // -2, //DREM, // - - // 0, //INEG, // - - // 0, //LNEG, // - - // 0, //FNEG, // - - // 0, //DNEG, // - - // -1, //ISHL, // - - // -1, //LSHL, // - - // -1, //ISHR, // - - // -1, //LSHR, // - - // -1, //IUSHR, // - - // -1, //LUSHR, // - - // -1, //IAND, // - - // -2, //LAND, // - - // -1, //IOR, // - - // -2, //LOR, // - - // -1, //IXOR, // - - // -2, //LXOR, // - - // 0, //IINC, // visitIincInsn - // 1, //I2L, // visitInsn - // 0, //I2F, // - - // 1, //I2D, // - - // -1, //L2I, // - - // -1, //L2F, // - - // 0, //L2D, // - - // 0, //F2I, // - - // 1, //F2L, // - - // 1, //F2D, // - - // -1, //D2I, // - - // 0, //D2L, // - - // -1, //D2F, // - - // 0, //I2B, // - - // 0, //I2C, // - - // 0, //I2S, // - - // -3, //LCMP, // - - // -1, //FCMPL, // - - // -1, //FCMPG, // - - // -3, //DCMPL, // - - // -3, //DCMPG, // - - // -1, //IFEQ, // visitJumpInsn - // -1, //IFNE, // - - // -1, //IFLT, // - - // -1, //IFGE, // - - // -1, //IFGT, // - - // -1, //IFLE, // - - // -2, //IF_ICMPEQ, // - - // -2, //IF_ICMPNE, // - - // -2, //IF_ICMPLT, // - - // -2, //IF_ICMPGE, // - - // -2, //IF_ICMPGT, // - - // -2, //IF_ICMPLE, // - - // -2, //IF_ACMPEQ, // - - // -2, //IF_ACMPNE, // - - // 0, //GOTO, // - - // 1, //JSR, // - - // 0, //RET, // visitVarInsn - // -1, //TABLESWITCH, // visiTableSwitchInsn - // -1, //LOOKUPSWITCH, // visitLookupSwitch - // -1, //IRETURN, // visitInsn - // -2, //LRETURN, // - - // -1, //FRETURN, // - - // -2, //DRETURN, // - - // -1, //ARETURN, // - - // 0, //RETURN, // - - // NA, //GETSTATIC, // visitFieldInsn - // NA, //PUTSTATIC, // - - // NA, //GETFIELD, // - - // NA, //PUTFIELD, // - - // NA, //INVOKEVIRTUAL, // visitMethodInsn - // NA, //INVOKESPECIAL, // - - // NA, //INVOKESTATIC, // - - // NA, //INVOKEINTERFACE, // - - // NA, //UNUSED, // NOT VISITED - // 1, //NEW, // visitTypeInsn - // 0, //NEWARRAY, // visitIntInsn - // 0, //ANEWARRAY, // visitTypeInsn - // 0, //ARRAYLENGTH, // visitInsn - // NA, //ATHROW, // - - // 0, //CHECKCAST, // visitTypeInsn - // 0, //INSTANCEOF, // - - // -1, //MONITORENTER, // visitInsn - // -1, //MONITOREXIT, // - - // NA, //WIDE, // NOT VISITED - // NA, //MULTIANEWARRAY, // visitMultiANewArrayInsn - // -1, //IFNULL, // visitJumpInsn - // -1, //IFNONNULL, // - - // NA, //GOTO_W, // - - // NA, //JSR_W, // - - // }; - // for (i = 0; i < b.length; ++i) { - // System.err.print((char)('E' + b[i])); - // } - // System.err.println(); - } - -/** - * The label (i.e. basic block) to which these input and output stack map - * frames correspond. - */ -Label owner; - -/** - * The input stack map frame locals. - */ -int[] inputLocals; - -/** - * The input stack map frame stack. - */ -int[] inputStack; - -/** - * The output stack map frame locals. - */ -private int[] outputLocals; - -/** - * The output stack map frame stack. - */ -private int[] outputStack; - -/** - * Relative size of the output stack. The exact semantics of this field - * depends on the algorithm that is used. - *

- * When only the maximum stack size is computed, this field is the size of - * the output stack relatively to the top of the input stack. - *

- * When the stack map frames are completely computed, this field is the - * actual number of types in {@link #outputStack}. - */ -private int outputStackTop; - -/** - * Number of types that are initialized in the basic block. - * - * @see #initializations - */ -private int initializationCount; - -/** - * The types that are initialized in the basic block. A constructor - * invocation on an UNINITIALIZED or UNINITIALIZED_THIS type must replace - * every occurence of this type in the local variables and in the - * operand stack. This cannot be done during the first phase of the - * algorithm since, during this phase, the local variables and the operand - * stack are not completely computed. It is therefore necessary to store the - * types on which constructors are invoked in the basic block, in order to - * do this replacement during the second phase of the algorithm, where the - * frames are fully computed. Note that this array can contain types that - * are relative to input locals or to the input stack (see below for the - * description of the algorithm). - */ -private int[] initializations; - -/** - * Returns the output frame local variable type at the given index. - * - * @param local the index of the local that must be returned. - * @return the output frame local variable type at the given index. - */ -private int get(final int local){ - if(outputLocals == null || local >= outputLocals.length) - { - // this local has never been assigned in this basic block, - // so it is still equal to its value in the input frame - return LOCAL | local; - } - else - { - int type = outputLocals[local]; - if(type == 0) - { - // this local has never been assigned in this basic block, - // so it is still equal to its value in the input frame - type = outputLocals[local] = LOCAL | local; - } - return type; - } -} - -/** - * Sets the output frame local variable type at the given index. - * - * @param local the index of the local that must be set. - * @param type the value of the local that must be set. - */ -private void set(final int local, final int type){ - // creates and/or resizes the output local variables array if necessary - if(outputLocals == null) - { - outputLocals = new int[10]; - } - int n = outputLocals.length; - if(local >= n) - { - int[] t = new int[Math.max(local + 1, 2 * n)]; - System.arraycopy(outputLocals, 0, t, 0, n); - outputLocals = t; - } - // sets the local variable - outputLocals[local] = type; -} - -/** - * Pushes a new type onto the output frame stack. - * - * @param type the type that must be pushed. - */ -private void push(final int type){ - // creates and/or resizes the output stack array if necessary - if(outputStack == null) - { - outputStack = new int[10]; - } - int n = outputStack.length; - if(outputStackTop >= n) - { - int[] t = new int[Math.max(outputStackTop + 1, 2 * n)]; - System.arraycopy(outputStack, 0, t, 0, n); - outputStack = t; - } - // pushes the type on the output stack - outputStack[outputStackTop++] = type; - // updates the maximun height reached by the output stack, if needed - int top = owner.inputStackTop + outputStackTop; - if(top > owner.outputStackMax) - { - owner.outputStackMax = top; - } -} - -/** - * Pushes a new type onto the output frame stack. - * - * @param cw the ClassWriter to which this label belongs. - * @param desc the descriptor of the type to be pushed. Can also be a method - * descriptor (in this case this method pushes its return type onto - * the output frame stack). - */ -private void push(final ClassWriter cw, final String desc){ - int type = type(cw, desc); - if(type != 0) - { - push(type); - if(type == LONG || type == DOUBLE) - { - push(TOP); - } - } -} - -/** - * Returns the int encoding of the given type. - * - * @param cw the ClassWriter to which this label belongs. - * @param desc a type descriptor. - * @return the int encoding of the given type. - */ -private int type(final ClassWriter cw, final String desc){ - String t; - int index = desc.charAt(0) == '(' ? desc.indexOf(')') + 1 : 0; - switch(desc.charAt(index)) - { - case'V': - return 0; - case'Z': - case'C': - case'B': - case'S': - case'I': - return INTEGER; - case'F': - return FLOAT; - case'J': - return LONG; - case'D': - return DOUBLE; - case'L': - // stores the internal name, not the descriptor! - t = desc.substring(index + 1, desc.length() - 1); - return OBJECT | cw.addType(t); - // case '[': - default: - // extracts the dimensions and the element type - int data; - int dims = index + 1; - while(desc.charAt(dims) == '[') - { - ++dims; - } - switch(desc.charAt(dims)) - { - case'Z': - data = BOOLEAN; - break; - case'C': - data = CHAR; - break; - case'B': - data = BYTE; - break; - case'S': - data = SHORT; - break; - case'I': - data = INTEGER; - break; - case'F': - data = FLOAT; - break; - case'J': - data = LONG; - break; - case'D': - data = DOUBLE; - break; - // case 'L': - default: - // stores the internal name, not the descriptor - t = desc.substring(dims + 1, desc.length() - 1); - data = OBJECT | cw.addType(t); - } - return (dims - index) << 28 | data; - } -} - -/** - * Pops a type from the output frame stack and returns its value. - * - * @return the type that has been popped from the output frame stack. - */ -private int pop(){ - if(outputStackTop > 0) - { - return outputStack[--outputStackTop]; - } - else - { - // if the output frame stack is empty, pops from the input stack - return STACK | -(--owner.inputStackTop); - } -} - -/** - * Pops the given number of types from the output frame stack. - * - * @param elements the number of types that must be popped. - */ -private void pop(final int elements){ - if(outputStackTop >= elements) - { - outputStackTop -= elements; - } - else - { - // if the number of elements to be popped is greater than the number - // of elements in the output stack, clear it, and pops the remaining - // elements from the input stack. - owner.inputStackTop -= elements - outputStackTop; - outputStackTop = 0; - } -} - -/** - * Pops a type from the output frame stack. - * - * @param desc the descriptor of the type to be popped. Can also be a method - * descriptor (in this case this method pops the types corresponding - * to the method arguments). - */ -private void pop(final String desc){ - char c = desc.charAt(0); - if(c == '(') - { - pop((MethodWriter.getArgumentsAndReturnSizes(desc) >> 2) - 1); - } - else if(c == 'J' || c == 'D') - { - pop(2); - } - else - { - pop(1); - } -} - -/** - * Adds a new type to the list of types on which a constructor is invoked in - * the basic block. - * - * @param var a type on a which a constructor is invoked. - */ -private void init(final int var){ - // creates and/or resizes the initializations array if necessary - if(initializations == null) - { - initializations = new int[2]; - } - int n = initializations.length; - if(initializationCount >= n) - { - int[] t = new int[Math.max(initializationCount + 1, 2 * n)]; - System.arraycopy(initializations, 0, t, 0, n); - initializations = t; - } - // stores the type to be initialized - initializations[initializationCount++] = var; -} - -/** - * Replaces the given type with the appropriate type if it is one of the - * types on which a constructor is invoked in the basic block. - * - * @param cw the ClassWriter to which this label belongs. - * @param t a type - * @return t or, if t is one of the types on which a constructor is invoked - * in the basic block, the type corresponding to this constructor. - */ -private int init(final ClassWriter cw, final int t){ - int s; - if(t == UNINITIALIZED_THIS) - { - s = OBJECT | cw.addType(cw.thisName); - } - else if((t & (DIM | BASE_KIND)) == UNINITIALIZED) - { - String type = cw.typeTable[t & BASE_VALUE].strVal1; - s = OBJECT | cw.addType(type); - } - else - { - return t; - } - for(int j = 0; j < initializationCount; ++j) - { - int u = initializations[j]; - int dim = u & DIM; - int kind = u & KIND; - if(kind == LOCAL) - { - u = dim + inputLocals[u & VALUE]; - } - else if(kind == STACK) - { - u = dim + inputStack[inputStack.length - (u & VALUE)]; - } - if(t == u) - { - return s; - } - } - return t; -} - -/** - * Initializes the input frame of the first basic block from the method - * descriptor. - * - * @param cw the ClassWriter to which this label belongs. - * @param access the access flags of the method to which this label belongs. - * @param args the formal parameter types of this method. - * @param maxLocals the maximum number of local variables of this method. - */ -void initInputFrame( - final ClassWriter cw, - final int access, - final Type[] args, - final int maxLocals){ - inputLocals = new int[maxLocals]; - inputStack = new int[0]; - int i = 0; - if((access & Opcodes.ACC_STATIC) == 0) - { - if((access & MethodWriter.ACC_CONSTRUCTOR) == 0) - { - inputLocals[i++] = OBJECT | cw.addType(cw.thisName); - } - else - { - inputLocals[i++] = UNINITIALIZED_THIS; - } - } - for(int j = 0; j < args.length; ++j) - { - int t = type(cw, args[j].getDescriptor()); - inputLocals[i++] = t; - if(t == LONG || t == DOUBLE) - { - inputLocals[i++] = TOP; - } - } - while(i < maxLocals) - { - inputLocals[i++] = TOP; - } -} - -/** - * Simulates the action of the given instruction on the output stack frame. - * - * @param opcode the opcode of the instruction. - * @param arg the operand of the instruction, if any. - * @param cw the class writer to which this label belongs. - * @param item the operand of the instructions, if any. - */ -void execute( - final int opcode, - final int arg, - final ClassWriter cw, - final Item item){ - int t1, t2, t3, t4; - switch(opcode) - { - case Opcodes.NOP: - case Opcodes.INEG: - case Opcodes.LNEG: - case Opcodes.FNEG: - case Opcodes.DNEG: - case Opcodes.I2B: - case Opcodes.I2C: - case Opcodes.I2S: - case Opcodes.GOTO: - case Opcodes.RETURN: - break; - case Opcodes.ACONST_NULL: - push(NULL); - break; - case Opcodes.ICONST_M1: - case Opcodes.ICONST_0: - case Opcodes.ICONST_1: - case Opcodes.ICONST_2: - case Opcodes.ICONST_3: - case Opcodes.ICONST_4: - case Opcodes.ICONST_5: - case Opcodes.BIPUSH: - case Opcodes.SIPUSH: - case Opcodes.ILOAD: - push(INTEGER); - break; - case Opcodes.LCONST_0: - case Opcodes.LCONST_1: - case Opcodes.LLOAD: - push(LONG); - push(TOP); - break; - case Opcodes.FCONST_0: - case Opcodes.FCONST_1: - case Opcodes.FCONST_2: - case Opcodes.FLOAD: - push(FLOAT); - break; - case Opcodes.DCONST_0: - case Opcodes.DCONST_1: - case Opcodes.DLOAD: - push(DOUBLE); - push(TOP); - break; - case Opcodes.LDC: - switch(item.type) - { - case ClassWriter.INT: - push(INTEGER); - break; - case ClassWriter.LONG: - push(LONG); - push(TOP); - break; - case ClassWriter.FLOAT: - push(FLOAT); - break; - case ClassWriter.DOUBLE: - push(DOUBLE); - push(TOP); - break; - case ClassWriter.CLASS: - push(OBJECT | cw.addType("java/lang/Class")); - break; - // case ClassWriter.STR: - default: - push(OBJECT | cw.addType("java/lang/String")); - } - break; - case Opcodes.ALOAD: - push(get(arg)); - break; - case Opcodes.IALOAD: - case Opcodes.BALOAD: - case Opcodes.CALOAD: - case Opcodes.SALOAD: - pop(2); - push(INTEGER); - break; - case Opcodes.LALOAD: - case Opcodes.D2L: - pop(2); - push(LONG); - push(TOP); - break; - case Opcodes.FALOAD: - pop(2); - push(FLOAT); - break; - case Opcodes.DALOAD: - case Opcodes.L2D: - pop(2); - push(DOUBLE); - push(TOP); - break; - case Opcodes.AALOAD: - pop(1); - t1 = pop(); - push(ELEMENT_OF + t1); - break; - case Opcodes.ISTORE: - case Opcodes.FSTORE: - case Opcodes.ASTORE: - t1 = pop(); - set(arg, t1); - if(arg > 0) - { - t2 = get(arg - 1); - // if t2 is of kind STACK or LOCAL we cannot know its size! - if(t2 == LONG || t2 == DOUBLE) - { - set(arg - 1, TOP); - } - } - break; - case Opcodes.LSTORE: - case Opcodes.DSTORE: - pop(1); - t1 = pop(); - set(arg, t1); - set(arg + 1, TOP); - if(arg > 0) - { - t2 = get(arg - 1); - // if t2 is of kind STACK or LOCAL we cannot know its size! - if(t2 == LONG || t2 == DOUBLE) - { - set(arg - 1, TOP); - } - } - break; - case Opcodes.IASTORE: - case Opcodes.BASTORE: - case Opcodes.CASTORE: - case Opcodes.SASTORE: - case Opcodes.FASTORE: - case Opcodes.AASTORE: - pop(3); - break; - case Opcodes.LASTORE: - case Opcodes.DASTORE: - pop(4); - break; - case Opcodes.POP: - case Opcodes.IFEQ: - case Opcodes.IFNE: - case Opcodes.IFLT: - case Opcodes.IFGE: - case Opcodes.IFGT: - case Opcodes.IFLE: - case Opcodes.IRETURN: - case Opcodes.FRETURN: - case Opcodes.ARETURN: - case Opcodes.TABLESWITCH: - case Opcodes.LOOKUPSWITCH: - case Opcodes.ATHROW: - case Opcodes.MONITORENTER: - case Opcodes.MONITOREXIT: - case Opcodes.IFNULL: - case Opcodes.IFNONNULL: - pop(1); - break; - case Opcodes.POP2: - case Opcodes.IF_ICMPEQ: - case Opcodes.IF_ICMPNE: - case Opcodes.IF_ICMPLT: - case Opcodes.IF_ICMPGE: - case Opcodes.IF_ICMPGT: - case Opcodes.IF_ICMPLE: - case Opcodes.IF_ACMPEQ: - case Opcodes.IF_ACMPNE: - case Opcodes.LRETURN: - case Opcodes.DRETURN: - pop(2); - break; - case Opcodes.DUP: - t1 = pop(); - push(t1); - push(t1); - break; - case Opcodes.DUP_X1: - t1 = pop(); - t2 = pop(); - push(t1); - push(t2); - push(t1); - break; - case Opcodes.DUP_X2: - t1 = pop(); - t2 = pop(); - t3 = pop(); - push(t1); - push(t3); - push(t2); - push(t1); - break; - case Opcodes.DUP2: - t1 = pop(); - t2 = pop(); - push(t2); - push(t1); - push(t2); - push(t1); - break; - case Opcodes.DUP2_X1: - t1 = pop(); - t2 = pop(); - t3 = pop(); - push(t2); - push(t1); - push(t3); - push(t2); - push(t1); - break; - case Opcodes.DUP2_X2: - t1 = pop(); - t2 = pop(); - t3 = pop(); - t4 = pop(); - push(t2); - push(t1); - push(t4); - push(t3); - push(t2); - push(t1); - break; - case Opcodes.SWAP: - t1 = pop(); - t2 = pop(); - push(t1); - push(t2); - break; - case Opcodes.IADD: - case Opcodes.ISUB: - case Opcodes.IMUL: - case Opcodes.IDIV: - case Opcodes.IREM: - case Opcodes.IAND: - case Opcodes.IOR: - case Opcodes.IXOR: - case Opcodes.ISHL: - case Opcodes.ISHR: - case Opcodes.IUSHR: - case Opcodes.L2I: - case Opcodes.D2I: - case Opcodes.FCMPL: - case Opcodes.FCMPG: - pop(2); - push(INTEGER); - break; - case Opcodes.LADD: - case Opcodes.LSUB: - case Opcodes.LMUL: - case Opcodes.LDIV: - case Opcodes.LREM: - case Opcodes.LAND: - case Opcodes.LOR: - case Opcodes.LXOR: - pop(4); - push(LONG); - push(TOP); - break; - case Opcodes.FADD: - case Opcodes.FSUB: - case Opcodes.FMUL: - case Opcodes.FDIV: - case Opcodes.FREM: - case Opcodes.L2F: - case Opcodes.D2F: - pop(2); - push(FLOAT); - break; - case Opcodes.DADD: - case Opcodes.DSUB: - case Opcodes.DMUL: - case Opcodes.DDIV: - case Opcodes.DREM: - pop(4); - push(DOUBLE); - push(TOP); - break; - case Opcodes.LSHL: - case Opcodes.LSHR: - case Opcodes.LUSHR: - pop(3); - push(LONG); - push(TOP); - break; - case Opcodes.IINC: - set(arg, INTEGER); - break; - case Opcodes.I2L: - case Opcodes.F2L: - pop(1); - push(LONG); - push(TOP); - break; - case Opcodes.I2F: - pop(1); - push(FLOAT); - break; - case Opcodes.I2D: - case Opcodes.F2D: - pop(1); - push(DOUBLE); - push(TOP); - break; - case Opcodes.F2I: - case Opcodes.ARRAYLENGTH: - case Opcodes.INSTANCEOF: - pop(1); - push(INTEGER); - break; - case Opcodes.LCMP: - case Opcodes.DCMPL: - case Opcodes.DCMPG: - pop(4); - push(INTEGER); - break; - case Opcodes.JSR: - case Opcodes.RET: - throw new RuntimeException("JSR/RET are not supported with computeFrames option"); - case Opcodes.GETSTATIC: - push(cw, item.strVal3); - break; - case Opcodes.PUTSTATIC: - pop(item.strVal3); - break; - case Opcodes.GETFIELD: - pop(1); - push(cw, item.strVal3); - break; - case Opcodes.PUTFIELD: - pop(item.strVal3); - pop(); - break; - case Opcodes.INVOKEVIRTUAL: - case Opcodes.INVOKESPECIAL: - case Opcodes.INVOKESTATIC: - case Opcodes.INVOKEINTERFACE: - pop(item.strVal3); - if(opcode != Opcodes.INVOKESTATIC) - { - t1 = pop(); - if(opcode == Opcodes.INVOKESPECIAL - && item.strVal2.charAt(0) == '<') - { - init(t1); - } - } - push(cw, item.strVal3); - break; - case Opcodes.NEW: - push(UNINITIALIZED | cw.addUninitializedType(item.strVal1, arg)); - break; - case Opcodes.NEWARRAY: - pop(); - switch(arg) - { - case Opcodes.T_BOOLEAN: - push(ARRAY_OF | BOOLEAN); - break; - case Opcodes.T_CHAR: - push(ARRAY_OF | CHAR); - break; - case Opcodes.T_BYTE: - push(ARRAY_OF | BYTE); - break; - case Opcodes.T_SHORT: - push(ARRAY_OF | SHORT); - break; - case Opcodes.T_INT: - push(ARRAY_OF | INTEGER); - break; - case Opcodes.T_FLOAT: - push(ARRAY_OF | FLOAT); - break; - case Opcodes.T_DOUBLE: - push(ARRAY_OF | DOUBLE); - break; - // case Opcodes.T_LONG: - default: - push(ARRAY_OF | LONG); - break; - } - break; - case Opcodes.ANEWARRAY: - String s = item.strVal1; - pop(); - if(s.charAt(0) == '[') - { - push(cw, "[" + s); - } - else - { - push(ARRAY_OF | OBJECT | cw.addType(s)); - } - break; - case Opcodes.CHECKCAST: - s = item.strVal1; - pop(); - if(s.charAt(0) == '[') - { - push(cw, s); - } - else - { - push(OBJECT | cw.addType(s)); - } - break; - // case Opcodes.MULTIANEWARRAY: - default: - pop(arg); - push(cw, item.strVal1); - break; - } -} - -/** - * Merges the input frame of the given basic block with the input and output - * frames of this basic block. Returns true if the input frame of - * the given label has been changed by this operation. - * - * @param cw the ClassWriter to which this label belongs. - * @param frame the basic block whose input frame must be updated. - * @param edge the kind of the {@link Edge} between this label and 'label'. - * See {@link Edge#info}. - * @return true if the input frame of the given label has been - * changed by this operation. - */ -boolean merge(final ClassWriter cw, final Frame frame, final int edge){ - boolean changed = false; - int i, s, dim, kind, t; - - int nLocal = inputLocals.length; - int nStack = inputStack.length; - if(frame.inputLocals == null) - { - frame.inputLocals = new int[nLocal]; - changed = true; - } - - for(i = 0; i < nLocal; ++i) - { - if(outputLocals != null && i < outputLocals.length) - { - s = outputLocals[i]; - if(s == 0) - { - t = inputLocals[i]; - } - else - { - dim = s & DIM; - kind = s & KIND; - if(kind == LOCAL) - { - t = dim + inputLocals[s & VALUE]; - } - else if(kind == STACK) - { - t = dim + inputStack[nStack - (s & VALUE)]; - } - else - { - t = s; - } - } - } - else - { - t = inputLocals[i]; - } - if(initializations != null) - { - t = init(cw, t); - } - changed |= merge(cw, t, frame.inputLocals, i); - } - - if(edge > 0) - { - for(i = 0; i < nLocal; ++i) - { - t = inputLocals[i]; - changed |= merge(cw, t, frame.inputLocals, i); - } - if(frame.inputStack == null) - { - frame.inputStack = new int[1]; - changed = true; - } - changed |= merge(cw, edge, frame.inputStack, 0); - return changed; - } - - int nInputStack = inputStack.length + owner.inputStackTop; - if(frame.inputStack == null) - { - frame.inputStack = new int[nInputStack + outputStackTop]; - changed = true; - } - - for(i = 0; i < nInputStack; ++i) - { - t = inputStack[i]; - if(initializations != null) - { - t = init(cw, t); - } - changed |= merge(cw, t, frame.inputStack, i); - } - for(i = 0; i < outputStackTop; ++i) - { - s = outputStack[i]; - dim = s & DIM; - kind = s & KIND; - if(kind == LOCAL) - { - t = dim + inputLocals[s & VALUE]; - } - else if(kind == STACK) - { - t = dim + inputStack[nStack - (s & VALUE)]; - } - else - { - t = s; - } - if(initializations != null) - { - t = init(cw, t); - } - changed |= merge(cw, t, frame.inputStack, nInputStack + i); - } - return changed; -} - -/** - * Merges the type at the given index in the given type array with the given - * type. Returns true if the type array has been modified by this - * operation. - * - * @param cw the ClassWriter to which this label belongs. - * @param t the type with which the type array element must be merged. - * @param types an array of types. - * @param index the index of the type that must be merged in 'types'. - * @return true if the type array has been modified by this - * operation. - */ -private boolean merge( - final ClassWriter cw, - int t, - final int[] types, - final int index){ - int u = types[index]; - if(u == t) - { - // if the types are equal, merge(u,t)=u, so there is no change - return false; - } - if((t & ~DIM) == NULL) - { - if(u == NULL) - { - return false; - } - t = NULL; - } - if(u == 0) - { - // if types[index] has never been assigned, merge(u,t)=t - types[index] = t; - return true; - } - int v; - if((u & BASE_KIND) == OBJECT || (u & DIM) != 0) - { - // if u is a reference type of any dimension - if(t == NULL) - { - // if t is the NULL type, merge(u,t)=u, so there is no change - return false; - } - else if((t & (DIM | BASE_KIND)) == (u & (DIM | BASE_KIND))) - { - if((u & BASE_KIND) == OBJECT) - { - // if t is also a reference type, and if u and t have the - // same dimension merge(u,t) = dim(t) | common parent of the - // element types of u and t - v = (t & DIM) | OBJECT - | cw.getMergedType(t & BASE_VALUE, u & BASE_VALUE); - } - else - { - // if u and t are array types, but not with the same element - // type, merge(u,t)=java/lang/Object - v = OBJECT | cw.addType("java/lang/Object"); - } - } - else if((t & BASE_KIND) == OBJECT || (t & DIM) != 0) - { - // if t is any other reference or array type, - // merge(u,t)=java/lang/Object - v = OBJECT | cw.addType("java/lang/Object"); - } - else - { - // if t is any other type, merge(u,t)=TOP - v = TOP; - } - } - else if(u == NULL) - { - // if u is the NULL type, merge(u,t)=t, - // or TOP if t is not a reference type - v = (t & BASE_KIND) == OBJECT || (t & DIM) != 0 ? t : TOP; - } - else - { - // if u is any other type, merge(u,t)=TOP whatever t - v = TOP; - } - if(u != v) - { - types[index] = v; - return true; - } - return false; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/Handler.java --- a/src/clojure/asm/Handler.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,70 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * Information about an exception handler block. - * - * @author Eric Bruneton - */ -class Handler{ - -/** - * Beginning of the exception handler's scope (inclusive). - */ -Label start; - -/** - * End of the exception handler's scope (exclusive). - */ -Label end; - -/** - * Beginning of the exception handler's code. - */ -Label handler; - -/** - * Internal name of the type of exceptions handled by this handler, or - * null to catch any exceptions. - */ -String desc; - -/** - * Constant pool index of the internal name of the type of exceptions - * handled by this handler, or 0 to catch any exceptions. - */ -int type; - -/** - * Next exception handler block info. - */ -Handler next; -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/Item.java --- a/src/clojure/asm/Item.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,258 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * A constant pool item. Constant pool items can be created with the 'newXXX' - * methods in the {@link ClassWriter} class. - * - * @author Eric Bruneton - */ -final class Item{ - -/** - * Index of this item in the constant pool. - */ -int index; - -/** - * Type of this constant pool item. A single class is used to represent all - * constant pool item types, in order to minimize the bytecode size of this - * package. The value of this field is one of {@link ClassWriter#INT}, - * {@link ClassWriter#LONG}, {@link ClassWriter#FLOAT}, - * {@link ClassWriter#DOUBLE}, {@link ClassWriter#UTF8}, - * {@link ClassWriter#STR}, {@link ClassWriter#CLASS}, - * {@link ClassWriter#NAME_TYPE}, {@link ClassWriter#FIELD}, - * {@link ClassWriter#METH}, {@link ClassWriter#IMETH}. - *

- * Special Item types are used for Items that are stored in the ClassWriter - * {@link ClassWriter#typeTable}, instead of the constant pool, in order to - * avoid clashes with normal constant pool items in the ClassWriter constant - * pool's hash table. These special item types are - * {@link ClassWriter#TYPE_NORMAL}, {@link ClassWriter#TYPE_UNINIT} and - * {@link ClassWriter#TYPE_MERGED}. - */ -int type; - -/** - * Value of this item, for an integer item. - */ -int intVal; - -/** - * Value of this item, for a long item. - */ -long longVal; - -/** - * First part of the value of this item, for items that do not hold a - * primitive value. - */ -String strVal1; - -/** - * Second part of the value of this item, for items that do not hold a - * primitive value. - */ -String strVal2; - -/** - * Third part of the value of this item, for items that do not hold a - * primitive value. - */ -String strVal3; - -/** - * The hash code value of this constant pool item. - */ -int hashCode; - -/** - * Link to another constant pool item, used for collision lists in the - * constant pool's hash table. - */ -Item next; - -/** - * Constructs an uninitialized {@link Item}. - */ -Item(){ -} - -/** - * Constructs an uninitialized {@link Item} for constant pool element at - * given position. - * - * @param index index of the item to be constructed. - */ -Item(final int index){ - this.index = index; -} - -/** - * Constructs a copy of the given item. - * - * @param index index of the item to be constructed. - * @param i the item that must be copied into the item to be constructed. - */ -Item(final int index, final Item i){ - this.index = index; - type = i.type; - intVal = i.intVal; - longVal = i.longVal; - strVal1 = i.strVal1; - strVal2 = i.strVal2; - strVal3 = i.strVal3; - hashCode = i.hashCode; -} - -/** - * Sets this item to an integer item. - * - * @param intVal the value of this item. - */ -void set(final int intVal){ - this.type = ClassWriter.INT; - this.intVal = intVal; - this.hashCode = 0x7FFFFFFF & (type + intVal); -} - -/** - * Sets this item to a long item. - * - * @param longVal the value of this item. - */ -void set(final long longVal){ - this.type = ClassWriter.LONG; - this.longVal = longVal; - this.hashCode = 0x7FFFFFFF & (type + (int) longVal); -} - -/** - * Sets this item to a float item. - * - * @param floatVal the value of this item. - */ -void set(final float floatVal){ - this.type = ClassWriter.FLOAT; - this.intVal = Float.floatToRawIntBits(floatVal); - this.hashCode = 0x7FFFFFFF & (type + (int) floatVal); -} - -/** - * Sets this item to a double item. - * - * @param doubleVal the value of this item. - */ -void set(final double doubleVal){ - this.type = ClassWriter.DOUBLE; - this.longVal = Double.doubleToRawLongBits(doubleVal); - this.hashCode = 0x7FFFFFFF & (type + (int) doubleVal); -} - -/** - * Sets this item to an item that do not hold a primitive value. - * - * @param type the type of this item. - * @param strVal1 first part of the value of this item. - * @param strVal2 second part of the value of this item. - * @param strVal3 third part of the value of this item. - */ -void set( - final int type, - final String strVal1, - final String strVal2, - final String strVal3){ - this.type = type; - this.strVal1 = strVal1; - this.strVal2 = strVal2; - this.strVal3 = strVal3; - switch(type) - { - case ClassWriter.UTF8: - case ClassWriter.STR: - case ClassWriter.CLASS: - case ClassWriter.TYPE_NORMAL: - hashCode = 0x7FFFFFFF & (type + strVal1.hashCode()); - return; - case ClassWriter.NAME_TYPE: - hashCode = 0x7FFFFFFF & (type + strVal1.hashCode() - * strVal2.hashCode()); - return; - // ClassWriter.FIELD: - // ClassWriter.METH: - // ClassWriter.IMETH: - default: - hashCode = 0x7FFFFFFF & (type + strVal1.hashCode() - * strVal2.hashCode() * strVal3.hashCode()); - } -} - -/** - * Indicates if the given item is equal to this one. - * - * @param i the item to be compared to this one. - * @return true if the given item if equal to this one, - * false otherwise. - */ -boolean isEqualTo(final Item i){ - if(i.type == type) - { - switch(type) - { - case ClassWriter.INT: - case ClassWriter.FLOAT: - return i.intVal == intVal; - case ClassWriter.TYPE_MERGED: - case ClassWriter.LONG: - case ClassWriter.DOUBLE: - return i.longVal == longVal; - case ClassWriter.UTF8: - case ClassWriter.STR: - case ClassWriter.CLASS: - case ClassWriter.TYPE_NORMAL: - return i.strVal1.equals(strVal1); - case ClassWriter.TYPE_UNINIT: - return i.intVal == intVal && i.strVal1.equals(strVal1); - case ClassWriter.NAME_TYPE: - return i.strVal1.equals(strVal1) - && i.strVal2.equals(strVal2); - // ClassWriter.FIELD: - // ClassWriter.METH: - // ClassWriter.IMETH: - default: - return i.strVal1.equals(strVal1) - && i.strVal2.equals(strVal2) - && i.strVal3.equals(strVal3); - } - } - return false; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/Label.java --- a/src/clojure/asm/Label.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,437 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * A label represents a position in the bytecode of a method. Labels are used - * for jump, goto, and switch instructions, and for try catch blocks. - * - * @author Eric Bruneton - */ -public class Label{ - -/** - * Indicates if this label is only used for debug attributes. Such a label - * is not the start of a basic block, the target of a jump instruction, or - * an exception handler. It can be safely ignored in control flow graph - * analysis algorithms (for optimization purposes). - */ -final static int DEBUG = 1; - -/** - * Indicates if the position of this label is known. - */ -final static int RESOLVED = 2; - -/** - * Indicates if this label has been updated, after instruction resizing. - */ -final static int RESIZED = 4; - -/** - * Indicates if this basic block has been pushed in the basic block stack. - * See {@link MethodWriter#visitMaxs visitMaxs}. - */ -final static int PUSHED = 8; - -/** - * Indicates if this label is the target of a jump instruction, or the start - * of an exception handler. - */ -final static int TARGET = 16; - -/** - * Indicates if a stack map frame must be stored for this label. - */ -final static int STORE = 32; - -/** - * Indicates if this label corresponds to a reachable basic block. - */ -final static int REACHABLE = 64; - -/** - * Indicates if this basic block ends with a JSR instruction. - */ -final static int JSR = 128; - -/** - * Indicates if this basic block ends with a RET instruction. - */ -final static int RET = 256; - -/** - * Field used to associate user information to a label. - */ -public Object info; - -/** - * Flags that indicate the status of this label. - * - * @see #DEBUG - * @see #RESOLVED - * @see #RESIZED - * @see #PUSHED - * @see #TARGET - * @see #STORE - * @see #REACHABLE - * @see #JSR - * @see #RET - */ -int status; - -/** - * The line number corresponding to this label, if known. - */ -int line; - -/** - * The position of this label in the code, if known. - */ -int position; - -/** - * Number of forward references to this label, times two. - */ -private int referenceCount; - -/** - * Informations about forward references. Each forward reference is - * described by two consecutive integers in this array: the first one is the - * position of the first byte of the bytecode instruction that contains the - * forward reference, while the second is the position of the first byte of - * the forward reference itself. In fact the sign of the first integer - * indicates if this reference uses 2 or 4 bytes, and its absolute value - * gives the position of the bytecode instruction. - */ -private int[] srcAndRefPositions; - -// ------------------------------------------------------------------------ - -/* - * Fields for the control flow and data flow graph analysis algorithms (used - * to compute the maximum stack size or the stack map frames). A control - * flow graph contains one node per "basic block", and one edge per "jump" - * from one basic block to another. Each node (i.e., each basic block) is - * represented by the Label object that corresponds to the first instruction - * of this basic block. Each node also stores the list of its successors in - * the graph, as a linked list of Edge objects. - * - * The control flow analysis algorithms used to compute the maximum stack - * size or the stack map frames are similar and use two steps. The first - * step, during the visit of each instruction, builds information about the - * state of the local variables and the operand stack at the end of each - * basic block, called the "output frame", relatively to the frame - * state at the beginning of the basic block, which is called the "input - * frame", and which is unknown during this step. The second step, - * in {@link MethodWriter#visitMaxs}, is a fix point algorithm that - * computes information about the input frame of each basic block, from the - * input state of the first basic block (known from the method signature), - * and by the using the previously computed relative output frames. - * - * The algorithm used to compute the maximum stack size only computes the - * relative output and absolute input stack heights, while the algorithm - * used to compute stack map frames computes relative output frames and - * absolute input frames. - */ - -/** - * Start of the output stack relatively to the input stack. The exact - * semantics of this field depends on the algorithm that is used. - *

- * When only the maximum stack size is computed, this field is the number of - * elements in the input stack. - *

- * When the stack map frames are completely computed, this field is the - * offset of the first output stack element relatively to the top of the - * input stack. This offset is always negative or null. A null offset means - * that the output stack must be appended to the input stack. A -n offset - * means that the first n output stack elements must replace the top n input - * stack elements, and that the other elements must be appended to the input - * stack. - */ -int inputStackTop; - -/** - * Maximum height reached by the output stack, relatively to the top of the - * input stack. This maximum is always positive or null. - */ -int outputStackMax; - -/** - * Information about the input and output stack map frames of this basic - * block. This field is only used when {@link ClassWriter#COMPUTE_FRAMES} - * option is used. - */ -Frame frame; - -/** - * The successor of this label, in the order they are visited. This linked - * list does not include labels used for debug info only. If - * {@link ClassWriter#COMPUTE_FRAMES} option is used then, in addition, it - * does not contain successive labels that denote the same bytecode position - * (in this case only the first label appears in this list). - */ -Label successor; - -/** - * The successors of this node in the control flow graph. These successors - * are stored in a linked list of {@link Edge Edge} objects, linked to each - * other by their {@link Edge#next} field. - */ -Edge successors; - -/** - * The next basic block in the basic block stack. This stack is used in the - * main loop of the fix point algorithm used in the second step of the - * control flow analysis algorithms. - * - * @see MethodWriter#visitMaxs - */ -Label next; - -// ------------------------------------------------------------------------ -// Constructor -// ------------------------------------------------------------------------ - -/** - * Constructs a new label. - */ -public Label(){ -} - -/** - * Constructs a new label. - * - * @param debug if this label is only used for debug attributes. - */ -Label(final boolean debug){ - this.status = debug ? DEBUG : 0; -} - -// ------------------------------------------------------------------------ -// Methods to compute offsets and to manage forward references -// ------------------------------------------------------------------------ - -/** - * Returns the offset corresponding to this label. This offset is computed - * from the start of the method's bytecode. This method is intended for - * {@link Attribute} sub classes, and is normally not needed by class - * generators or adapters. - * - * @return the offset corresponding to this label. - * @throws IllegalStateException if this label is not resolved yet. - */ -public int getOffset(){ - if((status & RESOLVED) == 0) - { - throw new IllegalStateException("Label offset position has not been resolved yet"); - } - return position; -} - -/** - * Puts a reference to this label in the bytecode of a method. If the - * position of the label is known, the offset is computed and written - * directly. Otherwise, a null offset is written and a new forward reference - * is declared for this label. - * - * @param owner the code writer that calls this method. - * @param out the bytecode of the method. - * @param source the position of first byte of the bytecode instruction that - * contains this label. - * @param wideOffset true if the reference must be stored in 4 - * bytes, or false if it must be stored with 2 bytes. - * @throws IllegalArgumentException if this label has not been created by - * the given code writer. - */ -void put( - final MethodWriter owner, - final ByteVector out, - final int source, - final boolean wideOffset){ - if((status & RESOLVED) != 0) - { - if(wideOffset) - { - out.putInt(position - source); - } - else - { - out.putShort(position - source); - } - } - else - { - if(wideOffset) - { - addReference(-1 - source, out.length); - out.putInt(-1); - } - else - { - addReference(source, out.length); - out.putShort(-1); - } - } -} - -/** - * Adds a forward reference to this label. This method must be called only - * for a true forward reference, i.e. only if this label is not resolved - * yet. For backward references, the offset of the reference can be, and - * must be, computed and stored directly. - * - * @param sourcePosition the position of the referencing instruction. This - * position will be used to compute the offset of this forward - * reference. - * @param referencePosition the position where the offset for this forward - * reference must be stored. - */ -private void addReference( - final int sourcePosition, - final int referencePosition){ - if(srcAndRefPositions == null) - { - srcAndRefPositions = new int[6]; - } - if(referenceCount >= srcAndRefPositions.length) - { - int[] a = new int[srcAndRefPositions.length + 6]; - System.arraycopy(srcAndRefPositions, - 0, - a, - 0, - srcAndRefPositions.length); - srcAndRefPositions = a; - } - srcAndRefPositions[referenceCount++] = sourcePosition; - srcAndRefPositions[referenceCount++] = referencePosition; -} - -/** - * Resolves all forward references to this label. This method must be called - * when this label is added to the bytecode of the method, i.e. when its - * position becomes known. This method fills in the blanks that where left - * in the bytecode by each forward reference previously added to this label. - * - * @param owner the code writer that calls this method. - * @param position the position of this label in the bytecode. - * @param data the bytecode of the method. - * @return true if a blank that was left for this label was to - * small to store the offset. In such a case the corresponding jump - * instruction is replaced with a pseudo instruction (using unused - * opcodes) using an unsigned two bytes offset. These pseudo - * instructions will need to be replaced with true instructions with - * wider offsets (4 bytes instead of 2). This is done in - * {@link MethodWriter#resizeInstructions}. - * @throws IllegalArgumentException if this label has already been resolved, - * or if it has not been created by the given code writer. - */ -boolean resolve( - final MethodWriter owner, - final int position, - final byte[] data){ - boolean needUpdate = false; - this.status |= RESOLVED; - this.position = position; - int i = 0; - while(i < referenceCount) - { - int source = srcAndRefPositions[i++]; - int reference = srcAndRefPositions[i++]; - int offset; - if(source >= 0) - { - offset = position - source; - if(offset < Short.MIN_VALUE || offset > Short.MAX_VALUE) - { - /* - * changes the opcode of the jump instruction, in order to - * be able to find it later (see resizeInstructions in - * MethodWriter). These temporary opcodes are similar to - * jump instruction opcodes, except that the 2 bytes offset - * is unsigned (and can therefore represent values from 0 to - * 65535, which is sufficient since the size of a method is - * limited to 65535 bytes). - */ - int opcode = data[reference - 1] & 0xFF; - if(opcode <= Opcodes.JSR) - { - // changes IFEQ ... JSR to opcodes 202 to 217 - data[reference - 1] = (byte) (opcode + 49); - } - else - { - // changes IFNULL and IFNONNULL to opcodes 218 and 219 - data[reference - 1] = (byte) (opcode + 20); - } - needUpdate = true; - } - data[reference++] = (byte) (offset >>> 8); - data[reference] = (byte) offset; - } - else - { - offset = position + source + 1; - data[reference++] = (byte) (offset >>> 24); - data[reference++] = (byte) (offset >>> 16); - data[reference++] = (byte) (offset >>> 8); - data[reference] = (byte) offset; - } - } - return needUpdate; -} - -/** - * Returns the first label of the series to which this label belongs. For an - * isolated label or for the first label in a series of successive labels, - * this method returns the label itself. For other labels it returns the - * first label of the series. - * - * @return the first label of the series to which this label belongs. - */ -Label getFirst(){ - return frame == null ? this : frame.owner; -} - -// ------------------------------------------------------------------------ -// Overriden Object methods -// ------------------------------------------------------------------------ - -/** - * Returns a string representation of this label. - * - * @return a string representation of this label. - */ -public String toString(){ - return "L" + System.identityHashCode(this); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/MethodAdapter.java --- a/src/clojure/asm/MethodAdapter.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,186 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * An empty {@link MethodVisitor} that delegates to another - * {@link MethodVisitor}. This class can be used as a super class to quickly - * implement usefull method adapter classes, just by overriding the necessary - * methods. - * - * @author Eric Bruneton - */ -public class MethodAdapter implements MethodVisitor{ - -/** - * The {@link MethodVisitor} to which this adapter delegates calls. - */ -protected MethodVisitor mv; - -/** - * Constructs a new {@link MethodAdapter} object. - * - * @param mv the code visitor to which this adapter must delegate calls. - */ -public MethodAdapter(final MethodVisitor mv){ - this.mv = mv; -} - -public AnnotationVisitor visitAnnotationDefault(){ - return mv.visitAnnotationDefault(); -} - -public AnnotationVisitor visitAnnotation( - final String desc, - final boolean visible){ - return mv.visitAnnotation(desc, visible); -} - -public AnnotationVisitor visitParameterAnnotation( - final int parameter, - final String desc, - final boolean visible){ - return mv.visitParameterAnnotation(parameter, desc, visible); -} - -public void visitAttribute(final Attribute attr){ - mv.visitAttribute(attr); -} - -public void visitCode(){ - mv.visitCode(); -} - -public void visitFrame( - final int type, - final int nLocal, - final Object[] local, - final int nStack, - final Object[] stack){ - mv.visitFrame(type, nLocal, local, nStack, stack); -} - -public void visitInsn(final int opcode){ - mv.visitInsn(opcode); -} - -public void visitIntInsn(final int opcode, final int operand){ - mv.visitIntInsn(opcode, operand); -} - -public void visitVarInsn(final int opcode, final int var){ - mv.visitVarInsn(opcode, var); -} - -public void visitTypeInsn(final int opcode, final String desc){ - mv.visitTypeInsn(opcode, desc); -} - -public void visitFieldInsn( - final int opcode, - final String owner, - final String name, - final String desc){ - mv.visitFieldInsn(opcode, owner, name, desc); -} - -public void visitMethodInsn( - final int opcode, - final String owner, - final String name, - final String desc){ - mv.visitMethodInsn(opcode, owner, name, desc); -} - -public void visitJumpInsn(final int opcode, final Label label){ - mv.visitJumpInsn(opcode, label); -} - -public void visitLabel(final Label label){ - mv.visitLabel(label); -} - -public void visitLdcInsn(final Object cst){ - mv.visitLdcInsn(cst); -} - -public void visitIincInsn(final int var, final int increment){ - mv.visitIincInsn(var, increment); -} - -public void visitTableSwitchInsn( - final int min, - final int max, - final Label dflt, - final Label labels[]){ - mv.visitTableSwitchInsn(min, max, dflt, labels); -} - -public void visitLookupSwitchInsn( - final Label dflt, - final int keys[], - final Label labels[]){ - mv.visitLookupSwitchInsn(dflt, keys, labels); -} - -public void visitMultiANewArrayInsn(final String desc, final int dims){ - mv.visitMultiANewArrayInsn(desc, dims); -} - -public void visitTryCatchBlock( - final Label start, - final Label end, - final Label handler, - final String type){ - mv.visitTryCatchBlock(start, end, handler, type); -} - -public void visitLocalVariable( - final String name, - final String desc, - final String signature, - final Label start, - final Label end, - final int index){ - mv.visitLocalVariable(name, desc, signature, start, end, index); -} - -public void visitLineNumber(final int line, final Label start){ - mv.visitLineNumber(line, start); -} - -public void visitMaxs(final int maxStack, final int maxLocals){ - mv.visitMaxs(maxStack, maxLocals); -} - -public void visitEnd(){ - mv.visitEnd(); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/MethodVisitor.java --- a/src/clojure/asm/MethodVisitor.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,396 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * A visitor to visit a Java method. The methods of this interface must be - * called in the following order: [ visitAnnotationDefault ] ( - * visitAnnotation | visitParameterAnnotation | - * visitAttribute )* [ visitCode ( visitFrame | - * visitXInsn | visitLabel | visitTryCatchBlock | - * visitLocalVariable | visitLineNumber)* visitMaxs ] - * visitEnd. In addition, the visitXInsn - * and visitLabel methods must be called in the sequential order of - * the bytecode instructions of the visited code, visitTryCatchBlock - * must be called before the labels passed as arguments have been - * visited, and the visitLocalVariable and visitLineNumber - * methods must be called after the labels passed as arguments have been - * visited. - * - * @author Eric Bruneton - */ -public interface MethodVisitor{ - -// ------------------------------------------------------------------------- -// Annotations and non standard attributes -// ------------------------------------------------------------------------- - -/** - * Visits the default value of this annotation interface method. - * - * @return a visitor to the visit the actual default value of this - * annotation interface method, or null if this visitor - * is not interested in visiting this default value. The 'name' - * parameters passed to the methods of this annotation visitor are - * ignored. Moreover, exacly one visit method must be called on this - * annotation visitor, followed by visitEnd. - */ -AnnotationVisitor visitAnnotationDefault(); - -/** - * Visits an annotation of this method. - * - * @param desc the class descriptor of the annotation class. - * @param visible true if the annotation is visible at runtime. - * @return a visitor to visit the annotation values, or null if - * this visitor is not interested in visiting this annotation. - */ -AnnotationVisitor visitAnnotation(String desc, boolean visible); - -/** - * Visits an annotation of a parameter this method. - * - * @param parameter the parameter index. - * @param desc the class descriptor of the annotation class. - * @param visible true if the annotation is visible at runtime. - * @return a visitor to visit the annotation values, or null if - * this visitor is not interested in visiting this annotation. - */ -AnnotationVisitor visitParameterAnnotation( - int parameter, - String desc, - boolean visible); - -/** - * Visits a non standard attribute of this method. - * - * @param attr an attribute. - */ -void visitAttribute(Attribute attr); - -/** - * Starts the visit of the method's code, if any (i.e. non abstract method). - */ -void visitCode(); - -/** - * Visits the current state of the local variables and operand stack - * elements. This method must(*) be called just before any - * instruction i that follows an unconditionnal branch instruction - * such as GOTO or THROW, that is the target of a jump instruction, or that - * starts an exception handler block. The visited types must describe the - * values of the local variables and of the operand stack elements just - * before i is executed.

(*) this is mandatory only - * for classes whose version is greater than or equal to - * {@link Opcodes#V1_6 V1_6}.

Packed frames are basically - * "deltas" from the state of the previous frame (very first frame is - * implicitly defined by the method's parameters and access flags):

    - *
  • {@link Opcodes#F_SAME} representing frame with exactly the same - * locals as the previous frame and with the empty stack.
  • {@link Opcodes#F_SAME1} - * representing frame with exactly the same locals as the previous frame and - * with single value on the stack (nStack is 1 and - * stack[0] contains value for the type of the stack item).
    • - *
  • {@link Opcodes#F_APPEND} representing frame with current locals are - * the same as the locals in the previous frame, except that additional - * locals are defined (nLocal is 1, 2 or 3 and - * local elements contains values representing added types).
    • - *
  • {@link Opcodes#F_CHOP} representing frame with current locals are - * the same as the locals in the previous frame, except that the last 1-3 - * locals are absent and with the empty stack (nLocals is 1, - * 2 or 3).
  • {@link Opcodes#F_FULL} representing complete frame - * data.
- * - * @param type the type of this stack map frame. Must be - * {@link Opcodes#F_NEW} for expanded frames, or - * {@link Opcodes#F_FULL}, {@link Opcodes#F_APPEND}, - * {@link Opcodes#F_CHOP}, {@link Opcodes#F_SAME} or - * {@link Opcodes#F_APPEND}, {@link Opcodes#F_SAME1} for compressed - * frames. - * @param nLocal the number of local variables in the visited frame. - * @param local the local variable types in this frame. This array must not - * be modified. Primitive types are represented by - * {@link Opcodes#TOP}, {@link Opcodes#INTEGER}, - * {@link Opcodes#FLOAT}, {@link Opcodes#LONG}, - * {@link Opcodes#DOUBLE},{@link Opcodes#NULL} or - * {@link Opcodes#UNINITIALIZED_THIS} (long and double are - * represented by a single element). Reference types are represented - * by String objects (representing internal names, or type - * descriptors for array types), and uninitialized types by Label - * objects (this label designates the NEW instruction that created - * this uninitialized value). - * @param nStack the number of operand stack elements in the visited frame. - * @param stack the operand stack types in this frame. This array must not - * be modified. Its content has the same format as the "local" array. - */ -void visitFrame( - int type, - int nLocal, - Object[] local, - int nStack, - Object[] stack); - -// ------------------------------------------------------------------------- -// Normal instructions -// ------------------------------------------------------------------------- - -/** - * Visits a zero operand instruction. - * - * @param opcode the opcode of the instruction to be visited. This opcode is - * either NOP, ACONST_NULL, ICONST_M1, ICONST_0, ICONST_1, ICONST_2, - * ICONST_3, ICONST_4, ICONST_5, LCONST_0, LCONST_1, FCONST_0, - * FCONST_1, FCONST_2, DCONST_0, DCONST_1, IALOAD, LALOAD, FALOAD, - * DALOAD, AALOAD, BALOAD, CALOAD, SALOAD, IASTORE, LASTORE, FASTORE, - * DASTORE, AASTORE, BASTORE, CASTORE, SASTORE, POP, POP2, DUP, - * DUP_X1, DUP_X2, DUP2, DUP2_X1, DUP2_X2, SWAP, IADD, LADD, FADD, - * DADD, ISUB, LSUB, FSUB, DSUB, IMUL, LMUL, FMUL, DMUL, IDIV, LDIV, - * FDIV, DDIV, IREM, LREM, FREM, DREM, INEG, LNEG, FNEG, DNEG, ISHL, - * LSHL, ISHR, LSHR, IUSHR, LUSHR, IAND, LAND, IOR, LOR, IXOR, LXOR, - * I2L, I2F, I2D, L2I, L2F, L2D, F2I, F2L, F2D, D2I, D2L, D2F, I2B, - * I2C, I2S, LCMP, FCMPL, FCMPG, DCMPL, DCMPG, IRETURN, LRETURN, - * FRETURN, DRETURN, ARETURN, RETURN, ARRAYLENGTH, ATHROW, - * MONITORENTER, or MONITOREXIT. - */ -void visitInsn(int opcode); - -/** - * Visits an instruction with a single int operand. - * - * @param opcode the opcode of the instruction to be visited. This opcode is - * either BIPUSH, SIPUSH or NEWARRAY. - * @param operand the operand of the instruction to be visited.
When - * opcode is BIPUSH, operand value should be between Byte.MIN_VALUE - * and Byte.MAX_VALUE.
When opcode is SIPUSH, operand value - * should be between Short.MIN_VALUE and Short.MAX_VALUE.
When - * opcode is NEWARRAY, operand value should be one of - * {@link Opcodes#T_BOOLEAN}, {@link Opcodes#T_CHAR}, - * {@link Opcodes#T_FLOAT}, {@link Opcodes#T_DOUBLE}, - * {@link Opcodes#T_BYTE}, {@link Opcodes#T_SHORT}, - * {@link Opcodes#T_INT} or {@link Opcodes#T_LONG}. - */ -void visitIntInsn(int opcode, int operand); - -/** - * Visits a local variable instruction. A local variable instruction is an - * instruction that loads or stores the value of a local variable. - * - * @param opcode the opcode of the local variable instruction to be visited. - * This opcode is either ILOAD, LLOAD, FLOAD, DLOAD, ALOAD, ISTORE, - * LSTORE, FSTORE, DSTORE, ASTORE or RET. - * @param var the operand of the instruction to be visited. This operand is - * the index of a local variable. - */ -void visitVarInsn(int opcode, int var); - -/** - * Visits a type instruction. A type instruction is an instruction that - * takes a type descriptor as parameter. - * - * @param opcode the opcode of the type instruction to be visited. This - * opcode is either NEW, ANEWARRAY, CHECKCAST or INSTANCEOF. - * @param desc the operand of the instruction to be visited. This operand is - * must be a fully qualified class name in internal form, or the type - * descriptor of an array type (see {@link Type Type}). - */ -void visitTypeInsn(int opcode, String desc); - -/** - * Visits a field instruction. A field instruction is an instruction that - * loads or stores the value of a field of an object. - * - * @param opcode the opcode of the type instruction to be visited. This - * opcode is either GETSTATIC, PUTSTATIC, GETFIELD or PUTFIELD. - * @param owner the internal name of the field's owner class (see {@link - * Type#getInternalName() getInternalName}). - * @param name the field's name. - * @param desc the field's descriptor (see {@link Type Type}). - */ -void visitFieldInsn(int opcode, String owner, String name, String desc); - -/** - * Visits a method instruction. A method instruction is an instruction that - * invokes a method. - * - * @param opcode the opcode of the type instruction to be visited. This - * opcode is either INVOKEVIRTUAL, INVOKESPECIAL, INVOKESTATIC or - * INVOKEINTERFACE. - * @param owner the internal name of the method's owner class (see {@link - * Type#getInternalName() getInternalName}). - * @param name the method's name. - * @param desc the method's descriptor (see {@link Type Type}). - */ -void visitMethodInsn(int opcode, String owner, String name, String desc); - -/** - * Visits a jump instruction. A jump instruction is an instruction that may - * jump to another instruction. - * - * @param opcode the opcode of the type instruction to be visited. This - * opcode is either IFEQ, IFNE, IFLT, IFGE, IFGT, IFLE, IF_ICMPEQ, - * IF_ICMPNE, IF_ICMPLT, IF_ICMPGE, IF_ICMPGT, IF_ICMPLE, IF_ACMPEQ, - * IF_ACMPNE, GOTO, JSR, IFNULL or IFNONNULL. - * @param label the operand of the instruction to be visited. This operand - * is a label that designates the instruction to which the jump - * instruction may jump. - */ -void visitJumpInsn(int opcode, Label label); - -/** - * Visits a label. A label designates the instruction that will be visited - * just after it. - * - * @param label a {@link Label Label} object. - */ -void visitLabel(Label label); - -// ------------------------------------------------------------------------- -// Special instructions -// ------------------------------------------------------------------------- - -/** - * Visits a LDC instruction. - * - * @param cst the constant to be loaded on the stack. This parameter must be - * a non null {@link Integer}, a {@link Float}, a {@link Long}, a - * {@link Double} a {@link String} (or a {@link Type} for - * .class constants, for classes whose version is 49.0 or - * more). - */ -void visitLdcInsn(Object cst); - -/** - * Visits an IINC instruction. - * - * @param var index of the local variable to be incremented. - * @param increment amount to increment the local variable by. - */ -void visitIincInsn(int var, int increment); - -/** - * Visits a TABLESWITCH instruction. - * - * @param min the minimum key value. - * @param max the maximum key value. - * @param dflt beginning of the default handler block. - * @param labels beginnings of the handler blocks. labels[i] is - * the beginning of the handler block for the min + i key. - */ -void visitTableSwitchInsn(int min, int max, Label dflt, Label labels[]); - -/** - * Visits a LOOKUPSWITCH instruction. - * - * @param dflt beginning of the default handler block. - * @param keys the values of the keys. - * @param labels beginnings of the handler blocks. labels[i] is - * the beginning of the handler block for the keys[i] key. - */ -void visitLookupSwitchInsn(Label dflt, int keys[], Label labels[]); - -/** - * Visits a MULTIANEWARRAY instruction. - * - * @param desc an array type descriptor (see {@link Type Type}). - * @param dims number of dimensions of the array to allocate. - */ -void visitMultiANewArrayInsn(String desc, int dims); - -// ------------------------------------------------------------------------- -// Exceptions table entries, debug information, max stack and max locals -// ------------------------------------------------------------------------- - -/** - * Visits a try catch block. - * - * @param start beginning of the exception handler's scope (inclusive). - * @param end end of the exception handler's scope (exclusive). - * @param handler beginning of the exception handler's code. - * @param type internal name of the type of exceptions handled by the - * handler, or null to catch any exceptions (for "finally" - * blocks). - * @throws IllegalArgumentException if one of the labels has already been - * visited by this visitor (by the {@link #visitLabel visitLabel} - * method). - */ -void visitTryCatchBlock(Label start, Label end, Label handler, String type); - -/** - * Visits a local variable declaration. - * - * @param name the name of a local variable. - * @param desc the type descriptor of this local variable. - * @param signature the type signature of this local variable. May be - * null if the local variable type does not use generic - * types. - * @param start the first instruction corresponding to the scope of this - * local variable (inclusive). - * @param end the last instruction corresponding to the scope of this local - * variable (exclusive). - * @param index the local variable's index. - * @throws IllegalArgumentException if one of the labels has not already - * been visited by this visitor (by the - * {@link #visitLabel visitLabel} method). - */ -void visitLocalVariable( - String name, - String desc, - String signature, - Label start, - Label end, - int index); - -/** - * Visits a line number declaration. - * - * @param line a line number. This number refers to the source file from - * which the class was compiled. - * @param start the first instruction corresponding to this line number. - * @throws IllegalArgumentException if start has not already been - * visited by this visitor (by the {@link #visitLabel visitLabel} - * method). - */ -void visitLineNumber(int line, Label start); - -/** - * Visits the maximum stack size and the maximum number of local variables - * of the method. - * - * @param maxStack maximum stack size of the method. - * @param maxLocals maximum number of local variables for the method. - */ -void visitMaxs(int maxStack, int maxLocals); - -/** - * Visits the end of the method. This method, which is the last one to be - * called, is used to inform the visitor that all the annotations and - * attributes of the method have been visited. - */ -void visitEnd(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/MethodWriter.java --- a/src/clojure/asm/MethodWriter.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3029 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * A {@link MethodVisitor} that generates methods in bytecode form. Each visit - * method of this class appends the bytecode corresponding to the visited - * instruction to a byte vector, in the order these methods are called. - * - * @author Eric Bruneton - * @author Eugene Kuleshov - */ -class MethodWriter implements MethodVisitor{ - -/** - * Pseudo access flag used to denote constructors. - */ -final static int ACC_CONSTRUCTOR = 262144; - -/** - * Frame has exactly the same locals as the previous stack map frame and - * number of stack items is zero. - */ -final static int SAME_FRAME = 0; // to 63 (0-3f) - -/** - * Frame has exactly the same locals as the previous stack map frame and - * number of stack items is 1 - */ -final static int SAME_LOCALS_1_STACK_ITEM_FRAME = 64; // to 127 (40-7f) - -/** - * Reserved for future use - */ -final static int RESERVED = 128; - -/** - * Frame has exactly the same locals as the previous stack map frame and - * number of stack items is 1. Offset is bigger then 63; - */ -final static int SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED = 247; // f7 - -/** - * Frame where current locals are the same as the locals in the previous - * frame, except that the k last locals are absent. The value of k is given - * by the formula 251-frame_type. - */ -final static int CHOP_FRAME = 248; // to 250 (f8-fA) - -/** - * Frame has exactly the same locals as the previous stack map frame and - * number of stack items is zero. Offset is bigger then 63; - */ -final static int SAME_FRAME_EXTENDED = 251; // fb - -/** - * Frame where current locals are the same as the locals in the previous - * frame, except that k additional locals are defined. The value of k is - * given by the formula frame_type-251. - */ -final static int APPEND_FRAME = 252; // to 254 // fc-fe - -/** - * Full frame - */ -final static int FULL_FRAME = 255; // ff - -/** - * Indicates that the stack map frames must be recomputed from scratch. In - * this case the maximum stack size and number of local variables is also - * recomputed from scratch. - * - * @see #compute - */ -private final static int FRAMES = 0; - -/** - * Indicates that the maximum stack size and number of local variables must - * be automatically computed. - * - * @see #compute - */ -private final static int MAXS = 1; - -/** - * Indicates that nothing must be automatically computed. - * - * @see #compute - */ -private final static int NOTHING = 2; - -/** - * Next method writer (see {@link ClassWriter#firstMethod firstMethod}). - */ -MethodWriter next; - -/** - * The class writer to which this method must be added. - */ -ClassWriter cw; - -/** - * Access flags of this method. - */ -private int access; - -/** - * The index of the constant pool item that contains the name of this - * method. - */ -private int name; - -/** - * The index of the constant pool item that contains the descriptor of this - * method. - */ -private int desc; - -/** - * The descriptor of this method. - */ -private String descriptor; - -/** - * The signature of this method. - */ -String signature; - -/** - * If not zero, indicates that the code of this method must be copied from - * the ClassReader associated to this writer in cw.cr. More - * precisely, this field gives the index of the first byte to copied from - * cw.cr.b. - */ -int classReaderOffset; - -/** - * If not zero, indicates that the code of this method must be copied from - * the ClassReader associated to this writer in cw.cr. More - * precisely, this field gives the number of bytes to copied from - * cw.cr.b. - */ -int classReaderLength; - -/** - * Number of exceptions that can be thrown by this method. - */ -int exceptionCount; - -/** - * The exceptions that can be thrown by this method. More precisely, this - * array contains the indexes of the constant pool items that contain the - * internal names of these exception classes. - */ -int[] exceptions; - -/** - * The annotation default attribute of this method. May be null. - */ -private ByteVector annd; - -/** - * The runtime visible annotations of this method. May be null. - */ -private AnnotationWriter anns; - -/** - * The runtime invisible annotations of this method. May be null. - */ -private AnnotationWriter ianns; - -/** - * The runtime visible parameter annotations of this method. May be - * null. - */ -private AnnotationWriter[] panns; - -/** - * The runtime invisible parameter annotations of this method. May be - * null. - */ -private AnnotationWriter[] ipanns; - -/** - * The non standard attributes of the method. - */ -private Attribute attrs; - -/** - * The bytecode of this method. - */ -private ByteVector code = new ByteVector(); - -/** - * Maximum stack size of this method. - */ -private int maxStack; - -/** - * Maximum number of local variables for this method. - */ -private int maxLocals; - -/** - * Number of stack map frames in the StackMapTable attribute. - */ -private int frameCount; - -/** - * The StackMapTable attribute. - */ -private ByteVector stackMap; - -/** - * The offset of the last frame that was written in the StackMapTable - * attribute. - */ -private int previousFrameOffset; - -/** - * The last frame that was written in the StackMapTable attribute. - * - * @see #frame - */ -private int[] previousFrame; - -/** - * Index of the next element to be added in {@link #frame}. - */ -private int frameIndex; - -/** - * The current stack map frame. The first element contains the offset of the - * instruction to which the frame corresponds, the second element is the - * number of locals and the third one is the number of stack elements. The - * local variables start at index 3 and are followed by the operand stack - * values. In summary frame[0] = offset, frame[1] = nLocal, frame[2] = - * nStack, frame[3] = nLocal. All types are encoded as integers, with the - * same format as the one used in {@link Label}, but limited to BASE types. - */ -private int[] frame; - -/** - * Number of elements in the exception handler list. - */ -private int handlerCount; - -/** - * The first element in the exception handler list. - */ -private Handler firstHandler; - -/** - * The last element in the exception handler list. - */ -private Handler lastHandler; - -/** - * Number of entries in the LocalVariableTable attribute. - */ -private int localVarCount; - -/** - * The LocalVariableTable attribute. - */ -private ByteVector localVar; - -/** - * Number of entries in the LocalVariableTypeTable attribute. - */ -private int localVarTypeCount; - -/** - * The LocalVariableTypeTable attribute. - */ -private ByteVector localVarType; - -/** - * Number of entries in the LineNumberTable attribute. - */ -private int lineNumberCount; - -/** - * The LineNumberTable attribute. - */ -private ByteVector lineNumber; - -/** - * The non standard attributes of the method's code. - */ -private Attribute cattrs; - -/** - * Indicates if some jump instructions are too small and need to be resized. - */ -private boolean resize; - -/** - * Indicates if the instructions contain at least one JSR instruction. - */ -private boolean jsr; - -// ------------------------------------------------------------------------ - -/* - * Fields for the control flow graph analysis algorithm (used to compute the - * maximum stack size). A control flow graph contains one node per "basic - * block", and one edge per "jump" from one basic block to another. Each - * node (i.e., each basic block) is represented by the Label object that - * corresponds to the first instruction of this basic block. Each node also - * stores the list of its successors in the graph, as a linked list of Edge - * objects. - */ - -/** - * Indicates what must be automatically computed. - * - * @see FRAMES - * @see MAXS - * @see NOTHING - */ -private int compute; - -/** - * A list of labels. This list is the list of basic blocks in the method, - * i.e. a list of Label objects linked to each other by their - * {@link Label#successor} field, in the order they are visited by - * {@link visitLabel}, and starting with the first basic block. - */ -private Label labels; - -/** - * The previous basic block. - */ -private Label previousBlock; - -/** - * The current basic block. - */ -private Label currentBlock; - -/** - * The (relative) stack size after the last visited instruction. This size - * is relative to the beginning of the current basic block, i.e., the true - * stack size after the last visited instruction is equal to the - * {@link Label#inputStackTop beginStackSize} of the current basic block - * plus stackSize. - */ -private int stackSize; - -/** - * The (relative) maximum stack size after the last visited instruction. - * This size is relative to the beginning of the current basic block, i.e., - * the true maximum stack size after the last visited instruction is equal - * to the {@link Label#inputStackTop beginStackSize} of the current basic - * block plus stackSize. - */ -private int maxStackSize; - -// ------------------------------------------------------------------------ -// Constructor -// ------------------------------------------------------------------------ - -/** - * Constructs a new {@link MethodWriter}. - * - * @param cw the class writer in which the method must be added. - * @param access the method's access flags (see {@link Opcodes}). - * @param name the method's name. - * @param desc the method's descriptor (see {@link Type}). - * @param signature the method's signature. May be null. - * @param exceptions the internal names of the method's exceptions. May be - * null. - * @param computeMaxs true if the maximum stack size and number - * of local variables must be automatically computed. - * @param computeFrames true if the stack map tables must be - * recomputed from scratch. - */ -MethodWriter( - final ClassWriter cw, - final int access, - final String name, - final String desc, - final String signature, - final String[] exceptions, - final boolean computeMaxs, - final boolean computeFrames){ - if(cw.firstMethod == null) - { - cw.firstMethod = this; - } - else - { - cw.lastMethod.next = this; - } - cw.lastMethod = this; - this.cw = cw; - this.access = access; - this.name = cw.newUTF8(name); - this.desc = cw.newUTF8(desc); - this.descriptor = desc; - this.signature = signature; - if(exceptions != null && exceptions.length > 0) - { - exceptionCount = exceptions.length; - this.exceptions = new int[exceptionCount]; - for(int i = 0; i < exceptionCount; ++i) - { - this.exceptions[i] = cw.newClass(exceptions[i]); - } - } - this.compute = computeFrames ? FRAMES : (computeMaxs ? MAXS : NOTHING); - if(computeMaxs || computeFrames) - { - if(computeFrames && name.equals("")) - { - this.access |= ACC_CONSTRUCTOR; - } - // updates maxLocals - int size = getArgumentsAndReturnSizes(descriptor) >> 2; - if((access & Opcodes.ACC_STATIC) != 0) - { - --size; - } - maxLocals = size; - // creates and visits the label for the first basic block - labels = new Label(); - labels.status |= Label.PUSHED; - visitLabel(labels); - } -} - -// ------------------------------------------------------------------------ -// Implementation of the MethodVisitor interface -// ------------------------------------------------------------------------ - -public AnnotationVisitor visitAnnotationDefault(){ - annd = new ByteVector(); - return new AnnotationWriter(cw, false, annd, null, 0); -} - -public AnnotationVisitor visitAnnotation( - final String desc, - final boolean visible){ - ByteVector bv = new ByteVector(); - // write type, and reserve space for values count - bv.putShort(cw.newUTF8(desc)).putShort(0); - AnnotationWriter aw = new AnnotationWriter(cw, true, bv, bv, 2); - if(visible) - { - aw.next = anns; - anns = aw; - } - else - { - aw.next = ianns; - ianns = aw; - } - return aw; -} - -public AnnotationVisitor visitParameterAnnotation( - final int parameter, - final String desc, - final boolean visible){ - ByteVector bv = new ByteVector(); - // write type, and reserve space for values count - bv.putShort(cw.newUTF8(desc)).putShort(0); - AnnotationWriter aw = new AnnotationWriter(cw, true, bv, bv, 2); - if(visible) - { - if(panns == null) - { - panns = new AnnotationWriter[Type.getArgumentTypes(descriptor).length]; - } - aw.next = panns[parameter]; - panns[parameter] = aw; - } - else - { - if(ipanns == null) - { - ipanns = new AnnotationWriter[Type.getArgumentTypes(descriptor).length]; - } - aw.next = ipanns[parameter]; - ipanns[parameter] = aw; - } - return aw; -} - -public void visitAttribute(final Attribute attr){ - if(attr.isCodeAttribute()) - { - attr.next = cattrs; - cattrs = attr; - } - else - { - attr.next = attrs; - attrs = attr; - } -} - -public void visitCode(){ -} - -public void visitFrame( - final int type, - final int nLocal, - final Object[] local, - final int nStack, - final Object[] stack){ - if(compute == FRAMES) - { - return; - } - - if(type == Opcodes.F_NEW) - { - startFrame(code.length, nLocal, nStack); - for(int i = 0; i < nLocal; ++i) - { - if(local[i] instanceof String) - { - frame[frameIndex++] = Frame.OBJECT - | cw.addType((String) local[i]); - } - else if(local[i] instanceof Integer) - { - frame[frameIndex++] = ((Integer) local[i]).intValue(); - } - else - { - frame[frameIndex++] = Frame.UNINITIALIZED - | cw.addUninitializedType("", - ((Label) local[i]).position); - } - } - for(int i = 0; i < nStack; ++i) - { - if(stack[i] instanceof String) - { - frame[frameIndex++] = Frame.OBJECT - | cw.addType((String) stack[i]); - } - else if(stack[i] instanceof Integer) - { - frame[frameIndex++] = ((Integer) stack[i]).intValue(); - } - else - { - frame[frameIndex++] = Frame.UNINITIALIZED - | cw.addUninitializedType("", - ((Label) stack[i]).position); - } - } - endFrame(); - } - else - { - int delta; - if(stackMap == null) - { - stackMap = new ByteVector(); - delta = code.length; - } - else - { - delta = code.length - previousFrameOffset - 1; - } - - switch(type) - { - case Opcodes.F_FULL: - stackMap.putByte(FULL_FRAME) - .putShort(delta) - .putShort(nLocal); - for(int i = 0; i < nLocal; ++i) - { - writeFrameType(local[i]); - } - stackMap.putShort(nStack); - for(int i = 0; i < nStack; ++i) - { - writeFrameType(stack[i]); - } - break; - case Opcodes.F_APPEND: - stackMap.putByte(SAME_FRAME_EXTENDED + nLocal) - .putShort(delta); - for(int i = 0; i < nLocal; ++i) - { - writeFrameType(local[i]); - } - break; - case Opcodes.F_CHOP: - stackMap.putByte(SAME_FRAME_EXTENDED - nLocal) - .putShort(delta); - break; - case Opcodes.F_SAME: - if(delta < 64) - { - stackMap.putByte(delta); - } - else - { - stackMap.putByte(SAME_FRAME_EXTENDED).putShort(delta); - } - break; - case Opcodes.F_SAME1: - if(delta < 64) - { - stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME + delta); - } - else - { - stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED) - .putShort(delta); - } - writeFrameType(stack[0]); - break; - } - - previousFrameOffset = code.length; - ++frameCount; - } -} - -public void visitInsn(final int opcode){ - // adds the instruction to the bytecode of the method - code.putByte(opcode); - // update currentBlock - // Label currentBlock = this.currentBlock; - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(opcode, 0, null, null); - } - else - { - // updates current and max stack sizes - int size = stackSize + Frame.SIZE[opcode]; - if(size > maxStackSize) - { - maxStackSize = size; - } - stackSize = size; - } - // if opcode == ATHROW or xRETURN, ends current block (no successor) - if((opcode >= Opcodes.IRETURN && opcode <= Opcodes.RETURN) - || opcode == Opcodes.ATHROW) - { - noSuccessor(); - } - } -} - -public void visitIntInsn(final int opcode, final int operand){ - // Label currentBlock = this.currentBlock; - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(opcode, operand, null, null); - } - else if(opcode != Opcodes.NEWARRAY) - { - // updates current and max stack sizes only for NEWARRAY - // (stack size variation = 0 for BIPUSH or SIPUSH) - int size = stackSize + 1; - if(size > maxStackSize) - { - maxStackSize = size; - } - stackSize = size; - } - } - // adds the instruction to the bytecode of the method - if(opcode == Opcodes.SIPUSH) - { - code.put12(opcode, operand); - } - else - { // BIPUSH or NEWARRAY - code.put11(opcode, operand); - } -} - -public void visitVarInsn(final int opcode, final int var){ - // Label currentBlock = this.currentBlock; - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(opcode, var, null, null); - } - else - { - // updates current and max stack sizes - if(opcode == Opcodes.RET) - { - // no stack change, but end of current block (no successor) - currentBlock.status |= Label.RET; - // save 'stackSize' here for future use - // (see {@link #findSubroutineSuccessors}) - currentBlock.inputStackTop = stackSize; - noSuccessor(); - } - else - { // xLOAD or xSTORE - int size = stackSize + Frame.SIZE[opcode]; - if(size > maxStackSize) - { - maxStackSize = size; - } - stackSize = size; - } - } - } - if(compute != NOTHING) - { - // updates max locals - int n; - if(opcode == Opcodes.LLOAD || opcode == Opcodes.DLOAD - || opcode == Opcodes.LSTORE || opcode == Opcodes.DSTORE) - { - n = var + 2; - } - else - { - n = var + 1; - } - if(n > maxLocals) - { - maxLocals = n; - } - } - // adds the instruction to the bytecode of the method - if(var < 4 && opcode != Opcodes.RET) - { - int opt; - if(opcode < Opcodes.ISTORE) - { - /* ILOAD_0 */ - opt = 26 + ((opcode - Opcodes.ILOAD) << 2) + var; - } - else - { - /* ISTORE_0 */ - opt = 59 + ((opcode - Opcodes.ISTORE) << 2) + var; - } - code.putByte(opt); - } - else if(var >= 256) - { - code.putByte(196 /* WIDE */).put12(opcode, var); - } - else - { - code.put11(opcode, var); - } - if(opcode >= Opcodes.ISTORE && compute == FRAMES && handlerCount > 0) - { - visitLabel(new Label()); - } -} - -public void visitTypeInsn(final int opcode, final String desc){ - Item i = cw.newClassItem(desc); - // Label currentBlock = this.currentBlock; - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(opcode, code.length, cw, i); - } - else if(opcode == Opcodes.NEW) - { - // updates current and max stack sizes only if opcode == NEW - // (no stack change for ANEWARRAY, CHECKCAST, INSTANCEOF) - int size = stackSize + 1; - if(size > maxStackSize) - { - maxStackSize = size; - } - stackSize = size; - } - } - // adds the instruction to the bytecode of the method - code.put12(opcode, i.index); -} - -public void visitFieldInsn( - final int opcode, - final String owner, - final String name, - final String desc){ - Item i = cw.newFieldItem(owner, name, desc); - // Label currentBlock = this.currentBlock; - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(opcode, 0, cw, i); - } - else - { - int size; - // computes the stack size variation - char c = desc.charAt(0); - switch(opcode) - { - case Opcodes.GETSTATIC: - size = stackSize + (c == 'D' || c == 'J' ? 2 : 1); - break; - case Opcodes.PUTSTATIC: - size = stackSize + (c == 'D' || c == 'J' ? -2 : -1); - break; - case Opcodes.GETFIELD: - size = stackSize + (c == 'D' || c == 'J' ? 1 : 0); - break; - // case Constants.PUTFIELD: - default: - size = stackSize + (c == 'D' || c == 'J' ? -3 : -2); - break; - } - // updates current and max stack sizes - if(size > maxStackSize) - { - maxStackSize = size; - } - stackSize = size; - } - } - // adds the instruction to the bytecode of the method - code.put12(opcode, i.index); -} - -public void visitMethodInsn( - final int opcode, - final String owner, - final String name, - final String desc){ - boolean itf = opcode == Opcodes.INVOKEINTERFACE; - Item i = cw.newMethodItem(owner, name, desc, itf); - int argSize = i.intVal; - // Label currentBlock = this.currentBlock; - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(opcode, 0, cw, i); - } - else - { - /* - * computes the stack size variation. In order not to recompute - * several times this variation for the same Item, we use the - * intVal field of this item to store this variation, once it - * has been computed. More precisely this intVal field stores - * the sizes of the arguments and of the return value - * corresponding to desc. - */ - if(argSize == 0) - { - // the above sizes have not been computed yet, - // so we compute them... - argSize = getArgumentsAndReturnSizes(desc); - // ... and we save them in order - // not to recompute them in the future - i.intVal = argSize; - } - int size; - if(opcode == Opcodes.INVOKESTATIC) - { - size = stackSize - (argSize >> 2) + (argSize & 0x03) + 1; - } - else - { - size = stackSize - (argSize >> 2) + (argSize & 0x03); - } - // updates current and max stack sizes - if(size > maxStackSize) - { - maxStackSize = size; - } - stackSize = size; - } - } - // adds the instruction to the bytecode of the method - if(itf) - { - if(argSize == 0) - { - argSize = getArgumentsAndReturnSizes(desc); - i.intVal = argSize; - } - code.put12(Opcodes.INVOKEINTERFACE, i.index).put11(argSize >> 2, 0); - } - else - { - code.put12(opcode, i.index); - } -} - -public void visitJumpInsn(final int opcode, final Label label){ - Label nextInsn = null; - // Label currentBlock = this.currentBlock; - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(opcode, 0, null, null); - // 'label' is the target of a jump instruction - label.getFirst().status |= Label.TARGET; - // adds 'label' as a successor of this basic block - addSuccessor(Edge.NORMAL, label); - if(opcode != Opcodes.GOTO) - { - // creates a Label for the next basic block - nextInsn = new Label(); - } - } - else - { - if(opcode == Opcodes.JSR) - { - jsr = true; - currentBlock.status |= Label.JSR; - addSuccessor(stackSize + 1, label); - // creates a Label for the next basic block - nextInsn = new Label(); - /* - * note that, by construction in this method, a JSR block - * has at least two successors in the control flow graph: - * the first one leads the next instruction after the JSR, - * while the second one leads to the JSR target. - */ - } - else - { - // updates current stack size (max stack size unchanged - // because stack size variation always negative in this - // case) - stackSize += Frame.SIZE[opcode]; - addSuccessor(stackSize, label); - } - } - } - // adds the instruction to the bytecode of the method - if((label.status & Label.RESOLVED) != 0 - && label.position - code.length < Short.MIN_VALUE) - { - /* - * case of a backward jump with an offset < -32768. In this case we - * automatically replace GOTO with GOTO_W, JSR with JSR_W and IFxxx - * with IFNOTxxx GOTO_W , where IFNOTxxx is the - * "opposite" opcode of IFxxx (i.e., IFNE for IFEQ) and where - * designates the instruction just after the GOTO_W. - */ - if(opcode == Opcodes.GOTO) - { - code.putByte(200); // GOTO_W - } - else if(opcode == Opcodes.JSR) - { - code.putByte(201); // JSR_W - } - else - { - // if the IF instruction is transformed into IFNOT GOTO_W the - // next instruction becomes the target of the IFNOT instruction - if(nextInsn != null) - { - nextInsn.status |= Label.TARGET; - } - code.putByte(opcode <= 166 - ? ((opcode + 1) ^ 1) - 1 - : opcode ^ 1); - code.putShort(8); // jump offset - code.putByte(200); // GOTO_W - } - label.put(this, code, code.length - 1, true); - } - else - { - /* - * case of a backward jump with an offset >= -32768, or of a forward - * jump with, of course, an unknown offset. In these cases we store - * the offset in 2 bytes (which will be increased in - * resizeInstructions, if needed). - */ - code.putByte(opcode); - label.put(this, code, code.length - 1, false); - } - if(currentBlock != null) - { - if(nextInsn != null) - { - // if the jump instruction is not a GOTO, the next instruction - // is also a successor of this instruction. Calling visitLabel - // adds the label of this next instruction as a successor of the - // current block, and starts a new basic block - visitLabel(nextInsn); - } - if(opcode == Opcodes.GOTO) - { - noSuccessor(); - } - } -} - -public void visitLabel(final Label label){ - // resolves previous forward references to label, if any - resize |= label.resolve(this, code.length, code.data); - // updates currentBlock - if((label.status & Label.DEBUG) != 0) - { - return; - } - if(compute == FRAMES) - { - if(currentBlock != null) - { - if(label.position == currentBlock.position) - { - // successive labels, do not start a new basic block - currentBlock.status |= (label.status & Label.TARGET); - label.frame = currentBlock.frame; - return; - } - // ends current block (with one new successor) - addSuccessor(Edge.NORMAL, label); - } - // begins a new current block - currentBlock = label; - if(label.frame == null) - { - label.frame = new Frame(); - label.frame.owner = label; - } - // updates the basic block list - if(previousBlock != null) - { - if(label.position == previousBlock.position) - { - previousBlock.status |= (label.status & Label.TARGET); - label.frame = previousBlock.frame; - currentBlock = previousBlock; - return; - } - previousBlock.successor = label; - } - previousBlock = label; - } - else if(compute == MAXS) - { - if(currentBlock != null) - { - // ends current block (with one new successor) - currentBlock.outputStackMax = maxStackSize; - addSuccessor(stackSize, label); - } - // begins a new current block - currentBlock = label; - // resets the relative current and max stack sizes - stackSize = 0; - maxStackSize = 0; - // updates the basic block list - if(previousBlock != null) - { - previousBlock.successor = label; - } - previousBlock = label; - } -} - -public void visitLdcInsn(final Object cst){ - Item i = cw.newConstItem(cst); - // Label currentBlock = this.currentBlock; - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(Opcodes.LDC, 0, cw, i); - } - else - { - int size; - // computes the stack size variation - if(i.type == ClassWriter.LONG || i.type == ClassWriter.DOUBLE) - { - size = stackSize + 2; - } - else - { - size = stackSize + 1; - } - // updates current and max stack sizes - if(size > maxStackSize) - { - maxStackSize = size; - } - stackSize = size; - } - } - // adds the instruction to the bytecode of the method - int index = i.index; - if(i.type == ClassWriter.LONG || i.type == ClassWriter.DOUBLE) - { - code.put12(20 /* LDC2_W */, index); - } - else if(index >= 256) - { - code.put12(19 /* LDC_W */, index); - } - else - { - code.put11(Opcodes.LDC, index); - } -} - -public void visitIincInsn(final int var, final int increment){ - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(Opcodes.IINC, var, null, null); - } - } - if(compute != NOTHING) - { - // updates max locals - int n = var + 1; - if(n > maxLocals) - { - maxLocals = n; - } - } - // adds the instruction to the bytecode of the method - if((var > 255) || (increment > 127) || (increment < -128)) - { - code.putByte(196 /* WIDE */) - .put12(Opcodes.IINC, var) - .putShort(increment); - } - else - { - code.putByte(Opcodes.IINC).put11(var, increment); - } -} - -public void visitTableSwitchInsn( - final int min, - final int max, - final Label dflt, - final Label labels[]){ - // adds the instruction to the bytecode of the method - int source = code.length; - code.putByte(Opcodes.TABLESWITCH); - code.length += (4 - code.length % 4) % 4; - dflt.put(this, code, source, true); - code.putInt(min).putInt(max); - for(int i = 0; i < labels.length; ++i) - { - labels[i].put(this, code, source, true); - } - // updates currentBlock - visitSwitchInsn(dflt, labels); -} - -public void visitLookupSwitchInsn( - final Label dflt, - final int keys[], - final Label labels[]){ - // adds the instruction to the bytecode of the method - int source = code.length; - code.putByte(Opcodes.LOOKUPSWITCH); - code.length += (4 - code.length % 4) % 4; - dflt.put(this, code, source, true); - code.putInt(labels.length); - for(int i = 0; i < labels.length; ++i) - { - code.putInt(keys[i]); - labels[i].put(this, code, source, true); - } - // updates currentBlock - visitSwitchInsn(dflt, labels); -} - -private void visitSwitchInsn(final Label dflt, final Label[] labels){ - // Label currentBlock = this.currentBlock; - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(Opcodes.LOOKUPSWITCH, 0, null, null); - // adds current block successors - addSuccessor(Edge.NORMAL, dflt); - dflt.getFirst().status |= Label.TARGET; - for(int i = 0; i < labels.length; ++i) - { - addSuccessor(Edge.NORMAL, labels[i]); - labels[i].getFirst().status |= Label.TARGET; - } - } - else - { - // updates current stack size (max stack size unchanged) - --stackSize; - // adds current block successors - addSuccessor(stackSize, dflt); - for(int i = 0; i < labels.length; ++i) - { - addSuccessor(stackSize, labels[i]); - } - } - // ends current block - noSuccessor(); - } -} - -public void visitMultiANewArrayInsn(final String desc, final int dims){ - Item i = cw.newClassItem(desc); - // Label currentBlock = this.currentBlock; - if(currentBlock != null) - { - if(compute == FRAMES) - { - currentBlock.frame.execute(Opcodes.MULTIANEWARRAY, dims, cw, i); - } - else - { - // updates current stack size (max stack size unchanged because - // stack size variation always negative or null) - stackSize += 1 - dims; - } - } - // adds the instruction to the bytecode of the method - code.put12(Opcodes.MULTIANEWARRAY, i.index).putByte(dims); -} - -public void visitTryCatchBlock( - final Label start, - final Label end, - final Label handler, - final String type){ - ++handlerCount; - Handler h = new Handler(); - h.start = start; - h.end = end; - h.handler = handler; - h.desc = type; - h.type = type != null ? cw.newClass(type) : 0; - if(lastHandler == null) - { - firstHandler = h; - } - else - { - lastHandler.next = h; - } - lastHandler = h; -} - -public void visitLocalVariable( - final String name, - final String desc, - final String signature, - final Label start, - final Label end, - final int index){ - if(signature != null) - { - if(localVarType == null) - { - localVarType = new ByteVector(); - } - ++localVarTypeCount; - localVarType.putShort(start.position) - .putShort(end.position - start.position) - .putShort(cw.newUTF8(name)) - .putShort(cw.newUTF8(signature)) - .putShort(index); - } - if(localVar == null) - { - localVar = new ByteVector(); - } - ++localVarCount; - localVar.putShort(start.position) - .putShort(end.position - start.position) - .putShort(cw.newUTF8(name)) - .putShort(cw.newUTF8(desc)) - .putShort(index); - if(compute != NOTHING) - { - // updates max locals - char c = desc.charAt(0); - int n = index + (c == 'J' || c == 'D' ? 2 : 1); - if(n > maxLocals) - { - maxLocals = n; - } - } -} - -public void visitLineNumber(final int line, final Label start){ - if(lineNumber == null) - { - lineNumber = new ByteVector(); - } - ++lineNumberCount; - lineNumber.putShort(start.position); - lineNumber.putShort(line); -} - -public void visitMaxs(final int maxStack, final int maxLocals){ - if(compute == FRAMES) - { - // completes the control flow graph with exception handler blocks - Handler handler = firstHandler; - while(handler != null) - { - Label l = handler.start.getFirst(); - Label h = handler.handler.getFirst(); - Label e = handler.end.getFirst(); - // computes the kind of the edges to 'h' - String t = handler.desc == null - ? "java/lang/Throwable" - : handler.desc; - int kind = Frame.OBJECT | cw.addType(t); - // h is an exception handler - h.status |= Label.TARGET; - // adds 'h' as a successor of labels between 'start' and 'end' - while(l != e) - { - // creates an edge to 'h' - Edge b = new Edge(); - b.info = kind; - b.successor = h; - // adds it to the successors of 'l' - b.next = l.successors; - l.successors = b; - // goes to the next label - l = l.successor; - } - handler = handler.next; - } - - // creates and visits the first (implicit) frame - Frame f = labels.frame; - Type[] args = Type.getArgumentTypes(descriptor); - f.initInputFrame(cw, access, args, this.maxLocals); - visitFrame(f); - - /* - * fix point algorithm: mark the first basic block as 'changed' - * (i.e. put it in the 'changed' list) and, while there are changed - * basic blocks, choose one, mark it as unchanged, and update its - * successors (which can be changed in the process). - */ - int max = 0; - Label changed = labels; - while(changed != null) - { - // removes a basic block from the list of changed basic blocks - Label l = changed; - changed = changed.next; - l.next = null; - f = l.frame; - // a reacheable jump target must be stored in the stack map - if((l.status & Label.TARGET) != 0) - { - l.status |= Label.STORE; - } - // all visited labels are reacheable, by definition - l.status |= Label.REACHABLE; - // updates the (absolute) maximum stack size - int blockMax = f.inputStack.length + l.outputStackMax; - if(blockMax > max) - { - max = blockMax; - } - // updates the successors of the current basic block - Edge e = l.successors; - while(e != null) - { - Label n = e.successor.getFirst(); - boolean change = f.merge(cw, n.frame, e.info); - if(change && n.next == null) - { - // if n has changed and is not already in the 'changed' - // list, adds it to this list - n.next = changed; - changed = n; - } - e = e.next; - } - } - this.maxStack = max; - - // visits all the frames that must be stored in the stack map - Label l = labels; - while(l != null) - { - f = l.frame; - if((l.status & Label.STORE) != 0) - { - visitFrame(f); - } - if((l.status & Label.REACHABLE) == 0) - { - // finds start and end of dead basic block - Label k = l.successor; - int start = l.position; - int end = (k == null ? code.length : k.position) - 1; - // if non empty basic block - if(end >= start) - { - // replaces instructions with NOP ... NOP ATHROW - for(int i = start; i < end; ++i) - { - code.data[i] = Opcodes.NOP; - } - code.data[end] = (byte) Opcodes.ATHROW; - // emits a frame for this unreachable block - startFrame(start, 0, 1); - frame[frameIndex++] = Frame.OBJECT - | cw.addType("java/lang/Throwable"); - endFrame(); - } - } - l = l.successor; - } - } - else if(compute == MAXS) - { - // completes the control flow graph with exception handler blocks - Handler handler = firstHandler; - while(handler != null) - { - Label l = handler.start; - Label h = handler.handler; - Label e = handler.end; - // adds 'h' as a successor of labels between 'start' and 'end' - while(l != e) - { - // creates an edge to 'h' - Edge b = new Edge(); - b.info = Edge.EXCEPTION; - b.successor = h; - // adds it to the successors of 'l' - if((l.status & Label.JSR) != 0) - { - // if l is a JSR block, adds b after the first two edges - // to preserve the hypothesis about JSR block successors - // order (see {@link #visitJumpInsn}) - b.next = l.successors.next.next; - l.successors.next.next = b; - } - else - { - b.next = l.successors; - l.successors = b; - } - // goes to the next label - l = l.successor; - } - handler = handler.next; - } - - if(jsr) - { - // completes the control flow graph with the RET successors - /* - * first step: finds the subroutines. This step determines, for - * each basic block, to which subroutine(s) it belongs, and - * stores this set as a bit set in the {@link Label#status} - * field. Subroutines are numbered with powers of two, from - * 0x1000 to 0x80000000 (so there must be at most 20 subroutines - * in a method). - */ - // finds the basic blocks that belong to the "main" subroutine - int id = 0x1000; - findSubroutine(labels, id); - // finds the basic blocks that belong to the real subroutines - Label l = labels; - while(l != null) - { - if((l.status & Label.JSR) != 0) - { - // the subroutine is defined by l's TARGET, not by l - Label subroutine = l.successors.next.successor; - // if this subroutine does not have an id yet... - if((subroutine.status & ~0xFFF) == 0) - { - // ...assigns it a new id and finds its basic blocks - id = id << 1; - findSubroutine(subroutine, id); - } - } - l = l.successor; - } - // second step: finds the successors of RET blocks - findSubroutineSuccessors(0x1000, new Label[10], 0); - } - - /* - * control flow analysis algorithm: while the block stack is not - * empty, pop a block from this stack, update the max stack size, - * compute the true (non relative) begin stack size of the - * successors of this block, and push these successors onto the - * stack (unless they have already been pushed onto the stack). - * Note: by hypothesis, the {@link Label#inputStackTop} of the - * blocks in the block stack are the true (non relative) beginning - * stack sizes of these blocks. - */ - int max = 0; - Label stack = labels; - while(stack != null) - { - // pops a block from the stack - Label l = stack; - stack = stack.next; - // computes the true (non relative) max stack size of this block - int start = l.inputStackTop; - int blockMax = start + l.outputStackMax; - // updates the global max stack size - if(blockMax > max) - { - max = blockMax; - } - // analyses the successors of the block - Edge b = l.successors; - if((l.status & Label.JSR) != 0) - { - // ignores the first edge of JSR blocks (virtual successor) - b = b.next; - } - while(b != null) - { - l = b.successor; - // if this successor has not already been pushed... - if((l.status & Label.PUSHED) == 0) - { - // computes its true beginning stack size... - l.inputStackTop = b.info == Edge.EXCEPTION ? 1 : start - + b.info; - // ...and pushes it onto the stack - l.status |= Label.PUSHED; - l.next = stack; - stack = l; - } - b = b.next; - } - } - this.maxStack = max; - } - else - { - this.maxStack = maxStack; - this.maxLocals = maxLocals; - } -} - -public void visitEnd(){ -} - -// ------------------------------------------------------------------------ -// Utility methods: control flow analysis algorithm -// ------------------------------------------------------------------------ - -/** - * Computes the size of the arguments and of the return value of a method. - * - * @param desc the descriptor of a method. - * @return the size of the arguments of the method (plus one for the - * implicit this argument), argSize, and the size of its return - * value, retSize, packed into a single int i = - * (argSize << 2) | retSize (argSize is therefore equal - * to i >> 2, and retSize to i & 0x03). - */ -static int getArgumentsAndReturnSizes(final String desc){ - int n = 1; - int c = 1; - while(true) - { - char car = desc.charAt(c++); - if(car == ')') - { - car = desc.charAt(c); - return n << 2 - | (car == 'V' ? 0 : (car == 'D' || car == 'J' ? 2 : 1)); - } - else if(car == 'L') - { - while(desc.charAt(c++) != ';') - { - } - n += 1; - } - else if(car == '[') - { - while((car = desc.charAt(c)) == '[') - { - ++c; - } - if(car == 'D' || car == 'J') - { - n -= 1; - } - } - else if(car == 'D' || car == 'J') - { - n += 2; - } - else - { - n += 1; - } - } -} - -/** - * Adds a successor to the {@link #currentBlock currentBlock} block. - * - * @param info information about the control flow edge to be added. - * @param successor the successor block to be added to the current block. - */ -private void addSuccessor(final int info, final Label successor){ - // creates and initializes an Edge object... - Edge b = new Edge(); - b.info = info; - b.successor = successor; - // ...and adds it to the successor list of the currentBlock block - b.next = currentBlock.successors; - currentBlock.successors = b; -} - -/** - * Ends the current basic block. This method must be used in the case where - * the current basic block does not have any successor. - */ -private void noSuccessor(){ - if(compute == FRAMES) - { - Label l = new Label(); - l.frame = new Frame(); - l.frame.owner = l; - l.resolve(this, code.length, code.data); - previousBlock.successor = l; - previousBlock = l; - } - else - { - currentBlock.outputStackMax = maxStackSize; - } - currentBlock = null; -} - -/** - * Finds the basic blocks that belong to a given subroutine, and marks these - * blocks as belonging to this subroutine (by using {@link Label#status} as - * a bit set (see {@link #visitMaxs}). This recursive method follows the - * control flow graph to find all the blocks that are reachable from the - * given block WITHOUT following any JSR target. - * - * @param block a block that belongs to the subroutine - * @param id the id of this subroutine - */ -private void findSubroutine(final Label block, final int id){ - // if 'block' is already marked as belonging to subroutine 'id', returns - if((block.status & id) != 0) - { - return; - } - // marks 'block' as belonging to subroutine 'id' - block.status |= id; - // calls this method recursively on each successor, except JSR targets - Edge e = block.successors; - while(e != null) - { - // if 'block' is a JSR block, then 'block.successors.next' leads - // to the JSR target (see {@link #visitJumpInsn}) and must therefore - // not be followed - if((block.status & Label.JSR) == 0 || e != block.successors.next) - { - findSubroutine(e.successor, id); - } - e = e.next; - } -} - -/** - * Finds the successors of the RET blocks of the specified subroutine, and - * of any nested subroutine it calls. - * - * @param id id of the subroutine whose RET block successors must be found. - * @param JSRs the JSR blocks that were followed to reach this subroutine. - * @param nJSRs number of JSR blocks in the JSRs array. - */ -private void findSubroutineSuccessors( - final int id, - final Label[] JSRs, - final int nJSRs){ - // iterates over all the basic blocks... - Label l = labels; - while(l != null) - { - // for those that belong to subroutine 'id'... - if((l.status & id) != 0) - { - if((l.status & Label.JSR) != 0) - { - // finds the subroutine to which 'l' leads by following the - // second edge of l.successors (see {@link #visitJumpInsn}) - int nId = l.successors.next.successor.status & ~0xFFF; - if(nId != id) - { - // calls this method recursively with l pushed onto the - // JSRs stack to find the successors of the RET blocks - // of this nested subroutine 'nId' - JSRs[nJSRs] = l; - findSubroutineSuccessors(nId, JSRs, nJSRs + 1); - } - } - else if((l.status & Label.RET) != 0) - { - /* - * finds the JSR block in the JSRs stack that corresponds to - * this RET block, and updates the successors of this RET - * block accordingly. This corresponding JSR is the one that - * leads to the subroutine to which the RET block belongs. - * But the RET block can belong to several subroutines (if a - * nested subroutine returns to its parent subroutine - * implicitely, without a RET). So, in fact, the JSR that - * corresponds to this RET is the first block in the JSRs - * stack, starting from the bottom of the stack, that leads - * to a subroutine to which the RET block belongs. - */ - for(int i = 0; i < nJSRs; ++i) - { - int JSRstatus = JSRs[i].successors.next.successor.status; - if(((JSRstatus & ~0xFFF) & (l.status & ~0xFFF)) != 0) - { - Edge e = new Edge(); - e.info = l.inputStackTop; - e.successor = JSRs[i].successors.successor; - e.next = l.successors; - l.successors = e; - break; - } - } - } - } - l = l.successor; - } -} - -// ------------------------------------------------------------------------ -// Utility methods: stack map frames -// ------------------------------------------------------------------------ - -/** - * Visits a frame that has been computed from scratch. - * - * @param f the frame that must be visited. - */ -private void visitFrame(final Frame f){ - int i, t; - int nTop = 0; - int nLocal = 0; - int nStack = 0; - int[] locals = f.inputLocals; - int[] stacks = f.inputStack; - // computes the number of locals (ignores TOP types that are just after - // a LONG or a DOUBLE, and all trailing TOP types) - for(i = 0; i < locals.length; ++i) - { - t = locals[i]; - if(t == Frame.TOP) - { - ++nTop; - } - else - { - nLocal += nTop + 1; - nTop = 0; - } - if(t == Frame.LONG || t == Frame.DOUBLE) - { - ++i; - } - } - // computes the stack size (ignores TOP types that are just after - // a LONG or a DOUBLE) - for(i = 0; i < stacks.length; ++i) - { - t = stacks[i]; - ++nStack; - if(t == Frame.LONG || t == Frame.DOUBLE) - { - ++i; - } - } - // visits the frame and its content - startFrame(f.owner.position, nLocal, nStack); - for(i = 0; nLocal > 0; ++i, --nLocal) - { - t = locals[i]; - frame[frameIndex++] = t; - if(t == Frame.LONG || t == Frame.DOUBLE) - { - ++i; - } - } - for(i = 0; i < stacks.length; ++i) - { - t = stacks[i]; - frame[frameIndex++] = t; - if(t == Frame.LONG || t == Frame.DOUBLE) - { - ++i; - } - } - endFrame(); -} - -/** - * Starts the visit of a stack map frame. - * - * @param offset the offset of the instruction to which the frame - * corresponds. - * @param nLocal the number of local variables in the frame. - * @param nStack the number of stack elements in the frame. - */ -private void startFrame(final int offset, final int nLocal, final int nStack){ - int n = 3 + nLocal + nStack; - if(frame == null || frame.length < n) - { - frame = new int[n]; - } - frame[0] = offset; - frame[1] = nLocal; - frame[2] = nStack; - frameIndex = 3; -} - -/** - * Checks if the visit of the current frame {@link #frame} is finished, and - * if yes, write it in the StackMapTable attribute. - */ -private void endFrame(){ - if(previousFrame != null) - { // do not write the first frame - if(stackMap == null) - { - stackMap = new ByteVector(); - } - writeFrame(); - ++frameCount; - } - previousFrame = frame; - frame = null; -} - -/** - * Compress and writes the current frame {@link #frame} in the StackMapTable - * attribute. - */ -private void writeFrame(){ - int clocalsSize = frame[1]; - int cstackSize = frame[2]; - if((cw.version & 0xFFFF) < Opcodes.V1_6) - { - stackMap.putShort(frame[0]).putShort(clocalsSize); - writeFrameTypes(3, 3 + clocalsSize); - stackMap.putShort(cstackSize); - writeFrameTypes(3 + clocalsSize, 3 + clocalsSize + cstackSize); - return; - } - int localsSize = previousFrame[1]; - int type = FULL_FRAME; - int k = 0; - int delta; - if(frameCount == 0) - { - delta = frame[0]; - } - else - { - delta = frame[0] - previousFrame[0] - 1; - } - if(cstackSize == 0) - { - k = clocalsSize - localsSize; - switch(k) - { - case-3: - case-2: - case-1: - type = CHOP_FRAME; - localsSize = clocalsSize; - break; - case 0: - type = delta < 64 ? SAME_FRAME : SAME_FRAME_EXTENDED; - break; - case 1: - case 2: - case 3: - type = APPEND_FRAME; - break; - } - } - else if(clocalsSize == localsSize && cstackSize == 1) - { - type = delta < 63 - ? SAME_LOCALS_1_STACK_ITEM_FRAME - : SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED; - } - if(type != FULL_FRAME) - { - // verify if locals are the same - int l = 3; - for(int j = 0; j < localsSize; j++) - { - if(frame[l] != previousFrame[l]) - { - type = FULL_FRAME; - break; - } - l++; - } - } - switch(type) - { - case SAME_FRAME: - stackMap.putByte(delta); - break; - case SAME_LOCALS_1_STACK_ITEM_FRAME: - stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME + delta); - writeFrameTypes(3 + clocalsSize, 4 + clocalsSize); - break; - case SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED: - stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED) - .putShort(delta); - writeFrameTypes(3 + clocalsSize, 4 + clocalsSize); - break; - case SAME_FRAME_EXTENDED: - stackMap.putByte(SAME_FRAME_EXTENDED).putShort(delta); - break; - case CHOP_FRAME: - stackMap.putByte(SAME_FRAME_EXTENDED + k).putShort(delta); - break; - case APPEND_FRAME: - stackMap.putByte(SAME_FRAME_EXTENDED + k).putShort(delta); - writeFrameTypes(3 + localsSize, 3 + clocalsSize); - break; - // case FULL_FRAME: - default: - stackMap.putByte(FULL_FRAME) - .putShort(delta) - .putShort(clocalsSize); - writeFrameTypes(3, 3 + clocalsSize); - stackMap.putShort(cstackSize); - writeFrameTypes(3 + clocalsSize, 3 + clocalsSize + cstackSize); - } -} - -/** - * Writes some types of the current frame {@link #frame} into the - * StackMapTableAttribute. This method converts types from the format used - * in {@link Label} to the format used in StackMapTable attributes. In - * particular, it converts type table indexes to constant pool indexes. - * - * @param start index of the first type in {@link #frame} to write. - * @param end index of last type in {@link #frame} to write (exclusive). - */ -private void writeFrameTypes(final int start, final int end){ - for(int i = start; i < end; ++i) - { - int t = frame[i]; - int d = t & Frame.DIM; - if(d == 0) - { - int v = t & Frame.BASE_VALUE; - switch(t & Frame.BASE_KIND) - { - case Frame.OBJECT: - stackMap.putByte(7) - .putShort(cw.newClass(cw.typeTable[v].strVal1)); - break; - case Frame.UNINITIALIZED: - stackMap.putByte(8).putShort(cw.typeTable[v].intVal); - break; - default: - stackMap.putByte(v); - } - } - else - { - StringBuffer buf = new StringBuffer(); - d >>= 28; - while(d-- > 0) - { - buf.append('['); - } - if((t & Frame.BASE_KIND) == Frame.OBJECT) - { - buf.append('L'); - buf.append(cw.typeTable[t & Frame.BASE_VALUE].strVal1); - buf.append(';'); - } - else - { - switch(t & 0xF) - { - case 1: - buf.append('I'); - break; - case 2: - buf.append('F'); - break; - case 3: - buf.append('D'); - break; - case 9: - buf.append('Z'); - break; - case 10: - buf.append('B'); - break; - case 11: - buf.append('C'); - break; - case 12: - buf.append('S'); - break; - default: - buf.append('J'); - } - } - stackMap.putByte(7).putShort(cw.newClass(buf.toString())); - } - } -} - -private void writeFrameType(final Object type){ - if(type instanceof String) - { - stackMap.putByte(7).putShort(cw.newClass((String) type)); - } - else if(type instanceof Integer) - { - stackMap.putByte(((Integer) type).intValue()); - } - else - { - stackMap.putByte(8).putShort(((Label) type).position); - } -} - -// ------------------------------------------------------------------------ -// Utility methods: dump bytecode array -// ------------------------------------------------------------------------ - -/** - * Returns the size of the bytecode of this method. - * - * @return the size of the bytecode of this method. - */ -final int getSize(){ - if(classReaderOffset != 0) - { - return 6 + classReaderLength; - } - if(resize) - { - // replaces the temporary jump opcodes introduced by Label.resolve. - resizeInstructions(); - } - int size = 8; - if(code.length > 0) - { - cw.newUTF8("Code"); - size += 18 + code.length + 8 * handlerCount; - if(localVar != null) - { - cw.newUTF8("LocalVariableTable"); - size += 8 + localVar.length; - } - if(localVarType != null) - { - cw.newUTF8("LocalVariableTypeTable"); - size += 8 + localVarType.length; - } - if(lineNumber != null) - { - cw.newUTF8("LineNumberTable"); - size += 8 + lineNumber.length; - } - if(stackMap != null) - { - boolean zip = (cw.version & 0xFFFF) >= Opcodes.V1_6; - cw.newUTF8(zip ? "StackMapTable" : "StackMap"); - size += 8 + stackMap.length; - } - if(cattrs != null) - { - size += cattrs.getSize(cw, - code.data, - code.length, - maxStack, - maxLocals); - } - } - if(exceptionCount > 0) - { - cw.newUTF8("Exceptions"); - size += 8 + 2 * exceptionCount; - } - if((access & Opcodes.ACC_SYNTHETIC) != 0 - && (cw.version & 0xffff) < Opcodes.V1_5) - { - cw.newUTF8("Synthetic"); - size += 6; - } - if((access & Opcodes.ACC_DEPRECATED) != 0) - { - cw.newUTF8("Deprecated"); - size += 6; - } - if(signature != null) - { - cw.newUTF8("Signature"); - cw.newUTF8(signature); - size += 8; - } - if(annd != null) - { - cw.newUTF8("AnnotationDefault"); - size += 6 + annd.length; - } - if(anns != null) - { - cw.newUTF8("RuntimeVisibleAnnotations"); - size += 8 + anns.getSize(); - } - if(ianns != null) - { - cw.newUTF8("RuntimeInvisibleAnnotations"); - size += 8 + ianns.getSize(); - } - if(panns != null) - { - cw.newUTF8("RuntimeVisibleParameterAnnotations"); - size += 7 + 2 * panns.length; - for(int i = panns.length - 1; i >= 0; --i) - { - size += panns[i] == null ? 0 : panns[i].getSize(); - } - } - if(ipanns != null) - { - cw.newUTF8("RuntimeInvisibleParameterAnnotations"); - size += 7 + 2 * ipanns.length; - for(int i = ipanns.length - 1; i >= 0; --i) - { - size += ipanns[i] == null ? 0 : ipanns[i].getSize(); - } - } - if(attrs != null) - { - size += attrs.getSize(cw, null, 0, -1, -1); - } - return size; -} - -/** - * Puts the bytecode of this method in the given byte vector. - * - * @param out the byte vector into which the bytecode of this method must be - * copied. - */ -final void put(final ByteVector out){ - out.putShort(access).putShort(name).putShort(desc); - if(classReaderOffset != 0) - { - out.putByteArray(cw.cr.b, classReaderOffset, classReaderLength); - return; - } - int attributeCount = 0; - if(code.length > 0) - { - ++attributeCount; - } - if(exceptionCount > 0) - { - ++attributeCount; - } - if((access & Opcodes.ACC_SYNTHETIC) != 0 - && (cw.version & 0xffff) < Opcodes.V1_5) - { - ++attributeCount; - } - if((access & Opcodes.ACC_DEPRECATED) != 0) - { - ++attributeCount; - } - if(signature != null) - { - ++attributeCount; - } - if(annd != null) - { - ++attributeCount; - } - if(anns != null) - { - ++attributeCount; - } - if(ianns != null) - { - ++attributeCount; - } - if(panns != null) - { - ++attributeCount; - } - if(ipanns != null) - { - ++attributeCount; - } - if(attrs != null) - { - attributeCount += attrs.getCount(); - } - out.putShort(attributeCount); - if(code.length > 0) - { - int size = 12 + code.length + 8 * handlerCount; - if(localVar != null) - { - size += 8 + localVar.length; - } - if(localVarType != null) - { - size += 8 + localVarType.length; - } - if(lineNumber != null) - { - size += 8 + lineNumber.length; - } - if(stackMap != null) - { - size += 8 + stackMap.length; - } - if(cattrs != null) - { - size += cattrs.getSize(cw, - code.data, - code.length, - maxStack, - maxLocals); - } - out.putShort(cw.newUTF8("Code")).putInt(size); - out.putShort(maxStack).putShort(maxLocals); - out.putInt(code.length).putByteArray(code.data, 0, code.length); - out.putShort(handlerCount); - if(handlerCount > 0) - { - Handler h = firstHandler; - while(h != null) - { - out.putShort(h.start.position) - .putShort(h.end.position) - .putShort(h.handler.position) - .putShort(h.type); - h = h.next; - } - } - attributeCount = 0; - if(localVar != null) - { - ++attributeCount; - } - if(localVarType != null) - { - ++attributeCount; - } - if(lineNumber != null) - { - ++attributeCount; - } - if(stackMap != null) - { - ++attributeCount; - } - if(cattrs != null) - { - attributeCount += cattrs.getCount(); - } - out.putShort(attributeCount); - if(localVar != null) - { - out.putShort(cw.newUTF8("LocalVariableTable")); - out.putInt(localVar.length + 2).putShort(localVarCount); - out.putByteArray(localVar.data, 0, localVar.length); - } - if(localVarType != null) - { - out.putShort(cw.newUTF8("LocalVariableTypeTable")); - out.putInt(localVarType.length + 2).putShort(localVarTypeCount); - out.putByteArray(localVarType.data, 0, localVarType.length); - } - if(lineNumber != null) - { - out.putShort(cw.newUTF8("LineNumberTable")); - out.putInt(lineNumber.length + 2).putShort(lineNumberCount); - out.putByteArray(lineNumber.data, 0, lineNumber.length); - } - if(stackMap != null) - { - boolean zip = (cw.version & 0xFFFF) >= Opcodes.V1_6; - out.putShort(cw.newUTF8(zip ? "StackMapTable" : "StackMap")); - out.putInt(stackMap.length + 2).putShort(frameCount); - out.putByteArray(stackMap.data, 0, stackMap.length); - } - if(cattrs != null) - { - cattrs.put(cw, code.data, code.length, maxLocals, maxStack, out); - } - } - if(exceptionCount > 0) - { - out.putShort(cw.newUTF8("Exceptions")) - .putInt(2 * exceptionCount + 2); - out.putShort(exceptionCount); - for(int i = 0; i < exceptionCount; ++i) - { - out.putShort(exceptions[i]); - } - } - if((access & Opcodes.ACC_SYNTHETIC) != 0 - && (cw.version & 0xffff) < Opcodes.V1_5) - { - out.putShort(cw.newUTF8("Synthetic")).putInt(0); - } - if((access & Opcodes.ACC_DEPRECATED) != 0) - { - out.putShort(cw.newUTF8("Deprecated")).putInt(0); - } - if(signature != null) - { - out.putShort(cw.newUTF8("Signature")) - .putInt(2) - .putShort(cw.newUTF8(signature)); - } - if(annd != null) - { - out.putShort(cw.newUTF8("AnnotationDefault")); - out.putInt(annd.length); - out.putByteArray(annd.data, 0, annd.length); - } - if(anns != null) - { - out.putShort(cw.newUTF8("RuntimeVisibleAnnotations")); - anns.put(out); - } - if(ianns != null) - { - out.putShort(cw.newUTF8("RuntimeInvisibleAnnotations")); - ianns.put(out); - } - if(panns != null) - { - out.putShort(cw.newUTF8("RuntimeVisibleParameterAnnotations")); - AnnotationWriter.put(panns, out); - } - if(ipanns != null) - { - out.putShort(cw.newUTF8("RuntimeInvisibleParameterAnnotations")); - AnnotationWriter.put(ipanns, out); - } - if(attrs != null) - { - attrs.put(cw, null, 0, -1, -1, out); - } -} - -// ------------------------------------------------------------------------ -// Utility methods: instruction resizing (used to handle GOTO_W and JSR_W) -// ------------------------------------------------------------------------ - -/** - * Resizes and replaces the temporary instructions inserted by - * {@link Label#resolve} for wide forward jumps, while keeping jump offsets - * and instruction addresses consistent. This may require to resize other - * existing instructions, or even to introduce new instructions: for - * example, increasing the size of an instruction by 2 at the middle of a - * method can increases the offset of an IFEQ instruction from 32766 to - * 32768, in which case IFEQ 32766 must be replaced with IFNEQ 8 GOTO_W - * 32765. This, in turn, may require to increase the size of another jump - * instruction, and so on... All these operations are handled automatically - * by this method.

This method must be called after all the method - * that is being built has been visited. In particular, the - * {@link Label Label} objects used to construct the method are no longer - * valid after this method has been called. - */ -private void resizeInstructions(){ - byte[] b = code.data; // bytecode of the method - int u, v, label; // indexes in b - int i, j; // loop indexes - /* - * 1st step: As explained above, resizing an instruction may require to - * resize another one, which may require to resize yet another one, and - * so on. The first step of the algorithm consists in finding all the - * instructions that need to be resized, without modifying the code. - * This is done by the following "fix point" algorithm: - * - * Parse the code to find the jump instructions whose offset will need - * more than 2 bytes to be stored (the future offset is computed from - * the current offset and from the number of bytes that will be inserted - * or removed between the source and target instructions). For each such - * instruction, adds an entry in (a copy of) the indexes and sizes - * arrays (if this has not already been done in a previous iteration!). - * - * If at least one entry has been added during the previous step, go - * back to the beginning, otherwise stop. - * - * In fact the real algorithm is complicated by the fact that the size - * of TABLESWITCH and LOOKUPSWITCH instructions depends on their - * position in the bytecode (because of padding). In order to ensure the - * convergence of the algorithm, the number of bytes to be added or - * removed from these instructions is over estimated during the previous - * loop, and computed exactly only after the loop is finished (this - * requires another pass to parse the bytecode of the method). - */ - int[] allIndexes = new int[0]; // copy of indexes - int[] allSizes = new int[0]; // copy of sizes - boolean[] resize; // instructions to be resized - int newOffset; // future offset of a jump instruction - - resize = new boolean[code.length]; - - // 3 = loop again, 2 = loop ended, 1 = last pass, 0 = done - int state = 3; - do - { - if(state == 3) - { - state = 2; - } - u = 0; - while(u < b.length) - { - int opcode = b[u] & 0xFF; // opcode of current instruction - int insert = 0; // bytes to be added after this instruction - - switch(ClassWriter.TYPE[opcode]) - { - case ClassWriter.NOARG_INSN: - case ClassWriter.IMPLVAR_INSN: - u += 1; - break; - case ClassWriter.LABEL_INSN: - if(opcode > 201) - { - // converts temporary opcodes 202 to 217, 218 and - // 219 to IFEQ ... JSR (inclusive), IFNULL and - // IFNONNULL - opcode = opcode < 218 ? opcode - 49 : opcode - 20; - label = u + readUnsignedShort(b, u + 1); - } - else - { - label = u + readShort(b, u + 1); - } - newOffset = getNewOffset(allIndexes, allSizes, u, label); - if(newOffset < Short.MIN_VALUE - || newOffset > Short.MAX_VALUE) - { - if(!resize[u]) - { - if(opcode == Opcodes.GOTO - || opcode == Opcodes.JSR) - { - // two additional bytes will be required to - // replace this GOTO or JSR instruction with - // a GOTO_W or a JSR_W - insert = 2; - } - else - { - // five additional bytes will be required to - // replace this IFxxx instruction with - // IFNOTxxx GOTO_W , where IFNOTxxx - // is the "opposite" opcode of IFxxx (i.e., - // IFNE for IFEQ) and where designates - // the instruction just after the GOTO_W. - insert = 5; - } - resize[u] = true; - } - } - u += 3; - break; - case ClassWriter.LABELW_INSN: - u += 5; - break; - case ClassWriter.TABL_INSN: - if(state == 1) - { - // true number of bytes to be added (or removed) - // from this instruction = (future number of padding - // bytes - current number of padding byte) - - // previously over estimated variation = - // = ((3 - newOffset%4) - (3 - u%4)) - u%4 - // = (-newOffset%4 + u%4) - u%4 - // = -(newOffset & 3) - newOffset = getNewOffset(allIndexes, allSizes, 0, u); - insert = -(newOffset & 3); - } - else if(!resize[u]) - { - // over estimation of the number of bytes to be - // added to this instruction = 3 - current number - // of padding bytes = 3 - (3 - u%4) = u%4 = u & 3 - insert = u & 3; - resize[u] = true; - } - // skips instruction - u = u + 4 - (u & 3); - u += 4 * (readInt(b, u + 8) - readInt(b, u + 4) + 1) + 12; - break; - case ClassWriter.LOOK_INSN: - if(state == 1) - { - // like TABL_INSN - newOffset = getNewOffset(allIndexes, allSizes, 0, u); - insert = -(newOffset & 3); - } - else if(!resize[u]) - { - // like TABL_INSN - insert = u & 3; - resize[u] = true; - } - // skips instruction - u = u + 4 - (u & 3); - u += 8 * readInt(b, u + 4) + 8; - break; - case ClassWriter.WIDE_INSN: - opcode = b[u + 1] & 0xFF; - if(opcode == Opcodes.IINC) - { - u += 6; - } - else - { - u += 4; - } - break; - case ClassWriter.VAR_INSN: - case ClassWriter.SBYTE_INSN: - case ClassWriter.LDC_INSN: - u += 2; - break; - case ClassWriter.SHORT_INSN: - case ClassWriter.LDCW_INSN: - case ClassWriter.FIELDORMETH_INSN: - case ClassWriter.TYPE_INSN: - case ClassWriter.IINC_INSN: - u += 3; - break; - case ClassWriter.ITFMETH_INSN: - u += 5; - break; - // case ClassWriter.MANA_INSN: - default: - u += 4; - break; - } - if(insert != 0) - { - // adds a new (u, insert) entry in the allIndexes and - // allSizes arrays - int[] newIndexes = new int[allIndexes.length + 1]; - int[] newSizes = new int[allSizes.length + 1]; - System.arraycopy(allIndexes, - 0, - newIndexes, - 0, - allIndexes.length); - System.arraycopy(allSizes, 0, newSizes, 0, allSizes.length); - newIndexes[allIndexes.length] = u; - newSizes[allSizes.length] = insert; - allIndexes = newIndexes; - allSizes = newSizes; - if(insert > 0) - { - state = 3; - } - } - } - if(state < 3) - { - --state; - } - } while(state != 0); - - // 2nd step: - // copies the bytecode of the method into a new bytevector, updates the - // offsets, and inserts (or removes) bytes as requested. - - ByteVector newCode = new ByteVector(code.length); - - u = 0; - while(u < code.length) - { - int opcode = b[u] & 0xFF; - switch(ClassWriter.TYPE[opcode]) - { - case ClassWriter.NOARG_INSN: - case ClassWriter.IMPLVAR_INSN: - newCode.putByte(opcode); - u += 1; - break; - case ClassWriter.LABEL_INSN: - if(opcode > 201) - { - // changes temporary opcodes 202 to 217 (inclusive), 218 - // and 219 to IFEQ ... JSR (inclusive), IFNULL and - // IFNONNULL - opcode = opcode < 218 ? opcode - 49 : opcode - 20; - label = u + readUnsignedShort(b, u + 1); - } - else - { - label = u + readShort(b, u + 1); - } - newOffset = getNewOffset(allIndexes, allSizes, u, label); - if(resize[u]) - { - // replaces GOTO with GOTO_W, JSR with JSR_W and IFxxx - // with IFNOTxxx GOTO_W , where IFNOTxxx is - // the "opposite" opcode of IFxxx (i.e., IFNE for IFEQ) - // and where designates the instruction just after - // the GOTO_W. - if(opcode == Opcodes.GOTO) - { - newCode.putByte(200); // GOTO_W - } - else if(opcode == Opcodes.JSR) - { - newCode.putByte(201); // JSR_W - } - else - { - newCode.putByte(opcode <= 166 - ? ((opcode + 1) ^ 1) - 1 - : opcode ^ 1); - newCode.putShort(8); // jump offset - newCode.putByte(200); // GOTO_W - // newOffset now computed from start of GOTO_W - newOffset -= 3; - } - newCode.putInt(newOffset); - } - else - { - newCode.putByte(opcode); - newCode.putShort(newOffset); - } - u += 3; - break; - case ClassWriter.LABELW_INSN: - label = u + readInt(b, u + 1); - newOffset = getNewOffset(allIndexes, allSizes, u, label); - newCode.putByte(opcode); - newCode.putInt(newOffset); - u += 5; - break; - case ClassWriter.TABL_INSN: - // skips 0 to 3 padding bytes - v = u; - u = u + 4 - (v & 3); - // reads and copies instruction - newCode.putByte(Opcodes.TABLESWITCH); - newCode.length += (4 - newCode.length % 4) % 4; - label = v + readInt(b, u); - u += 4; - newOffset = getNewOffset(allIndexes, allSizes, v, label); - newCode.putInt(newOffset); - j = readInt(b, u); - u += 4; - newCode.putInt(j); - j = readInt(b, u) - j + 1; - u += 4; - newCode.putInt(readInt(b, u - 4)); - for(; j > 0; --j) - { - label = v + readInt(b, u); - u += 4; - newOffset = getNewOffset(allIndexes, allSizes, v, label); - newCode.putInt(newOffset); - } - break; - case ClassWriter.LOOK_INSN: - // skips 0 to 3 padding bytes - v = u; - u = u + 4 - (v & 3); - // reads and copies instruction - newCode.putByte(Opcodes.LOOKUPSWITCH); - newCode.length += (4 - newCode.length % 4) % 4; - label = v + readInt(b, u); - u += 4; - newOffset = getNewOffset(allIndexes, allSizes, v, label); - newCode.putInt(newOffset); - j = readInt(b, u); - u += 4; - newCode.putInt(j); - for(; j > 0; --j) - { - newCode.putInt(readInt(b, u)); - u += 4; - label = v + readInt(b, u); - u += 4; - newOffset = getNewOffset(allIndexes, allSizes, v, label); - newCode.putInt(newOffset); - } - break; - case ClassWriter.WIDE_INSN: - opcode = b[u + 1] & 0xFF; - if(opcode == Opcodes.IINC) - { - newCode.putByteArray(b, u, 6); - u += 6; - } - else - { - newCode.putByteArray(b, u, 4); - u += 4; - } - break; - case ClassWriter.VAR_INSN: - case ClassWriter.SBYTE_INSN: - case ClassWriter.LDC_INSN: - newCode.putByteArray(b, u, 2); - u += 2; - break; - case ClassWriter.SHORT_INSN: - case ClassWriter.LDCW_INSN: - case ClassWriter.FIELDORMETH_INSN: - case ClassWriter.TYPE_INSN: - case ClassWriter.IINC_INSN: - newCode.putByteArray(b, u, 3); - u += 3; - break; - case ClassWriter.ITFMETH_INSN: - newCode.putByteArray(b, u, 5); - u += 5; - break; - // case MANA_INSN: - default: - newCode.putByteArray(b, u, 4); - u += 4; - break; - } - } - - // recomputes the stack map frames - if(frameCount > 0) - { - if(compute == FRAMES) - { - frameCount = 0; - stackMap = null; - previousFrame = null; - frame = null; - Frame f = new Frame(); - f.owner = labels; - Type[] args = Type.getArgumentTypes(descriptor); - f.initInputFrame(cw, access, args, maxLocals); - visitFrame(f); - Label l = labels; - while(l != null) - { - /* - * here we need the original label position. getNewOffset - * must therefore never have been called for this label. - */ - u = l.position - 3; - if((l.status & Label.STORE) != 0 || (u >= 0 && resize[u])) - { - getNewOffset(allIndexes, allSizes, l); - // TODO update offsets in UNINITIALIZED values - visitFrame(l.frame); - } - l = l.successor; - } - } - else - { - /* - * Resizing an existing stack map frame table is really hard. - * Not only the table must be parsed to update the offets, but - * new frames may be needed for jump instructions that were - * inserted by this method. And updating the offsets or - * inserting frames can change the format of the following - * frames, in case of packed frames. In practice the whole table - * must be recomputed. For this the frames are marked as - * potentially invalid. This will cause the whole class to be - * reread and rewritten with the COMPUTE_FRAMES option (see the - * ClassWriter.toByteArray method). This is not very efficient - * but is much easier and requires much less code than any other - * method I can think of. - */ - cw.invalidFrames = true; - } - } - // updates the exception handler block labels - Handler h = firstHandler; - while(h != null) - { - getNewOffset(allIndexes, allSizes, h.start); - getNewOffset(allIndexes, allSizes, h.end); - getNewOffset(allIndexes, allSizes, h.handler); - h = h.next; - } - // updates the instructions addresses in the - // local var and line number tables - for(i = 0; i < 2; ++i) - { - ByteVector bv = i == 0 ? localVar : localVarType; - if(bv != null) - { - b = bv.data; - u = 0; - while(u < bv.length) - { - label = readUnsignedShort(b, u); - newOffset = getNewOffset(allIndexes, allSizes, 0, label); - writeShort(b, u, newOffset); - label += readUnsignedShort(b, u + 2); - newOffset = getNewOffset(allIndexes, allSizes, 0, label) - - newOffset; - writeShort(b, u + 2, newOffset); - u += 10; - } - } - } - if(lineNumber != null) - { - b = lineNumber.data; - u = 0; - while(u < lineNumber.length) - { - writeShort(b, u, getNewOffset(allIndexes, - allSizes, - 0, - readUnsignedShort(b, u))); - u += 4; - } - } - // updates the labels of the other attributes - Attribute attr = cattrs; - while(attr != null) - { - Label[] labels = attr.getLabels(); - if(labels != null) - { - for(i = labels.length - 1; i >= 0; --i) - { - getNewOffset(allIndexes, allSizes, labels[i]); - } - } - attr = attr.next; - } - - // replaces old bytecodes with new ones - code = newCode; -} - -/** - * Reads an unsigned short value in the given byte array. - * - * @param b a byte array. - * @param index the start index of the value to be read. - * @return the read value. - */ -static int readUnsignedShort(final byte[] b, final int index){ - return ((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF); -} - -/** - * Reads a signed short value in the given byte array. - * - * @param b a byte array. - * @param index the start index of the value to be read. - * @return the read value. - */ -static short readShort(final byte[] b, final int index){ - return (short) (((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF)); -} - -/** - * Reads a signed int value in the given byte array. - * - * @param b a byte array. - * @param index the start index of the value to be read. - * @return the read value. - */ -static int readInt(final byte[] b, final int index){ - return ((b[index] & 0xFF) << 24) | ((b[index + 1] & 0xFF) << 16) - | ((b[index + 2] & 0xFF) << 8) | (b[index + 3] & 0xFF); -} - -/** - * Writes a short value in the given byte array. - * - * @param b a byte array. - * @param index where the first byte of the short value must be written. - * @param s the value to be written in the given byte array. - */ -static void writeShort(final byte[] b, final int index, final int s){ - b[index] = (byte) (s >>> 8); - b[index + 1] = (byte) s; -} - -/** - * Computes the future value of a bytecode offset.

Note: it is possible - * to have several entries for the same instruction in the indexes - * and sizes: two entries (index=a,size=b) and (index=a,size=b') - * are equivalent to a single entry (index=a,size=b+b'). - * - * @param indexes current positions of the instructions to be resized. Each - * instruction must be designated by the index of its last - * byte, plus one (or, in other words, by the index of the first - * byte of the next instruction). - * @param sizes the number of bytes to be added to the above - * instructions. More precisely, for each i < len, - * sizes[i] bytes will be added at the end of the - * instruction designated by indexes[i] or, if - * sizes[i] is negative, the last |sizes[i]| - * bytes of the instruction will be removed (the instruction size - * must not become negative or null). - * @param begin index of the first byte of the source instruction. - * @param end index of the first byte of the target instruction. - * @return the future value of the given bytecode offset. - */ -static int getNewOffset( - final int[] indexes, - final int[] sizes, - final int begin, - final int end){ - int offset = end - begin; - for(int i = 0; i < indexes.length; ++i) - { - if(begin < indexes[i] && indexes[i] <= end) - { - // forward jump - offset += sizes[i]; - } - else if(end < indexes[i] && indexes[i] <= begin) - { - // backward jump - offset -= sizes[i]; - } - } - return offset; -} - -/** - * Updates the offset of the given label. - * - * @param indexes current positions of the instructions to be resized. Each - * instruction must be designated by the index of its last - * byte, plus one (or, in other words, by the index of the first - * byte of the next instruction). - * @param sizes the number of bytes to be added to the above - * instructions. More precisely, for each i < len, - * sizes[i] bytes will be added at the end of the - * instruction designated by indexes[i] or, if - * sizes[i] is negative, the last |sizes[i]| - * bytes of the instruction will be removed (the instruction size - * must not become negative or null). - * @param label the label whose offset must be updated. - */ -static void getNewOffset( - final int[] indexes, - final int[] sizes, - final Label label){ - if((label.status & Label.RESIZED) == 0) - { - label.position = getNewOffset(indexes, sizes, 0, label.position); - label.status |= Label.RESIZED; - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/Opcodes.java --- a/src/clojure/asm/Opcodes.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,341 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -/** - * Defines the JVM opcodes, access flags and array type codes. This interface - * does not define all the JVM opcodes because some opcodes are automatically - * handled. For example, the xLOAD and xSTORE opcodes are automatically replaced - * by xLOAD_n and xSTORE_n opcodes when possible. The xLOAD_n and xSTORE_n - * opcodes are therefore not defined in this interface. Likewise for LDC, - * automatically replaced by LDC_W or LDC2_W when necessary, WIDE, GOTO_W and - * JSR_W. - * - * @author Eric Bruneton - * @author Eugene Kuleshov - */ -public interface Opcodes{ - -// versions - -int V1_1 = 3 << 16 | 45; -int V1_2 = 0 << 16 | 46; -int V1_3 = 0 << 16 | 47; -int V1_4 = 0 << 16 | 48; -int V1_5 = 0 << 16 | 49; -int V1_6 = 0 << 16 | 50; - -// access flags - -int ACC_PUBLIC = 0x0001; // class, field, method -int ACC_PRIVATE = 0x0002; // class, field, method -int ACC_PROTECTED = 0x0004; // class, field, method -int ACC_STATIC = 0x0008; // field, method -int ACC_FINAL = 0x0010; // class, field, method -int ACC_SUPER = 0x0020; // class -int ACC_SYNCHRONIZED = 0x0020; // method -int ACC_VOLATILE = 0x0040; // field -int ACC_BRIDGE = 0x0040; // method -int ACC_VARARGS = 0x0080; // method -int ACC_TRANSIENT = 0x0080; // field -int ACC_NATIVE = 0x0100; // method -int ACC_INTERFACE = 0x0200; // class -int ACC_ABSTRACT = 0x0400; // class, method -int ACC_STRICT = 0x0800; // method -int ACC_SYNTHETIC = 0x1000; // class, field, method -int ACC_ANNOTATION = 0x2000; // class -int ACC_ENUM = 0x4000; // class(?) field inner - -// ASM specific pseudo access flags - -int ACC_DEPRECATED = 131072; // class, field, method - -// types for NEWARRAY - -int T_BOOLEAN = 4; -int T_CHAR = 5; -int T_FLOAT = 6; -int T_DOUBLE = 7; -int T_BYTE = 8; -int T_SHORT = 9; -int T_INT = 10; -int T_LONG = 11; - -// stack map frame types - -/** - * Represents an expanded frame. See {@link ClassReader#EXPAND_FRAMES}. - */ -int F_NEW = -1; - -/** - * Represents a compressed frame with complete frame data. - */ -int F_FULL = 0; - -/** - * Represents a compressed frame where locals are the same as the locals in - * the previous frame, except that additional 1-3 locals are defined, and - * with an empty stack. - */ -int F_APPEND = 1; - -/** - * Represents a compressed frame where locals are the same as the locals in - * the previous frame, except that the last 1-3 locals are absent and with - * an empty stack. - */ -int F_CHOP = 2; - -/** - * Represents a compressed frame with exactly the same locals as the - * previous frame and with an empty stack. - */ -int F_SAME = 3; - -/** - * Represents a compressed frame with exactly the same locals as the - * previous frame and with a single value on the stack. - */ -int F_SAME1 = 4; - -Integer TOP = new Integer(0); -Integer INTEGER = new Integer(1); -Integer FLOAT = new Integer(2); -Integer DOUBLE = new Integer(3); -Integer LONG = new Integer(4); -Integer NULL = new Integer(5); -Integer UNINITIALIZED_THIS = new Integer(6); - -// opcodes // visit method (- = idem) - -int NOP = 0; // visitInsn -int ACONST_NULL = 1; // - -int ICONST_M1 = 2; // - -int ICONST_0 = 3; // - -int ICONST_1 = 4; // - -int ICONST_2 = 5; // - -int ICONST_3 = 6; // - -int ICONST_4 = 7; // - -int ICONST_5 = 8; // - -int LCONST_0 = 9; // - -int LCONST_1 = 10; // - -int FCONST_0 = 11; // - -int FCONST_1 = 12; // - -int FCONST_2 = 13; // - -int DCONST_0 = 14; // - -int DCONST_1 = 15; // - -int BIPUSH = 16; // visitIntInsn -int SIPUSH = 17; // - -int LDC = 18; // visitLdcInsn -// int LDC_W = 19; // - -// int LDC2_W = 20; // - -int ILOAD = 21; // visitVarInsn -int LLOAD = 22; // - -int FLOAD = 23; // - -int DLOAD = 24; // - -int ALOAD = 25; // - -// int ILOAD_0 = 26; // - -// int ILOAD_1 = 27; // - -// int ILOAD_2 = 28; // - -// int ILOAD_3 = 29; // - -// int LLOAD_0 = 30; // - -// int LLOAD_1 = 31; // - -// int LLOAD_2 = 32; // - -// int LLOAD_3 = 33; // - -// int FLOAD_0 = 34; // - -// int FLOAD_1 = 35; // - -// int FLOAD_2 = 36; // - -// int FLOAD_3 = 37; // - -// int DLOAD_0 = 38; // - -// int DLOAD_1 = 39; // - -// int DLOAD_2 = 40; // - -// int DLOAD_3 = 41; // - -// int ALOAD_0 = 42; // - -// int ALOAD_1 = 43; // - -// int ALOAD_2 = 44; // - -// int ALOAD_3 = 45; // - -int IALOAD = 46; // visitInsn -int LALOAD = 47; // - -int FALOAD = 48; // - -int DALOAD = 49; // - -int AALOAD = 50; // - -int BALOAD = 51; // - -int CALOAD = 52; // - -int SALOAD = 53; // - -int ISTORE = 54; // visitVarInsn -int LSTORE = 55; // - -int FSTORE = 56; // - -int DSTORE = 57; // - -int ASTORE = 58; // - -// int ISTORE_0 = 59; // - -// int ISTORE_1 = 60; // - -// int ISTORE_2 = 61; // - -// int ISTORE_3 = 62; // - -// int LSTORE_0 = 63; // - -// int LSTORE_1 = 64; // - -// int LSTORE_2 = 65; // - -// int LSTORE_3 = 66; // - -// int FSTORE_0 = 67; // - -// int FSTORE_1 = 68; // - -// int FSTORE_2 = 69; // - -// int FSTORE_3 = 70; // - -// int DSTORE_0 = 71; // - -// int DSTORE_1 = 72; // - -// int DSTORE_2 = 73; // - -// int DSTORE_3 = 74; // - -// int ASTORE_0 = 75; // - -// int ASTORE_1 = 76; // - -// int ASTORE_2 = 77; // - -// int ASTORE_3 = 78; // - -int IASTORE = 79; // visitInsn -int LASTORE = 80; // - -int FASTORE = 81; // - -int DASTORE = 82; // - -int AASTORE = 83; // - -int BASTORE = 84; // - -int CASTORE = 85; // - -int SASTORE = 86; // - -int POP = 87; // - -int POP2 = 88; // - -int DUP = 89; // - -int DUP_X1 = 90; // - -int DUP_X2 = 91; // - -int DUP2 = 92; // - -int DUP2_X1 = 93; // - -int DUP2_X2 = 94; // - -int SWAP = 95; // - -int IADD = 96; // - -int LADD = 97; // - -int FADD = 98; // - -int DADD = 99; // - -int ISUB = 100; // - -int LSUB = 101; // - -int FSUB = 102; // - -int DSUB = 103; // - -int IMUL = 104; // - -int LMUL = 105; // - -int FMUL = 106; // - -int DMUL = 107; // - -int IDIV = 108; // - -int LDIV = 109; // - -int FDIV = 110; // - -int DDIV = 111; // - -int IREM = 112; // - -int LREM = 113; // - -int FREM = 114; // - -int DREM = 115; // - -int INEG = 116; // - -int LNEG = 117; // - -int FNEG = 118; // - -int DNEG = 119; // - -int ISHL = 120; // - -int LSHL = 121; // - -int ISHR = 122; // - -int LSHR = 123; // - -int IUSHR = 124; // - -int LUSHR = 125; // - -int IAND = 126; // - -int LAND = 127; // - -int IOR = 128; // - -int LOR = 129; // - -int IXOR = 130; // - -int LXOR = 131; // - -int IINC = 132; // visitIincInsn -int I2L = 133; // visitInsn -int I2F = 134; // - -int I2D = 135; // - -int L2I = 136; // - -int L2F = 137; // - -int L2D = 138; // - -int F2I = 139; // - -int F2L = 140; // - -int F2D = 141; // - -int D2I = 142; // - -int D2L = 143; // - -int D2F = 144; // - -int I2B = 145; // - -int I2C = 146; // - -int I2S = 147; // - -int LCMP = 148; // - -int FCMPL = 149; // - -int FCMPG = 150; // - -int DCMPL = 151; // - -int DCMPG = 152; // - -int IFEQ = 153; // visitJumpInsn -int IFNE = 154; // - -int IFLT = 155; // - -int IFGE = 156; // - -int IFGT = 157; // - -int IFLE = 158; // - -int IF_ICMPEQ = 159; // - -int IF_ICMPNE = 160; // - -int IF_ICMPLT = 161; // - -int IF_ICMPGE = 162; // - -int IF_ICMPGT = 163; // - -int IF_ICMPLE = 164; // - -int IF_ACMPEQ = 165; // - -int IF_ACMPNE = 166; // - -int GOTO = 167; // - -int JSR = 168; // - -int RET = 169; // visitVarInsn -int TABLESWITCH = 170; // visiTableSwitchInsn -int LOOKUPSWITCH = 171; // visitLookupSwitch -int IRETURN = 172; // visitInsn -int LRETURN = 173; // - -int FRETURN = 174; // - -int DRETURN = 175; // - -int ARETURN = 176; // - -int RETURN = 177; // - -int GETSTATIC = 178; // visitFieldInsn -int PUTSTATIC = 179; // - -int GETFIELD = 180; // - -int PUTFIELD = 181; // - -int INVOKEVIRTUAL = 182; // visitMethodInsn -int INVOKESPECIAL = 183; // - -int INVOKESTATIC = 184; // - -int INVOKEINTERFACE = 185; // - -// int UNUSED = 186; // NOT VISITED -int NEW = 187; // visitTypeInsn -int NEWARRAY = 188; // visitIntInsn -int ANEWARRAY = 189; // visitTypeInsn -int ARRAYLENGTH = 190; // visitInsn -int ATHROW = 191; // - -int CHECKCAST = 192; // visitTypeInsn -int INSTANCEOF = 193; // - -int MONITORENTER = 194; // visitInsn -int MONITOREXIT = 195; // - -// int WIDE = 196; // NOT VISITED -int MULTIANEWARRAY = 197; // visitMultiANewArrayInsn -int IFNULL = 198; // visitJumpInsn -int IFNONNULL = 199; // - -// int GOTO_W = 200; // - -// int JSR_W = 201; // - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/Type.java --- a/src/clojure/asm/Type.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,872 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm; - -import java.lang.reflect.Constructor; -import java.lang.reflect.Method; - -/** - * A Java type. This class can be used to make it easier to manipulate type and - * method descriptors. - * - * @author Eric Bruneton - * @author Chris Nokleberg - */ -public class Type{ - -/** - * The sort of the void type. See {@link #getSort getSort}. - */ -public final static int VOID = 0; - -/** - * The sort of the boolean type. See {@link #getSort getSort}. - */ -public final static int BOOLEAN = 1; - -/** - * The sort of the char type. See {@link #getSort getSort}. - */ -public final static int CHAR = 2; - -/** - * The sort of the byte type. See {@link #getSort getSort}. - */ -public final static int BYTE = 3; - -/** - * The sort of the short type. See {@link #getSort getSort}. - */ -public final static int SHORT = 4; - -/** - * The sort of the int type. See {@link #getSort getSort}. - */ -public final static int INT = 5; - -/** - * The sort of the float type. See {@link #getSort getSort}. - */ -public final static int FLOAT = 6; - -/** - * The sort of the long type. See {@link #getSort getSort}. - */ -public final static int LONG = 7; - -/** - * The sort of the double type. See {@link #getSort getSort}. - */ -public final static int DOUBLE = 8; - -/** - * The sort of array reference types. See {@link #getSort getSort}. - */ -public final static int ARRAY = 9; - -/** - * The sort of object reference type. See {@link #getSort getSort}. - */ -public final static int OBJECT = 10; - -/** - * The void type. - */ -public final static Type VOID_TYPE = new Type(VOID); - -/** - * The boolean type. - */ -public final static Type BOOLEAN_TYPE = new Type(BOOLEAN); - -/** - * The char type. - */ -public final static Type CHAR_TYPE = new Type(CHAR); - -/** - * The byte type. - */ -public final static Type BYTE_TYPE = new Type(BYTE); - -/** - * The short type. - */ -public final static Type SHORT_TYPE = new Type(SHORT); - -/** - * The int type. - */ -public final static Type INT_TYPE = new Type(INT); - -/** - * The float type. - */ -public final static Type FLOAT_TYPE = new Type(FLOAT); - -/** - * The long type. - */ -public final static Type LONG_TYPE = new Type(LONG); - -/** - * The double type. - */ -public final static Type DOUBLE_TYPE = new Type(DOUBLE); - -// ------------------------------------------------------------------------ -// Fields -// ------------------------------------------------------------------------ - -/** - * The sort of this Java type. - */ -private final int sort; - -/** - * A buffer containing the descriptor of this Java type. This field is only - * used for reference types. - */ -private char[] buf; - -/** - * The offset of the descriptor of this Java type in {@link #buf buf}. This - * field is only used for reference types. - */ -private int off; - -/** - * The length of the descriptor of this Java type. - */ -private int len; - -// ------------------------------------------------------------------------ -// Constructors -// ------------------------------------------------------------------------ - -/** - * Constructs a primitive type. - * - * @param sort the sort of the primitive type to be constructed. - */ -private Type(final int sort){ - this.sort = sort; - this.len = 1; -} - -/** - * Constructs a reference type. - * - * @param sort the sort of the reference type to be constructed. - * @param buf a buffer containing the descriptor of the previous type. - * @param off the offset of this descriptor in the previous buffer. - * @param len the length of this descriptor. - */ -private Type(final int sort, final char[] buf, final int off, final int len){ - this.sort = sort; - this.buf = buf; - this.off = off; - this.len = len; -} - -/** - * Returns the Java type corresponding to the given type descriptor. - * - * @param typeDescriptor a type descriptor. - * @return the Java type corresponding to the given type descriptor. - */ -public static Type getType(final String typeDescriptor){ - return getType(typeDescriptor.toCharArray(), 0); -} - -/** - * Returns the Java type corresponding to the given class. - * - * @param c a class. - * @return the Java type corresponding to the given class. - */ -public static Type getType(final Class c){ - if(c.isPrimitive()) - { - if(c == Integer.TYPE) - { - return INT_TYPE; - } - else if(c == Void.TYPE) - { - return VOID_TYPE; - } - else if(c == Boolean.TYPE) - { - return BOOLEAN_TYPE; - } - else if(c == Byte.TYPE) - { - return BYTE_TYPE; - } - else if(c == Character.TYPE) - { - return CHAR_TYPE; - } - else if(c == Short.TYPE) - { - return SHORT_TYPE; - } - else if(c == Double.TYPE) - { - return DOUBLE_TYPE; - } - else if(c == Float.TYPE) - { - return FLOAT_TYPE; - } - else /* if (c == Long.TYPE) */ - { - return LONG_TYPE; - } - } - else - { - return getType(getDescriptor(c)); - } -} - -/** - * Returns the {@link Type#OBJECT} type for the given internal class name. - * This is a shortcut method for Type.getType("L"+name+";"). - * Note that opposed to {@link Type#getType(String)}, this method takes - * internal class names and not class descriptor. - * - * @param name an internal class name. - * @return the the {@link Type#OBJECT} type for the given class name. - */ -public static Type getObjectType(String name){ - int l = name.length(); - char[] buf = new char[l + 2]; - buf[0] = 'L'; - buf[l + 1] = ';'; - name.getChars(0, l, buf, 1); - return new Type(OBJECT, buf, 0, l + 2); -} - -/** - * Returns the Java types corresponding to the argument types of the given - * method descriptor. - * - * @param methodDescriptor a method descriptor. - * @return the Java types corresponding to the argument types of the given - * method descriptor. - */ -public static Type[] getArgumentTypes(final String methodDescriptor){ - char[] buf = methodDescriptor.toCharArray(); - int off = 1; - int size = 0; - while(true) - { - char car = buf[off++]; - if(car == ')') - { - break; - } - else if(car == 'L') - { - while(buf[off++] != ';') - { - } - ++size; - } - else if(car != '[') - { - ++size; - } - } - Type[] args = new Type[size]; - off = 1; - size = 0; - while(buf[off] != ')') - { - args[size] = getType(buf, off); - off += args[size].len; - size += 1; - } - return args; -} - -/** - * Returns the Java types corresponding to the argument types of the given - * method. - * - * @param method a method. - * @return the Java types corresponding to the argument types of the given - * method. - */ -public static Type[] getArgumentTypes(final Method method){ - Class[] classes = method.getParameterTypes(); - Type[] types = new Type[classes.length]; - for(int i = classes.length - 1; i >= 0; --i) - { - types[i] = getType(classes[i]); - } - return types; -} - -/** - * Returns the Java type corresponding to the return type of the given - * method descriptor. - * - * @param methodDescriptor a method descriptor. - * @return the Java type corresponding to the return type of the given - * method descriptor. - */ -public static Type getReturnType(final String methodDescriptor){ - char[] buf = methodDescriptor.toCharArray(); - return getType(buf, methodDescriptor.indexOf(')') + 1); -} - -/** - * Returns the Java type corresponding to the return type of the given - * method. - * - * @param method a method. - * @return the Java type corresponding to the return type of the given - * method. - */ -public static Type getReturnType(final Method method){ - return getType(method.getReturnType()); -} - -/** - * Returns the Java type corresponding to the given type descriptor. - * - * @param buf a buffer containing a type descriptor. - * @param off the offset of this descriptor in the previous buffer. - * @return the Java type corresponding to the given type descriptor. - */ -private static Type getType(final char[] buf, final int off){ - int len; - switch(buf[off]) - { - case'V': - return VOID_TYPE; - case'Z': - return BOOLEAN_TYPE; - case'C': - return CHAR_TYPE; - case'B': - return BYTE_TYPE; - case'S': - return SHORT_TYPE; - case'I': - return INT_TYPE; - case'F': - return FLOAT_TYPE; - case'J': - return LONG_TYPE; - case'D': - return DOUBLE_TYPE; - case'[': - len = 1; - while(buf[off + len] == '[') - { - ++len; - } - if(buf[off + len] == 'L') - { - ++len; - while(buf[off + len] != ';') - { - ++len; - } - } - return new Type(ARRAY, buf, off, len + 1); - // case 'L': - default: - len = 1; - while(buf[off + len] != ';') - { - ++len; - } - return new Type(OBJECT, buf, off, len + 1); - } -} - -// ------------------------------------------------------------------------ -// Accessors -// ------------------------------------------------------------------------ - -/** - * Returns the sort of this Java type. - * - * @return {@link #VOID VOID}, {@link #BOOLEAN BOOLEAN}, - * {@link #CHAR CHAR}, {@link #BYTE BYTE}, {@link #SHORT SHORT}, - * {@link #INT INT}, {@link #FLOAT FLOAT}, {@link #LONG LONG}, - * {@link #DOUBLE DOUBLE}, {@link #ARRAY ARRAY} or - * {@link #OBJECT OBJECT}. - */ -public int getSort(){ - return sort; -} - -/** - * Returns the number of dimensions of this array type. This method should - * only be used for an array type. - * - * @return the number of dimensions of this array type. - */ -public int getDimensions(){ - int i = 1; - while(buf[off + i] == '[') - { - ++i; - } - return i; -} - -/** - * Returns the type of the elements of this array type. This method should - * only be used for an array type. - * - * @return Returns the type of the elements of this array type. - */ -public Type getElementType(){ - return getType(buf, off + getDimensions()); -} - -/** - * Returns the name of the class corresponding to this type. - * - * @return the fully qualified name of the class corresponding to this type. - */ -public String getClassName(){ - switch(sort) - { - case VOID: - return "void"; - case BOOLEAN: - return "boolean"; - case CHAR: - return "char"; - case BYTE: - return "byte"; - case SHORT: - return "short"; - case INT: - return "int"; - case FLOAT: - return "float"; - case LONG: - return "long"; - case DOUBLE: - return "double"; - case ARRAY: - StringBuffer b = new StringBuffer(getElementType().getClassName()); - for(int i = getDimensions(); i > 0; --i) - { - b.append("[]"); - } - return b.toString(); - // case OBJECT: - default: - return new String(buf, off + 1, len - 2).replace('/', '.'); - } -} - -/** - * Returns the internal name of the class corresponding to this object type. - * The internal name of a class is its fully qualified name, where '.' are - * replaced by '/'. This method should only be used for an object type. - * - * @return the internal name of the class corresponding to this object type. - */ -public String getInternalName(){ - return new String(buf, off + 1, len - 2); -} - -// ------------------------------------------------------------------------ -// Conversion to type descriptors -// ------------------------------------------------------------------------ - -/** - * Returns the descriptor corresponding to this Java type. - * - * @return the descriptor corresponding to this Java type. - */ -public String getDescriptor(){ - StringBuffer buf = new StringBuffer(); - getDescriptor(buf); - return buf.toString(); -} - -/** - * Returns the descriptor corresponding to the given argument and return - * types. - * - * @param returnType the return type of the method. - * @param argumentTypes the argument types of the method. - * @return the descriptor corresponding to the given argument and return - * types. - */ -public static String getMethodDescriptor( - final Type returnType, - final Type[] argumentTypes){ - StringBuffer buf = new StringBuffer(); - buf.append('('); - for(int i = 0; i < argumentTypes.length; ++i) - { - argumentTypes[i].getDescriptor(buf); - } - buf.append(')'); - returnType.getDescriptor(buf); - return buf.toString(); -} - -/** - * Appends the descriptor corresponding to this Java type to the given - * string buffer. - * - * @param buf the string buffer to which the descriptor must be appended. - */ -private void getDescriptor(final StringBuffer buf){ - switch(sort) - { - case VOID: - buf.append('V'); - return; - case BOOLEAN: - buf.append('Z'); - return; - case CHAR: - buf.append('C'); - return; - case BYTE: - buf.append('B'); - return; - case SHORT: - buf.append('S'); - return; - case INT: - buf.append('I'); - return; - case FLOAT: - buf.append('F'); - return; - case LONG: - buf.append('J'); - return; - case DOUBLE: - buf.append('D'); - return; - // case ARRAY: - // case OBJECT: - default: - buf.append(this.buf, off, len); - } -} - -// ------------------------------------------------------------------------ -// Direct conversion from classes to type descriptors, -// without intermediate Type objects -// ------------------------------------------------------------------------ - -/** - * Returns the internal name of the given class. The internal name of a - * class is its fully qualified name, where '.' are replaced by '/'. - * - * @param c an object class. - * @return the internal name of the given class. - */ -public static String getInternalName(final Class c){ - return c.getName().replace('.', '/'); -} - -/** - * Returns the descriptor corresponding to the given Java type. - * - * @param c an object class, a primitive class or an array class. - * @return the descriptor corresponding to the given class. - */ -public static String getDescriptor(final Class c){ - StringBuffer buf = new StringBuffer(); - getDescriptor(buf, c); - return buf.toString(); -} - -/** - * Returns the descriptor corresponding to the given constructor. - * - * @param c a {@link Constructor Constructor} object. - * @return the descriptor of the given constructor. - */ -public static String getConstructorDescriptor(final Constructor c){ - Class[] parameters = c.getParameterTypes(); - StringBuffer buf = new StringBuffer(); - buf.append('('); - for(int i = 0; i < parameters.length; ++i) - { - getDescriptor(buf, parameters[i]); - } - return buf.append(")V").toString(); -} - -/** - * Returns the descriptor corresponding to the given method. - * - * @param m a {@link Method Method} object. - * @return the descriptor of the given method. - */ -public static String getMethodDescriptor(final Method m){ - Class[] parameters = m.getParameterTypes(); - StringBuffer buf = new StringBuffer(); - buf.append('('); - for(int i = 0; i < parameters.length; ++i) - { - getDescriptor(buf, parameters[i]); - } - buf.append(')'); - getDescriptor(buf, m.getReturnType()); - return buf.toString(); -} - -/** - * Appends the descriptor of the given class to the given string buffer. - * - * @param buf the string buffer to which the descriptor must be appended. - * @param c the class whose descriptor must be computed. - */ -private static void getDescriptor(final StringBuffer buf, final Class c){ - Class d = c; - while(true) - { - if(d.isPrimitive()) - { - char car; - if(d == Integer.TYPE) - { - car = 'I'; - } - else if(d == Void.TYPE) - { - car = 'V'; - } - else if(d == Boolean.TYPE) - { - car = 'Z'; - } - else if(d == Byte.TYPE) - { - car = 'B'; - } - else if(d == Character.TYPE) - { - car = 'C'; - } - else if(d == Short.TYPE) - { - car = 'S'; - } - else if(d == Double.TYPE) - { - car = 'D'; - } - else if(d == Float.TYPE) - { - car = 'F'; - } - else /* if (d == Long.TYPE) */ - { - car = 'J'; - } - buf.append(car); - return; - } - else if(d.isArray()) - { - buf.append('['); - d = d.getComponentType(); - } - else - { - buf.append('L'); - String name = d.getName(); - int len = name.length(); - for(int i = 0; i < len; ++i) - { - char car = name.charAt(i); - buf.append(car == '.' ? '/' : car); - } - buf.append(';'); - return; - } - } -} - -// ------------------------------------------------------------------------ -// Corresponding size and opcodes -// ------------------------------------------------------------------------ - -/** - * Returns the size of values of this type. - * - * @return the size of values of this type, i.e., 2 for long and - * double, and 1 otherwise. - */ -public int getSize(){ - return sort == LONG || sort == DOUBLE ? 2 : 1; -} - -/** - * Returns a JVM instruction opcode adapted to this Java type. - * - * @param opcode a JVM instruction opcode. This opcode must be one of ILOAD, - * ISTORE, IALOAD, IASTORE, IADD, ISUB, IMUL, IDIV, IREM, INEG, ISHL, - * ISHR, IUSHR, IAND, IOR, IXOR and IRETURN. - * @return an opcode that is similar to the given opcode, but adapted to - * this Java type. For example, if this type is float and - * opcode is IRETURN, this method returns FRETURN. - */ -public int getOpcode(final int opcode){ - if(opcode == Opcodes.IALOAD || opcode == Opcodes.IASTORE) - { - switch(sort) - { - case BOOLEAN: - case BYTE: - return opcode + 5; - case CHAR: - return opcode + 6; - case SHORT: - return opcode + 7; - case INT: - return opcode; - case FLOAT: - return opcode + 2; - case LONG: - return opcode + 1; - case DOUBLE: - return opcode + 3; - // case ARRAY: - // case OBJECT: - default: - return opcode + 4; - } - } - else - { - switch(sort) - { - case VOID: - return opcode + 5; - case BOOLEAN: - case CHAR: - case BYTE: - case SHORT: - case INT: - return opcode; - case FLOAT: - return opcode + 2; - case LONG: - return opcode + 1; - case DOUBLE: - return opcode + 3; - // case ARRAY: - // case OBJECT: - default: - return opcode + 4; - } - } -} - -// ------------------------------------------------------------------------ -// Equals, hashCode and toString -// ------------------------------------------------------------------------ - -/** - * Tests if the given object is equal to this type. - * - * @param o the object to be compared to this type. - * @return true if the given object is equal to this type. - */ -public boolean equals(final Object o){ - if(this == o) - { - return true; - } - if(!(o instanceof Type)) - { - return false; - } - Type t = (Type) o; - if(sort != t.sort) - { - return false; - } - if(sort == Type.OBJECT || sort == Type.ARRAY) - { - if(len != t.len) - { - return false; - } - for(int i = off, j = t.off, end = i + len; i < end; i++, j++) - { - if(buf[i] != t.buf[j]) - { - return false; - } - } - } - return true; -} - -/** - * Returns a hash code value for this type. - * - * @return a hash code value for this type. - */ -public int hashCode(){ - int hc = 13 * sort; - if(sort == Type.OBJECT || sort == Type.ARRAY) - { - for(int i = off, end = i + len; i < end; i++) - { - hc = 17 * (hc + buf[i]); - } - } - return hc; -} - -/** - * Returns a string representation of this type. - * - * @return the descriptor of this type. - */ -public String toString(){ - return getDescriptor(); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/AdviceAdapter.java --- a/src/clojure/asm/commons/AdviceAdapter.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,681 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm.commons; - -import java.util.ArrayList; -import java.util.HashMap; - -import clojure.asm.Label; -import clojure.asm.MethodVisitor; -import clojure.asm.Opcodes; -import clojure.asm.Type; - -/** - * A {@link clojure.asm.MethodAdapter} to insert before, after and around - * advices in methods and constructors.

The behavior for constructors is - * like this:

    - *

    - *

  1. as long as the INVOKESPECIAL for the object initialization has not been - * reached, every bytecode instruction is dispatched in the ctor code visitor
    2. - *

    - *

  2. when this one is reached, it is only added in the ctor code visitor and - * a JP invoke is added
    3. - *

    - *

  3. after that, only the other code visitor receives the instructions
    4. - *

    - *

- * - * @author Eugene Kuleshov - * @author Eric Bruneton - */ -public abstract class AdviceAdapter extends GeneratorAdapter implements Opcodes{ -private static final Object THIS = new Object(); -private static final Object OTHER = new Object(); - -protected int methodAccess; -protected String methodDesc; - -private boolean constructor; -private boolean superInitialized; -private ArrayList stackFrame; -private HashMap branches; - -/** - * Creates a new {@link AdviceAdapter}. - * - * @param mv the method visitor to which this adapter delegates calls. - * @param access the method's access flags (see {@link Opcodes}). - * @param name the method's name. - * @param desc the method's descriptor (see {@link Type Type}). - */ -public AdviceAdapter( - final MethodVisitor mv, - final int access, - final String name, - final String desc){ - super(mv, access, name, desc); - methodAccess = access; - methodDesc = desc; - - constructor = "".equals(name); -} - -public void visitCode(){ - mv.visitCode(); - if(!constructor) - { - superInitialized = true; - onMethodEnter(); - } - else - { - stackFrame = new ArrayList(); - branches = new HashMap(); - } -} - -public void visitLabel(final Label label){ - mv.visitLabel(label); - - if(constructor && branches != null) - { - ArrayList frame = (ArrayList) branches.get(label); - if(frame != null) - { - stackFrame = frame; - branches.remove(label); - } - } -} - -public void visitInsn(final int opcode){ - if(constructor) - { - switch(opcode) - { - case RETURN: // empty stack - onMethodExit(opcode); - break; - - case IRETURN: // 1 before n/a after - case FRETURN: // 1 before n/a after - case ARETURN: // 1 before n/a after - case ATHROW: // 1 before n/a after - popValue(); - popValue(); - onMethodExit(opcode); - break; - - case LRETURN: // 2 before n/a after - case DRETURN: // 2 before n/a after - popValue(); - popValue(); - onMethodExit(opcode); - break; - - case NOP: - case LALOAD: // remove 2 add 2 - case DALOAD: // remove 2 add 2 - case LNEG: - case DNEG: - case FNEG: - case INEG: - case L2D: - case D2L: - case F2I: - case I2B: - case I2C: - case I2S: - case I2F: - case Opcodes.ARRAYLENGTH: - break; - - case ACONST_NULL: - case ICONST_M1: - case ICONST_0: - case ICONST_1: - case ICONST_2: - case ICONST_3: - case ICONST_4: - case ICONST_5: - case FCONST_0: - case FCONST_1: - case FCONST_2: - case F2L: // 1 before 2 after - case F2D: - case I2L: - case I2D: - pushValue(OTHER); - break; - - case LCONST_0: - case LCONST_1: - case DCONST_0: - case DCONST_1: - pushValue(OTHER); - pushValue(OTHER); - break; - - case IALOAD: // remove 2 add 1 - case FALOAD: // remove 2 add 1 - case AALOAD: // remove 2 add 1 - case BALOAD: // remove 2 add 1 - case CALOAD: // remove 2 add 1 - case SALOAD: // remove 2 add 1 - case POP: - case IADD: - case FADD: - case ISUB: - case LSHL: // 3 before 2 after - case LSHR: // 3 before 2 after - case LUSHR: // 3 before 2 after - case L2I: // 2 before 1 after - case L2F: // 2 before 1 after - case D2I: // 2 before 1 after - case D2F: // 2 before 1 after - case FSUB: - case FMUL: - case FDIV: - case FREM: - case FCMPL: // 2 before 1 after - case FCMPG: // 2 before 1 after - case IMUL: - case IDIV: - case IREM: - case ISHL: - case ISHR: - case IUSHR: - case IAND: - case IOR: - case IXOR: - case MONITORENTER: - case MONITOREXIT: - popValue(); - break; - - case POP2: - case LSUB: - case LMUL: - case LDIV: - case LREM: - case LADD: - case LAND: - case LOR: - case LXOR: - case DADD: - case DMUL: - case DSUB: - case DDIV: - case DREM: - popValue(); - popValue(); - break; - - case IASTORE: - case FASTORE: - case AASTORE: - case BASTORE: - case CASTORE: - case SASTORE: - case LCMP: // 4 before 1 after - case DCMPL: - case DCMPG: - popValue(); - popValue(); - popValue(); - break; - - case LASTORE: - case DASTORE: - popValue(); - popValue(); - popValue(); - popValue(); - break; - - case DUP: - pushValue(peekValue()); - break; - - case DUP_X1: - // TODO optimize this - { - Object o1 = popValue(); - Object o2 = popValue(); - pushValue(o1); - pushValue(o2); - pushValue(o1); - } - break; - - case DUP_X2: - // TODO optimize this - { - Object o1 = popValue(); - Object o2 = popValue(); - Object o3 = popValue(); - pushValue(o1); - pushValue(o3); - pushValue(o2); - pushValue(o1); - } - break; - - case DUP2: - // TODO optimize this - { - Object o1 = popValue(); - Object o2 = popValue(); - pushValue(o2); - pushValue(o1); - pushValue(o2); - pushValue(o1); - } - break; - - case DUP2_X1: - // TODO optimize this - { - Object o1 = popValue(); - Object o2 = popValue(); - Object o3 = popValue(); - pushValue(o2); - pushValue(o1); - pushValue(o3); - pushValue(o2); - pushValue(o1); - } - break; - - case DUP2_X2: - // TODO optimize this - { - Object o1 = popValue(); - Object o2 = popValue(); - Object o3 = popValue(); - Object o4 = popValue(); - pushValue(o2); - pushValue(o1); - pushValue(o4); - pushValue(o3); - pushValue(o2); - pushValue(o1); - } - break; - - case SWAP: - { - Object o1 = popValue(); - Object o2 = popValue(); - pushValue(o1); - pushValue(o2); - } - break; - } - } - else - { - switch(opcode) - { - case RETURN: - case IRETURN: - case FRETURN: - case ARETURN: - case LRETURN: - case DRETURN: - case ATHROW: - onMethodExit(opcode); - break; - } - } - mv.visitInsn(opcode); -} - -public void visitVarInsn(final int opcode, final int var){ - super.visitVarInsn(opcode, var); - - if(constructor) - { - switch(opcode) - { - case ILOAD: - case FLOAD: - pushValue(OTHER); - break; - case LLOAD: - case DLOAD: - pushValue(OTHER); - pushValue(OTHER); - break; - case ALOAD: - pushValue(var == 0 ? THIS : OTHER); - break; - case ASTORE: - case ISTORE: - case FSTORE: - popValue(); - break; - case LSTORE: - case DSTORE: - popValue(); - popValue(); - break; - } - } -} - -public void visitFieldInsn( - final int opcode, - final String owner, - final String name, - final String desc){ - mv.visitFieldInsn(opcode, owner, name, desc); - - if(constructor) - { - char c = desc.charAt(0); - boolean longOrDouble = c == 'J' || c == 'D'; - switch(opcode) - { - case GETSTATIC: - pushValue(OTHER); - if(longOrDouble) - { - pushValue(OTHER); - } - break; - case PUTSTATIC: - popValue(); - if(longOrDouble) - { - popValue(); - } - break; - case PUTFIELD: - popValue(); - if(longOrDouble) - { - popValue(); - popValue(); - } - break; - // case GETFIELD: - default: - if(longOrDouble) - { - pushValue(OTHER); - } - } - } -} - -public void visitIntInsn(final int opcode, final int operand){ - mv.visitIntInsn(opcode, operand); - - if(constructor && opcode != NEWARRAY) - { - pushValue(OTHER); - } -} - -public void visitLdcInsn(final Object cst){ - mv.visitLdcInsn(cst); - - if(constructor) - { - pushValue(OTHER); - if(cst instanceof Double || cst instanceof Long) - { - pushValue(OTHER); - } - } -} - -public void visitMultiANewArrayInsn(final String desc, final int dims){ - mv.visitMultiANewArrayInsn(desc, dims); - - if(constructor) - { - for(int i = 0; i < dims; i++) - { - popValue(); - } - pushValue(OTHER); - } -} - -public void visitTypeInsn(final int opcode, final String name){ - mv.visitTypeInsn(opcode, name); - - // ANEWARRAY, CHECKCAST or INSTANCEOF don't change stack - if(constructor && opcode == NEW) - { - pushValue(OTHER); - } -} - -public void visitMethodInsn( - final int opcode, - final String owner, - final String name, - final String desc){ - mv.visitMethodInsn(opcode, owner, name, desc); - - if(constructor) - { - Type[] types = Type.getArgumentTypes(desc); - for(int i = 0; i < types.length; i++) - { - popValue(); - if(types[i].getSize() == 2) - { - popValue(); - } - } - switch(opcode) - { - // case INVOKESTATIC: - // break; - - case INVOKEINTERFACE: - case INVOKEVIRTUAL: - popValue(); // objectref - break; - - case INVOKESPECIAL: - Object type = popValue(); // objectref - if(type == THIS && !superInitialized) - { - onMethodEnter(); - superInitialized = true; - // once super has been initialized it is no longer - // necessary to keep track of stack state - constructor = false; - } - break; - } - - Type returnType = Type.getReturnType(desc); - if(returnType != Type.VOID_TYPE) - { - pushValue(OTHER); - if(returnType.getSize() == 2) - { - pushValue(OTHER); - } - } - } -} - -public void visitJumpInsn(final int opcode, final Label label){ - mv.visitJumpInsn(opcode, label); - - if(constructor) - { - switch(opcode) - { - case IFEQ: - case IFNE: - case IFLT: - case IFGE: - case IFGT: - case IFLE: - case IFNULL: - case IFNONNULL: - popValue(); - break; - - case IF_ICMPEQ: - case IF_ICMPNE: - case IF_ICMPLT: - case IF_ICMPGE: - case IF_ICMPGT: - case IF_ICMPLE: - case IF_ACMPEQ: - case IF_ACMPNE: - popValue(); - popValue(); - break; - - case JSR: - pushValue(OTHER); - break; - } - addBranch(label); - } -} - -public void visitLookupSwitchInsn( - final Label dflt, - final int[] keys, - final Label[] labels){ - mv.visitLookupSwitchInsn(dflt, keys, labels); - - if(constructor) - { - popValue(); - addBranches(dflt, labels); - } -} - -public void visitTableSwitchInsn( - final int min, - final int max, - final Label dflt, - final Label[] labels){ - mv.visitTableSwitchInsn(min, max, dflt, labels); - - if(constructor) - { - popValue(); - addBranches(dflt, labels); - } -} - -private void addBranches(final Label dflt, final Label[] labels){ - addBranch(dflt); - for(int i = 0; i < labels.length; i++) - { - addBranch(labels[i]); - } -} - -private void addBranch(final Label label){ - if(branches.containsKey(label)) - { - return; - } - ArrayList frame = new ArrayList(); - frame.addAll(stackFrame); - branches.put(label, frame); -} - -private Object popValue(){ - return stackFrame.remove(stackFrame.size() - 1); -} - -private Object peekValue(){ - return stackFrame.get(stackFrame.size() - 1); -} - -private void pushValue(final Object o){ - stackFrame.add(o); -} - -/** - * Called at the beginning of the method or after super class class call in - * the constructor.

- *

- * Custom code can use or change all the local variables, but should not - * change state of the stack. - */ -protected abstract void onMethodEnter(); - -/** - * Called before explicit exit from the method using either return or throw. - * Top element on the stack contains the return value or exception instance. - * For example: - *

- * 

- *   public void onMethodExit(int opcode) {
- *     if(opcode==RETURN) {
- *         visitInsn(ACONST_NULL);
- *     } else if(opcode==ARETURN || opcode==ATHROW) {
- *         dup();
- *     } else {
- *         if(opcode==LRETURN || opcode==DRETURN) {
- *             dup2();
- *         } else {
- *             dup();
- *         }
- *         box(Type.getReturnType(this.methodDesc));
- *     }
- *     visitIntInsn(SIPUSH, opcode);
- *     visitMethodInsn(INVOKESTATIC, owner, "onExit", "(Ljava/lang/Object;I)V");
- *   }
- * 

- *   // an actual call back method
- *   public static void onExit(int opcode, Object param) {
- *     ...
- *
- *

- *

- *

- * Custom code can use or change all the local variables, but should not - * change state of the stack. - * - * @param opcode one of the RETURN, IRETURN, FRETURN, ARETURN, LRETURN, - * DRETURN or ATHROW - */ -protected abstract void onMethodExit(int opcode); - -// TODO onException, onMethodCall - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/AnalyzerAdapter.java --- a/src/clojure/asm/commons/AnalyzerAdapter.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,938 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm.commons; - -import java.util.ArrayList; -import java.util.HashMap; -import java.util.List; -import java.util.Map; - -import clojure.asm.Label; -import clojure.asm.MethodAdapter; -import clojure.asm.MethodVisitor; -import clojure.asm.Opcodes; -import clojure.asm.Type; - -/** - * A {@link MethodAdapter} that keeps track of stack map frame changes between - * {@link #visitFrame(int,int,Object[],int,Object[]) visitFrame} calls. This - * adapter must be used with the - * {@link clojure.asm.ClassReader#EXPAND_FRAMES} option. Each visitXXX - * instruction delegates to the next visitor in the chain, if any, and then - * simulates the effect of this instruction on the stack map frame, represented - * by {@link #locals} and {@link #stack}. The next visitor in the chain can get - * the state of the stack map frame before each instruction by reading - * the value of these fields in its visitXXX methods (this requires a - * reference to the AnalyzerAdapter that is before it in the chain). - * - * @author Eric Bruneton - */ -public class AnalyzerAdapter extends MethodAdapter{ - -/** - * List of the local variable slots for current execution - * frame. Primitive types are represented by {@link Opcodes#TOP}, - * {@link Opcodes#INTEGER}, {@link Opcodes#FLOAT}, {@link Opcodes#LONG}, - * {@link Opcodes#DOUBLE},{@link Opcodes#NULL} or - * {@link Opcodes#UNINITIALIZED_THIS} (long and double are represented by a - * two elements, the second one being TOP). Reference types are represented - * by String objects (representing internal names, or type descriptors for - * array types), and uninitialized types by Label objects (this label - * designates the NEW instruction that created this uninitialized value). - * This field is null for unreacheable instructions. - */ -public List locals; - -/** - * List of the operand stack slots for current execution - * frame. Primitive types are represented by {@link Opcodes#TOP}, - * {@link Opcodes#INTEGER}, {@link Opcodes#FLOAT}, {@link Opcodes#LONG}, - * {@link Opcodes#DOUBLE},{@link Opcodes#NULL} or - * {@link Opcodes#UNINITIALIZED_THIS} (long and double are represented by a - * two elements, the second one being TOP). Reference types are represented - * by String objects (representing internal names, or type descriptors for - * array types), and uninitialized types by Label objects (this label - * designates the NEW instruction that created this uninitialized value). - * This field is null for unreacheable instructions. - */ -public List stack; - -/** - * The labels that designate the next instruction to be visited. May be - * null. - */ -private List labels; - -/** - * Information about uninitialized types in the current execution frame. - * This map associates internal names to Label objects. Each label - * designates a NEW instruction that created the currently uninitialized - * types, and the associated internal name represents the NEW operand, i.e. - * the final, initialized type value. - */ -private Map uninitializedTypes; - -/** - * The maximum stack size of this method. - */ -private int maxStack; - -/** - * The maximum number of local variables of this method. - */ -private int maxLocals; - -/** - * Creates a new {@link AnalyzerAdapter}. - * - * @param owner the owner's class name. - * @param access the method's access flags (see {@link Opcodes}). - * @param name the method's name. - * @param desc the method's descriptor (see {@link Type Type}). - * @param mv the method visitor to which this adapter delegates calls. May - * be null. - */ -public AnalyzerAdapter( - final String owner, - final int access, - final String name, - final String desc, - final MethodVisitor mv){ - super(mv); - locals = new ArrayList(); - stack = new ArrayList(); - uninitializedTypes = new HashMap(); - - if((access & Opcodes.ACC_STATIC) == 0) - { - if(name.equals("")) - { - locals.add(Opcodes.UNINITIALIZED_THIS); - } - else - { - locals.add(owner); - } - } - Type[] types = Type.getArgumentTypes(desc); - for(int i = 0; i < types.length; ++i) - { - Type type = types[i]; - switch(type.getSort()) - { - case Type.BOOLEAN: - case Type.CHAR: - case Type.BYTE: - case Type.SHORT: - case Type.INT: - locals.add(Opcodes.INTEGER); - break; - case Type.FLOAT: - locals.add(Opcodes.FLOAT); - break; - case Type.LONG: - locals.add(Opcodes.LONG); - locals.add(Opcodes.TOP); - break; - case Type.DOUBLE: - locals.add(Opcodes.DOUBLE); - locals.add(Opcodes.TOP); - break; - case Type.ARRAY: - locals.add(types[i].getDescriptor()); - break; - // case Type.OBJECT: - default: - locals.add(types[i].getInternalName()); - } - } -} - -public void visitFrame( - final int type, - final int nLocal, - final Object[] local, - final int nStack, - final Object[] stack){ - if(type != Opcodes.F_NEW) - { // uncompressed frame - throw new IllegalStateException("ClassReader.accept() should be called with EXPAND_FRAMES flag"); - } - - if(mv != null) - { - mv.visitFrame(type, nLocal, local, nStack, stack); - } - - if(this.locals != null) - { - this.locals.clear(); - this.stack.clear(); - } - else - { - this.locals = new ArrayList(); - this.stack = new ArrayList(); - } - visitFrameTypes(nLocal, local, this.locals); - visitFrameTypes(nStack, stack, this.stack); - maxStack = Math.max(maxStack, this.stack.size()); -} - -private void visitFrameTypes( - final int n, - final Object[] types, - final List result){ - for(int i = 0; i < n; ++i) - { - Object type = types[i]; - result.add(type); - if(type == Opcodes.LONG || type == Opcodes.DOUBLE) - { - result.add(Opcodes.TOP); - } - } -} - -public void visitInsn(final int opcode){ - if(mv != null) - { - mv.visitInsn(opcode); - } - execute(opcode, 0, null); - if((opcode >= Opcodes.IRETURN && opcode <= Opcodes.RETURN) - || opcode == Opcodes.ATHROW) - { - this.locals = null; - this.stack = null; - } -} - -public void visitIntInsn(final int opcode, final int operand){ - if(mv != null) - { - mv.visitIntInsn(opcode, operand); - } - execute(opcode, operand, null); -} - -public void visitVarInsn(final int opcode, final int var){ - if(mv != null) - { - mv.visitVarInsn(opcode, var); - } - execute(opcode, var, null); -} - -public void visitTypeInsn(final int opcode, final String desc){ - if(opcode == Opcodes.NEW) - { - if(labels == null) - { - Label l = new Label(); - labels = new ArrayList(3); - labels.add(l); - if(mv != null) - { - mv.visitLabel(l); - } - } - for(int i = 0; i < labels.size(); ++i) - { - uninitializedTypes.put(labels.get(i), desc); - } - } - if(mv != null) - { - mv.visitTypeInsn(opcode, desc); - } - execute(opcode, 0, desc); -} - -public void visitFieldInsn( - final int opcode, - final String owner, - final String name, - final String desc){ - if(mv != null) - { - mv.visitFieldInsn(opcode, owner, name, desc); - } - execute(opcode, 0, desc); -} - -public void visitMethodInsn( - final int opcode, - final String owner, - final String name, - final String desc){ - if(mv != null) - { - mv.visitMethodInsn(opcode, owner, name, desc); - } - pop(desc); - if(opcode != Opcodes.INVOKESTATIC) - { - Object t = pop(); - if(opcode == Opcodes.INVOKESPECIAL && name.charAt(0) == '<') - { - Object u; - if(t == Opcodes.UNINITIALIZED_THIS) - { - u = owner; - } - else - { - u = uninitializedTypes.get(t); - } - for(int i = 0; i < locals.size(); ++i) - { - if(locals.get(i) == t) - { - locals.set(i, u); - } - } - for(int i = 0; i < stack.size(); ++i) - { - if(stack.get(i) == t) - { - stack.set(i, u); - } - } - } - } - pushDesc(desc); - labels = null; -} - -public void visitJumpInsn(final int opcode, final Label label){ - if(mv != null) - { - mv.visitJumpInsn(opcode, label); - } - execute(opcode, 0, null); - if(opcode == Opcodes.GOTO) - { - this.locals = null; - this.stack = null; - } -} - -public void visitLabel(final Label label){ - if(mv != null) - { - mv.visitLabel(label); - } - if(labels == null) - { - labels = new ArrayList(3); - } - labels.add(label); -} - -public void visitLdcInsn(final Object cst){ - if(mv != null) - { - mv.visitLdcInsn(cst); - } - if(cst instanceof Integer) - { - push(Opcodes.INTEGER); - } - else if(cst instanceof Long) - { - push(Opcodes.LONG); - push(Opcodes.TOP); - } - else if(cst instanceof Float) - { - push(Opcodes.FLOAT); - } - else if(cst instanceof Double) - { - push(Opcodes.DOUBLE); - push(Opcodes.TOP); - } - else if(cst instanceof String) - { - push("java/lang/String"); - } - else if(cst instanceof Type) - { - push("java/lang/Class"); - } - else - { - throw new IllegalArgumentException(); - } - labels = null; -} - -public void visitIincInsn(final int var, final int increment){ - if(mv != null) - { - mv.visitIincInsn(var, increment); - } - execute(Opcodes.IINC, var, null); -} - -public void visitTableSwitchInsn( - final int min, - final int max, - final Label dflt, - final Label labels[]){ - if(mv != null) - { - mv.visitTableSwitchInsn(min, max, dflt, labels); - } - execute(Opcodes.TABLESWITCH, 0, null); - this.locals = null; - this.stack = null; -} - -public void visitLookupSwitchInsn( - final Label dflt, - final int keys[], - final Label labels[]){ - if(mv != null) - { - mv.visitLookupSwitchInsn(dflt, keys, labels); - } - execute(Opcodes.LOOKUPSWITCH, 0, null); - this.locals = null; - this.stack = null; -} - -public void visitMultiANewArrayInsn(final String desc, final int dims){ - if(mv != null) - { - mv.visitMultiANewArrayInsn(desc, dims); - } - execute(Opcodes.MULTIANEWARRAY, dims, desc); -} - -public void visitMaxs(final int maxStack, final int maxLocals){ - if(mv != null) - { - this.maxStack = Math.max(this.maxStack, maxStack); - this.maxLocals = Math.max(this.maxLocals, maxLocals); - mv.visitMaxs(this.maxStack, this.maxLocals); - } -} - -// ------------------------------------------------------------------------ - -private Object get(final int local){ - maxLocals = Math.max(maxLocals, local); - return local < locals.size() ? locals.get(local) : Opcodes.TOP; -} - -private void set(final int local, final Object type){ - maxLocals = Math.max(maxLocals, local); - while(local >= locals.size()) - { - locals.add(Opcodes.TOP); - } - locals.set(local, type); -} - -private void push(final Object type){ - stack.add(type); - maxStack = Math.max(maxStack, stack.size()); -} - -private void pushDesc(final String desc){ - int index = desc.charAt(0) == '(' ? desc.indexOf(')') + 1 : 0; - switch(desc.charAt(index)) - { - case'V': - return; - case'Z': - case'C': - case'B': - case'S': - case'I': - push(Opcodes.INTEGER); - return; - case'F': - push(Opcodes.FLOAT); - return; - case'J': - push(Opcodes.LONG); - push(Opcodes.TOP); - return; - case'D': - push(Opcodes.DOUBLE); - push(Opcodes.TOP); - return; - case'[': - if(index == 0) - { - push(desc); - } - else - { - push(desc.substring(index, desc.length())); - } - break; - // case 'L': - default: - if(index == 0) - { - push(desc.substring(1, desc.length() - 1)); - } - else - { - push(desc.substring(index + 1, desc.length() - 1)); - } - return; - } -} - -private Object pop(){ - return stack.remove(stack.size() - 1); -} - -private void pop(final int n){ - int size = stack.size(); - int end = size - n; - for(int i = size - 1; i >= end; --i) - { - stack.remove(i); - } -} - -private void pop(final String desc){ - char c = desc.charAt(0); - if(c == '(') - { - int n = 0; - Type[] types = Type.getArgumentTypes(desc); - for(int i = 0; i < types.length; ++i) - { - n += types[i].getSize(); - } - pop(n); - } - else if(c == 'J' || c == 'D') - { - pop(2); - } - else - { - pop(1); - } -} - -private void execute(final int opcode, final int iarg, final String sarg){ - if(this.locals == null) - { - return; - } - Object t1, t2, t3, t4; - switch(opcode) - { - case Opcodes.NOP: - case Opcodes.INEG: - case Opcodes.LNEG: - case Opcodes.FNEG: - case Opcodes.DNEG: - case Opcodes.I2B: - case Opcodes.I2C: - case Opcodes.I2S: - case Opcodes.GOTO: - case Opcodes.RETURN: - break; - case Opcodes.ACONST_NULL: - push(Opcodes.NULL); - break; - case Opcodes.ICONST_M1: - case Opcodes.ICONST_0: - case Opcodes.ICONST_1: - case Opcodes.ICONST_2: - case Opcodes.ICONST_3: - case Opcodes.ICONST_4: - case Opcodes.ICONST_5: - case Opcodes.BIPUSH: - case Opcodes.SIPUSH: - push(Opcodes.INTEGER); - break; - case Opcodes.LCONST_0: - case Opcodes.LCONST_1: - push(Opcodes.LONG); - push(Opcodes.TOP); - break; - case Opcodes.FCONST_0: - case Opcodes.FCONST_1: - case Opcodes.FCONST_2: - push(Opcodes.FLOAT); - break; - case Opcodes.DCONST_0: - case Opcodes.DCONST_1: - push(Opcodes.DOUBLE); - push(Opcodes.TOP); - break; - case Opcodes.ILOAD: - case Opcodes.FLOAD: - case Opcodes.ALOAD: - push(get(iarg)); - break; - case Opcodes.LLOAD: - case Opcodes.DLOAD: - push(get(iarg)); - push(Opcodes.TOP); - break; - case Opcodes.IALOAD: - case Opcodes.BALOAD: - case Opcodes.CALOAD: - case Opcodes.SALOAD: - pop(2); - push(Opcodes.INTEGER); - break; - case Opcodes.LALOAD: - case Opcodes.D2L: - pop(2); - push(Opcodes.LONG); - push(Opcodes.TOP); - break; - case Opcodes.FALOAD: - pop(2); - push(Opcodes.FLOAT); - break; - case Opcodes.DALOAD: - case Opcodes.L2D: - pop(2); - push(Opcodes.DOUBLE); - push(Opcodes.TOP); - break; - case Opcodes.AALOAD: - pop(1); - t1 = pop(); - pushDesc(((String) t1).substring(1)); - break; - case Opcodes.ISTORE: - case Opcodes.FSTORE: - case Opcodes.ASTORE: - t1 = pop(); - set(iarg, t1); - if(iarg > 0) - { - t2 = get(iarg - 1); - if(t2 == Opcodes.LONG || t2 == Opcodes.DOUBLE) - { - set(iarg - 1, Opcodes.TOP); - } - } - break; - case Opcodes.LSTORE: - case Opcodes.DSTORE: - pop(1); - t1 = pop(); - set(iarg, t1); - set(iarg + 1, Opcodes.TOP); - if(iarg > 0) - { - t2 = get(iarg - 1); - if(t2 == Opcodes.LONG || t2 == Opcodes.DOUBLE) - { - set(iarg - 1, Opcodes.TOP); - } - } - break; - case Opcodes.IASTORE: - case Opcodes.BASTORE: - case Opcodes.CASTORE: - case Opcodes.SASTORE: - case Opcodes.FASTORE: - case Opcodes.AASTORE: - pop(3); - break; - case Opcodes.LASTORE: - case Opcodes.DASTORE: - pop(4); - break; - case Opcodes.POP: - case Opcodes.IFEQ: - case Opcodes.IFNE: - case Opcodes.IFLT: - case Opcodes.IFGE: - case Opcodes.IFGT: - case Opcodes.IFLE: - case Opcodes.IRETURN: - case Opcodes.FRETURN: - case Opcodes.ARETURN: - case Opcodes.TABLESWITCH: - case Opcodes.LOOKUPSWITCH: - case Opcodes.ATHROW: - case Opcodes.MONITORENTER: - case Opcodes.MONITOREXIT: - case Opcodes.IFNULL: - case Opcodes.IFNONNULL: - pop(1); - break; - case Opcodes.POP2: - case Opcodes.IF_ICMPEQ: - case Opcodes.IF_ICMPNE: - case Opcodes.IF_ICMPLT: - case Opcodes.IF_ICMPGE: - case Opcodes.IF_ICMPGT: - case Opcodes.IF_ICMPLE: - case Opcodes.IF_ACMPEQ: - case Opcodes.IF_ACMPNE: - case Opcodes.LRETURN: - case Opcodes.DRETURN: - pop(2); - break; - case Opcodes.DUP: - t1 = pop(); - push(t1); - push(t1); - break; - case Opcodes.DUP_X1: - t1 = pop(); - t2 = pop(); - push(t1); - push(t2); - push(t1); - break; - case Opcodes.DUP_X2: - t1 = pop(); - t2 = pop(); - t3 = pop(); - push(t1); - push(t3); - push(t2); - push(t1); - break; - case Opcodes.DUP2: - t1 = pop(); - t2 = pop(); - push(t2); - push(t1); - push(t2); - push(t1); - break; - case Opcodes.DUP2_X1: - t1 = pop(); - t2 = pop(); - t3 = pop(); - push(t2); - push(t1); - push(t3); - push(t2); - push(t1); - break; - case Opcodes.DUP2_X2: - t1 = pop(); - t2 = pop(); - t3 = pop(); - t4 = pop(); - push(t2); - push(t1); - push(t4); - push(t3); - push(t2); - push(t1); - break; - case Opcodes.SWAP: - t1 = pop(); - t2 = pop(); - push(t1); - push(t2); - break; - case Opcodes.IADD: - case Opcodes.ISUB: - case Opcodes.IMUL: - case Opcodes.IDIV: - case Opcodes.IREM: - case Opcodes.IAND: - case Opcodes.IOR: - case Opcodes.IXOR: - case Opcodes.ISHL: - case Opcodes.ISHR: - case Opcodes.IUSHR: - case Opcodes.L2I: - case Opcodes.D2I: - case Opcodes.FCMPL: - case Opcodes.FCMPG: - pop(2); - push(Opcodes.INTEGER); - break; - case Opcodes.LADD: - case Opcodes.LSUB: - case Opcodes.LMUL: - case Opcodes.LDIV: - case Opcodes.LREM: - case Opcodes.LAND: - case Opcodes.LOR: - case Opcodes.LXOR: - pop(4); - push(Opcodes.LONG); - push(Opcodes.TOP); - break; - case Opcodes.FADD: - case Opcodes.FSUB: - case Opcodes.FMUL: - case Opcodes.FDIV: - case Opcodes.FREM: - case Opcodes.L2F: - case Opcodes.D2F: - pop(2); - push(Opcodes.FLOAT); - break; - case Opcodes.DADD: - case Opcodes.DSUB: - case Opcodes.DMUL: - case Opcodes.DDIV: - case Opcodes.DREM: - pop(4); - push(Opcodes.DOUBLE); - push(Opcodes.TOP); - break; - case Opcodes.LSHL: - case Opcodes.LSHR: - case Opcodes.LUSHR: - pop(3); - push(Opcodes.LONG); - push(Opcodes.TOP); - break; - case Opcodes.IINC: - set(iarg, Opcodes.INTEGER); - break; - case Opcodes.I2L: - case Opcodes.F2L: - pop(1); - push(Opcodes.LONG); - push(Opcodes.TOP); - break; - case Opcodes.I2F: - pop(1); - push(Opcodes.FLOAT); - break; - case Opcodes.I2D: - case Opcodes.F2D: - pop(1); - push(Opcodes.DOUBLE); - push(Opcodes.TOP); - break; - case Opcodes.F2I: - case Opcodes.ARRAYLENGTH: - case Opcodes.INSTANCEOF: - pop(1); - push(Opcodes.INTEGER); - break; - case Opcodes.LCMP: - case Opcodes.DCMPL: - case Opcodes.DCMPG: - pop(4); - push(Opcodes.INTEGER); - break; - case Opcodes.JSR: - case Opcodes.RET: - throw new RuntimeException("JSR/RET are not supported"); - case Opcodes.GETSTATIC: - pushDesc(sarg); - break; - case Opcodes.PUTSTATIC: - pop(sarg); - break; - case Opcodes.GETFIELD: - pop(1); - pushDesc(sarg); - break; - case Opcodes.PUTFIELD: - pop(sarg); - pop(); - break; - case Opcodes.NEW: - push(labels.get(0)); - break; - case Opcodes.NEWARRAY: - pop(); - switch(iarg) - { - case Opcodes.T_BOOLEAN: - pushDesc("[Z"); - break; - case Opcodes.T_CHAR: - pushDesc("[C"); - break; - case Opcodes.T_BYTE: - pushDesc("[B"); - break; - case Opcodes.T_SHORT: - pushDesc("[S"); - break; - case Opcodes.T_INT: - pushDesc("[I"); - break; - case Opcodes.T_FLOAT: - pushDesc("[F"); - break; - case Opcodes.T_DOUBLE: - pushDesc("[D"); - break; - // case Opcodes.T_LONG: - default: - pushDesc("[J"); - break; - } - break; - case Opcodes.ANEWARRAY: - pop(); - if(sarg.charAt(0) == '[') - { - pushDesc("[" + sarg); - } - else - { - pushDesc("[L" + sarg + ";"); - } - break; - case Opcodes.CHECKCAST: - pop(); - if(sarg.charAt(0) == '[') - { - pushDesc(sarg); - } - else - { - push(sarg); - } - break; - // case Opcodes.MULTIANEWARRAY: - default: - pop(iarg); - pushDesc(sarg); - break; - } - labels = null; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/CodeSizeEvaluator.java --- a/src/clojure/asm/commons/CodeSizeEvaluator.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,234 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm.commons; - -import clojure.asm.Label; -import clojure.asm.MethodAdapter; -import clojure.asm.MethodVisitor; -import clojure.asm.Opcodes; - -/** - * A {@link MethodAdapter} that can be used to approximate method size. - * - * @author Eugene Kuleshov - */ -public class CodeSizeEvaluator extends MethodAdapter implements Opcodes{ - -private int minSize; - -private int maxSize; - -public CodeSizeEvaluator(final MethodVisitor mv){ - super(mv); -} - -public int getMinSize(){ - return this.minSize; -} - -public int getMaxSize(){ - return this.maxSize; -} - -public void visitInsn(final int opcode){ - minSize += 1; - maxSize += 1; - if(mv != null) - { - mv.visitInsn(opcode); - } -} - -public void visitIntInsn(final int opcode, final int operand){ - if(opcode == SIPUSH) - { - minSize += 3; - maxSize += 3; - } - else - { - minSize += 2; - maxSize += 2; - } - if(mv != null) - { - mv.visitIntInsn(opcode, operand); - } -} - -public void visitVarInsn(final int opcode, final int var){ - if(var < 4 && opcode != Opcodes.RET) - { - minSize += 1; - maxSize += 1; - } - else if(var >= 256) - { - minSize += 4; - maxSize += 4; - } - else - { - minSize += 2; - maxSize += 2; - } - if(mv != null) - { - mv.visitVarInsn(opcode, var); - } -} - -public void visitTypeInsn(final int opcode, final String desc){ - minSize += 3; - maxSize += 3; - if(mv != null) - { - mv.visitTypeInsn(opcode, desc); - } -} - -public void visitFieldInsn( - final int opcode, - final String owner, - final String name, - final String desc){ - minSize += 3; - maxSize += 3; - if(mv != null) - { - mv.visitFieldInsn(opcode, owner, name, desc); - } -} - -public void visitMethodInsn( - final int opcode, - final String owner, - final String name, - final String desc){ - if(opcode == INVOKEINTERFACE) - { - minSize += 5; - maxSize += 5; - } - else - { - minSize += 3; - maxSize += 3; - } - if(mv != null) - { - mv.visitMethodInsn(opcode, owner, name, desc); - } -} - -public void visitJumpInsn(final int opcode, final Label label){ - minSize += 3; - if(opcode == GOTO || opcode == JSR) - { - maxSize += 5; - } - else - { - maxSize += 8; - } - if(mv != null) - { - mv.visitJumpInsn(opcode, label); - } -} - -public void visitLdcInsn(final Object cst){ - if(cst instanceof Long || cst instanceof Double) - { - minSize += 3; - maxSize += 3; - } - else - { - minSize += 2; - maxSize += 3; - } - if(mv != null) - { - mv.visitLdcInsn(cst); - } -} - -public void visitIincInsn(final int var, final int increment){ - if(var > 255 || increment > 127 || increment < -128) - { - minSize += 6; - maxSize += 6; - } - else - { - minSize += 3; - maxSize += 3; - } - if(mv != null) - { - mv.visitIincInsn(var, increment); - } -} - -public void visitTableSwitchInsn( - final int min, - final int max, - final Label dflt, - final Label[] labels){ - minSize += 13 + labels.length * 4; - maxSize += 16 + labels.length * 4; - if(mv != null) - { - mv.visitTableSwitchInsn(min, max, dflt, labels); - } -} - -public void visitLookupSwitchInsn( - final Label dflt, - final int[] keys, - final Label[] labels){ - minSize += 9 + keys.length * 8; - maxSize += 12 + keys.length * 8; - if(mv != null) - { - mv.visitLookupSwitchInsn(dflt, keys, labels); - } -} - -public void visitMultiANewArrayInsn(final String desc, final int dims){ - minSize += 4; - maxSize += 4; - if(mv != null) - { - mv.visitMultiANewArrayInsn(desc, dims); - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/EmptyVisitor.java --- a/src/clojure/asm/commons/EmptyVisitor.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,221 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm.commons; - -import clojure.asm.AnnotationVisitor; -import clojure.asm.Attribute; -import clojure.asm.ClassVisitor; -import clojure.asm.FieldVisitor; -import clojure.asm.Label; -import clojure.asm.MethodVisitor; - -/** - * An empty implementation of the ASM visitor interfaces. - * - * @author Eric Bruneton - */ -public class EmptyVisitor implements - ClassVisitor, - FieldVisitor, - MethodVisitor, - AnnotationVisitor{ - -public void visit( - final int version, - final int access, - final String name, - final String signature, - final String superName, - final String[] interfaces){ -} - -public void visitSource(final String source, final String debug){ -} - -public void visitOuterClass( - final String owner, - final String name, - final String desc){ -} - -public AnnotationVisitor visitAnnotation( - final String desc, - final boolean visible){ - return this; -} - -public void visitAttribute(final Attribute attr){ -} - -public void visitInnerClass( - final String name, - final String outerName, - final String innerName, - final int access){ -} - -public FieldVisitor visitField( - final int access, - final String name, - final String desc, - final String signature, - final Object value){ - return this; -} - -public MethodVisitor visitMethod( - final int access, - final String name, - final String desc, - final String signature, - final String[] exceptions){ - return this; -} - -public void visitEnd(){ -} - -public AnnotationVisitor visitAnnotationDefault(){ - return this; -} - -public AnnotationVisitor visitParameterAnnotation( - final int parameter, - final String desc, - final boolean visible){ - return this; -} - -public void visitCode(){ -} - -public void visitFrame( - final int type, - final int nLocal, - final Object[] local, - final int nStack, - final Object[] stack){ -} - -public void visitInsn(final int opcode){ -} - -public void visitIntInsn(final int opcode, final int operand){ -} - -public void visitVarInsn(final int opcode, final int var){ -} - -public void visitTypeInsn(final int opcode, final String desc){ -} - -public void visitFieldInsn( - final int opcode, - final String owner, - final String name, - final String desc){ -} - -public void visitMethodInsn( - final int opcode, - final String owner, - final String name, - final String desc){ -} - -public void visitJumpInsn(final int opcode, final Label label){ -} - -public void visitLabel(final Label label){ -} - -public void visitLdcInsn(final Object cst){ -} - -public void visitIincInsn(final int var, final int increment){ -} - -public void visitTableSwitchInsn( - final int min, - final int max, - final Label dflt, - final Label labels[]){ -} - -public void visitLookupSwitchInsn( - final Label dflt, - final int keys[], - final Label labels[]){ -} - -public void visitMultiANewArrayInsn(final String desc, final int dims){ -} - -public void visitTryCatchBlock( - final Label start, - final Label end, - final Label handler, - final String type){ -} - -public void visitLocalVariable( - final String name, - final String desc, - final String signature, - final Label start, - final Label end, - final int index){ -} - -public void visitLineNumber(final int line, final Label start){ -} - -public void visitMaxs(final int maxStack, final int maxLocals){ -} - -public void visit(final String name, final Object value){ -} - -public void visitEnum( - final String name, - final String desc, - final String value){ -} - -public AnnotationVisitor visitAnnotation( - final String name, - final String desc){ - return this; -} - -public AnnotationVisitor visitArray(final String name){ - return this; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/GeneratorAdapter.java --- a/src/clojure/asm/commons/GeneratorAdapter.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1533 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm.commons; - -import java.util.ArrayList; -import java.util.Arrays; -import java.util.List; - -import clojure.asm.ClassVisitor; -import clojure.asm.Label; -import clojure.asm.MethodVisitor; -import clojure.asm.Opcodes; -import clojure.asm.Type; - -/** - * A {@link clojure.asm.MethodAdapter} with convenient methods to generate - * code. For example, using this adapter, the class below - *

- * 

- * public class Example {
- *     public static void main(String[] args) {
- *         System.out.println("Hello world!");
- *     }
- * }
- *
- *

- * can be generated as follows: - *

- * 

- * ClassWriter cw = new ClassWriter(true);
- * cw.visit(V1_1, ACC_PUBLIC, "Example", null, "java/lang/Object", null);
- * 

- * Method m = Method.getMethod("void <init> ()");
- * GeneratorAdapter mg = new GeneratorAdapter(ACC_PUBLIC, m, null, null, cw);
- * mg.loadThis();
- * mg.invokeConstructor(Type.getType(Object.class), m);
- * mg.returnValue();
- * mg.endMethod();
- * 

- * m = Method.getMethod("void main (String[])");
- * mg = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC, m, null, null, cw);
- * mg.getStatic(Type.getType(System.class), "out", Type.getType(PrintStream.class));
- * mg.push("Hello world!");
- * mg.invokeVirtual(Type.getType(PrintStream.class), Method.getMethod("void println (String)"));
- * mg.returnValue();
- * mg.endMethod();
- * 

- * cw.visitEnd();
- *
- * - * @author Juozas Baliuka - * @author Chris Nokleberg - * @author Eric Bruneton - */ -public class GeneratorAdapter extends LocalVariablesSorter{ - -private final static Type BYTE_TYPE = Type.getObjectType("java/lang/Byte"); - -private final static Type BOOLEAN_TYPE = Type.getObjectType("java/lang/Boolean"); - -private final static Type SHORT_TYPE = Type.getObjectType("java/lang/Short"); - -private final static Type CHARACTER_TYPE = Type.getObjectType("java/lang/Character"); - -private final static Type INTEGER_TYPE = Type.getObjectType("java/lang/Integer"); - -private final static Type FLOAT_TYPE = Type.getObjectType("java/lang/Float"); - -private final static Type LONG_TYPE = Type.getObjectType("java/lang/Long"); - -private final static Type DOUBLE_TYPE = Type.getObjectType("java/lang/Double"); - -private final static Type NUMBER_TYPE = Type.getObjectType("java/lang/Number"); - -private final static Type OBJECT_TYPE = Type.getObjectType("java/lang/Object"); - -private final static Method BOOLEAN_VALUE = Method.getMethod("boolean booleanValue()"); - -private final static Method CHAR_VALUE = Method.getMethod("char charValue()"); - -private final static Method INT_VALUE = Method.getMethod("int intValue()"); - -private final static Method FLOAT_VALUE = Method.getMethod("float floatValue()"); - -private final static Method LONG_VALUE = Method.getMethod("long longValue()"); - -private final static Method DOUBLE_VALUE = Method.getMethod("double doubleValue()"); - -/** - * Constant for the {@link #math math} method. - */ -public final static int ADD = Opcodes.IADD; - -/** - * Constant for the {@link #math math} method. - */ -public final static int SUB = Opcodes.ISUB; - -/** - * Constant for the {@link #math math} method. - */ -public final static int MUL = Opcodes.IMUL; - -/** - * Constant for the {@link #math math} method. - */ -public final static int DIV = Opcodes.IDIV; - -/** - * Constant for the {@link #math math} method. - */ -public final static int REM = Opcodes.IREM; - -/** - * Constant for the {@link #math math} method. - */ -public final static int NEG = Opcodes.INEG; - -/** - * Constant for the {@link #math math} method. - */ -public final static int SHL = Opcodes.ISHL; - -/** - * Constant for the {@link #math math} method. - */ -public final static int SHR = Opcodes.ISHR; - -/** - * Constant for the {@link #math math} method. - */ -public final static int USHR = Opcodes.IUSHR; - -/** - * Constant for the {@link #math math} method. - */ -public final static int AND = Opcodes.IAND; - -/** - * Constant for the {@link #math math} method. - */ -public final static int OR = Opcodes.IOR; - -/** - * Constant for the {@link #math math} method. - */ -public final static int XOR = Opcodes.IXOR; - -/** - * Constant for the {@link #ifCmp ifCmp} method. - */ -public final static int EQ = Opcodes.IFEQ; - -/** - * Constant for the {@link #ifCmp ifCmp} method. - */ -public final static int NE = Opcodes.IFNE; - -/** - * Constant for the {@link #ifCmp ifCmp} method. - */ -public final static int LT = Opcodes.IFLT; - -/** - * Constant for the {@link #ifCmp ifCmp} method. - */ -public final static int GE = Opcodes.IFGE; - -/** - * Constant for the {@link #ifCmp ifCmp} method. - */ -public final static int GT = Opcodes.IFGT; - -/** - * Constant for the {@link #ifCmp ifCmp} method. - */ -public final static int LE = Opcodes.IFLE; - -/** - * Access flags of the method visited by this adapter. - */ -private final int access; - -/** - * Return type of the method visited by this adapter. - */ -private final Type returnType; - -/** - * Argument types of the method visited by this adapter. - */ -private final Type[] argumentTypes; - -/** - * Types of the local variables of the method visited by this adapter. - */ -private final List localTypes = new ArrayList(); - -/** - * Creates a new {@link GeneratorAdapter}. - * - * @param mv the method visitor to which this adapter delegates calls. - * @param access the method's access flags (see {@link Opcodes}). - * @param name the method's name. - * @param desc the method's descriptor (see {@link Type Type}). - */ -public GeneratorAdapter( - final MethodVisitor mv, - final int access, - final String name, - final String desc){ - super(access, desc, mv); - this.access = access; - this.returnType = Type.getReturnType(desc); - this.argumentTypes = Type.getArgumentTypes(desc); -} - -/** - * Creates a new {@link GeneratorAdapter}. - * - * @param access access flags of the adapted method. - * @param method the adapted method. - * @param mv the method visitor to which this adapter delegates calls. - */ -public GeneratorAdapter( - final int access, - final Method method, - final MethodVisitor mv){ - super(access, method.getDescriptor(), mv); - this.access = access; - this.returnType = method.getReturnType(); - this.argumentTypes = method.getArgumentTypes(); -} - -/** - * Creates a new {@link GeneratorAdapter}. - * - * @param access access flags of the adapted method. - * @param method the adapted method. - * @param signature the signature of the adapted method (may be - * null). - * @param exceptions the exceptions thrown by the adapted method (may be - * null). - * @param cv the class visitor to which this adapter delegates calls. - */ -public GeneratorAdapter( - final int access, - final Method method, - final String signature, - final Type[] exceptions, - final ClassVisitor cv){ - this(access, method, cv.visitMethod(access, - method.getName(), - method.getDescriptor(), - signature, - getInternalNames(exceptions))); -} - -/** - * Returns the internal names of the given types. - * - * @param types a set of types. - * @return the internal names of the given types. - */ -private static String[] getInternalNames(final Type[] types){ - if(types == null) - { - return null; - } - String[] names = new String[types.length]; - for(int i = 0; i < names.length; ++i) - { - names[i] = types[i].getInternalName(); - } - return names; -} - -// ------------------------------------------------------------------------ -// Instructions to push constants on the stack -// ------------------------------------------------------------------------ - -/** - * Generates the instruction to push the given value on the stack. - * - * @param value the value to be pushed on the stack. - */ -public void push(final boolean value){ - push(value ? 1 : 0); -} - -/** - * Generates the instruction to push the given value on the stack. - * - * @param value the value to be pushed on the stack. - */ -public void push(final int value){ - if(value >= -1 && value <= 5) - { - mv.visitInsn(Opcodes.ICONST_0 + value); - } - else if(value >= Byte.MIN_VALUE && value <= Byte.MAX_VALUE) - { - mv.visitIntInsn(Opcodes.BIPUSH, value); - } - else if(value >= Short.MIN_VALUE && value <= Short.MAX_VALUE) - { - mv.visitIntInsn(Opcodes.SIPUSH, value); - } - else - { - mv.visitLdcInsn(new Integer(value)); - } -} - -/** - * Generates the instruction to push the given value on the stack. - * - * @param value the value to be pushed on the stack. - */ -public void push(final long value){ - if(value == 0L || value == 1L) - { - mv.visitInsn(Opcodes.LCONST_0 + (int) value); - } - else - { - mv.visitLdcInsn(new Long(value)); - } -} - -/** - * Generates the instruction to push the given value on the stack. - * - * @param value the value to be pushed on the stack. - */ -public void push(final float value){ - int bits = Float.floatToIntBits(value); - if(bits == 0L || bits == 0x3f800000 || bits == 0x40000000) - { // 0..2 - mv.visitInsn(Opcodes.FCONST_0 + (int) value); - } - else - { - mv.visitLdcInsn(new Float(value)); - } -} - -/** - * Generates the instruction to push the given value on the stack. - * - * @param value the value to be pushed on the stack. - */ -public void push(final double value){ - long bits = Double.doubleToLongBits(value); - if(bits == 0L || bits == 0x3ff0000000000000L) - { // +0.0d and 1.0d - mv.visitInsn(Opcodes.DCONST_0 + (int) value); - } - else - { - mv.visitLdcInsn(new Double(value)); - } -} - -/** - * Generates the instruction to push the given value on the stack. - * - * @param value the value to be pushed on the stack. May be null. - */ -public void push(final String value){ - if(value == null) - { - mv.visitInsn(Opcodes.ACONST_NULL); - } - else - { - mv.visitLdcInsn(value); - } -} - -/** - * Generates the instruction to push the given value on the stack. - * - * @param value the value to be pushed on the stack. - */ -public void push(final Type value){ - if(value == null) - { - mv.visitInsn(Opcodes.ACONST_NULL); - } - else - { - mv.visitLdcInsn(value); - } -} - -// ------------------------------------------------------------------------ -// Instructions to load and store method arguments -// ------------------------------------------------------------------------ - -/** - * Returns the index of the given method argument in the frame's local - * variables array. - * - * @param arg the index of a method argument. - * @return the index of the given method argument in the frame's local - * variables array. - */ -private int getArgIndex(final int arg){ - int index = (access & Opcodes.ACC_STATIC) == 0 ? 1 : 0; - for(int i = 0; i < arg; i++) - { - index += argumentTypes[i].getSize(); - } - return index; -} - -/** - * Generates the instruction to push a local variable on the stack. - * - * @param type the type of the local variable to be loaded. - * @param index an index in the frame's local variables array. - */ -private void loadInsn(final Type type, final int index){ - mv.visitVarInsn(type.getOpcode(Opcodes.ILOAD), index); -} - -/** - * Generates the instruction to store the top stack value in a local - * variable. - * - * @param type the type of the local variable to be stored. - * @param index an index in the frame's local variables array. - */ -private void storeInsn(final Type type, final int index){ - mv.visitVarInsn(type.getOpcode(Opcodes.ISTORE), index); -} - -/** - * Generates the instruction to load 'this' on the stack. - */ -public void loadThis(){ - if((access & Opcodes.ACC_STATIC) != 0) - { - throw new IllegalStateException("no 'this' pointer within static method"); - } - mv.visitVarInsn(Opcodes.ALOAD, 0); -} - -/** - * Generates the instruction to load the given method argument on the stack. - * - * @param arg the index of a method argument. - */ -public void loadArg(final int arg){ - loadInsn(argumentTypes[arg], getArgIndex(arg)); -} - -/** - * Generates the instructions to load the given method arguments on the - * stack. - * - * @param arg the index of the first method argument to be loaded. - * @param count the number of method arguments to be loaded. - */ -public void loadArgs(final int arg, final int count){ - int index = getArgIndex(arg); - for(int i = 0; i < count; ++i) - { - Type t = argumentTypes[arg + i]; - loadInsn(t, index); - index += t.getSize(); - } -} - -/** - * Generates the instructions to load all the method arguments on the stack. - */ -public void loadArgs(){ - loadArgs(0, argumentTypes.length); -} - -/** - * Generates the instructions to load all the method arguments on the stack, - * as a single object array. - */ -public void loadArgArray(){ - push(argumentTypes.length); - newArray(OBJECT_TYPE); - for(int i = 0; i < argumentTypes.length; i++) - { - dup(); - push(i); - loadArg(i); - box(argumentTypes[i]); - arrayStore(OBJECT_TYPE); - } -} - -/** - * Generates the instruction to store the top stack value in the given - * method argument. - * - * @param arg the index of a method argument. - */ -public void storeArg(final int arg){ - storeInsn(argumentTypes[arg], getArgIndex(arg)); -} - -// ------------------------------------------------------------------------ -// Instructions to load and store local variables -// ------------------------------------------------------------------------ - -/** - * Returns the type of the given local variable. - * - * @param local a local variable identifier, as returned by - * {@link LocalVariablesSorter#newLocal(Type) newLocal()}. - * @return the type of the given local variable. - */ -public Type getLocalType(final int local){ - return (Type) localTypes.get(local - firstLocal); -} - -protected void setLocalType(final int local, final Type type){ - int index = local - firstLocal; - while(localTypes.size() < index + 1) - { - localTypes.add(null); - } - localTypes.set(index, type); -} - -/** - * Generates the instruction to load the given local variable on the stack. - * - * @param local a local variable identifier, as returned by - * {@link LocalVariablesSorter#newLocal(Type) newLocal()}. - */ -public void loadLocal(final int local){ - loadInsn(getLocalType(local), local); -} - -/** - * Generates the instruction to load the given local variable on the stack. - * - * @param local a local variable identifier, as returned by - * {@link LocalVariablesSorter#newLocal(Type) newLocal()}. - * @param type the type of this local variable. - */ -public void loadLocal(final int local, final Type type){ - setLocalType(local, type); - loadInsn(type, local); -} - -/** - * Generates the instruction to store the top stack value in the given local - * variable. - * - * @param local a local variable identifier, as returned by - * {@link LocalVariablesSorter#newLocal(Type) newLocal()}. - */ -public void storeLocal(final int local){ - storeInsn(getLocalType(local), local); -} - -/** - * Generates the instruction to store the top stack value in the given local - * variable. - * - * @param local a local variable identifier, as returned by - * {@link LocalVariablesSorter#newLocal(Type) newLocal()}. - * @param type the type of this local variable. - */ -public void storeLocal(final int local, final Type type){ - setLocalType(local, type); - storeInsn(type, local); -} - -/** - * Generates the instruction to load an element from an array. - * - * @param type the type of the array element to be loaded. - */ -public void arrayLoad(final Type type){ - mv.visitInsn(type.getOpcode(Opcodes.IALOAD)); -} - -/** - * Generates the instruction to store an element in an array. - * - * @param type the type of the array element to be stored. - */ -public void arrayStore(final Type type){ - mv.visitInsn(type.getOpcode(Opcodes.IASTORE)); -} - -// ------------------------------------------------------------------------ -// Instructions to manage the stack -// ------------------------------------------------------------------------ - -/** - * Generates a POP instruction. - */ -public void pop(){ - mv.visitInsn(Opcodes.POP); -} - -/** - * Generates a POP2 instruction. - */ -public void pop2(){ - mv.visitInsn(Opcodes.POP2); -} - -/** - * Generates a DUP instruction. - */ -public void dup(){ - mv.visitInsn(Opcodes.DUP); -} - -/** - * Generates a DUP2 instruction. - */ -public void dup2(){ - mv.visitInsn(Opcodes.DUP2); -} - -/** - * Generates a DUP_X1 instruction. - */ -public void dupX1(){ - mv.visitInsn(Opcodes.DUP_X1); -} - -/** - * Generates a DUP_X2 instruction. - */ -public void dupX2(){ - mv.visitInsn(Opcodes.DUP_X2); -} - -/** - * Generates a DUP2_X1 instruction. - */ -public void dup2X1(){ - mv.visitInsn(Opcodes.DUP2_X1); -} - -/** - * Generates a DUP2_X2 instruction. - */ -public void dup2X2(){ - mv.visitInsn(Opcodes.DUP2_X2); -} - -/** - * Generates a SWAP instruction. - */ -public void swap(){ - mv.visitInsn(Opcodes.SWAP); -} - -/** - * Generates the instructions to swap the top two stack values. - * - * @param prev type of the top - 1 stack value. - * @param type type of the top stack value. - */ -public void swap(final Type prev, final Type type){ - if(type.getSize() == 1) - { - if(prev.getSize() == 1) - { - swap(); // same as dupX1(), pop(); - } - else - { - dupX2(); - pop(); - } - } - else - { - if(prev.getSize() == 1) - { - dup2X1(); - pop2(); - } - else - { - dup2X2(); - pop2(); - } - } -} - -// ------------------------------------------------------------------------ -// Instructions to do mathematical and logical operations -// ------------------------------------------------------------------------ - -/** - * Generates the instruction to do the specified mathematical or logical - * operation. - * - * @param op a mathematical or logical operation. Must be one of ADD, SUB, - * MUL, DIV, REM, NEG, SHL, SHR, USHR, AND, OR, XOR. - * @param type the type of the operand(s) for this operation. - */ -public void math(final int op, final Type type){ - mv.visitInsn(type.getOpcode(op)); -} - -/** - * Generates the instructions to compute the bitwise negation of the top - * stack value. - */ -public void not(){ - mv.visitInsn(Opcodes.ICONST_1); - mv.visitInsn(Opcodes.IXOR); -} - -/** - * Generates the instruction to increment the given local variable. - * - * @param local the local variable to be incremented. - * @param amount the amount by which the local variable must be incremented. - */ -public void iinc(final int local, final int amount){ - mv.visitIincInsn(local, amount); -} - -/** - * Generates the instructions to cast a numerical value from one type to - * another. - * - * @param from the type of the top stack value - * @param to the type into which this value must be cast. - */ -public void cast(final Type from, final Type to){ - if(from != to) - { - if(from == Type.DOUBLE_TYPE) - { - if(to == Type.FLOAT_TYPE) - { - mv.visitInsn(Opcodes.D2F); - } - else if(to == Type.LONG_TYPE) - { - mv.visitInsn(Opcodes.D2L); - } - else - { - mv.visitInsn(Opcodes.D2I); - cast(Type.INT_TYPE, to); - } - } - else if(from == Type.FLOAT_TYPE) - { - if(to == Type.DOUBLE_TYPE) - { - mv.visitInsn(Opcodes.F2D); - } - else if(to == Type.LONG_TYPE) - { - mv.visitInsn(Opcodes.F2L); - } - else - { - mv.visitInsn(Opcodes.F2I); - cast(Type.INT_TYPE, to); - } - } - else if(from == Type.LONG_TYPE) - { - if(to == Type.DOUBLE_TYPE) - { - mv.visitInsn(Opcodes.L2D); - } - else if(to == Type.FLOAT_TYPE) - { - mv.visitInsn(Opcodes.L2F); - } - else - { - mv.visitInsn(Opcodes.L2I); - cast(Type.INT_TYPE, to); - } - } - else - { - if(to == Type.BYTE_TYPE) - { - mv.visitInsn(Opcodes.I2B); - } - else if(to == Type.CHAR_TYPE) - { - mv.visitInsn(Opcodes.I2C); - } - else if(to == Type.DOUBLE_TYPE) - { - mv.visitInsn(Opcodes.I2D); - } - else if(to == Type.FLOAT_TYPE) - { - mv.visitInsn(Opcodes.I2F); - } - else if(to == Type.LONG_TYPE) - { - mv.visitInsn(Opcodes.I2L); - } - else if(to == Type.SHORT_TYPE) - { - mv.visitInsn(Opcodes.I2S); - } - } - } -} - -// ------------------------------------------------------------------------ -// Instructions to do boxing and unboxing operations -// ------------------------------------------------------------------------ - -/** - * Generates the instructions to box the top stack value. This value is - * replaced by its boxed equivalent on top of the stack. - * - * @param type the type of the top stack value. - */ -public void box(final Type type){ - if(type.getSort() == Type.OBJECT || type.getSort() == Type.ARRAY) - { - return; - } - if(type == Type.VOID_TYPE) - { - push((String) null); - } - else - { - Type boxed = type; - switch(type.getSort()) - { - case Type.BYTE: - boxed = BYTE_TYPE; - break; - case Type.BOOLEAN: - boxed = BOOLEAN_TYPE; - break; - case Type.SHORT: - boxed = SHORT_TYPE; - break; - case Type.CHAR: - boxed = CHARACTER_TYPE; - break; - case Type.INT: - boxed = INTEGER_TYPE; - break; - case Type.FLOAT: - boxed = FLOAT_TYPE; - break; - case Type.LONG: - boxed = LONG_TYPE; - break; - case Type.DOUBLE: - boxed = DOUBLE_TYPE; - break; - } - newInstance(boxed); - if(type.getSize() == 2) - { - // Pp -> Ppo -> oPpo -> ooPpo -> ooPp -> o - dupX2(); - dupX2(); - pop(); - } - else - { - // p -> po -> opo -> oop -> o - dupX1(); - swap(); - } - invokeConstructor(boxed, new Method("", - Type.VOID_TYPE, - new Type[]{type})); - } -} - -/** - * Generates the instructions to unbox the top stack value. This value is - * replaced by its unboxed equivalent on top of the stack. - * - * @param type the type of the top stack value. - */ -public void unbox(final Type type){ - Type t = NUMBER_TYPE; - Method sig = null; - switch(type.getSort()) - { - case Type.VOID: - return; - case Type.CHAR: - t = CHARACTER_TYPE; - sig = CHAR_VALUE; - break; - case Type.BOOLEAN: - t = BOOLEAN_TYPE; - sig = BOOLEAN_VALUE; - break; - case Type.DOUBLE: - sig = DOUBLE_VALUE; - break; - case Type.FLOAT: - sig = FLOAT_VALUE; - break; - case Type.LONG: - sig = LONG_VALUE; - break; - case Type.INT: - case Type.SHORT: - case Type.BYTE: - sig = INT_VALUE; - } - if(sig == null) - { - checkCast(type); - } - else - { - checkCast(t); - invokeVirtual(t, sig); - } -} - -// ------------------------------------------------------------------------ -// Instructions to jump to other instructions -// ------------------------------------------------------------------------ - -/** - * Creates a new {@link Label}. - * - * @return a new {@link Label}. - */ -public Label newLabel(){ - return new Label(); -} - -/** - * Marks the current code position with the given label. - * - * @param label a label. - */ -public void mark(final Label label){ - mv.visitLabel(label); -} - -/** - * Marks the current code position with a new label. - * - * @return the label that was created to mark the current code position. - */ -public Label mark(){ - Label label = new Label(); - mv.visitLabel(label); - return label; -} - -/** - * Generates the instructions to jump to a label based on the comparison of - * the top two stack values. - * - * @param type the type of the top two stack values. - * @param mode how these values must be compared. One of EQ, NE, LT, GE, GT, - * LE. - * @param label where to jump if the comparison result is true. - */ -public void ifCmp(final Type type, final int mode, final Label label){ - int intOp = -1; - switch(type.getSort()) - { - case Type.LONG: - mv.visitInsn(Opcodes.LCMP); - break; - case Type.DOUBLE: - mv.visitInsn(Opcodes.DCMPG); - break; - case Type.FLOAT: - mv.visitInsn(Opcodes.FCMPG); - break; - case Type.ARRAY: - case Type.OBJECT: - switch(mode) - { - case EQ: - mv.visitJumpInsn(Opcodes.IF_ACMPEQ, label); - return; - case NE: - mv.visitJumpInsn(Opcodes.IF_ACMPNE, label); - return; - } - throw new IllegalArgumentException("Bad comparison for type " - + type); - default: - switch(mode) - { - case EQ: - intOp = Opcodes.IF_ICMPEQ; - break; - case NE: - intOp = Opcodes.IF_ICMPNE; - break; - case GE: - intOp = Opcodes.IF_ICMPGE; - break; - case LT: - intOp = Opcodes.IF_ICMPLT; - break; - case LE: - intOp = Opcodes.IF_ICMPLE; - break; - case GT: - intOp = Opcodes.IF_ICMPGT; - break; - } - mv.visitJumpInsn(intOp, label); - return; - } - int jumpMode = mode; - switch(mode) - { - case GE: - jumpMode = LT; - break; - case LE: - jumpMode = GT; - break; - } - mv.visitJumpInsn(jumpMode, label); -} - -/** - * Generates the instructions to jump to a label based on the comparison of - * the top two integer stack values. - * - * @param mode how these values must be compared. One of EQ, NE, LT, GE, GT, - * LE. - * @param label where to jump if the comparison result is true. - */ -public void ifICmp(final int mode, final Label label){ - ifCmp(Type.INT_TYPE, mode, label); -} - -/** - * Generates the instructions to jump to a label based on the comparison of - * the top integer stack value with zero. - * - * @param mode how these values must be compared. One of EQ, NE, LT, GE, GT, - * LE. - * @param label where to jump if the comparison result is true. - */ -public void ifZCmp(final int mode, final Label label){ - mv.visitJumpInsn(mode, label); -} - -/** - * Generates the instruction to jump to the given label if the top stack - * value is null. - * - * @param label where to jump if the condition is true. - */ -public void ifNull(final Label label){ - mv.visitJumpInsn(Opcodes.IFNULL, label); -} - -/** - * Generates the instruction to jump to the given label if the top stack - * value is not null. - * - * @param label where to jump if the condition is true. - */ -public void ifNonNull(final Label label){ - mv.visitJumpInsn(Opcodes.IFNONNULL, label); -} - -/** - * Generates the instruction to jump to the given label. - * - * @param label where to jump if the condition is true. - */ -public void goTo(final Label label){ - mv.visitJumpInsn(Opcodes.GOTO, label); -} - -/** - * Generates a RET instruction. - * - * @param local a local variable identifier, as returned by - * {@link LocalVariablesSorter#newLocal(Type) newLocal()}. - */ -public void ret(final int local){ - mv.visitVarInsn(Opcodes.RET, local); -} - -/** - * Generates the instructions for a switch statement. - * - * @param keys the switch case keys. - * @param generator a generator to generate the code for the switch cases. - */ -public void tableSwitch( - final int[] keys, - final TableSwitchGenerator generator){ - float density; - if(keys.length == 0) - { - density = 0; - } - else - { - density = (float) keys.length - / (keys[keys.length - 1] - keys[0] + 1); - } - tableSwitch(keys, generator, density >= 0.5f); -} - -/** - * Generates the instructions for a switch statement. - * - * @param keys the switch case keys. - * @param generator a generator to generate the code for the switch cases. - * @param useTable true to use a TABLESWITCH instruction, or - * false to use a LOOKUPSWITCH instruction. - */ -public void tableSwitch( - final int[] keys, - final TableSwitchGenerator generator, - final boolean useTable){ - for(int i = 1; i < keys.length; ++i) - { - if(keys[i] < keys[i - 1]) - { - throw new IllegalArgumentException("keys must be sorted ascending"); - } - } - Label def = newLabel(); - Label end = newLabel(); - if(keys.length > 0) - { - int len = keys.length; - int min = keys[0]; - int max = keys[len - 1]; - int range = max - min + 1; - if(useTable) - { - Label[] labels = new Label[range]; - Arrays.fill(labels, def); - for(int i = 0; i < len; ++i) - { - labels[keys[i] - min] = newLabel(); - } - mv.visitTableSwitchInsn(min, max, def, labels); - for(int i = 0; i < range; ++i) - { - Label label = labels[i]; - if(label != def) - { - mark(label); - generator.generateCase(i + min, end); - } - } - } - else - { - Label[] labels = new Label[len]; - for(int i = 0; i < len; ++i) - { - labels[i] = newLabel(); - } - mv.visitLookupSwitchInsn(def, keys, labels); - for(int i = 0; i < len; ++i) - { - mark(labels[i]); - generator.generateCase(keys[i], end); - } - } - } - mark(def); - generator.generateDefault(); - mark(end); -} - -/** - * Generates the instruction to return the top stack value to the caller. - */ -public void returnValue(){ - mv.visitInsn(returnType.getOpcode(Opcodes.IRETURN)); -} - -// ------------------------------------------------------------------------ -// Instructions to load and store fields -// ------------------------------------------------------------------------ - -/** - * Generates a get field or set field instruction. - * - * @param opcode the instruction's opcode. - * @param ownerType the class in which the field is defined. - * @param name the name of the field. - * @param fieldType the type of the field. - */ -private void fieldInsn( - final int opcode, - final Type ownerType, - final String name, - final Type fieldType){ - mv.visitFieldInsn(opcode, - ownerType.getInternalName(), - name, - fieldType.getDescriptor()); -} - -/** - * Generates the instruction to push the value of a static field on the - * stack. - * - * @param owner the class in which the field is defined. - * @param name the name of the field. - * @param type the type of the field. - */ -public void getStatic(final Type owner, final String name, final Type type){ - fieldInsn(Opcodes.GETSTATIC, owner, name, type); -} - -/** - * Generates the instruction to store the top stack value in a static field. - * - * @param owner the class in which the field is defined. - * @param name the name of the field. - * @param type the type of the field. - */ -public void putStatic(final Type owner, final String name, final Type type){ - fieldInsn(Opcodes.PUTSTATIC, owner, name, type); -} - -/** - * Generates the instruction to push the value of a non static field on the - * stack. - * - * @param owner the class in which the field is defined. - * @param name the name of the field. - * @param type the type of the field. - */ -public void getField(final Type owner, final String name, final Type type){ - fieldInsn(Opcodes.GETFIELD, owner, name, type); -} - -/** - * Generates the instruction to store the top stack value in a non static - * field. - * - * @param owner the class in which the field is defined. - * @param name the name of the field. - * @param type the type of the field. - */ -public void putField(final Type owner, final String name, final Type type){ - fieldInsn(Opcodes.PUTFIELD, owner, name, type); -} - -// ------------------------------------------------------------------------ -// Instructions to invoke methods -// ------------------------------------------------------------------------ - -/** - * Generates an invoke method instruction. - * - * @param opcode the instruction's opcode. - * @param type the class in which the method is defined. - * @param method the method to be invoked. - */ -private void invokeInsn( - final int opcode, - final Type type, - final Method method){ - String owner = type.getSort() == Type.ARRAY - ? type.getDescriptor() - : type.getInternalName(); - mv.visitMethodInsn(opcode, - owner, - method.getName(), - method.getDescriptor()); -} - -/** - * Generates the instruction to invoke a normal method. - * - * @param owner the class in which the method is defined. - * @param method the method to be invoked. - */ -public void invokeVirtual(final Type owner, final Method method){ - invokeInsn(Opcodes.INVOKEVIRTUAL, owner, method); -} - -/** - * Generates the instruction to invoke a constructor. - * - * @param type the class in which the constructor is defined. - * @param method the constructor to be invoked. - */ -public void invokeConstructor(final Type type, final Method method){ - invokeInsn(Opcodes.INVOKESPECIAL, type, method); -} - -/** - * Generates the instruction to invoke a static method. - * - * @param owner the class in which the method is defined. - * @param method the method to be invoked. - */ -public void invokeStatic(final Type owner, final Method method){ - invokeInsn(Opcodes.INVOKESTATIC, owner, method); -} - -/** - * Generates the instruction to invoke an interface method. - * - * @param owner the class in which the method is defined. - * @param method the method to be invoked. - */ -public void invokeInterface(final Type owner, final Method method){ - invokeInsn(Opcodes.INVOKEINTERFACE, owner, method); -} - -// ------------------------------------------------------------------------ -// Instructions to create objects and arrays -// ------------------------------------------------------------------------ - -/** - * Generates a type dependent instruction. - * - * @param opcode the instruction's opcode. - * @param type the instruction's operand. - */ -private void typeInsn(final int opcode, final Type type){ - String desc; - if(type.getSort() == Type.ARRAY) - { - desc = type.getDescriptor(); - } - else - { - desc = type.getInternalName(); - } - mv.visitTypeInsn(opcode, desc); -} - -/** - * Generates the instruction to create a new object. - * - * @param type the class of the object to be created. - */ -public void newInstance(final Type type){ - typeInsn(Opcodes.NEW, type); -} - -/** - * Generates the instruction to create a new array. - * - * @param type the type of the array elements. - */ -public void newArray(final Type type){ - int typ; - switch(type.getSort()) - { - case Type.BOOLEAN: - typ = Opcodes.T_BOOLEAN; - break; - case Type.CHAR: - typ = Opcodes.T_CHAR; - break; - case Type.BYTE: - typ = Opcodes.T_BYTE; - break; - case Type.SHORT: - typ = Opcodes.T_SHORT; - break; - case Type.INT: - typ = Opcodes.T_INT; - break; - case Type.FLOAT: - typ = Opcodes.T_FLOAT; - break; - case Type.LONG: - typ = Opcodes.T_LONG; - break; - case Type.DOUBLE: - typ = Opcodes.T_DOUBLE; - break; - default: - typeInsn(Opcodes.ANEWARRAY, type); - return; - } - mv.visitIntInsn(Opcodes.NEWARRAY, typ); -} - -// ------------------------------------------------------------------------ -// Miscelaneous instructions -// ------------------------------------------------------------------------ - -/** - * Generates the instruction to compute the length of an array. - */ -public void arrayLength(){ - mv.visitInsn(Opcodes.ARRAYLENGTH); -} - -/** - * Generates the instruction to throw an exception. - */ -public void throwException(){ - mv.visitInsn(Opcodes.ATHROW); -} - -/** - * Generates the instructions to create and throw an exception. The - * exception class must have a constructor with a single String argument. - * - * @param type the class of the exception to be thrown. - * @param msg the detailed message of the exception. - */ -public void throwException(final Type type, final String msg){ - newInstance(type); - dup(); - push(msg); - invokeConstructor(type, Method.getMethod("void (String)")); - throwException(); -} - -/** - * Generates the instruction to check that the top stack value is of the - * given type. - * - * @param type a class or interface type. - */ -public void checkCast(final Type type){ - if(!type.equals(OBJECT_TYPE)) - { - typeInsn(Opcodes.CHECKCAST, type); - } -} - -/** - * Generates the instruction to test if the top stack value is of the given - * type. - * - * @param type a class or interface type. - */ -public void instanceOf(final Type type){ - typeInsn(Opcodes.INSTANCEOF, type); -} - -/** - * Generates the instruction to get the monitor of the top stack value. - */ -public void monitorEnter(){ - mv.visitInsn(Opcodes.MONITORENTER); -} - -/** - * Generates the instruction to release the monitor of the top stack value. - */ -public void monitorExit(){ - mv.visitInsn(Opcodes.MONITOREXIT); -} - -// ------------------------------------------------------------------------ -// Non instructions -// ------------------------------------------------------------------------ - -/** - * Marks the end of the visited method. - */ -public void endMethod(){ - if((access & Opcodes.ACC_ABSTRACT) == 0) - { - mv.visitMaxs(0, 0); - } - mv.visitEnd(); -} - -/** - * Marks the start of an exception handler. - * - * @param start beginning of the exception handler's scope (inclusive). - * @param end end of the exception handler's scope (exclusive). - * @param exception internal name of the type of exceptions handled by the - * handler. - */ -public void catchException( - final Label start, - final Label end, - final Type exception){ - mv.visitTryCatchBlock(start, end, mark(), exception.getInternalName()); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/LocalVariablesSorter.java --- a/src/clojure/asm/commons/LocalVariablesSorter.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,330 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm.commons; - -import clojure.asm.Label; -import clojure.asm.MethodAdapter; -import clojure.asm.MethodVisitor; -import clojure.asm.Opcodes; -import clojure.asm.Type; - -/** - * A {@link MethodAdapter} that renumbers local variables in their order of - * appearance. This adapter allows one to easily add new local variables to a - * method. It may be used by inheriting from this class, but the preferred way - * of using it is via delegation: the next visitor in the chain can indeed add - * new locals when needed by calling {@link #newLocal} on this adapter (this - * requires a reference back to this {@link LocalVariablesSorter}). - * - * @author Chris Nokleberg - * @author Eugene Kuleshov - * @author Eric Bruneton - */ -public class LocalVariablesSorter extends MethodAdapter{ - -private final static Type OBJECT_TYPE = Type.getObjectType("java/lang/Object"); - -/** - * Mapping from old to new local variable indexes. A local variable at index - * i of size 1 is remapped to 'mapping[2*i]', while a local variable at - * index i of size 2 is remapped to 'mapping[2*i+1]'. - */ -private int[] mapping = new int[40]; - -/** - * Array used to store stack map local variable types after remapping. - */ -private Object[] newLocals = new Object[20]; - -/** - * Index of the first local variable, after formal parameters. - */ -protected final int firstLocal; - -/** - * Index of the next local variable to be created by {@link #newLocal}. - */ -protected int nextLocal; - -/** - * Indicates if at least one local variable has moved due to remapping. - */ -private boolean changed; - -/** - * Creates a new {@link LocalVariablesSorter}. - * - * @param access access flags of the adapted method. - * @param desc the method's descriptor (see {@link Type Type}). - * @param mv the method visitor to which this adapter delegates calls. - */ -public LocalVariablesSorter( - final int access, - final String desc, - final MethodVisitor mv){ - super(mv); - Type[] args = Type.getArgumentTypes(desc); - nextLocal = (Opcodes.ACC_STATIC & access) != 0 ? 0 : 1; - for(int i = 0; i < args.length; i++) - { - nextLocal += args[i].getSize(); - } - firstLocal = nextLocal; -} - -public void visitVarInsn(final int opcode, final int var){ - Type type; - switch(opcode) - { - case Opcodes.LLOAD: - case Opcodes.LSTORE: - type = Type.LONG_TYPE; - break; - - case Opcodes.DLOAD: - case Opcodes.DSTORE: - type = Type.DOUBLE_TYPE; - break; - - case Opcodes.FLOAD: - case Opcodes.FSTORE: - type = Type.FLOAT_TYPE; - break; - - case Opcodes.ILOAD: - case Opcodes.ISTORE: - type = Type.INT_TYPE; - break; - - case Opcodes.ALOAD: - case Opcodes.ASTORE: - type = OBJECT_TYPE; - break; - - // case RET: - default: - type = Type.VOID_TYPE; - } - mv.visitVarInsn(opcode, remap(var, type)); -} - -public void visitIincInsn(final int var, final int increment){ - mv.visitIincInsn(remap(var, Type.INT_TYPE), increment); -} - -public void visitMaxs(final int maxStack, final int maxLocals){ - mv.visitMaxs(maxStack, nextLocal); -} - -public void visitLocalVariable( - final String name, - final String desc, - final String signature, - final Label start, - final Label end, - final int index){ - int size = "J".equals(desc) || "D".equals(desc) ? 2 : 1; - int newIndex = remap(index, size); - mv.visitLocalVariable(name, desc, signature, start, end, newIndex); -} - -public void visitFrame( - final int type, - final int nLocal, - final Object[] local, - final int nStack, - final Object[] stack){ - if(type != Opcodes.F_NEW) - { // uncompressed frame - throw new IllegalStateException("ClassReader.accept() should be called with EXPAND_FRAMES flag"); - } - - if(!changed) - { // optimization for the case where mapping = identity - mv.visitFrame(type, nLocal, local, nStack, stack); - return; - } - - // creates a copy of newLocals - Object[] oldLocals = new Object[newLocals.length]; - System.arraycopy(newLocals, 0, oldLocals, 0, oldLocals.length); - - // copies types from 'local' to 'newLocals' - // 'newLocals' already contains the variables added with 'newLocal' - - int index = 0; // old local variable index - int number = 0; // old local variable number - for(; number < nLocal; ++number) - { - Object t = local[number]; - int size = t == Opcodes.LONG || t == Opcodes.DOUBLE ? 2 : 1; - if(t != Opcodes.TOP) - { - setFrameLocal(remap(index, size), t); - } - index += size; - } - - // removes TOP after long and double types as well as trailing TOPs - - index = 0; - number = 0; - for(int i = 0; index < newLocals.length; ++i) - { - Object t = newLocals[index++]; - if(t != null && t != Opcodes.TOP) - { - newLocals[i] = t; - number = i + 1; - if(t == Opcodes.LONG || t == Opcodes.DOUBLE) - { - index += 1; - } - } - else - { - newLocals[i] = Opcodes.TOP; - } - } - - // visits remapped frame - mv.visitFrame(type, number, newLocals, nStack, stack); - - // restores original value of 'newLocals' - newLocals = oldLocals; -} - -// ------------- - -/** - * Creates a new local variable of the given type. - * - * @param type the type of the local variable to be created. - * @return the identifier of the newly created local variable. - */ -public int newLocal(final Type type){ - Object t; - switch(type.getSort()) - { - case Type.BOOLEAN: - case Type.CHAR: - case Type.BYTE: - case Type.SHORT: - case Type.INT: - t = Opcodes.INTEGER; - break; - case Type.FLOAT: - t = Opcodes.FLOAT; - break; - case Type.LONG: - t = Opcodes.LONG; - break; - case Type.DOUBLE: - t = Opcodes.DOUBLE; - break; - case Type.ARRAY: - t = type.getDescriptor(); - break; - // case Type.OBJECT: - default: - t = type.getInternalName(); - break; - } - int local = nextLocal; - setLocalType(local, type); - setFrameLocal(local, t); - nextLocal += type.getSize(); - return local; -} - -/** - * Sets the current type of the given local variable. The default - * implementation of this method does nothing. - * - * @param local a local variable identifier, as returned by {@link #newLocal - * newLocal()}. - * @param type the type of the value being stored in the local variable - */ -protected void setLocalType(final int local, final Type type){ -} - -private void setFrameLocal(final int local, final Object type){ - int l = newLocals.length; - if(local >= l) - { - Object[] a = new Object[Math.max(2 * l, local + 1)]; - System.arraycopy(newLocals, 0, a, 0, l); - newLocals = a; - } - newLocals[local] = type; -} - -private int remap(final int var, final Type type){ - if(var < firstLocal) - { - return var; - } - int key = 2 * var + type.getSize() - 1; - int size = mapping.length; - if(key >= size) - { - int[] newMapping = new int[Math.max(2 * size, key + 1)]; - System.arraycopy(mapping, 0, newMapping, 0, size); - mapping = newMapping; - } - int value = mapping[key]; - if(value == 0) - { - value = nextLocal + 1; - mapping[key] = value; - setLocalType(nextLocal, type); - nextLocal += type.getSize(); - } - if(value - 1 != var) - { - changed = true; - } - return value - 1; -} - -private int remap(final int var, final int size){ - if(var < firstLocal || !changed) - { - return var; - } - int key = 2 * var + size - 1; - int value = key < mapping.length ? mapping[key] : 0; - if(value == 0) - { - throw new IllegalStateException("Unknown local variable " + var); - } - return value - 1; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/Method.java --- a/src/clojure/asm/commons/Method.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,267 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm.commons; - -import java.util.HashMap; -import java.util.Map; - -import clojure.asm.Type; - -/** - * A named method descriptor. - * - * @author Juozas Baliuka - * @author Chris Nokleberg - * @author Eric Bruneton - */ -public class Method{ - -/** - * The method name. - */ -private final String name; - -/** - * The method descriptor. - */ -private final String desc; - -/** - * Maps primitive Java type names to their descriptors. - */ -private final static Map DESCRIPTORS; - -static - { - DESCRIPTORS = new HashMap(); - DESCRIPTORS.put("void", "V"); - DESCRIPTORS.put("byte", "B"); - DESCRIPTORS.put("char", "C"); - DESCRIPTORS.put("double", "D"); - DESCRIPTORS.put("float", "F"); - DESCRIPTORS.put("int", "I"); - DESCRIPTORS.put("long", "J"); - DESCRIPTORS.put("short", "S"); - DESCRIPTORS.put("boolean", "Z"); - } - -/** - * Creates a new {@link Method}. - * - * @param name the method's name. - * @param desc the method's descriptor. - */ -public Method(final String name, final String desc){ - this.name = name; - this.desc = desc; -} - -/** - * Creates a new {@link Method}. - * - * @param name the method's name. - * @param returnType the method's return type. - * @param argumentTypes the method's argument types. - */ -public Method( - final String name, - final Type returnType, - final Type[] argumentTypes){ - this(name, Type.getMethodDescriptor(returnType, argumentTypes)); -} - -/** - * Returns a {@link Method} corresponding to the given Java method - * declaration. - * - * @param method a Java method declaration, without argument names, of the - * form "returnType name (argumentType1, ... argumentTypeN)", where - * the types are in plain Java (e.g. "int", "float", - * "java.util.List", ...). Classes of the java.lang package can be - * specified by their unqualified name; all other classes names must - * be fully qualified. - * @return a {@link Method} corresponding to the given Java method - * declaration. - * @throws IllegalArgumentException if method could not get - * parsed. - */ -public static Method getMethod(final String method) - throws IllegalArgumentException{ - return getMethod(method, false); -} - -/** - * Returns a {@link Method} corresponding to the given Java method - * declaration. - * - * @param method a Java method declaration, without argument names, of the - * form "returnType name (argumentType1, ... argumentTypeN)", where - * the types are in plain Java (e.g. "int", "float", - * "java.util.List", ...). Classes of the java.lang package may be - * specified by their unqualified name, depending on the - * defaultPackage argument; all other classes names must be fully - * qualified. - * @param defaultPackage true if unqualified class names belong to the - * default package, or false if they correspond to java.lang classes. - * For instance "Object" means "Object" if this option is true, or - * "java.lang.Object" otherwise. - * @return a {@link Method} corresponding to the given Java method - * declaration. - * @throws IllegalArgumentException if method could not get - * parsed. - */ -public static Method getMethod( - final String method, - final boolean defaultPackage) throws IllegalArgumentException{ - int space = method.indexOf(' '); - int start = method.indexOf('(', space) + 1; - int end = method.indexOf(')', start); - if(space == -1 || start == -1 || end == -1) - { - throw new IllegalArgumentException(); - } - // TODO: Check validity of returnType, methodName and arguments. - String returnType = method.substring(0, space); - String methodName = method.substring(space + 1, start - 1).trim(); - StringBuffer sb = new StringBuffer(); - sb.append('('); - int p; - do - { - String s; - p = method.indexOf(',', start); - if(p == -1) - { - s = map(method.substring(start, end).trim(), defaultPackage); - } - else - { - s = map(method.substring(start, p).trim(), defaultPackage); - start = p + 1; - } - sb.append(s); - } while(p != -1); - sb.append(')'); - sb.append(map(returnType, defaultPackage)); - return new Method(methodName, sb.toString()); -} - -private static String map(final String type, final boolean defaultPackage){ - if(type.equals("")) - { - return type; - } - - StringBuffer sb = new StringBuffer(); - int index = 0; - while((index = type.indexOf("[]", index) + 1) > 0) - { - sb.append('['); - } - - String t = type.substring(0, type.length() - sb.length() * 2); - String desc = (String) DESCRIPTORS.get(t); - if(desc != null) - { - sb.append(desc); - } - else - { - sb.append('L'); - if(t.indexOf('.') < 0) - { - if(!defaultPackage) - { - sb.append("java/lang/"); - } - sb.append(t); - } - else - { - sb.append(t.replace('.', '/')); - } - sb.append(';'); - } - return sb.toString(); -} - -/** - * Returns the name of the method described by this object. - * - * @return the name of the method described by this object. - */ -public String getName(){ - return name; -} - -/** - * Returns the descriptor of the method described by this object. - * - * @return the descriptor of the method described by this object. - */ -public String getDescriptor(){ - return desc; -} - -/** - * Returns the return type of the method described by this object. - * - * @return the return type of the method described by this object. - */ -public Type getReturnType(){ - return Type.getReturnType(desc); -} - -/** - * Returns the argument types of the method described by this object. - * - * @return the argument types of the method described by this object. - */ -public Type[] getArgumentTypes(){ - return Type.getArgumentTypes(desc); -} - -public String toString(){ - return name + desc; -} - -public boolean equals(final Object o){ - if(!(o instanceof Method)) - { - return false; - } - Method other = (Method) o; - return name.equals(other.name) && desc.equals(other.desc); -} - -public int hashCode(){ - return name.hashCode() ^ desc.hashCode(); -} -} \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/SerialVersionUIDAdder.java --- a/src/clojure/asm/commons/SerialVersionUIDAdder.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,508 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm.commons; - -import java.io.ByteArrayOutputStream; -import java.io.DataOutputStream; -import java.io.IOException; -import java.security.MessageDigest; -import java.util.ArrayList; -import java.util.Arrays; -import java.util.Collection; - -import clojure.asm.ClassAdapter; -import clojure.asm.ClassVisitor; -import clojure.asm.FieldVisitor; -import clojure.asm.MethodVisitor; -import clojure.asm.Opcodes; - -/** - * A {@link ClassAdapter} that adds a serial version unique identifier to a - * class if missing. Here is typical usage of this class: - *

- * 

- *   ClassWriter cw = new ClassWriter(...);
- *   ClassVisitor sv = new SerialVersionUIDAdder(cw);
- *   ClassVisitor ca = new MyClassAdapter(sv);
- *   new ClassReader(orginalClass).accept(ca, false);
- *
- *

- * The SVUID algorithm can be found http://java.sun.com/j2se/1.4.2/docs/guide/serialization/spec/class.html: - *

- * 

- * The serialVersionUID is computed using the signature of a stream of bytes
- * that reflect the class definition. The National Institute of Standards and
- * Technology (NIST) Secure Hash Algorithm (SHA-1) is used to compute a
- * signature for the stream. The first two 32-bit quantities are used to form a
- * 64-bit hash. A java.lang.DataOutputStream is used to convert primitive data
- * types to a sequence of bytes. The values input to the stream are defined by
- * the Java Virtual Machine (VM) specification for classes.
- * 

- * The sequence of items in the stream is as follows:
- * 

- * 1. The class name written using UTF encoding.
- * 2. The class modifiers written as a 32-bit integer.
- * 3. The name of each interface sorted by name written using UTF encoding.
- * 4. For each field of the class sorted by field name (except private static
- * and private transient fields):
- * 1. The name of the field in UTF encoding.
- * 2. The modifiers of the field written as a 32-bit integer.
- * 3. The descriptor of the field in UTF encoding
- * 5. If a class initializer exists, write out the following:
- * 1. The name of the method, <clinit>, in UTF encoding.
- * 2. The modifier of the method, java.lang.reflect.Modifier.STATIC,
- * written as a 32-bit integer.
- * 3. The descriptor of the method, ()V, in UTF encoding.
- * 6. For each non-private constructor sorted by method name and signature:
- * 1. The name of the method, <init>, in UTF encoding.
- * 2. The modifiers of the method written as a 32-bit integer.
- * 3. The descriptor of the method in UTF encoding.
- * 7. For each non-private method sorted by method name and signature:
- * 1. The name of the method in UTF encoding.
- * 2. The modifiers of the method written as a 32-bit integer.
- * 3. The descriptor of the method in UTF encoding.
- * 8. The SHA-1 algorithm is executed on the stream of bytes produced by
- * DataOutputStream and produces five 32-bit values sha[0..4].
- * 

- * 9. The hash value is assembled from the first and second 32-bit values of
- * the SHA-1 message digest. If the result of the message digest, the five
- * 32-bit words H0 H1 H2 H3 H4, is in an array of five int values named
- * sha, the hash value would be computed as follows:
- * 

- * long hash = ((sha[0] >>> 24) & 0xFF) |
- * ((sha[0] >>> 16) & 0xFF) << 8 |
- * ((sha[0] >>> 8) & 0xFF) << 16 |
- * ((sha[0] >>> 0) & 0xFF) << 24 |
- * ((sha[1] >>> 24) & 0xFF) << 32 |
- * ((sha[1] >>> 16) & 0xFF) << 40 |
- * ((sha[1] >>> 8) & 0xFF) << 48 |
- * ((sha[1] >>> 0) & 0xFF) << 56;
- *
- * - * @author Rajendra Inamdar, Vishal Vishnoi - */ -public class SerialVersionUIDAdder extends ClassAdapter{ - -/** - * Flag that indicates if we need to compute SVUID. - */ -protected boolean computeSVUID; - -/** - * Set to true if the class already has SVUID. - */ -protected boolean hasSVUID; - -/** - * Classes access flags. - */ -protected int access; - -/** - * Internal name of the class - */ -protected String name; - -/** - * Interfaces implemented by the class. - */ -protected String[] interfaces; - -/** - * Collection of fields. (except private static and private transient - * fields) - */ -protected Collection svuidFields; - -/** - * Set to true if the class has static initializer. - */ -protected boolean hasStaticInitializer; - -/** - * Collection of non-private constructors. - */ -protected Collection svuidConstructors; - -/** - * Collection of non-private methods. - */ -protected Collection svuidMethods; - -/** - * Creates a new {@link SerialVersionUIDAdder}. - * - * @param cv a {@link ClassVisitor} to which this visitor will delegate - * calls. - */ -public SerialVersionUIDAdder(final ClassVisitor cv){ - super(cv); - svuidFields = new ArrayList(); - svuidConstructors = new ArrayList(); - svuidMethods = new ArrayList(); -} - -// ------------------------------------------------------------------------ -// Overriden methods -// ------------------------------------------------------------------------ - -/* - * Visit class header and get class name, access , and intefraces - * informatoin (step 1,2, and 3) for SVUID computation. - */ - -public void visit( - final int version, - final int access, - final String name, - final String signature, - final String superName, - final String[] interfaces){ - computeSVUID = (access & Opcodes.ACC_INTERFACE) == 0; - - if(computeSVUID) - { - this.name = name; - this.access = access; - this.interfaces = interfaces; - } - - super.visit(version, access, name, signature, superName, interfaces); -} - -/* - * Visit the methods and get constructor and method information (step 5 and - * 7). Also determince if there is a class initializer (step 6). - */ -public MethodVisitor visitMethod( - final int access, - final String name, - final String desc, - final String signature, - final String[] exceptions){ - if(computeSVUID) - { - if(name.equals("")) - { - hasStaticInitializer = true; - } - /* - * Remembers non private constructors and methods for SVUID - * computation For constructor and method modifiers, only the - * ACC_PUBLIC, ACC_PRIVATE, ACC_PROTECTED, ACC_STATIC, ACC_FINAL, - * ACC_SYNCHRONIZED, ACC_NATIVE, ACC_ABSTRACT and ACC_STRICT flags - * are used. - */ - int mods = access - & (Opcodes.ACC_PUBLIC | Opcodes.ACC_PRIVATE - | Opcodes.ACC_PROTECTED | Opcodes.ACC_STATIC - | Opcodes.ACC_FINAL | Opcodes.ACC_SYNCHRONIZED - | Opcodes.ACC_NATIVE | Opcodes.ACC_ABSTRACT | Opcodes.ACC_STRICT); - - // all non private methods - if((access & Opcodes.ACC_PRIVATE) == 0) - { - if(name.equals("")) - { - svuidConstructors.add(new Item(name, mods, desc)); - } - else if(!name.equals("")) - { - svuidMethods.add(new Item(name, mods, desc)); - } - } - } - - return cv.visitMethod(access, name, desc, signature, exceptions); -} - -/* - * Gets class field information for step 4 of the alogrithm. Also determines - * if the class already has a SVUID. - */ -public FieldVisitor visitField( - final int access, - final String name, - final String desc, - final String signature, - final Object value){ - if(computeSVUID) - { - if(name.equals("serialVersionUID")) - { - // since the class already has SVUID, we won't be computing it. - computeSVUID = false; - hasSVUID = true; - } - /* - * Remember field for SVUID computation For field modifiers, only - * the ACC_PUBLIC, ACC_PRIVATE, ACC_PROTECTED, ACC_STATIC, - * ACC_FINAL, ACC_VOLATILE, and ACC_TRANSIENT flags are used when - * computing serialVersionUID values. - */ - int mods = access - & (Opcodes.ACC_PUBLIC | Opcodes.ACC_PRIVATE - | Opcodes.ACC_PROTECTED | Opcodes.ACC_STATIC - | Opcodes.ACC_FINAL | Opcodes.ACC_VOLATILE | Opcodes.ACC_TRANSIENT); - - if((access & Opcodes.ACC_PRIVATE) == 0 - || (access & (Opcodes.ACC_STATIC | Opcodes.ACC_TRANSIENT)) == 0) - { - svuidFields.add(new Item(name, mods, desc)); - } - } - - return super.visitField(access, name, desc, signature, value); -} - -/* - * Add the SVUID if class doesn't have one - */ -public void visitEnd(){ - // compute SVUID and add it to the class - if(computeSVUID && !hasSVUID) - { - try - { - cv.visitField(Opcodes.ACC_FINAL + Opcodes.ACC_STATIC, - "serialVersionUID", - "J", - null, - new Long(computeSVUID())); - } - catch(Throwable e) - { - throw new RuntimeException("Error while computing SVUID for " - + name, e); - } - } - - super.visitEnd(); -} - -// ------------------------------------------------------------------------ -// Utility methods -// ------------------------------------------------------------------------ - -/** - * Returns the value of SVUID if the class doesn't have one already. Please - * note that 0 is returned if the class already has SVUID, thus use - * isHasSVUID to determine if the class already had an SVUID. - * - * @return Returns the serial version UID - * @throws IOException - */ -protected long computeSVUID() throws IOException{ - ByteArrayOutputStream bos = null; - DataOutputStream dos = null; - long svuid = 0; - - try - { - bos = new ByteArrayOutputStream(); - dos = new DataOutputStream(bos); - - /* - * 1. The class name written using UTF encoding. - */ - dos.writeUTF(name.replace('/', '.')); - - /* - * 2. The class modifiers written as a 32-bit integer. - */ - dos.writeInt(access - & (Opcodes.ACC_PUBLIC | Opcodes.ACC_FINAL - | Opcodes.ACC_INTERFACE | Opcodes.ACC_ABSTRACT)); - - /* - * 3. The name of each interface sorted by name written using UTF - * encoding. - */ - Arrays.sort(interfaces); - for(int i = 0; i < interfaces.length; i++) - { - dos.writeUTF(interfaces[i].replace('/', '.')); - } - - /* - * 4. For each field of the class sorted by field name (except - * private static and private transient fields): - * - * 1. The name of the field in UTF encoding. 2. The modifiers of the - * field written as a 32-bit integer. 3. The descriptor of the field - * in UTF encoding - * - * Note that field signatutes are not dot separated. Method and - * constructor signatures are dot separated. Go figure... - */ - writeItems(svuidFields, dos, false); - - /* - * 5. If a class initializer exists, write out the following: 1. The - * name of the method, , in UTF encoding. 2. The modifier of - * the method, java.lang.reflect.Modifier.STATIC, written as a - * 32-bit integer. 3. The descriptor of the method, ()V, in UTF - * encoding. - */ - if(hasStaticInitializer) - { - dos.writeUTF(""); - dos.writeInt(Opcodes.ACC_STATIC); - dos.writeUTF("()V"); - } // if.. - - /* - * 6. For each non-private constructor sorted by method name and - * signature: 1. The name of the method, , in UTF encoding. 2. - * The modifiers of the method written as a 32-bit integer. 3. The - * descriptor of the method in UTF encoding. - */ - writeItems(svuidConstructors, dos, true); - - /* - * 7. For each non-private method sorted by method name and - * signature: 1. The name of the method in UTF encoding. 2. The - * modifiers of the method written as a 32-bit integer. 3. The - * descriptor of the method in UTF encoding. - */ - writeItems(svuidMethods, dos, true); - - dos.flush(); - - /* - * 8. The SHA-1 algorithm is executed on the stream of bytes - * produced by DataOutputStream and produces five 32-bit values - * sha[0..4]. - */ - byte[] hashBytes = computeSHAdigest(bos.toByteArray()); - - /* - * 9. The hash value is assembled from the first and second 32-bit - * values of the SHA-1 message digest. If the result of the message - * digest, the five 32-bit words H0 H1 H2 H3 H4, is in an array of - * five int values named sha, the hash value would be computed as - * follows: - * - * long hash = ((sha[0] >>> 24) & 0xFF) | ((sha[0] >>> 16) & 0xFF) << - * 8 | ((sha[0] >>> 8) & 0xFF) << 16 | ((sha[0] >>> 0) & 0xFF) << - * 24 | ((sha[1] >>> 24) & 0xFF) << 32 | ((sha[1] >>> 16) & 0xFF) << - * 40 | ((sha[1] >>> 8) & 0xFF) << 48 | ((sha[1] >>> 0) & 0xFF) << - * 56; - */ - for(int i = Math.min(hashBytes.length, 8) - 1; i >= 0; i--) - { - svuid = (svuid << 8) | (hashBytes[i] & 0xFF); - } - } - finally - { - // close the stream (if open) - if(dos != null) - { - dos.close(); - } - } - - return svuid; -} - -/** - * Returns the SHA-1 message digest of the given value. - * - * @param value the value whose SHA message digest must be computed. - * @return the SHA-1 message digest of the given value. - */ -protected byte[] computeSHAdigest(final byte[] value){ - try - { - return MessageDigest.getInstance("SHA").digest(value); - } - catch(Exception e) - { - throw new UnsupportedOperationException(e); - } -} - -/** - * Sorts the items in the collection and writes it to the data output stream - * - * @param itemCollection collection of items - * @param dos a DataOutputStream value - * @param dotted a boolean value - * @throws IOException if an error occurs - */ -private void writeItems( - final Collection itemCollection, - final DataOutputStream dos, - final boolean dotted) throws IOException{ - int size = itemCollection.size(); - Item items[] = (Item[]) itemCollection.toArray(new Item[size]); - Arrays.sort(items); - for(int i = 0; i < size; i++) - { - dos.writeUTF(items[i].name); - dos.writeInt(items[i].access); - dos.writeUTF(dotted - ? items[i].desc.replace('/', '.') - : items[i].desc); - } -} - -// ------------------------------------------------------------------------ -// Inner classes -// ------------------------------------------------------------------------ - -static class Item implements Comparable{ - - String name; - - int access; - - String desc; - - Item(final String name, final int access, final String desc){ - this.name = name; - this.access = access; - this.desc = desc; - } - - public int compareTo(final Object o){ - Item other = (Item) o; - int retVal = name.compareTo(other.name); - if(retVal == 0) - { - retVal = desc.compareTo(other.desc); - } - return retVal; - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/StaticInitMerger.java --- a/src/clojure/asm/commons/StaticInitMerger.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,102 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm.commons; - -import clojure.asm.ClassAdapter; -import clojure.asm.ClassVisitor; -import clojure.asm.MethodVisitor; -import clojure.asm.Opcodes; - -/** - * A {@link ClassAdapter} that merges clinit methods into a single one. - * - * @author Eric Bruneton - */ -public class StaticInitMerger extends ClassAdapter{ - -private String name; - -private MethodVisitor clinit; - -private String prefix; - -private int counter; - -public StaticInitMerger(final String prefix, final ClassVisitor cv){ - super(cv); - this.prefix = prefix; -} - -public void visit( - final int version, - final int access, - final String name, - final String signature, - final String superName, - final String[] interfaces){ - cv.visit(version, access, name, signature, superName, interfaces); - this.name = name; -} - -public MethodVisitor visitMethod( - final int access, - final String name, - final String desc, - final String signature, - final String[] exceptions){ - MethodVisitor mv; - if(name.equals("")) - { - int a = Opcodes.ACC_PRIVATE + Opcodes.ACC_STATIC; - String n = prefix + counter++; - mv = cv.visitMethod(a, n, desc, signature, exceptions); - - if(clinit == null) - { - clinit = cv.visitMethod(a, name, desc, null, null); - } - clinit.visitMethodInsn(Opcodes.INVOKESTATIC, this.name, n, desc); - } - else - { - mv = cv.visitMethod(access, name, desc, signature, exceptions); - } - return mv; -} - -public void visitEnd(){ - if(clinit != null) - { - clinit.visitInsn(Opcodes.RETURN); - clinit.visitMaxs(0, 0); - } - cv.visitEnd(); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/TableSwitchGenerator.java --- a/src/clojure/asm/commons/TableSwitchGenerator.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/*** - * ASM: a very small and fast Java bytecode manipulation framework - * Copyright (c) 2000-2005 INRIA, France Telecom - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. Neither the name of the copyright holders nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF - * THE POSSIBILITY OF SUCH DAMAGE. - */ -package clojure.asm.commons; - -import clojure.asm.Label; - -/** - * A code generator for switch statements. - * - * @author Juozas Baliuka - * @author Chris Nokleberg - * @author Eric Bruneton - */ -public interface TableSwitchGenerator{ - -/** - * Generates the code for a switch case. - * - * @param key the switch case key. - * @param end a label that corresponds to the end of the switch statement. - */ -void generateCase(int key, Label end); - -/** - * Generates the code for the default switch case. - */ -void generateDefault(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/commons/package.html --- a/src/clojure/asm/commons/package.html Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,48 +0,0 @@ - - - -Provides some useful class and method adapters. The preferred way of using - these adapters is by chaining them together and to custom adapters (instead of - inheriting from them). Indeed this approach provides more combination -possibilities than inheritance. For instance, suppose you want to implement an -adapter MyAdapter than needs sorted local variables and intermediate stack map -frame values taking into account the local variables sort. By using inheritance, -this would require MyAdapter to extend AnalyzerAdapter, itself extending -LocalVariablesSorter. But AnalyzerAdapter is not a subclass of -LocalVariablesSorter, so this is not possible. On the contrary, by using -delegation, you can make LocalVariablesSorter delegate to AnalyzerAdapter, -itself delegating to MyAdapter. In this case AnalyzerAdapter computes -intermediate frames based on the output of LocalVariablesSorter, and MyAdapter -can add new locals by calling the newLocal method on LocalVariablesSorter, and -can get the stack map frame state before each instruction by reading the locals -and stack fields in AnalyzerAdapter (this requires references from MyAdapter -back to LocalVariablesSorter and AnalyzerAdapter). - \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/asm/package.html --- a/src/clojure/asm/package.html Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ - - - -Provides a small and fast bytecode manipulation framework. - -

- The ASM framework is organized - around the {@link clojure.asm.ClassVisitor ClassVisitor}, - {@link clojure.asm.FieldVisitor FieldVisitor} and - {@link clojure.asm.MethodVisitor MethodVisitor} interfaces, which allow - one to visit the fields and methods of a class, including the bytecode - instructions of each method. - -

- In addition to these main interfaces, ASM provides a {@link - clojure.asm.ClassReader ClassReader} class, that can parse an - existing class and make a given visitor visit it. ASM also provides - a {@link clojure.asm.ClassWriter ClassWriter} class, which is - a visitor that generates Java class files. - -

- In order to generate a class from scratch, only the {@link - clojure.asm.ClassWriter ClassWriter} class is necessary. Indeed, - in order to generate a class, one must just call its visitXXX - methods with the appropriate arguments to generate the desired fields - and methods. See the "helloworld" example in the ASM distribution for - more details about class generation. - -

- In order to modify existing classes, one must use a {@link - clojure.asm.ClassReader ClassReader} class to analyze - the original class, a class modifier, and a {@link clojure.asm.ClassWriter - ClassWriter} to construct the modified class. The class modifier - is just a {@link clojure.asm.ClassVisitor ClassVisitor} - that delegates most of the work to another {@link clojure.asm.ClassVisitor - ClassVisitor}, but that sometimes changes some parameter values, - or call additional methods, in order to implement the desired - modification process. In order to make it easier to implement such - class modifiers, ASM provides the {@link clojure.asm.ClassAdapter - ClassAdapter} and {@link clojure.asm.MethodAdapter MethodAdapter} - classes, which implement the {@link clojure.asm.ClassVisitor ClassVisitor} - and {@link clojure.asm.MethodVisitor MethodVisitor} interfaces by - delegating all work to other visitors. See the "adapt" example in the ASM - distribution for more details about class modification. - -

- The size of the core ASM library, asm.jar, is only 42KB, which is much - smaller than the size of the - BCEL library (504KB), and than the - size of the - SERP library (150KB). ASM is also - much faster than these tools. Indeed the overhead of a load time class - transformation process is of the order of 60% with ASM, 700% or more with BCEL, - and 1100% or more with SERP (see the test/perf directory in the ASM - distribution)! - - @since ASM 1.3 - - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/accumulators.clj --- a/src/clojure/contrib/accumulators.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,324 +0,0 @@ -;; Accumulators - -;; by Konrad Hinsen -;; last updated May 19, 2009 - -;; This module defines various accumulators (list, vector, map, -;; sum, product, counter, and combinations thereof) with a common -;; interface defined by the multimethods add and combine. -;; For each accumulator type, its empty value is defined in this module. -;; Applications typically use this as a starting value and add data -;; using the add multimethod. - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "A generic accumulator interface and implementations of various - accumulators."} - clojure.contrib.accumulators - (:refer-clojure :exclude (deftype)) - (:use [clojure.contrib.types :only (deftype)]) - (:use [clojure.contrib.def :only (defvar defvar- defmacro-)]) - (:require [clojure.contrib.generic.arithmetic :as ga])) - -(defmulti add - "Add item to the accumulator acc. The exact meaning of adding an - an item depends on the type of the accumulator." - {:arglists '([acc item])} - (fn [acc item] (type acc))) - -(defn add-items - "Add all elements of a collection coll to the accumulator acc." - [acc items] - (reduce add acc items)) - -(defmulti combine - "Combine the values of the accumulators acc1 and acc2 into a - single accumulator of the same type." - {:arglists '([& accs])} - (fn [& accs] (type (first accs)))) - -; -; An ::accumulator type tag is attached to tbe built-in types -; when used as accumulators, and new types are derived from it. -; Multimethods add and combine for ::accumulator sub-dispatch on class. -; We also define generic addition as the combine operation. -; -(let [meta-map {:type ::accumulator}] - (defn- with-acc-tag - [x] - (with-meta x meta-map))) - -(defmethod add ::accumulator - [a e] - ((get-method add (class a)) a e)) - -(defmethod combine ::accumulator - [& as] - (apply (get-method combine (class (first as))) as)) - -(defmethod ga/+ ::accumulator - [x y] - (combine x y)) - -; -; Vector accumulator -; -(defvar empty-vector (with-acc-tag []) - "An empty vector accumulator. Adding an item appends it at the end.") - -(defmethod combine clojure.lang.IPersistentVector - [& vs] - (with-acc-tag (vec (apply concat vs)))) - -(defmethod add clojure.lang.IPersistentVector - [v e] - (with-acc-tag (conj v e))) - -; -; List accumulator -; -(defvar empty-list (with-acc-tag '()) - "An empty list accumulator. Adding an item appends it at the beginning.") - -(defmethod combine clojure.lang.IPersistentList - [& vs] - (with-acc-tag (apply concat vs))) - -(defmethod add clojure.lang.IPersistentList - [v e] - (with-acc-tag (conj v e))) - -; -; Queue accumulator -; -(defvar empty-queue (with-acc-tag clojure.lang.PersistentQueue/EMPTY) - "An empty queue accumulator. Adding an item appends it at the end.") - -(defmethod combine clojure.lang.PersistentQueue - [& vs] - (add-items (first vs) (apply concat (rest vs)))) - -(defmethod add clojure.lang.PersistentQueue - [v e] - (with-acc-tag (conj v e))) - -; -; Set accumulator -; -(defvar empty-set (with-acc-tag #{}) - "An empty set accumulator.") - -(defmethod combine (class empty-set) - [& vs] - (with-acc-tag (apply clojure.set/union vs))) - -(defmethod add (class empty-set) - [v e] - (with-acc-tag (conj v e))) - -; -; String accumulator -; -(defvar empty-string "" - "An empty string accumulator. Adding an item (string or character) - appends it at the end.") - -(defmethod combine java.lang.String - [& vs] - (apply str vs)) - -(defmethod add java.lang.String - [v e] - (str v e)) - -; -; Map accumulator -; -(defvar empty-map (with-acc-tag {}) - "An empty map accumulator. Items to be added must be [key value] pairs.") - -(defmethod combine clojure.lang.IPersistentMap - [& vs] - (with-acc-tag (apply merge vs))) - -(defmethod add clojure.lang.IPersistentMap - [v e] - (with-acc-tag (conj v e))) - -; -; Numerical accumulators: sum, product, minimum, maximum -; -(defmacro- defacc - [name op empty doc-string] - (let [type-tag (keyword (str *ns*) (str name)) - empty-symbol (symbol (str "empty-" name))] - `(let [op# ~op] - (deftype ~type-tag ~name - (fn [~'x] {:value ~'x}) - (fn [~'x] (list (:value ~'x)))) - (derive ~type-tag ::accumulator) - (defvar ~empty-symbol (~name ~empty) ~doc-string) - (defmethod combine ~type-tag [& vs#] - (~name (apply op# (map :value vs#)))) - (defmethod add ~type-tag [v# e#] - (~name (op# (:value v#) e#)))))) - -(defacc sum + 0 - "An empty sum accumulator. Only numbers can be added.") - -(defacc product * 1 - "An empty sum accumulator. Only numbers can be added.") - -; The empty maximum accumulator should have value -infinity. -; This is represented by nil and taken into account in an -; adapted max function. In the minimum accumulator, nil is -; similarly used to represent +infinity. - -(defacc maximum (fn [& xs] - (when-let [xs (seq (filter identity xs))] - (apply max xs))) - nil - "An empty maximum accumulator. Only numbers can be added.") - -(defacc minimum (fn [& xs] - (when-let [xs (seq (filter identity xs))] - (apply min xs))) - nil - "An empty minimum accumulator. Only numbers can be added.") - -; -; Numeric min-max accumulator -; (combination of minimum and maximum) -; -(deftype ::min-max min-max - (fn [min max] {:min min :max max}) - (fn [mm] (list (:min mm) (:max mm)))) - -(derive ::min-max ::accumulator) - -(defvar empty-min-max (min-max nil nil) - "An empty min-max accumulator, combining minimum and maximum. - Only numbers can be added.") - -(defmethod combine ::min-max - [& vs] - (let [total-min (apply min (map :min vs)) - total-max (apply max (map :max vs))] - (min-max total-min total-max))) - -(defmethod add ::min-max - [v e] - (let [min-v (:min v) - max-v (:max v) - new-min (if (nil? min-v) e (min min-v e)) - new-max (if (nil? max-v) e (max max-v e))] - (min-max new-min new-max))) - -; -; Mean and variance accumulator -; -(deftype ::mean-variance mean-variance) - -(derive ::mean-variance ::accumulator) - -(defvar empty-mean-variance (mean-variance {:n 0 :mean 0 :variance 0}) - "An empty mean-variance accumulator, combining sample mean and - sample variance. Only numbers can be added.") - -(defmethod combine ::mean-variance - ([mv] - mv) - - ([mv1 mv2] - (let [{n1 :n mean1 :mean var1 :variance} mv1 - {n2 :n mean2 :mean var2 :variance} mv2 - n (+ n1 n2) - mean (/ (+ (* n1 mean1) (* n2 mean2)) n) - sq #(* % %) - c (+ (* n1 (sq (- mean mean1))) (* n2 (sq (- mean mean2)))) - var (if (< n 2) - 0 - (/ (+ c (* (dec n1) var1) (* (dec n2) var2)) (dec n)))] - (mean-variance {:n n :mean mean :variance var}))) - - ([mv1 mv2 & mvs] - (reduce combine (combine mv1 mv2) mvs))) - -(defmethod add ::mean-variance - [mv x] - (let [{n :n mean :mean var :variance} mv - n1 (inc n) - d (- x mean) - new-mean (+ mean (/ d n1)) - new-var (if (zero? n) 0 (/ (+ (* (dec n) var) (* d (- x new-mean))) n))] - (mean-variance {:n n1 :mean new-mean :variance new-var}))) - -; -; Counter accumulator -; -(deftype ::counter counter) - -(derive ::counter ::accumulator) - -(defvar empty-counter (counter {}) - "An empty counter accumulator. Its value is a map that stores for - every item the number of times it was added.") - -(defmethod combine ::counter - [v & vs] - (letfn [(add-item [cntr [item n]] - (assoc cntr item (+ n (get cntr item 0)))) - (add-two [c1 c2] (reduce add-item c1 c2))] - (reduce add-two v vs))) - -(defmethod add ::counter - [v e] - (assoc v e (inc (get v e 0)))) - -; -; Counter accumulator with total count -; -(deftype ::counter-with-total counter-with-total) -(derive ::counter-with-total ::counter) - -(defvar empty-counter-with-total - (counter-with-total {:total 0}) - "An empty counter-with-total accumulator. It works like the counter - accumulator, except that the total number of items added is stored as the - value of the key :total.") - -(defmethod add ::counter-with-total - [v e] - (assoc v e (inc (get v e 0)) - :total (inc (:total v)))) - -; -; Accumulator n-tuple -; -(deftype ::tuple acc-tuple) - -(derive ::tuple ::accumulator) - -(defn empty-tuple - "Returns an accumulator tuple with the supplied empty-accumulators - as its value. Accumulator tuples consist of several accumulators that - work in parallel. Added items must be sequences whose number of elements - matches the number of sub-accumulators." - [empty-accumulators] - (acc-tuple (into [] empty-accumulators))) - -(defmethod combine ::tuple - [& vs] - (acc-tuple (vec (map combine vs)))) - -(defmethod add ::tuple - [v e] - (acc-tuple (vec (map add v e)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/agent_utils.clj --- a/src/clojure/contrib/agent_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -; Copyright (c) Christophe Grand, November 2008. All rights reserved. - -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this -; distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; misc agent utilities - -;; note to other contrib members: feel free to add to this lib - -(ns - ^{:author "Christophe Grande", - :doc "Miscellaneous agent utilities - (note to other contrib members: feel free to add to this lib)", -} - clojure.contrib.agent-utils) - -(defmacro capture-and-send - "Capture the current value of the specified vars and rebind - them on the agent thread before executing the action. - - Example: - (capture-and-send [*out*] a f b c)" - - [vars agent action & args] - (let [locals (map #(gensym (name %)) vars)] - `(let [~@(interleave locals vars) - action# (fn [& args#] - (binding [~@(interleave vars locals)] - (apply ~action args#)))] - (send ~agent action# ~@args)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/apply_macro.clj --- a/src/clojure/contrib/apply_macro.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -;;; apply_macro.clj: make macros behave like functions - -;; by Stuart Sierra, http://stuartsierra.com/ -;; January 28, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; Don't use this. I mean it. It's evil. How evil? You can't -;; handle it, that's how evil it is. That's right. I did it so you -;; don't have to, ok? Look but don't touch. Use this lib and you'll -;; go blind. - -;; DEPRECATED in 1.2 with no replacement. - -(ns ^{:deprecated "1.2"} - clojure.contrib.apply-macro) - -;; Copied from clojure.core/spread, which is private. -(defn- spread - "Flatten final argument list as in apply." - [arglist] - (cond - (nil? arglist) nil - (nil? (rest arglist)) (seq (first arglist)) - :else (cons (first arglist) (spread (rest arglist))))) - -(defmacro apply-macro - "This is evil. Don't ever use it. It makes a macro behave like a - function. Seriously, how messed up is that? - - Evaluates all args, then uses them as arguments to the macro as with - apply. - - (def things [true true false]) - (apply-macro and things) - ;; Expands to: (and true true false)" - [macro & args] - (cons macro (spread (map eval args)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/base64.clj --- a/src/clojure/contrib/base64.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,99 +0,0 @@ -;;; base64.clj: Experimental Base-64 encoding and (later) decoding - -;; by Stuart Sierra, http://stuartsierra.com/ -;; August 19, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(ns ^{:doc "Base-64 encoding and (maybe later) decoding. - - This is mainly here as an example. It is much slower than the - Apache Commons Codec implementation or sun.misc.BASE64Encoder." - :author "Stuart Sierra"} - clojure.contrib.base64 - (:import (java.io InputStream Writer ByteArrayInputStream - StringWriter))) - -(def *base64-alphabet* - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=") - -(defn encode - "Encodes bytes of input, writing Base 64 text on output. alphabet - is a 65-character String containing the 64 characters to use in the - encoding; the 65th character is the pad character. line-length is - the maximum number of characters per line, nil for no line breaks." - [^InputStream input ^Writer output ^String alphabet line-length] - (let [buffer (make-array Byte/TYPE 3)] - (loop [line 0] - (let [len (.read input buffer)] - (when (pos? len) - ;; Pre-boxing the bytes as Integers is more efficient for - ;; Clojure's bit operations. - (let [b0 (Integer/valueOf (int (aget buffer 0))) - b1 (Integer/valueOf (int (aget buffer 1))) - b2 (Integer/valueOf (int (aget buffer 2)))] - (cond (= len 3) - (let [s0 (bit-and 0x3F (bit-shift-right b0 2)) - s1 (bit-and 0x3F - (bit-or (bit-shift-left b0 4) - (bit-shift-right b1 4))) - s2 (bit-and 0x3F - (bit-or (bit-shift-left b1 2) - (bit-shift-right b2 6))) - s3 (bit-and 0x3F b2)] - (.append output (.charAt alphabet s0)) - (.append output (.charAt alphabet s1)) - (.append output (.charAt alphabet s2)) - (.append output (.charAt alphabet s3))) - - (= len 2) - (let [s0 (bit-and 0x3F (bit-shift-right b0 2)) - s1 (bit-and 0x3F - (bit-or (bit-shift-left b0 4) - (bit-shift-right b1 4))) - s2 (bit-and 0x3F (bit-shift-left b1 2))] - (.append output (.charAt alphabet s0)) - (.append output (.charAt alphabet s1)) - (.append output (.charAt alphabet s2)) - (.append output (.charAt alphabet 64))) - - (= len 1) - (let [s0 (bit-and 0x3F (bit-shift-right b0 2)) - s1 (bit-and 0x3F (bit-shift-left b0 4))] - (.append output (.charAt alphabet s0)) - (.append output (.charAt alphabet s1)) - (.append output (.charAt alphabet 64)) - (.append output (.charAt alphabet 64))))) - (if (and line-length (> (+ line 4) line-length)) - (do (.append output \newline) - (recur 0)) - (recur (+ line 4)))))))) - -(defn encode-str - "Encodes String in base 64; returns a String. If not specified, - encoding is UTF-8 and line-length is nil." - ([s] (encode-str s "UTF-8" nil)) - ([^String s ^String encoding line-length] - (let [output (StringWriter.)] - (encode (ByteArrayInputStream. (.getBytes s encoding)) - output *base64-alphabet* line-length) - (.toString output)))) - - -;;; tests - -;; (deftest t-encode-str -;; (is (= (encode-str "") "")) -;; (is (= (encode-str "f") "Zg==")) -;; (is (= (encode-str "fo") "Zm8=")) -;; (is (= (encode-str "foo") "Zm9v")) -;; (is (= (encode-str "foob") "Zm9vYg==")) -;; (is (= (encode-str "fooba") "Zm9vYmE=")) -;; (is (= (encode-str "foobar") "Zm9vYmFy"))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/classpath.clj --- a/src/clojure/contrib/classpath.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -;;; classpath.clj: utilities for working with the Java class path - -;; by Stuart Sierra, http://stuartsierra.com/ -;; April 19, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(ns - ^{:author "Stuart Sierra", - :doc "Utilities for dealing with the JVM's classpath"} - clojure.contrib.classpath - (:require [clojure.contrib.jar :as jar]) - (:import (java.io File) - (java.util.jar JarFile))) - -(defn classpath - "Returns a sequence of File objects of the elements on CLASSPATH." - [] - (map #(File. %) - (.split (System/getProperty "java.class.path") - (System/getProperty "path.separator")))) - -(defn classpath-directories - "Returns a sequence of File objects for the directories on classpath." - [] - (filter #(.isDirectory %) (classpath))) - -(defn classpath-jarfiles - "Returns a sequence of JarFile objects for the JAR files on classpath." - [] - (map #(JarFile. %) (filter jar/jar-file? (classpath)))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/combinatorics.clj --- a/src/clojure/contrib/combinatorics.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,164 +0,0 @@ -;;; combinatorics.clj: efficient, functional algorithms for generating lazy -;;; sequences for common combinatorial functions. - -;; by Mark Engelberg (mark.engelberg@gmail.com) -;; January 27, 2009 - -(comment -" -(combinations items n) - A lazy sequence of all the unique -ways of taking n different elements from items. -Example: (combinations [1 2 3] 2) -> ((1 2) (1 3) (2 3)) - -(subsets items) - A lazy sequence of all the subsets of -items (but generalized to all sequences, not just sets). -Example: (subsets [1 2 3]) -> (() (1) (2) (3) (1 2) (1 3) (2 3) (1 2 3)) - -(cartesian-product & seqs) - Takes any number of sequences -as arguments, and returns a lazy sequence of all the ways -to take one item from each seq. -Example: (cartesian-product [1 2] [3 4]) -> ((1 3) (1 4) (2 3) (2 4)) -(cartesian-product seq1 seq2 seq3 ...) behaves like but is -faster than a nested for loop, such as: -(for [i1 seq1 i2 seq2 i3 seq3 ...] (list i1 i2 i3 ...)) - -(selections items n) - A lazy sequence of all the ways to -take n (possibly the same) items from the sequence of items. -Example: (selections [1 2] 3) -> ((1 1 1) (1 1 2) (1 2 1) (1 2 2) (2 1 1) (2 1 2) (2 2 1) (2 2 2)) - -(permutations items) - A lazy sequence of all the permutations -of items. -Example: (permutations [1 2 3]) -> ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)) - -(lex-permutations items) - A lazy sequence of all distinct -permutations in lexicographic order -(this function returns the permutations as -vectors). Only works on sequences of comparable -items. (Note that the result will be quite different from -permutations when the sequence contains duplicate items.) -Example: (lex-permutations [1 1 2]) -> ([1 1 2] [1 2 1] [2 1 1]) - -About permutations vs. lex-permutations: -lex-permutations is faster than permutations, but only works -on sequences of numbers. They operate differently -on sequences with duplicate items (lex-permutations will only -give you back distinct permutations). lex-permutations always -returns the permutations sorted lexicographically whereas -permutations will be in an order where the input sequence -comes first. In general, I recommend using the regular -permutations function unless you have a specific -need for lex-permutations. - -About this code: -These combinatorial functions can be written in an elegant way using recursion. However, when dealing with combinations and permutations, you're usually generating large numbers of things, and speed counts. My objective was to write the fastest possible code I could, restricting myself to Clojure's functional, persistent data structures (rather than using Java's arrays) so that this code could be safely leveraged within Clojure's transactional concurrency system. - -I also restricted myself to algorithms that return results in a standard order. For example, there are faster ways to generate cartesian-product, but I don't know of a faster way to generate the results in the standard nested-for-loop order. - -Most of these algorithms are derived from algorithms found in Knuth's wonderful Art of Computer Programming books (specifically, the volume 4 fascicles), which present fast, iterative solutions to these common combinatorial problems. Unfortunately, these iterative versions are somewhat inscrutable. If you want to better understand these algorithms, the Knuth books are the place to start. - -On my own computer, I use versions of all these algorithms that return sequences built with an uncached variation of lazy-seq. Not only does this boost performance, but it's easier to use these rather large sequences more safely (from a memory consumption standpoint). If some form of uncached sequences makes it into Clojure, I will update this accordingly. -" -) - - -(ns - ^{:author "Mark Engelberg", - :doc "Efficient, functional algorithms for generating lazy -sequences for common combinatorial functions. (See the source code -for a longer description.)"} - clojure.contrib.combinatorics) - -(defn- index-combinations - [n cnt] - (lazy-seq - (let [c (vec (cons nil (for [j (range 1 (inc n))] (+ j cnt (- (inc n)))))), - iter-comb - (fn iter-comb [c j] - (if (> j n) nil - (let [c (assoc c j (dec (c j)))] - (if (< (c j) j) [c (inc j)] - (loop [c c, j j] - (if (= j 1) [c j] - (recur (assoc c (dec j) (dec (c j))) (dec j)))))))), - step - (fn step [c j] - (cons (rseq (subvec c 1 (inc n))) - (lazy-seq (let [next-step (iter-comb c j)] - (when next-step (step (next-step 0) (next-step 1)))))))] - (step c 1)))) - -(defn combinations - "All the unique ways of taking n different elements from items" - [items n] - (let [v-items (vec (reverse items))] - (if (zero? n) (list ()) - (let [cnt (count items)] - (cond (> n cnt) nil - (= n cnt) (list (seq items)) - :else - (map #(map v-items %) (index-combinations n cnt))))))) - -(defn subsets - "All the subsets of items" - [items] - (mapcat (fn [n] (combinations items n)) - (range (inc (count items))))) - -(defn cartesian-product - "All the ways to take one item from each sequence" - [& seqs] - (let [v-original-seqs (vec seqs) - step - (fn step [v-seqs] - (let [increment - (fn [v-seqs] - (loop [i (dec (count v-seqs)), v-seqs v-seqs] - (if (= i -1) nil - (if-let [rst (next (v-seqs i))] - (assoc v-seqs i rst) - (recur (dec i) (assoc v-seqs i (v-original-seqs i)))))))] - (when v-seqs - (cons (map first v-seqs) - (lazy-seq (step (increment v-seqs)))))))] - (when (every? first seqs) - (lazy-seq (step v-original-seqs))))) - - -(defn selections - "All the ways of taking n (possibly the same) elements from the sequence of items" - [items n] - (apply cartesian-product (take n (repeat items)))) - - -(defn- iter-perm [v] - (let [len (count v), - j (loop [i (- len 2)] - (cond (= i -1) nil - (< (v i) (v (inc i))) i - :else (recur (dec i))))] - (when j - (let [vj (v j), - l (loop [i (dec len)] - (if (< vj (v i)) i (recur (dec i))))] - (loop [v (assoc v j (v l) l vj), k (inc j), l (dec len)] - (if (< k l) - (recur (assoc v k (v l) l (v k)) (inc k) (dec l)) - v)))))) - -(defn- vec-lex-permutations [v] - (when v (cons v (lazy-seq (vec-lex-permutations (iter-perm v)))))) - -(defn lex-permutations - "Fast lexicographic permutation generator for a sequence of numbers" - [c] - (lazy-seq - (let [vec-sorted (vec (sort c))] - (if (zero? (count vec-sorted)) - (list []) - (vec-lex-permutations vec-sorted))))) - -(defn permutations - "All the permutations of items, lexicographic by index" - [items] - (let [v (vec items)] - (map #(map v %) (lex-permutations (range (count v)))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/command_line.clj --- a/src/clojure/contrib/command_line.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,121 +0,0 @@ -; Copyright (c) Chris Houser, Nov-Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Process command-line arguments according to a given cmdspec - -(ns - ^{:author "Chris Houser", - :doc "Process command-line arguments according to a given cmdspec"} - clojure.contrib.command-line - (:use (clojure.contrib [string :only (join)]))) - -(defn make-map [args cmdspec] - (let [{spec true [rest-sym] false} (group-by vector? cmdspec) - rest-str (str rest-sym) - key-data (into {} (for [[syms [_ default]] (map #(split-with symbol? %) - (conj spec '[help? h?])) - sym syms] - [(re-find #"^.*[^?]" (str sym)) - {:sym (str (first syms)) :default default}])) - defaults (into {} (for [[_ {:keys [default sym]}] key-data - :when default] - [sym default]))] - (loop [[argkey & [argval :as r]] args - cmdmap (assoc defaults :cmdspec cmdspec rest-str [])] - (if argkey - (let [[_ & [keybase]] (re-find #"^--?(.*)" argkey)] - (cond - (= keybase nil) (recur r (update-in cmdmap [rest-str] conj argkey)) - (= keybase "") (update-in cmdmap [rest-str] #(apply conj % r)) - :else (if-let [found (key-data keybase)] - (if (= \? (last (:sym found))) - (recur r (assoc cmdmap (:sym found) true)) - (recur (next r) (assoc cmdmap (:sym found) - (if (or (nil? r) (= \- (ffirst r))) - (:default found) - (first r))))) - (throw (Exception. (str "Unknown option " argkey)))))) - cmdmap)))) - -(defn- align - "Align strings given as vectors of columns, with first vector - specifying right or left alignment (:r or :l) for each column." - [spec & rows] - (let [maxes (vec (for [n (range (count (first rows)))] - (apply max (map (comp count #(nth % n)) rows)))) - fmt (join " " - (for [n (range (count maxes))] - (str "%" - (when-not (zero? (maxes n)) - (str (when (= (spec n) :l) "-") (maxes n))) - "s")))] - (join "\n" - (for [row rows] - (apply format fmt row))))) - -(defn- rmv-q - "Remove ?" - [^String s] - (if (.endsWith s "?") - (.substring s 0 (dec (count s))) - s)) - -(defn print-help [desc cmdmap] - (println desc) - (println "Options") - (println - (apply align [:l :l :l] - (for [spec (:cmdspec cmdmap) :when (vector? spec)] - (let [[argnames [text default]] (split-with symbol? spec) - [_ opt q] (re-find #"^(.*[^?])(\??)$" - (str (first argnames))) - argnames (map (comp rmv-q str) argnames) - argnames - (join ", " - (for [arg argnames] - (if (= 1 (count arg)) - (str "-" arg) - (str "--" arg))))] - [(str " " argnames (when (= "" q) " ") " ") - text - (if-not default - "" - (str " [default " default "]"))]))))) - -(defmacro with-command-line - "Bind locals to command-line args." - [args desc cmdspec & body] - (let [locals (vec (for [spec cmdspec] - (if (vector? spec) - (first spec) - spec)))] - `(let [{:strs ~locals :as cmdmap#} (make-map ~args '~cmdspec)] - (if (cmdmap# "help?") - (print-help ~desc cmdmap#) - (do ~@body))))) - -(comment - -; example of usage: - -(with-command-line *command-line-args* - "tojs -- Compile ClojureScript to JavaScript" - [[simple? s? "Runs some simple built-in tests"] - [serve "Starts a repl server on the given port" 8081] - [mkboot? "Generates a boot.js file"] - [verbose? v? "Includes extra fn names and comments in js"] - filenames] - (binding [*debug-fn-names* verbose? *debug-comments* verbose?] - (cond - simple? (simple-tests) - serve (start-server (Integer/parseInt serve)) - mkboot? (mkboot) - :else (doseq [filename filenames] - (filetojs filename))))) - -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/complex_numbers.clj --- a/src/clojure/contrib/complex_numbers.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,293 +0,0 @@ -;; Complex numbers - -;; by Konrad Hinsen -;; last updated May 4, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Complex numbers - NOTE: This library is in evolution. Most math functions are - not implemented yet."} - clojure.contrib.complex-numbers - (:refer-clojure :exclude (deftype)) - (:use [clojure.contrib.types :only (deftype)] - [clojure.contrib.generic :only (root-type)]) - (:require [clojure.contrib.generic.arithmetic :as ga] - [clojure.contrib.generic.comparison :as gc] - [clojure.contrib.generic.math-functions :as gm])) - -; -; Complex numbers are represented as struct maps. The real and imaginary -; parts can be of any type for which arithmetic and maths functions -; are defined. -; -(defstruct complex-struct :real :imag) - -; -; The general complex number type -; -(deftype ::complex complex - (fn [real imag] (struct complex-struct real imag)) - (fn [c] (vals c))) - -(derive ::complex root-type) - -; -; A specialized subtype for pure imaginary numbers. Introducing this type -; reduces the number of operations by eliminating additions with and -; multiplications by zero. -; -(deftype ::pure-imaginary imaginary - (fn [imag] (struct complex-struct 0 imag)) - (fn [c] (list (:imag c)))) - -(derive ::pure-imaginary ::complex) - -; -; Extraction of real and imaginary parts -; -(def real (accessor complex-struct :real)) -(def imag (accessor complex-struct :imag)) - -; -; Equality and zero test -; -(defmethod gc/zero? ::complex - [x] - (let [[rx ix] (vals x)] - (and (zero? rx) (zero? ix)))) - -(defmethod gc/= [::complex ::complex] - [x y] - (let [[rx ix] (vals x) - [ry iy] (vals y)] - (and (gc/= rx ry) (gc/= ix iy)))) - -(defmethod gc/= [::pure-imaginary ::pure-imaginary] - [x y] - (gc/= (imag x) (imag y))) - -(defmethod gc/= [::complex ::pure-imaginary] - [x y] - (let [[rx ix] (vals x)] - (and (gc/zero? rx) (gc/= ix (imag y))))) - -(defmethod gc/= [::pure-imaginary ::complex] - [x y] - (let [[ry iy] (vals y)] - (and (gc/zero? ry) (gc/= (imag x) iy)))) - -(defmethod gc/= [::complex root-type] - [x y] - (let [[rx ix] (vals x)] - (and (gc/zero? ix) (gc/= rx y)))) - -(defmethod gc/= [root-type ::complex] - [x y] - (let [[ry iy] (vals y)] - (and (gc/zero? iy) (gc/= x ry)))) - -(defmethod gc/= [::pure-imaginary root-type] - [x y] - (and (gc/zero? (imag x)) (gc/zero? y))) - -(defmethod gc/= [root-type ::pure-imaginary] - [x y] - (and (gc/zero? x) (gc/zero? (imag y)))) - -; -; Addition -; -(defmethod ga/+ [::complex ::complex] - [x y] - (let [[rx ix] (vals x) - [ry iy] (vals y)] - (complex (ga/+ rx ry) (ga/+ ix iy)))) - -(defmethod ga/+ [::pure-imaginary ::pure-imaginary] - [x y] - (imaginary (ga/+ (imag x) (imag y)))) - -(defmethod ga/+ [::complex ::pure-imaginary] - [x y] - (let [[rx ix] (vals x)] - (complex rx (ga/+ ix (imag y))))) - -(defmethod ga/+ [::pure-imaginary ::complex] - [x y] - (let [[ry iy] (vals y)] - (complex ry (ga/+ (imag x) iy)))) - -(defmethod ga/+ [::complex root-type] - [x y] - (let [[rx ix] (vals x)] - (complex (ga/+ rx y) ix))) - -(defmethod ga/+ [root-type ::complex] - [x y] - (let [[ry iy] (vals y)] - (complex (ga/+ x ry) iy))) - -(defmethod ga/+ [::pure-imaginary root-type] - [x y] - (complex y (imag x))) - -(defmethod ga/+ [root-type ::pure-imaginary] - [x y] - (complex x (imag y))) - -; -; Negation -; -(defmethod ga/- ::complex - [x] - (let [[rx ix] (vals x)] - (complex (ga/- rx) (ga/- ix)))) - -(defmethod ga/- ::pure-imaginary - [x] - (imaginary (ga/- (imag x)))) - -; -; Subtraction is automatically supplied by ga/-, optimized implementations -; can be added later... -; - -; -; Multiplication -; -(defmethod ga/* [::complex ::complex] - [x y] - (let [[rx ix] (vals x) - [ry iy] (vals y)] - (complex (ga/- (ga/* rx ry) (ga/* ix iy)) - (ga/+ (ga/* rx iy) (ga/* ix ry))))) - -(defmethod ga/* [::pure-imaginary ::pure-imaginary] - [x y] - (ga/- (ga/* (imag x) (imag y)))) - -(defmethod ga/* [::complex ::pure-imaginary] - [x y] - (let [[rx ix] (vals x) - iy (imag y)] - (complex (ga/- (ga/* ix iy)) - (ga/* rx iy)))) - -(defmethod ga/* [::pure-imaginary ::complex] - [x y] - (let [ix (imag x) - [ry iy] (vals y)] - (complex (ga/- (ga/* ix iy)) - (ga/* ix ry)))) - -(defmethod ga/* [::complex root-type] - [x y] - (let [[rx ix] (vals x)] - (complex (ga/* rx y) (ga/* ix y)))) - -(defmethod ga/* [root-type ::complex] - [x y] - (let [[ry iy] (vals y)] - (complex (ga/* x ry) (ga/* x iy)))) - -(defmethod ga/* [::pure-imaginary root-type] - [x y] - (imaginary (ga/* (imag x) y))) - -(defmethod ga/* [root-type ::pure-imaginary] - [x y] - (imaginary (ga/* x (imag y)))) - -; -; Inversion -; -(ga/defmethod* ga / ::complex - [x] - (let [[rx ix] (vals x) - den ((ga/qsym ga /) (ga/+ (ga/* rx rx) (ga/* ix ix)))] - (complex (ga/* rx den) (ga/- (ga/* ix den))))) - -(ga/defmethod* ga / ::pure-imaginary - [x] - (imaginary (ga/- ((ga/qsym ga /) (imag x))))) - -; -; Division is automatically supplied by ga//, optimized implementations -; can be added later... -; - -; -; Conjugation -; -(defmethod gm/conjugate ::complex - [x] - (let [[r i] (vals x)] - (complex r (ga/- i)))) - -(defmethod gm/conjugate ::pure-imaginary - [x] - (imaginary (ga/- (imag x)))) - -; -; Absolute value -; -(defmethod gm/abs ::complex - [x] - (let [[r i] (vals x)] - (gm/sqrt (ga/+ (ga/* r r) (ga/* i i))))) - -(defmethod gm/abs ::pure-imaginary - [x] - (gm/abs (imag x))) - -; -; Square root -; -(let [one-half (/ 1 2) - one-eighth (/ 1 8)] - (defmethod gm/sqrt ::complex - [x] - (let [[r i] (vals x)] - (if (and (gc/zero? r) (gc/zero? i)) - 0 - (let [; The basic formula would say - ; abs (gm/sqrt (ga/+ (ga/* r r) (ga/* i i))) - ; p (gm/sqrt (ga/* one-half (ga/+ abs r))) - ; but the slightly more complicated one below - ; avoids overflow for large r or i. - ar (gm/abs r) - ai (gm/abs i) - r8 (ga/* one-eighth ar) - i8 (ga/* one-eighth ai) - abs (gm/sqrt (ga/+ (ga/* r8 r8) (ga/* i8 i8))) - p (ga/* 2 (gm/sqrt (ga/+ abs r8))) - q ((ga/qsym ga /) ai (ga/* 2 p)) - s (gm/sgn i)] - (if (gc/< r 0) - (complex q (ga/* s p)) - (complex p (ga/* s q)))))))) - -; -; Exponential function -; -(defmethod gm/exp ::complex - [x] - (let [[r i] (vals x) - exp-r (gm/exp r) - cos-i (gm/cos i) - sin-i (gm/sin i)] - (complex (ga/* exp-r cos-i) (ga/* exp-r sin-i)))) - -(defmethod gm/exp ::pure-imaginary - [x] - (let [i (imag x)] - (complex (gm/cos i) (gm/sin i)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/cond.clj --- a/src/clojure/contrib/cond.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; File: cond.clj -;; -;; scgilardi (gmail) -;; 2 October 2008 - -(ns ^{:author "Stephen C. Gilardi" - :doc "Extensions to the basic cond function."} - clojure.contrib.cond) - -(defmacro cond-let - "Takes a binding-form and a set of test/expr pairs. Evaluates each test - one at a time. If a test returns logical true, cond-let evaluates and - returns expr with binding-form bound to the value of test and doesn't - evaluate any of the other tests or exprs. To provide a default value - either provide a literal that evaluates to logical true and is - binding-compatible with binding-form, or use :else as the test and don't - refer to any parts of binding-form in the expr. (cond-let binding-form) - returns nil." - [bindings & clauses] - (let [binding (first bindings)] - (when-let [[test expr & more] clauses] - (if (= test :else) - expr - `(if-let [~binding ~test] - ~expr - (cond-let ~bindings ~@more)))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/condition.clj --- a/src/clojure/contrib/condition.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,147 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; condition.clj -;; -;; scgilardi (gmail) -;; Created 09 June 2009 - -(ns ^{:author "Stephen C. Gilardi" - :doc "Flexible raising and handling of conditions: - -Functions: - - raise: raises a condition - handler-case: dispatches raised conditions to appropriate handlers - print-stack-trace: prints abbreviated or full condition stack traces - -Data: - - A condition is a map containing values for these keys: - - - :type, a condition type specifier, typically a keyword - - :stack-trace, a stack trace to the site of the raise - - :message, a human-readable message (optional) - - :cause, a wrapped exception or condition (optional) - - other keys given as arguments to raise (optional) - -Note: requires AOT compilation. - -Based on an idea from Chouser: -http://groups.google.com/group/clojure/browse_frm/thread/da1285c538f22bb5"} - clojure.contrib.condition - (:require clojure.contrib.condition.Condition) - (:import clojure.contrib.condition.Condition - clojure.lang.IPersistentMap) - (:use (clojure.contrib - [def :only (defvar)] - [seq :only (separate)]))) - -(defvar *condition* - "While a handler is running, bound to the condition being handled") - -(defvar *selector* - "While a handler is running, bound to the selector returned by the - handler-case dispatch-fn for *condition*") - -(defvar *condition-object* - "While a handler is running, bound to the Condition object whose metadata - is the condition") - -(defvar *full-stack-traces* false - "Bind to true to include clojure.{core,lang,main} frames in stack - traces") - -(defmacro raise - "Raises a condition. With no arguments, re-raises the current condition. - With one argument (a map), raises the argument. With two or more - arguments, raises a map with keys and values from the arguments." - ([] - `(throw *condition-object*)) - ([m] - `(throw (Condition. ~m))) - ([key val & keyvals] - `(raise (hash-map ~key ~val ~@keyvals)))) - -(defmacro handler-case - "Executes body in a context where raised conditions can be handled. - - dispatch-fn accepts a raised condition (a map) and returns a selector - used to choose a handler. Commonly, dispatch-fn will be :type to dispatch - on the condition's :type value. - - Handlers are forms within body: - - (handle key - ...) - - If a condition is raised, executes the body of the first handler whose - key satisfies (isa? selector key). If no handlers match, re-raises the - condition. - - While a handler is running, *condition* is bound to the condition being - handled and *selector* is bound to to the value returned by dispatch-fn - that matched the handler's key." - [dispatch-fn & body] - (let [[handlers code] - (separate #(and (list? %) (= 'handle (first %))) body)] - `(try - ~@code - (catch Condition c# - (binding [*condition-object* c# - *condition* (meta c#) - *selector* (~dispatch-fn (meta c#))] - (cond - ~@(mapcat - (fn [[_ key & body]] - `[(isa? *selector* ~key) (do ~@body)]) - handlers) - :else (raise))))))) - -(defmulti stack-trace-info - "Returns header, stack-trace, and cause info from conditions and - Throwables" - class) - -(defmethod stack-trace-info IPersistentMap - [condition] - [(format "condition: %s, %s" (:type condition) - (dissoc condition :type :stack-trace :cause)) - (:stack-trace condition) - (:cause condition)]) - -(defmethod stack-trace-info Condition - [condition] - (stack-trace-info (meta condition))) - -(defmethod stack-trace-info Throwable - [throwable] - [(str throwable) - (.getStackTrace throwable) - (.getCause throwable)]) - -(defn print-stack-trace - "Prints a stack trace for a condition or Throwable. Skips frames for - classes in clojure.{core,lang,main} unless the *full-stack-traces* is - bound to logical true" - [x] - (let [[header frames cause] (stack-trace-info x)] - (printf "%s\n" header) - (doseq [frame frames] - (let [classname (.getClassName frame)] - (if (or *full-stack-traces* - (not (re-matches - #"clojure.(?:core|lang|main).*" classname))) - (printf " at %s/%s(%s:%s)\n" - classname - (.getMethodName frame) - (.getFileName frame) - (.getLineNumber frame))))) - (when cause - (printf "caused by: ") - (recur cause)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/condition/Condition.clj --- a/src/clojure/contrib/condition/Condition.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,43 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; Condition.clj -;; -;; Used by clojure.contrib.condition to implement a "Throwable map" -;; -;; scgilardi (gmail) -;; Created 09 June 2009 - -(ns clojure.contrib.condition.Condition - (:gen-class :extends Throwable - :implements [clojure.lang.IMeta] - :state state - :init init - :post-init post-init - :constructors {[clojure.lang.IPersistentMap] - [String Throwable]})) - -(defn -init - "Constructs a Condition object with condition (a map) as its - metadata. Also initializes the superclass with the values at :message - and :cause, if any, so they are also available via .getMessage and - .getCause." - [condition] - [[(:message condition) (:cause condition)] (atom condition)]) - -(defn -post-init - "Adds :stack-trace to the condition. Drops the bottom 3 frames because - they are always the same: implementation details of Condition and raise." - [this condition] - (swap! (.state this) assoc - :stack-trace (into-array (drop 3 (.getStackTrace this))))) - -(defn -meta - "Returns this object's metadata, the condition" - [this] - @(.state this)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/core.clj --- a/src/clojure/contrib/core.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,89 +0,0 @@ -; Copyright (c) Laurent Petit and others, March 2009. All rights reserved. - -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this -; distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; functions/macros variants of the ones that can be found in clojure.core - -;; note to other contrib members: feel free to add to this lib - -(ns - ^{:author "Laurent Petit (and others)" - :doc "Functions/macros variants of the ones that can be found in clojure.core - (note to other contrib members: feel free to add to this lib)"} - clojure.contrib.core - (:use clojure.contrib.def)) - -(defmacro- defnilsafe [docstring non-safe-name nil-safe-name] - `(defmacro ~nil-safe-name ~docstring - {:arglists '([~'x ~'form] [~'x ~'form ~'& ~'forms])} - ([x# form#] - `(let [~'i# ~x#] (when-not (nil? ~'i#) (~'~non-safe-name ~'i# ~form#)))) - ([x# form# & more#] - `(~'~nil-safe-name (~'~nil-safe-name ~x# ~form#) ~@more#)))) - -(defnilsafe - "Same as clojure.core/-> but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation). - Examples : - (-?> \"foo\" .toUpperCase (.substring 1)) returns \"OO\" - (-?> nil .toUpperCase (.substring 1)) returns nil - " - -> -?>) - -(defnilsafe - "Same as clojure.core/.. but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation). - Examples : - (.?. \"foo\" .toUpperCase (.substring 1)) returns \"OO\" - (.?. nil .toUpperCase (.substring 1)) returns nil - " - .. .?.) - -(defnilsafe - "Same as clojure.core/->> but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation). - Examples : - (-?>> (range 5) (map inc)) returns (1 2 3 4 5) - (-?>> [] seq (map inc)) returns nil - " - ->> -?>>) - -;; ---------------------------------------------------------------------- -;; scgilardi at gmail - -(defn dissoc-in - "Dissociates an entry from a nested associative structure returning a new - nested structure. keys is a sequence of keys. Any empty maps that result - will not be present in the new structure." - [m [k & ks :as keys]] - (if ks - (if-let [nextmap (get m k)] - (let [newmap (dissoc-in nextmap ks)] - (if (seq newmap) - (assoc m k newmap) - (dissoc m k))) - m) - (dissoc m k))) - -(defn new-by-name - "Constructs a Java object whose class is specified by a String." - [class-name & args] - (clojure.lang.Reflector/invokeConstructor - (clojure.lang.RT/classForName class-name) - (into-array Object args))) - -(defn seqable? - "Returns true if (seq x) will succeed, false otherwise." - [x] - (or (seq? x) - (instance? clojure.lang.Seqable x) - (nil? x) - (instance? Iterable x) - (-> x .getClass .isArray) - (string? x) - (instance? java.util.Map x))) - -;; ---------------------------------------------------------------------- diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/dataflow.clj --- a/src/clojure/contrib/dataflow.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,509 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; dataflow.clj -;; -;; A Library to Support a Dataflow Model of State -;; -;; straszheimjeffrey (gmail) -;; Created 10 March 2009 - - -(ns - ^{:author "Jeffrey Straszheim", - :doc "A library to support a dataflow model of state"} - clojure.contrib.dataflow - (:use [clojure.set :only (union intersection difference)]) - (:use [clojure.contrib.graph :only (directed-graph - reverse-graph - dependency-list - get-neighbors)]) - (:use [clojure.walk :only (postwalk)]) - (:use [clojure.contrib.except :only (throwf)]) - (:import java.io.Writer)) - - -;;; Chief Data Structures - - -;; Source Cell - -; The data of a source cell is directly set by a calling function. It -; never depends on other cells. - -(defstruct source-cell - :name ; The name, a symbol - :value ; Its value, a Ref - :cell-type) ; Should be ::source-cell - -;; Cell - -; A standard cell that computes its value from other cells. - -(defstruct standard-cell - :name ; The name, a symbol - :value ; Its value, a Ref - :dependents ; The names of cells on which this depends, a collection - :fun ; A closure that computes the value, given an environment - :display ; The original expression for display - :cell-type) ; Should be ::cell - -(derive ::cell ::dependent-cell) ; A cell that has a dependents field - -;; Validator - -; A cell that has no value, but can throw an exception when run - -(defstruct validator-cell - :name ; Always ::validator - :dependents ; The names of cells on which this depends, a collection - :fun ; A clojure that can throw an exception - :display ; The original exprssion for display - :cell-type) ; Should be ::validator-cell - -(derive ::validator-cell ::dependent-cell) - - -;; A sentinal value - -(def *empty-value* (java.lang.Object.)) - - -;; Dataflow - -; A collection of cells and dependency information - -(defstruct dataflow - :cells ; A set of all cells - :cells-map ; A map of cell names (symbols) to collections of cells - :fore-graph ; The inverse of the dependency graph, nodes are cells - :topological) ; A vector of sets of independent nodes -- orders the computation - - -;;; Environment Access - -(defn get-cells - "Get all the cells named by name" - [df name] - ((:cells-map @df) name)) - -(defn get-cell - "Get the single cell named by name" - [df name] - (let [cells (get-cells df name)] - (cond - (= (count cells) 1) (first cells) - (> (count cells) 1) (throwf Exception "Cell %s has multiple instances" name) - :otherwise (throwf Exception "Cell %s is undefined" name)))) - -(defn source-cell? - "Is this cell a source cell?" - [cell] - (isa? (:cell-type cell) ::source-cell)) - -(defn get-source-cells - "Returns a collection of source cells from the dataflow" - [df] - (for [cell (:cells @df) - :when (source-cell? cell)] - cell)) - -(defn get-value - "Gets a value from the df matching the passed symbol. - Signals an error if the name is not present, or if it not a single - value." - [df name] - (let [cell (get-cell df name) - result @(:value cell)] - (do (when (= *empty-value* result) - (throwf Exception "Cell named %s empty" name)) - result))) - -(defn get-values - "Gets a collection of values from the df by name" - [df name] - (let [cells (get-cells df name) - results (map #(-> % :value deref) cells)] - (do - (when (some #(= % *empty-value*) results) - (throwf Exception "At least one empty cell named %s found" name)) - results))) - -(defn get-old-value - "Looks up an old value" - [df env name] - (if (contains? env name) - (env name) - (get-value df name))) - -(defn get-value-from-cell - "Given a cell, get its value" - [cell] - (-> cell :value deref)) - -;;; Build Dataflow Structure - -(defn- build-cells-map - "Given a collection of cells, build a name->cells-collection map - from it." - [cs] - (let [step (fn [m c] - (let [n (:name c) - o (get m n #{}) - s (conj o c)] - (assoc m n s)))] - (reduce step {} cs))) - -(defn- build-back-graph - "Builds the backward dependency graph from the cells map. Each - node of the graph is a cell." - [cells cells-map] - (let [step (fn [n] - (apply union (for [dep-name (:dependents n)] - (cells-map dep-name)))) - neighbors (zipmap cells (map step cells))] - (struct-map directed-graph - :nodes cells - :neighbors neighbors))) - -(defn- build-dataflow* - "Builds the dataflow structure" - [cs] - (let [cells (set cs) - cells-map (build-cells-map cs) - back-graph (build-back-graph cells cells-map) - fore-graph (reverse-graph back-graph)] - (struct-map dataflow - :cells cells - :cells-map cells-map - :fore-graph fore-graph - :topological (dependency-list back-graph)))) - -(def initialize) - -(defn build-dataflow - "Given a collection of cells, build and return a dataflow object" - [cs] - (dosync - (let [df (ref (build-dataflow* cs))] - (initialize df) - df))) - - -;;; Displaying a dataflow - -(defn print-dataflow - "Prints a dataflow, one cell per line" - [df] - (println) - (let [f (fn [cell] (-> cell :name str))] - (doseq [cell (sort-by f (:cells @df))] - (prn cell)))) - - -;;; Modifying a Dataflow - -(defn add-cells - "Given a collection of cells, add them to the dataflow." - [df cells] - (dosync - (let [new-cells (union (set cells) (:cells @df))] - (ref-set df (build-dataflow* new-cells)) - (initialize df)))) - -(defn remove-cells - "Given a collection of cells, remove them from the dataflow." - [df cells] - (dosync - (let [new-cells (difference (:cells @df) (set cells))] - (ref-set df (build-dataflow* new-cells)) - (initialize df)))) - - -;;; Cell building - -(def *meta* {:type ::dataflow-cell}) - -(defn build-source-cell - "Builds a source cell" - [name init] - (with-meta (struct source-cell name (ref init) ::source-cell) - *meta*)) - -(defn- is-col-var? - [symb] - (let [name (name symb)] - (and (= \? (first name)) - (= \* (second name))))) - -(defn- is-old-var? - [symb] - (let [name (name symb)] - (and (= \? (first name)) - (= \- (second name))))) - -(defn- is-var? - [symb] - (let [name (name symb)] - (and (= \? (first name)) - (-> symb is-col-var? not) - (-> symb is-old-var? not)))) - -(defn- cell-name - [symb] - `(quote ~(cond (is-var? symb) (-> symb name (.substring 1) symbol) - (or (is-col-var? symb) - (is-old-var? symb)) (-> symb name (.substring 2) symbol)))) - -(defn- replace-symbol - "Walk the from replacing the ?X forms with the needed calls" - [dfs ov form] - (cond - (-> form symbol? not) form - (is-var? form) `(get-value ~dfs ~(cell-name form)) - (is-col-var? form) `(get-values ~dfs ~(cell-name form)) - (is-old-var? form) `(get-old-value ~dfs ~ov ~(cell-name form)) - :otherwise form)) - -(defn- build-fun - "Build the closure needed to compute a cell" - [form] - (let [dfs (gensym "df_") - ov (gensym "old_")] - `(fn [~dfs ~ov] ~(postwalk (partial replace-symbol dfs ov) form)))) - -(defn- get-deps - "Get the names of the dependent cells" - [form] - (let [step (fn [f] - (cond - (coll? f) (apply union f) - (-> f symbol? not) nil - (is-var? f) #{(cell-name f)} - (is-col-var? f) #{(cell-name f)} - (is-old-var? f) #{(cell-name f)} - :otherwise nil))] - (postwalk step form))) - -(defn build-standard-cell - "Builds a standard cell" - [name deps fun expr] - (with-meta (struct standard-cell name (ref *empty-value*) deps fun expr ::cell) - *meta*)) - -(defn build-validator-cell - "Builds a validator cell" - [deps fun expr] - (with-meta (struct validator-cell ::validator deps fun expr ::validator-cell) - *meta*)) - -(defmacro cell - "Build a standard cell, like this: - - (cell fred - (* ?mary ?joe)) - - Which creates a cell named fred that is the product of a cell mary and cell joe - - Or: - - (cell joe - (apply * ?*sally)) - - Which creates a cell that applies * to the collection of all cells named sally - - Or: - - (cell :source fred 0) - - Which builds a source cell fred with initial value 0 - - Or: - - (cell :validator (when (< ?fred ?sally) - (throwf \"%s must be greater than %s\" ?fred ?sally)) - - Which will perform the validation" - [type & data] - (cond - (symbol? type) (let [name type ; No type for standard cell - expr (first data) ; we ignore extra data! - deps (get-deps expr) - fun (build-fun expr)] - `(build-standard-cell '~name ~deps ~fun '~expr)) - (= type :source) (let [[name init] data] - `(build-source-cell '~name ~init)) - (= type :validator) (let [[expr] data - deps (get-deps expr) - fun (build-fun expr)] - `(build-validator-cell ~deps ~fun '~expr)))) - - -;;; Cell Display - -(defmulti display-cell - "A 'readable' form of the cell" - :cell-type) - -(defmethod display-cell ::source-cell - [cell] - (list 'cell :source (:name cell) (-> cell :value deref))) - -(defmethod display-cell ::cell - [cell] - (list 'cell (:name cell) (:display cell) (-> cell :value deref))) - -(defmethod display-cell ::validator-cell - [cell] - (list 'cell :validator (:display cell))) - -(defmethod print-method ::dataflow-cell - [f ^Writer w] - (binding [*out* w] - (pr (display-cell f)))) - - -;;; Evaluation - -(defmulti eval-cell - "Evaluate a dataflow cell. Return [changed, old val]" - (fn [df data old cell] (:cell-type cell))) - -(defmethod eval-cell ::source-cell - [df data old cell] - (let [name (:name cell) - val (:value cell) - ov @val] - (if (contains? data name) - (let [new-val (data name)] - (if (not= ov new-val) - (do (ref-set val new-val) - [true ov]) - [false ov])) - [false ov]))) - -(defmethod eval-cell ::cell - [df data old cell] - (let [val (:value cell) - old-val @val - new-val ((:fun cell) df old)] - (if (not= old-val new-val) - (do (ref-set val new-val) - [true old-val]) - [false old-val]))) - -(defmethod eval-cell ::validator-cell - [df data old cell] - (do ((:fun cell) df old) - [false nil])) - -(defn- perform-flow - "Evaluate the needed cells (a set) from the given dataflow. Data is - a name-value mapping of new values for the source cells" - [df data needed] - (loop [needed needed - tops (:topological @df) - old {}] - (let [now (first tops) ; Now is a set of nodes - new-tops (next tops)] - (when (and (-> needed empty? not) - (-> now empty? not)) - (let [step (fn [[needed old] cell] - (let [[changed ov] (try - (eval-cell df data old cell) - (catch Exception e - (throw (Exception. (str cell) e)))) - nn (disj needed cell)] - (if changed - [(union nn (get-neighbors (:fore-graph @df) cell)) - (assoc old (:name cell) ov)] - [nn old]))) - [new-needed new-old] (reduce step - [needed old] - (intersection now needed))] - (recur new-needed new-tops new-old)))))) - -(defn- validate-update - "Ensure that all the updated cells are source cells" - [df names] - (let [scns (set (map :name (get-source-cells df)))] - (doseq [name names] - (when (-> name scns not) - (throwf Exception "Cell %n is not a source cell" name))))) - -(defn update-values - "Given a dataflow, and a map of name-value pairs, update the - dataflow by binding the new values. Each name must be of a source - cell" - [df data] - (dosync - (validate-update df (keys data)) - (let [needed (apply union (for [name (keys data)] - (set ((:cells-map @df) name))))] - (perform-flow df data needed)))) - -(defn- initialize - "Apply all the current source cell values. Useful for a new - dataflow, or one that has been updated with new cells" - [df] - (let [needed (:cells @df) - fg (:fore-graph @df)] - (perform-flow df {} needed))) - - -;;; Watchers - -(defn add-cell-watcher - "Adds a watcher to a cell to respond to changes of value. The is a - function of 4 values: a key, the cell, its old value, its new - value. This is implemented using Clojure's add-watch to the - underlying ref, and shared its sematics" - [cell key fun] - (let [val (:value cell)] - (add-watch val key (fn [key _ old-v new-v] - (fun key cell old-v new-v))))) - - -(comment - - (def df - (build-dataflow - [(cell :source fred 1) - (cell :source mary 0) - (cell greg (+ ?fred ?mary)) - (cell joan (+ ?fred ?mary)) - (cell joan (* ?fred ?mary)) - (cell sally (apply + ?*joan)) - (cell :validator (when (number? ?-greg) - (when (<= ?greg ?-greg) - (throwf Exception "Non monotonic"))))])) - - (do (println) - (print-dataflow df)) - - (add-cell-watcher (get-cell df 'sally) - nil - (fn [key cell o n] - (printf "sally changed from %s to %s\n" o n))) - - (update-values df {'fred 1 'mary 1}) - (update-values df {'fred 5 'mary 1}) - (update-values df {'fred 0 'mary 0}) - - (get-value df 'fred) - (get-values df 'joan) - (get-value df 'sally) - (get-value df 'greg) - - (use :reload 'clojure.contrib.dataflow) - (use 'clojure.stacktrace) (e) - (use 'clojure.contrib.trace) -) - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/datalog.clj --- a/src/clojure/contrib/datalog.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; datalog.clj -;; -;; A Clojure implementation of Datalog -;; -;; straszheimjeffrey (gmail) -;; Created 2 March 2009 - - -;;; Please see the example.clj file in the datalog folder - - -(ns - ^{:author "Jeffrey Straszheim", - :doc "A Clojure implementation of Datalog"} - clojure.contrib.datalog - (:use clojure.contrib.datalog.rules - clojure.contrib.datalog.softstrat - clojure.contrib.datalog.database) - (:use [clojure.set :only (intersection)] - [clojure.contrib.except :only (throwf)])) - -(defstruct work-plan - :work-plan ; The underlying structure - :rules ; The original rules - :query ; The original query - :work-plan-type) ; The type of plan - -(defn- validate-work-plan - "Ensure any top level semantics are not violated" - [work-plan database] - (let [common-relations (-> work-plan :rules (intersection (-> database keys set)))] - (when (-> common-relations - empty? - not) - (throwf "The rules and database define the same relation(s): %s" common-relations)))) - ; More will follow - -(defn build-work-plan - "Given a list of rules and a query, build a work plan that can be - used to execute the query." - [rules query] - (struct-map work-plan - :work-plan (build-soft-strat-work-plan rules query) - :rules rules - :query query - :work-plan-type ::soft-stratified)) - -(defn run-work-plan - "Given a work plan, a database, and some query bindings, run the - work plan and return the results." - [work-plan database query-bindings] - (validate-work-plan work-plan database) - (evaluate-soft-work-set (:work-plan work-plan) database query-bindings)) - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/datalog/database.clj --- a/src/clojure/contrib/datalog/database.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,288 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; database.clj -;; -;; A Clojure implementation of Datalog -- Support for in-memory database -;; -;; straszheimjeffrey (gmail) -;; Created 21 Feburary 2009 - - -(ns clojure.contrib.datalog.database - (:use clojure.contrib.datalog.util) - (:use clojure.contrib.def) - (:use [clojure.set :only (union intersection difference)]) - (:use [clojure.contrib.except :only (throwf)]) - (:import java.io.Writer)) - - -(defstruct relation - :schema ; A set of key names - :data ; A set of tuples - :indexes) ; A map key names to indexes (in turn a map of value to tuples) - - -;;; DDL - -(defmethod print-method ::datalog-database - [db ^Writer writer] - (binding [*out* writer] - (do - (println "(datalog-database") - (println "{") - (doseq [key (keys db)] - (println) - (println key) - (print-method (db key) writer)) - (println "})")))) - -(defn datalog-database - [rels] - (with-meta rels {:type ::datalog-database})) - -(def empty-database (datalog-database {})) - -(defmethod print-method ::datalog-relation - [rel ^Writer writer] - (binding [*out* writer] - (do - (println "(datalog-relation") - (println " ;; Schema") - (println " " (:schema rel)) - (println) - (println " ;; Data") - (println " #{") - (doseq [tuple (:data rel)] - (println " " tuple)) - (println " }") - (println) - (println " ;; Indexes") - (println " {") - (doseq [key (-> rel :indexes keys)] - (println " " key) - (println " {") - (doseq [val (keys ((:indexes rel) key))] - (println " " val) - (println " " (get-in rel [:indexes key val]))) - (println " }")) - (println " })")))) - -(defn datalog-relation - "Creates a relation" - [schema data indexes] - (with-meta (struct relation schema data indexes) {:type ::datalog-relation})) - -(defn add-relation - "Adds a relation to the database" - [db name keys] - (assoc db name (datalog-relation (set keys) #{} {}))) - -(defn add-index - "Adds an index to an empty relation named name" - [db name key] - (assert (empty? (:data (db name)))) - (let [rel (db name) - inx (assoc (:indexes rel) key {})] - (assoc db name (datalog-relation (:schema rel) - (:data rel) - inx)))) - -(defn ensure-relation - "If the database lacks the named relation, add it" - [db name keys indexes] - (if-let [rel (db name)] - (do - (assert (= (:schema rel) (set keys))) - db) - (let [db1 (add-relation db name keys)] - (reduce (fn [db key] (add-index db name key)) - db1 - indexes)))) - - -(defmacro make-database - "Makes a database, like this - (make-database - (relation :fred [:mary :sue]) - (index :fred :mary) - (relation :sally [:jen :becky]) - (index :sally :jen) - (index :sally :becky))" - [& commands] - (let [wrapper (fn [cur new] - (let [cmd (first new) - body (next new)] - (assert (= 2 (count body))) - (cond - (= cmd 'relation) - `(add-relation ~cur ~(first body) ~(fnext body)) - (= cmd 'index) - `(add-index ~cur ~(first body) ~(fnext body)) - :otherwise (throwf "%s not recognized" new))))] - (reduce wrapper `empty-database commands))) - -(defn get-relation - "Get a relation object by name" - [db rel-name] - (db rel-name)) - -(defn replace-relation - "Add or replace a fully constructed relation object to the database." - [db rel-name rel] - (assoc db rel-name rel)) - - -;;; DML - - -(defn database-counts - "Returns a map with the count of elements in each relation." - [db] - (map-values #(-> % :data count) db)) - -(defn- modify-indexes - "Perform f on the indexed tuple-set. f should take a set and tuple, - and return the new set." - [idxs tuple f] - (into {} (for [ik (keys idxs)] - (let [im (idxs ik) - iv (tuple ik) - os (get im iv #{}) - ns (f os tuple)] - [ik (if (empty? ns) - (dissoc im iv) - (assoc im iv (f os tuple)))])))) - -(defn- add-to-indexes - "Adds the tuple to the appropriate keys in the index map" - [idxs tuple] - (modify-indexes idxs tuple conj)) - -(defn- remove-from-indexes - "Removes the tuple from the appropriate keys in the index map" - [idxs tuple] - (modify-indexes idxs tuple disj)) - -(defn add-tuple - "Two forms: - - [db relation-name tuple] adds tuple to the named relation. Returns - the new database. - - [rel tuple] adds to the relation object. Returns the new relation." - ([db rel-name tuple] - (assert (= (-> tuple keys set) (-> rel-name db :schema))) - (assoc db rel-name (add-tuple (db rel-name) tuple))) - ([rel tuple] - (let [data (:data rel) - new-data (conj data tuple)] - (if (identical? data new-data) ; optimization hack! - rel - (let [idxs (add-to-indexes (:indexes rel) tuple)] - (assoc rel :data new-data :indexes idxs)))))) - -(defn remove-tuple - "Two forms: - - [db relation-name tuple] removes the tuple from the named relation, - returns a new database. - - [rel tuple] removes the tuple from the relation. Returns the new - relation." - ([db rel-name tuple] (assoc db rel-name (remove-tuple (db rel-name) tuple))) - ([rel tuple] - (let [data (:data rel) - new-data (disj data tuple)] - (if (identical? data new-data) - rel - (let [idxs (remove-from-indexes (:indexes rel) tuple)] - (assoc rel :data new-data :indexes idxs)))))) - -(defn add-tuples - "Adds a collection of tuples to the db, as - (add-tuples db - [:rel-name :key-1 1 :key-2 2] - [:rel-name :key-1 2 :key-2 3])" - [db & tupls] - (reduce #(add-tuple %1 (first %2) (apply hash-map (next %2))) db tupls)) - -(defn- find-indexes - "Given a map of indexes and a partial tuple, return the sets of full tuples" - [idxs pt] - (if (empty? idxs) - nil - (filter identity (for [key (keys pt)] - (if-let [idx-map (idxs key)] - (get idx-map (pt key) #{}) - nil))))) - -(defn- match? - "Is m2 contained in m1?" - [m1 m2] - (let [compare (fn [key] - (and (contains? m1 key) - (= (m1 key) (m2 key))))] - (every? compare (keys m2)))) - -(defn- scan-space - "Computes a stream of tuples from relation rn matching partial tuple (pt) - and applies fun to each" - [fun db rn pt] - (let [rel (db rn) - idxs (find-indexes (:indexes rel) pt) - space (if (empty? idxs) - (:data rel) ; table scan :( - (reduce intersection idxs))] - (trace-datalog (when (empty? idxs) - (println (format "Table scan of %s: %s rows!!!!!" - rn - (count space))))) - (fun #(match? % pt) space))) - -(defn select - "finds all matching tuples to the partial tuple (pt) in the relation named (rn)" - [db rn pt] - (scan-space filter db rn pt)) - -(defn any-match? - "Finds if there are any matching records for the partial tuple" - [db rn pt] - (if (= (-> pt keys set) (:schema (db rn))) - (contains? (:data (db rn)) pt) - (scan-space some db rn pt))) - - -;;; Merge - -(defn merge-indexes - [idx1 idx2] - (merge-with (fn [h1 h2] (merge-with union h1 h2)) idx1 idx2)) - -(defn merge-relations - "Merges two relations" - [r1 r2] - (assert (= (:schema r1) (:schema r2))) - (let [merged-indexes (merge-indexes (:indexes r1) - (:indexes r2)) - merged-data (union (:data r1) - (:data r2))] - (assoc r1 :data merged-data :indexes merged-indexes))) - -(defn database-merge - "Merges databases together" - [dbs] - (apply merge-with merge-relations dbs)) - -(defn database-merge-parallel - "Merges databases together in parallel" - [dbs] - (preduce merge-relations dbs)) - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/datalog/literals.clj --- a/src/clojure/contrib/datalog/literals.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,413 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; literals.clj -;; -;; A Clojure implementation of Datalog -- Literals -;; -;; straszheimjeffrey (gmail) -;; Created 25 Feburary 2009 - - -(ns clojure.contrib.datalog.literals - (:use clojure.contrib.datalog.util) - (:use clojure.contrib.datalog.database) - (:use [clojure.set :only (intersection)]) - (:use [clojure.contrib.set :only (subset?)])) - - -;;; Type Definitions - -(defstruct atomic-literal - :predicate ; The predicate name - :term-bindings ; A map of column names to bindings - :literal-type) ; ::literal or ::negated - -(derive ::negated ::literal) - -(defstruct conditional-literal - :fun ; The fun to call - :symbol ; The fun symbol (for display) - :terms ; The formal arguments - :literal-type) ; ::conditional - - -;;; Basics - - -(defmulti literal-predicate - "Return the predicate/relation this conditional operates over" - :literal-type) - -(defmulti literal-columns - "Return the column names this applies to" - :literal-type) - -(defmulti literal-vars - "Returns the logic vars used by this literal" - :literal-type) - -(defmulti positive-vars - "Returns the logic vars used in a positive position" - :literal-type) - -(defmulti negative-vars - "Returns the logic vars used in a negative position" - :literal-type) - -(defmethod literal-predicate ::literal - [l] - (:predicate l)) - -(defmethod literal-predicate ::conditional - [l] - nil) - -(defmethod literal-columns ::literal - [l] - (-> l :term-bindings keys set)) - -(defmethod literal-columns ::conditional - [l] - nil) - -(defmethod literal-vars ::literal - [l] - (set (filter is-var? (-> l :term-bindings vals)))) - -(defmethod literal-vars ::conditional - [l] - (set (filter is-var? (:terms l)))) - -(defmethod positive-vars ::literal - [l] - (literal-vars l)) - -(defmethod positive-vars ::negated - [l] - nil) - -(defmethod positive-vars ::conditional - [l] - nil) - -(defmethod negative-vars ::literal - [l] - nil) - -(defmethod negative-vars ::negated - [l] - (literal-vars l)) - -(defmethod negative-vars ::conditional - [l] - (literal-vars l)) - -(defn negated? - "Is this literal a negated literal?" - [l] - (= (:literal-type l) ::negated)) - -(defn positive? - "Is this a positive literal?" - [l] - (= (:literal-type l) ::literal)) - - -;;; Building Literals - -(def negation-symbol 'not!) -(def conditional-symbol 'if) - -(defmulti build-literal - "(Returns an unevaluated expression (to be used in macros) of a - literal." - first) - -(defn build-atom - "Returns an unevaluated expression (to be used in a macro) of an - atom." - [f type] - (let [p (first f) - ts (map #(if (is-var? %) `(quote ~%) %) (next f)) - b (if (seq ts) (apply assoc {} ts) nil)] - `(struct atomic-literal ~p ~b ~type))) - -(defmethod build-literal :default - [f] - (build-atom f ::literal)) - -(defmethod build-literal negation-symbol - [f] - (build-atom (rest f) ::negated)) - -(defmethod build-literal conditional-symbol - [f] - (let [symbol (fnext f) - terms (nnext f) - fun `(fn [binds#] (apply ~symbol binds#))] - `(struct conditional-literal - ~fun - '~symbol - '~terms - ::conditional))) - - -;;; Display - -(defmulti display-literal - "Converts a struct representing a literal to a normal list" - :literal-type) - -(defn- display - [l] - (conj (-> l :term-bindings list* flatten) (literal-predicate l))) - -(defmethod display-literal ::literal - [l] - (display l)) - -(defmethod display-literal ::negated - [l] - (conj (display l) negation-symbol)) - -(defmethod display-literal ::conditional - [l] - (list* conditional-symbol (:symbol l) (:terms l))) - - -;;; Sip computation - -(defmulti get-vs-from-cs - "From a set of columns, return the vars" - :literal-type) - -(defmethod get-vs-from-cs ::literal - [l bound] - (set (filter is-var? - (vals (select-keys (:term-bindings l) - bound))))) - -(defmethod get-vs-from-cs ::conditional - [l bound] - nil) - - -(defmulti get-cs-from-vs - "From a set of vars, get the columns" - :literal-type) - -(defmethod get-cs-from-vs ::literal - [l bound] - (reduce conj - #{} - (remove nil? - (map (fn [[k v]] (if (bound v) k nil)) - (:term-bindings l))))) - -(defmethod get-cs-from-vs ::conditional - [l bound] - nil) - - -(defmulti get-self-bound-cs - "Get the columns that are bound withing the literal." - :literal-type) - -(defmethod get-self-bound-cs ::literal - [l] - (reduce conj - #{} - (remove nil? - (map (fn [[k v]] (if (not (is-var? v)) k nil)) - (:term-bindings l))))) - -(defmethod get-self-bound-cs ::conditional - [l] - nil) - - -(defmulti literal-appropriate? - "When passed a set of bound vars, determines if this literal can be - used during this point of a SIP computation." - (fn [b l] (:literal-type l))) - -(defmethod literal-appropriate? ::literal - [bound l] - (not (empty? (intersection (literal-vars l) bound)))) - -(defmethod literal-appropriate? ::negated - [bound l] - (subset? (literal-vars l) bound)) - -(defmethod literal-appropriate? ::conditional - [bound l] - (subset? (literal-vars l) bound)) - - -(defmulti adorned-literal - "When passed a set of bound columns, returns the adorned literal" - (fn [l b] (:literal-type l))) - -(defmethod adorned-literal ::literal - [l bound] - (let [pred (literal-predicate l) - bnds (intersection (literal-columns l) bound)] - (if (empty? bound) - l - (assoc l :predicate {:pred pred :bound bnds})))) - -(defmethod adorned-literal ::conditional - [l bound] - l) - - -(defn get-adorned-bindings - "Get the bindings from this adorned literal." - [pred] - (:bound pred)) - -(defn get-base-predicate - "Get the base predicate from this predicate." - [pred] - (if (map? pred) - (:pred pred) - pred)) - - -;;; Magic Stuff - -(defn magic-literal - "Create a magic version of this adorned predicate." - [l] - (assert (-> l :literal-type (isa? ::literal))) - (let [pred (literal-predicate l) - pred-map (if (map? pred) pred {:pred pred}) - bound (get-adorned-bindings pred) - ntb (select-keys (:term-bindings l) bound)] - (assoc l :predicate (assoc pred-map :magic true) :term-bindings ntb :literal-type ::literal))) - -(defn literal-magic? - "Is this literal magic?" - [lit] - (let [pred (literal-predicate lit)] - (when (map? pred) - (:magic pred)))) - -(defn build-seed-bindings - "Given a seed literal, already adorned and in magic form, convert - its bound constants to new variables." - [s] - (assert (-> s :literal-type (isa? ::literal))) - (let [ntbs (map-values (fn [_] (gensym '?_gen_)) (:term-bindings s))] - (assoc s :term-bindings ntbs))) - - -;;; Semi-naive support - -(defn negated-literal - "Given a literal l, return a negated version" - [l] - (assert (-> l :literal-type (= ::literal))) - (assoc l :literal-type ::negated)) - -(defn delta-literal - "Given a literal l, return a delta version" - [l] - (let [pred* (:predicate l) - pred (if (map? pred*) pred* {:pred pred*})] - (assoc l :predicate (assoc pred :delta true)))) - - -;;; Database operations - -(defn- build-partial-tuple - [lit binds] - (let [tbs (:term-bindings lit) - each (fn [[key val :as pair]] - (if (is-var? val) - (if-let [n (binds val)] - [key n] - nil) - pair))] - (into {} (remove nil? (map each tbs))))) - -(defn- project-onto-literal - "Given a literal, and a materialized tuple, return a set of variable - bindings." - [lit tuple] - (let [step (fn [binds [key val]] - (if (and (is-var? val) - (contains? tuple key)) - (assoc binds val (tuple key)) - binds))] - (reduce step {} (:term-bindings lit)))) - - -(defn- join-literal* - [db lit bs fun] - (let [each (fn [binds] - (let [pt (build-partial-tuple lit binds)] - (fun binds pt)))] - (when (contains? db (literal-predicate lit)) - (apply concat (map each bs))))) - -(defmulti join-literal - "Given a database (db), a literal (lit) and a seq of bindings (bs), - return a new seq of bindings by joining this literal." - (fn [db lit bs] (:literal-type lit))) - -(defmethod join-literal ::literal - [db lit bs] - (join-literal* db lit bs (fn [binds pt] - (map #(merge binds %) - (map (partial project-onto-literal lit) - (select db (literal-predicate lit) pt)))))) - -(defmethod join-literal ::negated - [db lit bs] - (join-literal* db lit bs (fn [binds pt] - (if (any-match? db (literal-predicate lit) pt) - nil - [binds])))) - -(defmethod join-literal ::conditional - [db lit bs] - (let [each (fn [binds] - (let [resolve (fn [term] - (if (is-var? term) - (binds term) - term)) - args (map resolve (:terms lit))] - (if ((:fun lit) args) - binds - nil)))] - (remove nil? (map each bs)))) - -(defn project-literal - "Project a stream of bindings onto a literal/relation. Returns a new - db." - ([db lit bs] (project-literal db lit bs is-var?)) - ([db lit bs var?] - (assert (= (:literal-type lit) ::literal)) - (let [rel-name (literal-predicate lit) - columns (-> lit :term-bindings keys) - idxs (vec (get-adorned-bindings (literal-predicate lit))) - db1 (ensure-relation db rel-name columns idxs) - rel (get-relation db1 rel-name) - step (fn [rel bindings] - (let [step (fn [t [k v]] - (if (var? v) - (assoc t k (bindings v)) - (assoc t k v))) - tuple (reduce step {} (:term-bindings lit))] - (add-tuple rel tuple)))] - (replace-relation db rel-name (reduce step rel bs))))) - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/datalog/magic.clj --- a/src/clojure/contrib/datalog/magic.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,128 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; magic.clj -;; -;; A Clojure implementation of Datalog -- Magic Sets -;; -;; straszheimjeffrey (gmail) -;; Created 18 Feburary 2009 - - -(ns clojure.contrib.datalog.magic - (:use clojure.contrib.datalog.util - clojure.contrib.datalog.literals - clojure.contrib.datalog.rules) - (:use [clojure.set :only (union intersection difference)])) - - -;;; Adornment - -(defn adorn-query - "Adorn a query" - [q] - (adorned-literal q (get-self-bound-cs q))) - -(defn adorn-rules-set - "Adorns the given rules-set for the given query. (rs) is a - rules-set, (q) is an adorned query." - [rs q] - (let [i-preds (all-predicates rs) - p-map (predicate-map rs)] - (loop [nrs empty-rules-set ; The rules set being built - needed #{(literal-predicate q)}] - (if (empty? needed) - nrs - (let [pred (first needed) - remaining (disj needed pred) - base-pred (get-base-predicate pred) - bindings (get-adorned-bindings pred) - new-rules (p-map base-pred) - new-adorned-rules (map (partial compute-sip bindings i-preds) - new-rules) - new-nrs (reduce conj nrs new-adorned-rules) - current-preds (all-predicates new-nrs) - not-needed? (fn [pred] - (or (current-preds pred) - (-> pred get-base-predicate i-preds not))) - add-pred (fn [np pred] - (if (not-needed? pred) np (conj np pred))) - add-preds (fn [np rule] - (reduce add-pred np (map literal-predicate (:body rule)))) - new-needed (reduce add-preds remaining new-adorned-rules)] - (recur new-nrs new-needed)))))) - - -;;; Magic ! - -(defn seed-relation - "Given a magic form of a query, give back the literal form of its seed - relation" - [q] - (let [pred (-> q literal-predicate get-base-predicate) - bnds (-> q literal-predicate get-adorned-bindings)] - (with-meta (assoc q :predicate [pred :magic-seed bnds]) {}))) - -(defn seed-rule - "Given an adorned query, give back its seed rule" - [q] - (let [mq (build-seed-bindings (magic-literal q)) - sr (seed-relation mq)] - (build-rule mq [sr]))) - -(defn build-partial-tuple - "Given a query and a set of bindings, build a partial tuple needed - to extract the relation from the database." - [q bindings] - (into {} (remove nil? (map (fn [[k v :as pair]] - (if (is-var? v) - nil - (if (is-query-var? v) - [k (bindings v)] - pair))) - (:term-bindings q))))) - -(defn seed-predicate-for-insertion - "Given a query, return the predicate to use for database insertion." - [q] - (let [seed (-> q seed-rule :body first) - columns (-> seed :term-bindings keys) - new-term-bindings (-> q :term-bindings (select-keys columns))] - (assoc seed :term-bindings new-term-bindings))) - -(defn magic-transform - "Return a magic transformation of an adorned rules-set (rs). The - (i-preds) are the predicates of the intension database. These - default to the predicates within the rules-set." - ([rs] - (magic-transform rs (all-predicates rs))) - ([rs i-preds] - (let [not-duplicate? (fn [l mh bd] - (or (not (empty? bd)) - (not (= (magic-literal l) - mh)))) - xr (fn [rs rule] - (let [head (:head rule) - body (:body rule) - mh (magic-literal head) - answer-rule (build-rule head - (concat [mh] body)) - step (fn [[rs bd] l] - (if (and (i-preds (literal-predicate l)) - (not-duplicate? l mh bd)) - (let [nr (build-rule (magic-literal l) - (concat [mh] bd))] - [(conj rs nr) (conj bd l)]) - [rs (conj bd l)])) - [nrs _] (reduce step [rs []] body)] - (conj nrs answer-rule)))] - (reduce xr empty-rules-set rs)))) - - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/datalog/rules.clj --- a/src/clojure/contrib/datalog/rules.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,208 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; rules.clj -;; -;; A Clojure implementation of Datalog -- Rules Engine -;; -;; straszheimjeffrey (gmail) -;; Created 2 Feburary 2009 - - -(ns clojure.contrib.datalog.rules - (:use clojure.contrib.datalog.util) - (:use clojure.contrib.datalog.literals - clojure.contrib.datalog.database) - (:use [clojure.set :only (union intersection difference)]) - (:use [clojure.contrib.set :only (subset?)]) - (:use [clojure.contrib.except :only (throwf)]) - (:import java.io.Writer)) - - -(defstruct datalog-rule - :head - :body) - -(defn display-rule - "Return the rule in a readable format." - [rule] - (list* '<- - (-> rule :head display-literal) - (map display-literal (:body rule)))) - -(defn display-query - "Return a query in a readable format." - [query] - (list* '?- (display-literal query))) - - -;;; Check rule safety - -(defn is-safe? - "Is the rule safe according to the datalog protocol?" - [rule] - (let [hv (literal-vars (:head rule)) - bpv (apply union (map positive-vars (:body rule))) - bnv (apply union (map negative-vars (:body rule))) - ehv (difference hv bpv) - env (difference bnv bpv)] - (when-not (empty? ehv) - (throwf "Head vars %s not bound in body in rule %s" ehv rule)) - (when-not (empty? env) - (throwf "Body vars %s not bound in negative positions in rule %s" env rule)) - rule)) - - -;;; Rule creation and printing - -(defn build-rule - [hd bd] - (with-meta (struct datalog-rule hd bd) {:type ::datalog-rule})) - -(defmacro <- - "Build a datalog rule. Like this: - - (<- (:head :x ?x :y ?y) (:body-1 :x ?x :y ?y) (:body-2 :z ?z) (not! :body-3 :x ?x) (if > ?y ?z))" - [hd & body] - (let [head (build-atom hd :clojure.contrib.datalog.literals/literal) - body (map build-literal body)] - `(is-safe? (build-rule ~head [~@body])))) - -(defmethod print-method ::datalog-rule - [rule ^Writer writer] - (print-method (display-rule rule) writer)) - -(defn return-rule-data - "Returns an untypted rule that will be fully printed" - [rule] - (with-meta rule {})) - -(defmacro ?- - "Define a datalog query" - [& q] - (let [qq (build-atom q :clojure.contrib.datalog.literals/literal)] - `(with-meta ~qq {:type ::datalog-query}))) - -(defmethod print-method ::datalog-query - [query ^Writer writer] - (print-method (display-query query) writer)) - - - -;;; SIP - -(defn compute-sip - "Given a set of bound column names, return an adorned sip for this - rule. A set of intensional predicates should be provided to - determine what should be adorned." - [bindings i-preds rule] - (let [next-lit (fn [bv body] - (or (first (drop-while - #(not (literal-appropriate? bv %)) - body)) - (first (drop-while (complement positive?) body)))) - adorn (fn [lit bvs] - (if (i-preds (literal-predicate lit)) - (let [bnds (union (get-cs-from-vs lit bvs) - (get-self-bound-cs lit))] - (adorned-literal lit bnds)) - lit)) - new-h (adorned-literal (:head rule) bindings)] - (loop [bound-vars (get-vs-from-cs (:head rule) bindings) - body (:body rule) - sip []] - (if-let [next (next-lit bound-vars body)] - (recur (union bound-vars (literal-vars next)) - (remove #(= % next) body) - (conj sip (adorn next bound-vars))) - (build-rule new-h (concat sip body)))))) - - -;;; Rule sets - -(defn make-rules-set - "Given an existing set of rules, make it a 'rules-set' for - printing." - [rs] - (with-meta rs {:type ::datalog-rules-set})) - -(def empty-rules-set (make-rules-set #{})) - -(defn rules-set - "Given a collection of rules return a rules set" - [& rules] - (reduce conj empty-rules-set rules)) - -(defmethod print-method ::datalog-rules-set - [rules ^Writer writer] - (binding [*out* writer] - (do - (print "(rules-set") - (doseq [rule rules] - (println) - (print " ") - (print rule)) - (println ")")))) - -(defn predicate-map - "Given a rules-set, return a map of rules keyed by their predicates. - Each value will be a set of rules." - [rs] - (let [add-rule (fn [m r] - (let [pred (-> r :head literal-predicate) - os (get m pred #{})] - (assoc m pred (conj os r))))] - (reduce add-rule {} rs))) - -(defn all-predicates - "Given a rules-set, return all defined predicates" - [rs] - (set (map literal-predicate (map :head rs)))) - -(defn non-base-rules - "Return a collection of rules that depend, somehow, on other rules" - [rs] - (let [pred (all-predicates rs) - non-base (fn [r] - (if (some #(pred %) - (map literal-predicate (:body r))) - r - nil))] - (remove nil? (map non-base rs)))) - - -;;; Database operations - -(def empty-bindings [{}]) - -(defn apply-rule - "Apply the rule against db-1, adding the results to the appropriate - relation in db-2. The relation will be created if needed." - ([db rule] (apply-rule db db rule)) - ([db-1 db-2 rule] - (trace-datalog (println) - (println) - (println "--------------- Begin Rule ---------------") - (println rule)) - (let [head (:head rule) - body (:body rule) - step (fn [bs lit] - (trace-datalog (println bs) - (println lit)) - (join-literal db-1 lit bs)) - bs (reduce step empty-bindings body)] - (do (trace-datalog (println bs)) - (project-literal db-2 head bs))))) - -(defn apply-rules-set - [db rs] - (reduce (fn [rdb rule] - (apply-rule db rdb rule)) db rs)) - - -;; End of file \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/datalog/softstrat.clj --- a/src/clojure/contrib/datalog/softstrat.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,161 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; softstrat.clj -;; -;; A Clojure implementation of Datalog -- Soft Stratification -;; -;; straszheimjeffrey (gmail) -;; Created 28 Feburary 2009 - - -(ns clojure.contrib.datalog.softstrat - (:use clojure.contrib.datalog.util - clojure.contrib.datalog.database - clojure.contrib.datalog.literals - clojure.contrib.datalog.rules - clojure.contrib.datalog.magic) - (:use [clojure.set :only (union intersection difference)]) - (:use [clojure.contrib.seq :only (indexed)]) - (:require [clojure.contrib.graph :as graph])) - - -;;; Dependency graph - -(defn- build-rules-graph - "Given a rules-set (rs), build a graph where each predicate symbol in rs, - there is a node n, and for each rule (<- h b-1 b-2 ...), there are edges - from the (literal-predicate h) -> (literal-predicate b-*), one for each - b-*." - [rs] - (let [preds (all-predicates rs) - pred-map (predicate-map rs) - step (fn [nbs pred] - (let [rules (pred-map pred) - preds (reduce (fn [pds lits] - (reduce (fn [pds lit] - (if-let [pred (literal-predicate lit)] - (conj pds pred) - pds)) - pds - lits)) - #{} - (map :body rules))] - (assoc nbs pred preds))) - neighbors (reduce step {} preds)] - (struct graph/directed-graph preds neighbors))) - -(defn- build-def - "Given a rules-set, build its def function" - [rs] - (let [pred-map (predicate-map rs) - graph (-> rs - build-rules-graph - graph/transitive-closure - graph/add-loops)] - (fn [pred] - (apply union (map set (map pred-map (graph/get-neighbors graph pred))))))) - - -;;; Soft Stratificattion REQ Graph - -(defn- req - "Returns a rules-set that is a superset of req(lit) for the lit at - index lit-index" - [rs soft-def rule lit-index] - (let [head (:head rule) - body (:body rule) - lit (nth body lit-index) - pre (subvec (vec body) 0 lit-index)] - (conj (-> lit literal-predicate soft-def (magic-transform (all-predicates rs))) - (build-rule (magic-literal lit) pre)))) - -(defn- rule-dep - "Given a rule, return the set of rules it depends on." - [rs mrs soft-def rule] - (let [step (fn [nrs [idx lit]] - (if (negated? lit) - (union nrs (req rs soft-def rule idx)) - nrs))] - (intersection mrs - (reduce step empty-rules-set (-> rule :body indexed))))) - -(defn- soft-strat-graph - "The dependency graph for soft stratification." - [rs mrs] - (let [soft-def (build-def rs) - step (fn [nbrs rule] - (assoc nbrs rule (rule-dep rs mrs soft-def rule))) - nbrs (reduce step {} mrs)] - (struct graph/directed-graph mrs nbrs))) - -(defn- build-soft-strat - "Given a rules-set (unadorned) and an adorned query, return the soft - stratified list. The rules will be magic transformed, and the - magic seed will be appended." - [rs q] - (let [ars (adorn-rules-set rs q) - mrs (conj (magic-transform ars) - (seed-rule q)) - gr (soft-strat-graph ars mrs)] - (map make-rules-set (graph/dependency-list gr)))) - - -;;; Work plan - -(defstruct soft-strat-work-plan - :query - :stratification) - -(defn build-soft-strat-work-plan - "Return a work plan for the given rules-set and query" - [rs q] - (let [aq (adorn-query q)] - (struct soft-strat-work-plan aq (build-soft-strat rs aq)))) - -(defn get-all-relations - "Return a set of all relation names defined in this workplan" - [ws] - (apply union (map all-predicates (:stratification ws)))) - - -;;; Evaluate - -(defn- weak-consq-operator - [db strat] - (trace-datalog (println) - (println) - (println "=============== Begin iteration ===============")) - (let [counts (database-counts db)] - (loop [strat strat] - (let [rs (first strat)] - (if rs - (let [new-db (apply-rules-set db rs)] - (if (= counts (database-counts new-db)) - (recur (next strat)) - new-db)) - db))))) - -(defn evaluate-soft-work-set - ([ws db] (evaluate-soft-work-set ws db {})) - ([ws db bindings] - (let [query (:query ws) - strat (:stratification ws) - seed (seed-predicate-for-insertion query) - seeded-db (project-literal db seed [bindings] is-query-var?) - fun (fn [data] - (weak-consq-operator data strat)) - equal (fn [db1 db2] - (= (database-counts db1) (database-counts db2))) - new-db (graph/fixed-point seeded-db fun nil equal) - pt (build-partial-tuple query bindings)] - (select new-db (literal-predicate query) pt)))) - - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/datalog/util.clj --- a/src/clojure/contrib/datalog/util.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,89 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; util.clj -;; -;; A Clojure implementation of Datalog -- Utilities -;; -;; straszheimjeffrey (gmail) -;; Created 3 Feburary 2009 - - -(ns clojure.contrib.datalog.util - (:use [clojure.contrib.seq :only (separate)])) - - - -;;; Bindings and logic vars. A binding in a hash of logic vars to -;;; bound values. Logic vars are any symbol prefixed with a \?. - -(defn is-var? - "Is this a logic variable: e.g. a symbol prefixed with a ?" - [sym] - (when (symbol? sym) - (let [name (name sym)] - (and (= \? (first name)) - (not= \? (fnext name)))))) - -(defn is-query-var? - "Is this a query variable: e.g. a symbol prefixed with ??" - [sym] - (when (symbol? sym) - (let [name (name sym)] - (and (= \? (first name)) - (= \? (fnext name)))))) - -(defn map-values - "Like map, but works over the values of a hash map" - [f hash] - (let [key-vals (map (fn [[key val]] [key (f val)]) hash)] - (if (seq key-vals) - (apply conj (empty hash) key-vals) - hash))) - -(defn keys-to-vals - "Given a map and a collection of keys, return the collection of vals" - [m ks] - (vals (select-keys m ks))) - -(defn reverse-map - "Reverse the keys/values of a map" - [m] - (into {} (map (fn [[k v]] [v k]) m))) - - -;;; Preduce -- A parallel reduce over hashes - -(defn preduce - "Similar to merge-with, but the contents of each key are merged in - parallel using f. - - f - a function of 2 arguments. - data - a collection of hashes." - [f data] - (let [data-1 (map (fn [h] (map-values #(list %) h)) data) - merged (doall (apply merge-with concat data-1)) - ; Groups w/ multiple elements are identified for parallel processing - [complex simple] (separate (fn [[key vals]] (> (count vals) 1)) merged) - fold-group (fn [[key vals]] {key (reduce f vals)}) - fix-single (fn [[key [val]]] [key val])] - (apply merge (concat (pmap fold-group merged) (map fix-single simple))))) - - -;;; Debuging and Tracing - -(def *trace-datalog* nil) - -(defmacro trace-datalog - "If *test-datalog* is set to true, run the enclosed commands" - [& body] - `(when *trace-datalog* - ~@body)) - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/def.clj --- a/src/clojure/contrib/def.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; File: def.clj -;; -;; def.clj provides variants of def that make including doc strings and -;; making private definitions more succinct. -;; -;; scgilardi (gmail) -;; 17 May 2008 - -(ns - ^{:author "Stephen C. Gilardi", - :doc "def.clj provides variants of def that make including doc strings and -making private definitions more succinct."} - clojure.contrib.def) - -(defmacro defvar - "Defines a var with an optional intializer and doc string" - ([name] - (list `def name)) - ([name init] - (list `def name init)) - ([name init doc] - (list `def (with-meta name (assoc (meta name) :doc doc)) init))) - -(defmacro defunbound - "Defines an unbound var with optional doc string" - ([name] - (list `def name)) - ([name doc] - (list `def (with-meta name (assoc (meta name) :doc doc))))) - -(defmacro defmacro- - "Same as defmacro but yields a private definition" - [name & decls] - (list* `defmacro (with-meta name (assoc (meta name) :private true)) decls)) - -(defmacro defvar- - "Same as defvar but yields a private definition" - [name & decls] - (list* `defvar (with-meta name (assoc (meta name) :private true)) decls)) - -(defmacro defunbound- - "Same as defunbound but yields a private definition" - [name & decls] - (list* `defunbound (with-meta name (assoc (meta name) :private true)) decls)) - -(defmacro defstruct- - "Same as defstruct but yields a private definition" - [name & decls] - (list* `defstruct (with-meta name (assoc (meta name) :private true)) decls)) - -(defmacro defonce- - "Same as defonce but yields a private definition" - ([name expr] - (list `defonce (with-meta name (assoc (meta name) :private true)) expr)) - ([name expr doc] - (list `defonce (with-meta name (assoc (meta name) :private true :doc doc)) expr))) - -(defmacro defalias - "Defines an alias for a var: a new var with the same root binding (if - any) and similar metadata. The metadata of the alias is its initial - metadata (as provided by def) merged into the metadata of the original." - ([name orig] - `(do - (alter-meta! - (if (.hasRoot (var ~orig)) - (def ~name (.getRoot (var ~orig))) - (def ~name)) - ;; When copying metadata, disregard {:macro false}. - ;; Workaround for http://www.assembla.com/spaces/clojure/tickets/273 - #(conj (dissoc % :macro) - (apply dissoc (meta (var ~orig)) (remove #{:macro} (keys %))))) - (var ~name))) - ([name orig doc] - (list `defalias (with-meta name (assoc (meta name) :doc doc)) orig))) - -; defhinted by Chouser: -(defmacro defhinted - "Defines a var with a type hint matching the class of the given - init. Be careful about using any form of 'def' or 'binding' to a - value of a different type. See http://paste.lisp.org/display/73344" - [sym init] - `(do - (def ~sym ~init) - (alter-meta! (var ~sym) assoc :tag (class ~sym)) - (var ~sym))) - -; name-with-attributes by Konrad Hinsen: -(defn name-with-attributes - "To be used in macro definitions. - Handles optional docstrings and attribute maps for a name to be defined - in a list of macro arguments. If the first macro argument is a string, - it is added as a docstring to name and removed from the macro argument - list. If afterwards the first macro argument is a map, its entries are - added to the name's metadata map and the map is removed from the - macro argument list. The return value is a vector containing the name - with its extended metadata map and the list of unprocessed macro - arguments." - [name macro-args] - (let [[docstring macro-args] (if (string? (first macro-args)) - [(first macro-args) (next macro-args)] - [nil macro-args]) - [attr macro-args] (if (map? (first macro-args)) - [(first macro-args) (next macro-args)] - [{} macro-args]) - attr (if docstring - (assoc attr :doc docstring) - attr) - attr (if (meta name) - (conj (meta name) attr) - attr)] - [(with-meta name attr) macro-args])) - -; defnk by Meikel Brandmeyer: -(defmacro defnk - "Define a function accepting keyword arguments. Symbols up to the first - keyword in the parameter list are taken as positional arguments. Then - an alternating sequence of keywords and defaults values is expected. The - values of the keyword arguments are available in the function body by - virtue of the symbol corresponding to the keyword (cf. :keys destructuring). - defnk accepts an optional docstring as well as an optional metadata map." - [fn-name & fn-tail] - (let [[fn-name [args & body]] (name-with-attributes fn-name fn-tail) - [pos kw-vals] (split-with symbol? args) - syms (map #(-> % name symbol) (take-nth 2 kw-vals)) - values (take-nth 2 (rest kw-vals)) - sym-vals (apply hash-map (interleave syms values)) - de-map {:keys (vec syms) - :or sym-vals}] - `(defn ~fn-name - [~@pos & options#] - (let [~de-map (apply hash-map options#)] - ~@body)))) - -; defn-memo by Chouser: -(defmacro defn-memo - "Just like defn, but memoizes the function using clojure.core/memoize" - [fn-name & defn-stuff] - `(do - (defn ~fn-name ~@defn-stuff) - (alter-var-root (var ~fn-name) memoize) - (var ~fn-name))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/duck_streams.clj --- a/src/clojure/contrib/duck_streams.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,418 +0,0 @@ -;;; duck_streams.clj -- duck-typed I/O streams for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; May 13, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; This file defines "duck-typed" I/O utility functions for Clojure. -;; The 'reader' and 'writer' functions will open and return an -;; instance of java.io.BufferedReader and java.io.PrintWriter, -;; respectively, for a variety of argument types -- filenames as -;; strings, URLs, java.io.File's, etc. 'reader' even works on http -;; URLs. -;; -;; Note: this is not really "duck typing" as implemented in languages -;; like Ruby. A better name would have been "do-what-I-mean-streams" -;; or "just-give-me-a-stream", but ducks are funnier. - - -;; CHANGE LOG -;; -;; July 23, 2010: DEPRECATED in 1.2. Use clojure.java.io instead. -;; -;; May 13, 2009: added functions to open writers for appending -;; -;; May 3, 2009: renamed file to file-str, for compatibility with -;; clojure.contrib.java-utils. reader/writer no longer use this -;; function. -;; -;; February 16, 2009: (lazy branch) fixed read-lines to work with lazy -;; Clojure. -;; -;; January 10, 2009: added *default-encoding*, so streams are always -;; opened as UTF-8. -;; -;; December 19, 2008: rewrote reader and writer as multimethods; added -;; slurp*, file, and read-lines -;; -;; April 8, 2008: first version - -(ns - ^{:author "Stuart Sierra", - :deprecated "1.2" - :doc "This file defines \"duck-typed\" I/O utility functions for Clojure. - The 'reader' and 'writer' functions will open and return an - instance of java.io.BufferedReader and java.io.PrintWriter, - respectively, for a variety of argument types -- filenames as - strings, URLs, java.io.File's, etc. 'reader' even works on http - URLs. - - Note: this is not really \"duck typing\" as implemented in languages - like Ruby. A better name would have been \"do-what-I-mean-streams\" - or \"just-give-me-a-stream\", but ducks are funnier."} - clojure.contrib.duck-streams - (:refer-clojure :exclude (spit)) - (:import - (java.io Reader InputStream InputStreamReader PushbackReader - BufferedReader File PrintWriter OutputStream - OutputStreamWriter BufferedWriter Writer - FileInputStream FileOutputStream ByteArrayOutputStream - StringReader ByteArrayInputStream) - (java.net URI URL MalformedURLException Socket))) - - -(def - ^{:doc "Name of the default encoding to use when reading & writing. - Default is UTF-8." - :tag "java.lang.String"} - *default-encoding* "UTF-8") - -(def - ^{:doc "Size, in bytes or characters, of the buffer used when - copying streams."} - *buffer-size* 1024) - -(def - ^{:doc "Type object for a Java primitive byte array."} - *byte-array-type* (class (make-array Byte/TYPE 0))) - - -(defn ^File file-str - "Concatenates args as strings and returns a java.io.File. Replaces - all / and \\ with File/separatorChar. Replaces ~ at the start of - the path with the user.home system property." - [& args] - (let [^String s (apply str args) - s (.replaceAll (re-matcher #"[/\\]" s) File/separator) - s (if (.startsWith s "~") - (str (System/getProperty "user.home") - File/separator (subs s 1)) - s)] - (File. s))) - - -(defmulti ^{:tag BufferedReader - :doc "Attempts to coerce its argument into an open - java.io.BufferedReader. Argument may be an instance of Reader, - BufferedReader, InputStream, File, URI, URL, Socket, or String. - - If argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. Uses *default-encoding* as the text encoding. - - Should be used inside with-open to ensure the Reader is properly - closed." - :arglists '([x])} - reader class) - -(defmethod reader Reader [x] - (BufferedReader. x)) - -(defmethod reader InputStream [^InputStream x] - (BufferedReader. (InputStreamReader. x *default-encoding*))) - -(defmethod reader File [^File x] - (reader (FileInputStream. x))) - -(defmethod reader URL [^URL x] - (reader (if (= "file" (.getProtocol x)) - (FileInputStream. (.getPath x)) - (.openStream x)))) - -(defmethod reader URI [^URI x] - (reader (.toURL x))) - -(defmethod reader String [^String x] - (try (let [url (URL. x)] - (reader url)) - (catch MalformedURLException e - (reader (File. x))))) - -(defmethod reader Socket [^Socket x] - (reader (.getInputStream x))) - -(defmethod reader :default [x] - (throw (Exception. (str "Cannot open " (pr-str x) " as a reader.")))) - - -(def - ^{:doc "If true, writer and spit will open files in append mode. - Defaults to false. Use append-writer or append-spit." - :tag "java.lang.Boolean"} - *append-to-writer* false) - - -(defmulti ^{:tag PrintWriter - :doc "Attempts to coerce its argument into an open java.io.PrintWriter - wrapped around a java.io.BufferedWriter. Argument may be an - instance of Writer, PrintWriter, BufferedWriter, OutputStream, File, - URI, URL, Socket, or String. - - If argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the Writer is properly - closed." - :arglists '([x])} - writer class) - -(defn- assert-not-appending [] - (when *append-to-writer* - (throw (Exception. "Cannot change an open stream to append mode.")))) - -(defmethod writer PrintWriter [x] - (assert-not-appending) - x) - -(defmethod writer BufferedWriter [^BufferedWriter x] - (assert-not-appending) - (PrintWriter. x)) - -(defmethod writer Writer [x] - (assert-not-appending) - ;; Writer includes sub-classes such as FileWriter - (PrintWriter. (BufferedWriter. x))) - -(defmethod writer OutputStream [^OutputStream x] - (assert-not-appending) - (PrintWriter. - (BufferedWriter. - (OutputStreamWriter. x *default-encoding*)))) - -(defmethod writer File [^File x] - (let [stream (FileOutputStream. x *append-to-writer*)] - (binding [*append-to-writer* false] - (writer stream)))) - -(defmethod writer URL [^URL x] - (if (= "file" (.getProtocol x)) - (writer (File. (.getPath x))) - (throw (Exception. (str "Cannot write to non-file URL <" x ">"))))) - -(defmethod writer URI [^URI x] - (writer (.toURL x))) - -(defmethod writer String [^String x] - (try (let [url (URL. x)] - (writer url)) - (catch MalformedURLException err - (writer (File. x))))) - -(defmethod writer Socket [^Socket x] - (writer (.getOutputStream x))) - -(defmethod writer :default [x] - (throw (Exception. (str "Cannot open <" (pr-str x) "> as a writer.")))) - - -(defn append-writer - "Like writer but opens file for appending. Does not work on streams - that are already open." - [x] - (binding [*append-to-writer* true] - (writer x))) - - -(defn write-lines - "Writes lines (a seq) to f, separated by newlines. f is opened with - writer, and automatically closed at the end of the sequence." - [f lines] - (with-open [^PrintWriter writer (writer f)] - (loop [lines lines] - (when-let [line (first lines)] - (.write writer (str line)) - (.println writer) - (recur (rest lines)))))) - -(defn read-lines - "Like clojure.core/line-seq but opens f with reader. Automatically - closes the reader AFTER YOU CONSUME THE ENTIRE SEQUENCE." - [f] - (let [read-line (fn this [^BufferedReader rdr] - (lazy-seq - (if-let [line (.readLine rdr)] - (cons line (this rdr)) - (.close rdr))))] - (read-line (reader f)))) - -(defn ^String slurp* - "Like clojure.core/slurp but opens f with reader." - [f] - (with-open [^BufferedReader r (reader f)] - (let [sb (StringBuilder.)] - (loop [c (.read r)] - (if (neg? c) - (str sb) - (do (.append sb (char c)) - (recur (.read r)))))))) - -(defn spit - "Opposite of slurp. Opens f with writer, writes content, then - closes f." - [f content] - (with-open [^PrintWriter w (writer f)] - (.print w content))) - -(defn append-spit - "Like spit but appends to file." - [f content] - (with-open [^PrintWriter w (append-writer f)] - (.print w content))) - -(defn pwd - "Returns current working directory as a String. (Like UNIX 'pwd'.) - Note: In Java, you cannot change the current working directory." - [] - (System/getProperty "user.dir")) - - - -(defmacro with-out-writer - "Opens a writer on f, binds it to *out*, and evalutes body. - Anything printed within body will be written to f." - [f & body] - `(with-open [stream# (writer ~f)] - (binding [*out* stream#] - ~@body))) - -(defmacro with-out-append-writer - "Like with-out-writer but appends to file." - [f & body] - `(with-open [stream# (append-writer ~f)] - (binding [*out* stream#] - ~@body))) - -(defmacro with-in-reader - "Opens a PushbackReader on f, binds it to *in*, and evaluates body." - [f & body] - `(with-open [stream# (PushbackReader. (reader ~f))] - (binding [*in* stream#] - ~@body))) - -(defmulti - ^{:doc "Copies input to output. Returns nil. - Input may be an InputStream, Reader, File, byte[], or String. - Output may be an OutputStream, Writer, or File. - - Does not close any streams except those it opens itself - (on a File). - - Writing a File fails if the parent directory does not exist." - :arglists '([input output])} - copy - (fn [input output] [(type input) (type output)])) - -(defmethod copy [InputStream OutputStream] [^InputStream input ^OutputStream output] - (let [buffer (make-array Byte/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (do (.write output buffer 0 size) - (recur))))))) - -(defmethod copy [InputStream Writer] [^InputStream input ^Writer output] - (let [^"[B" buffer (make-array Byte/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (let [chars (.toCharArray (String. buffer 0 size *default-encoding*))] - (do (.write output chars) - (recur)))))))) - -(defmethod copy [InputStream File] [^InputStream input ^File output] - (with-open [out (FileOutputStream. output)] - (copy input out))) - -(defmethod copy [Reader OutputStream] [^Reader input ^OutputStream output] - (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (let [bytes (.getBytes (String. buffer 0 size) *default-encoding*)] - (do (.write output bytes) - (recur)))))))) - -(defmethod copy [Reader Writer] [^Reader input ^Writer output] - (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (do (.write output buffer 0 size) - (recur))))))) - -(defmethod copy [Reader File] [^Reader input ^File output] - (with-open [out (FileOutputStream. output)] - (copy input out))) - -(defmethod copy [File OutputStream] [^File input ^OutputStream output] - (with-open [in (FileInputStream. input)] - (copy in output))) - -(defmethod copy [File Writer] [^File input ^Writer output] - (with-open [in (FileInputStream. input)] - (copy in output))) - -(defmethod copy [File File] [^File input ^File output] - (with-open [in (FileInputStream. input) - out (FileOutputStream. output)] - (copy in out))) - -(defmethod copy [String OutputStream] [^String input ^OutputStream output] - (copy (StringReader. input) output)) - -(defmethod copy [String Writer] [^String input ^Writer output] - (copy (StringReader. input) output)) - -(defmethod copy [String File] [^String input ^File output] - (copy (StringReader. input) output)) - -(defmethod copy [*byte-array-type* OutputStream] [^"[B" input ^OutputStream output] - (copy (ByteArrayInputStream. input) output)) - -(defmethod copy [*byte-array-type* Writer] [^"[B" input ^Writer output] - (copy (ByteArrayInputStream. input) output)) - -(defmethod copy [*byte-array-type* File] [^"[B" input ^Writer output] - (copy (ByteArrayInputStream. input) output)) - - -(defn make-parents - "Creates all parent directories of file." - [^File file] - (.mkdirs (.getParentFile file))) - -(defmulti - ^{:doc "Converts argument into a Java byte array. Argument may be - a String, File, InputStream, or Reader. If the argument is already - a byte array, returns it." - :arglists '([arg])} - to-byte-array type) - -(defmethod to-byte-array *byte-array-type* [x] x) - -(defmethod to-byte-array String [^String x] - (.getBytes x *default-encoding*)) - -(defmethod to-byte-array File [^File x] - (with-open [input (FileInputStream. x) - buffer (ByteArrayOutputStream.)] - (copy input buffer) - (.toByteArray buffer))) - -(defmethod to-byte-array InputStream [^InputStream x] - (let [buffer (ByteArrayOutputStream.)] - (copy x buffer) - (.toByteArray buffer))) - -(defmethod to-byte-array Reader [^Reader x] - (.getBytes (slurp* x) *default-encoding*)) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/error_kit.clj --- a/src/clojure/contrib/error_kit.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,289 +0,0 @@ -; Copyright (c) Chris Houser, Jan 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; == EXPERIMENTAL == -; System for defining and using custom errors -; Please contact Chouser if you have any suggestions for better names -; or API adjustments. - -(ns - ^{:author "Chris Houser", - :doc "EXPERIMENTAL -System for defining and using custom errors -Please contact Chouser if you have any suggestions for better names -or API adjustments."} - clojure.contrib.error-kit - (:use [clojure.contrib.def :only (defvar defvar-)] - [clojure.stacktrace :only (root-cause)])) - -(defn- make-ctrl-exception [msg data] - "Create an exception object with associated data, used for passing - control and data to a dynamically containing handler." - (proxy [Error clojure.lang.IDeref] [msg] - (toString [] (str "Error Kit Control Exception: " msg ", " (pr-str data))) - (deref [] data))) - -(defvar- ctrl-exception-class - (class (make-ctrl-exception nil nil))) - -(defvar- *handler-stack* () "Stack of bound handler symbols") - -(defvar- *continues* {} "Map of currently available continue forms") - - -(defmacro throw-msg - "Returns a function that throws a Java Exception with the given - name. Useful to associate a new error-kit error type with a - particular Java Exception class, via the :unhandled error key." - [class-name] - `(fn [x#] (throw (new ~class-name (:msg x#))))) - -(defn error - "Base type for all error-kit errors" - {::args [:msg :unhandled :tag]} - [details] - (merge {:tag `error :msg "exception via error-kit" - :unhandled (throw-msg Exception)} - details)) - -(defn- qualify-sym [sym] - (let [v (resolve sym)] - (assert v) - (apply symbol (map #(str (% (meta v))) [:ns :name])))) - -(defmacro deferror - "Define a new error type" - {:arglists '([name [parent-error?] doc-string? [args*] & body] - [name [parent-error?] doc-string? args-destruct-map & body])} - [err-name pvec & decl] - (let [pvec (if (empty? pvec) [`error] pvec) - [docstr args & body] (if (string? (first decl)) decl (cons nil decl)) - args (or args []) - argmap (if (vector? args) `{:keys ~args} args) - body (or body {}) - qual-err-name (symbol (str *ns*) (name err-name))] - (assert (== (count pvec) 1)) ; only support single-inheritance for now - (assert (vector? args)) ; only vector (keyword destruct) args for now - `(do - (defn ~err-name [details#] - (let [basedata# ((resolve (first (parents '~qual-err-name))) details#) - ~argmap basedata#] - (merge basedata# {:tag '~qual-err-name} (do ~@body) details#))) - (alter-meta! (var ~err-name) assoc - :doc ~docstr ::args ~(vec (map #(keyword (str %)) args))) - ~@(for [parent pvec] - `(derive '~qual-err-name '~(qualify-sym parent))) - (var ~err-name)))) - -(defn- throw-to [msg target-map args] - (throw (make-ctrl-exception msg (assoc target-map :args args)))) - -(defn raise* - "Raise the given error object, best if created by an error - constructor defined with deferror. See also 'raise' macro." - [err] - (let [err-tag (:tag err)] - (loop [hs *handler-stack*] - (if (empty? hs) - ((:unhandled err) err) - (let [[{:keys [htag] :as handler}] hs] - (if (and htag (not (isa? err-tag htag))) - (recur (next hs)) - (let [rtn ((:hfunc handler) err)] - (if-not (vector? rtn) - (throw-to "default" handler (list rtn)) - (condp = (rtn 0) - ::continue-with (rtn 1) - ::continue (if-let [continue (*continues* (rtn 1))] - (throw-to "continue" continue (rtn 2)) - (do (prn *continues*) (throw - (Exception. - (str "Unbound continue name " (rtn 1)))))) - ::do-not-handle (recur (next hs)) - (throw-to "do-not-handle" handler (list rtn))))))))))) - -(defmacro raise - "Raise an error of the type err-name, constructed with the given args" - [err-name & args] - `(raise* (~err-name ~(zipmap (::args (meta (resolve err-name))) - args)))) - -; It'd be nice to assert that these are used in a tail position of a handler -(defmacro do-not-handle - "Use in a tail position of a 'handle' form to indicate 'raise' should - not consider the error handled, but should continue searching for an - appropriate 'handle' form. Allows finer-grain control over catching - than just the error type." - [] - `[::do-not-handle]) - -(defmacro continue-with [value] - "Use in a tail position of a 'handle' form to cause the currently - running 'raise' to return the given 'value'." - `[::continue-with ~value]) - -(defmacro continue [continue-name & args] - "Use in a tail position of a 'handle' form to pass control to the - named 'continue' form, passing in the given args. The 'continue' - form with the given name and the smallest dynamic scope surrounding - the currently running 'raise' will be used." - `[::continue '~continue-name [~@args]]) - - -(def ^{:doc "Special form to be used inside a 'with-handler'. When - any error is 'raised' from withing the dynamic scope of 'body' that - is of error-name's type or a derived type, the args will be bound - and the body executed. If no 'error-name' is given, the body will - be executed for regardless of the type of error raised. The body - may return a value, in which case that will be the return value of - the entire 'with-handler' form, or it may use any of the special - return forms, 'do-not-handle', 'continue-with', or 'continue'." - :arglists '([error-name? [args*] & body] - [error-name? args-destruct-map-args & body])} - handle) - -(def ^{:doc "Special form to be used inside a 'with-handler'. - Control can be passed to this 'continue' form from a 'raise' enclosed - in this with-handler's dynamic scope, when this 'continue-name' is - given to a 'continue' form." - :arglists '([continue-name [args*] & body])} - bind-continue) - -(defn- special-form [form] - (and (list form) - (symbol? (first form)) - (#{#'handle #'bind-continue} (resolve (first form))))) - - -(defmacro with-handler - "This is error-kit's dynamic scope form. The body will be executed - in a dynamic context that includes all of the following 'handle' and - 'bind-continue' forms." - [& forms] - (let [[body special-forms] (split-with (complement special-form) forms)] - (assert (every? special-form special-forms)) - (let [blockid (gensym) - handlers (for [[type & more] special-forms - :when (= (resolve type) #'handle)] - (let [[htag args & hbody] (if (symbol? (first more)) - more - (cons nil more)) - argmap (if (vector? args) `{:keys ~args} args)] - `{:blockid '~blockid - :htag ~(when htag (list `quote (qualify-sym htag))) - :hfunc (fn [~argmap] ~@hbody) - :rfunc identity})) - continues (into {} - (for [[type & more] special-forms - :when (= (resolve type) #'bind-continue)] - [(list `quote (first more)) - `{:blockid '~blockid - :rfunc (fn ~@(next more))}]))] - `(try - (binding [*handler-stack* (list* ~@handlers @#'*handler-stack*) - *continues* (merge @#'*continues* ~@continues)] - ~@body) - (catch Throwable e# - (let [root-cause# (root-cause e#)] - (if-not (instance? @#'ctrl-exception-class root-cause#) - (throw e#) - (let [data# @root-cause#] - (if (= '~blockid (:blockid data#)) - (apply (:rfunc data#) (:args data#)) - (throw e#)))))))))) - -(defn rebind-fn [func] - (let [a *handler-stack*, b *continues*] - (fn [& args] - (binding [*handler-stack* a - *continues* b] - (apply func args))))) - -(comment - -(alias 'kit 'clojure.contrib.error-kit) - -; This defines an error and its action if unhandled. A good choice of -; unhandled. action is to throw a Java exception so users of your code -; who do not want to use error-kit can still use normal Java try/catch -; forms to handle the error. -(kit/deferror number-error [] [n] - {:msg (str "Number error: " n) - :unhandled (kit/throw-msg NumberFormatException)}) - -(kit/deferror odd-number-error [number-error] - "Indicates an odd number was given to an operation that is only - defined for even numbers." - [n] - {:msg (str "Can't handle odd number: " n)}) - -; Raise an error by name with any extra args defined by the deferror -(defn int-half [i] - (if (even? i) - (quot i 2) - (kit/raise odd-number-error i))) - -; Throws Java NumberFormatException because there's no 'handle' form -(vec (map int-half [2 4 5 8])) - -; Throws Java Exception with details provided by 'raise' -(kit/with-handler - (vec (map int-half [2 4 5 8])) - (kit/handle odd-number-error [n] - (throw (Exception. (format "Odd number %d in vector." n))))) - -; The above is equivalent to the more complicated version below: -(kit/with-handler - (vec (map int-half [2 4 5 8])) - (kit/handle {:keys [n tag]} - (if (isa? tag `odd-number-error) - (throw (Exception. (format "Odd number %d in vector." n))) - (kit/do-not-handle)))) - -; Returns "invalid" string instead of a vector when an error is encountered -(kit/with-handler - (vec (map int-half [2 4 5 8])) - (kit/handle kit/error [n] - "invalid")) - -; Inserts a zero into the returned vector where there was an error, in -; this case [1 2 0 4] -(kit/with-handler - (vec (map int-half [2 4 5 8])) - (kit/handle number-error [n] - (kit/continue-with 0))) - -; Intermediate continue: [1 2 :oops 5 4] -(defn int-half-vec [s] - (reduce (fn [v i] - (kit/with-handler - (conj v (int-half i)) - (kit/bind-continue instead-of-half [& instead-seq] - (apply conj v instead-seq)))) - [] s)) - -(kit/with-handler - (int-half-vec [2 4 5 8]) - (kit/handle number-error [n] - (kit/continue instead-of-half :oops n))) - -; Notes: - -; It seems likely you'd want to convert a handle clause to -; bind-continue, since it would allow higher forms to request what you -; used to do by default. Thus both should appear in the same -; with-handler form - -; Should continue-names be namespace qualified, and therefore require -; pre-definition in some namespace? -; (kit/defcontinue skip-thing "docstring") - -; Could add 'catch' for Java Exceptions and 'finally' support to -; with-handler forms. - -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/except.clj --- a/src/clojure/contrib/except.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,95 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; except.clj -;; -;; Provides functions that make it easy to specify the class, cause, and -;; message when throwing an Exception or Error. The optional message is -;; formatted using clojure.core/format. -;; -;; scgilardi (gmail) -;; Created 07 July 2008 - -(ns - ^{:author "Stephen C. Gilardi", - :doc "Provides functions that make it easy to specify the class, cause, and -message when throwing an Exception or Error. The optional message is -formatted using clojure.core/format."} - clojure.contrib.except - (:import (clojure.lang Reflector))) - -(declare throwable) - -(defn throwf - "Throws an Exception or Error with an optional message formatted using - clojure.core/format. All arguments are optional: - - class? cause? format? format-args* - - - class defaults to Exception, if present it must name a kind of - Throwable - - cause defaults to nil, if present it must be a Throwable - - format is a format string for clojure.core/format - - format-args are objects that correspond to format specifiers in - format." - [& args] - (throw (throwable args))) - -(defn throw-if - "Throws an Exception or Error if test is true. args are those documented - for throwf." - [test & args] - (when test - (throw (throwable args)))) - -(defn throw-if-not - "Throws an Exception or Error if test is false. args are those documented - for throwf." - [test & args] - (when-not test - (throw (throwable args)))) - -(defn throw-arg - "Throws an IllegalArgumentException. All arguments are optional: - - cause? format? format-args* - - - cause defaults to nil, if present it must be a Throwable - - format is a format string for clojure.core/format - - format-args are objects that correspond to format specifiers in - format." - [& args] - (throw (throwable (cons IllegalArgumentException args)))) - -(defn- throwable? - "Returns true if x is a Throwable" - [x] - (instance? Throwable x)) - -(defn- throwable - "Constructs a Throwable with optional cause and formatted message. Its - stack trace will begin with our caller's caller. Args are as described - for throwf except throwable accepts them as list rather than inline." - [args] - (let [[arg] args - [class & args] (if (class? arg) args (cons Exception args)) - [arg] args - [cause & args] (if (throwable? arg) args (cons nil args)) - message (when args (apply format args)) - ctor-args (into-array Object - (cond (and message cause) [message cause] - message [message] - cause [cause])) - throwable (Reflector/invokeConstructor class ctor-args) - our-prefix "clojure.contrib.except$throwable" - not-us? #(not (.startsWith (.getClassName %) our-prefix)) - raw-trace (.getStackTrace throwable) - edited-trace (into-array StackTraceElement - (drop 3 (drop-while not-us? raw-trace)))] - (.setStackTrace throwable edited-trace) - throwable)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/fcase.clj --- a/src/clojure/contrib/fcase.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,108 +0,0 @@ -;;; fcase.clj -- simple variants of "case" for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; April 7, 2008 - -;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; This file defines a generic "case" macro called "fcase" which takes -;; the equality-testing function as an argument. It also defines a -;; traditional "case" macro that tests using "=" and variants that -;; test for regular expressions and class membership. - - -;; Note (December 23, 2008): This library has been supplanted by the -;; inclusion of "condp" in clojure.core as of Clojure SVN rev. 1180. - - -(ns - ^{:author "Stuart Sierra", - :doc "This file defines a generic \"case\" macro called \"fcase\" which takes -the equality-testing function as an argument. It also defines a -traditional \"case\" macro that tests using \"=\" and variants that -test for regular expressions and class membership. - - -Note (December 23, 2008): This library has been supplanted by the -inclusion of \"condp\" in clojure.core as of Clojure SVN rev. 1180."} - - clojure.contrib.fcase - (:refer-clojure :exclude (case))) - - -(defmacro fcase - "Generic switch/case macro. 'fcase' is short for 'function case'. - - The 'compare-fn' is a fn of two arguments. - - The 'test-expr-clauses' are value-expression pairs without - surrounding parentheses, like in Clojure's 'cond'. - - The 'case-value' is evaluated once and cached. Then, 'compare-fn' - is called once for each clause, with the clause's test value as its - first argument and 'case-value' as its second argument. If - 'compare-fn' returns logical true, the clause's expression is - evaluated and returned. If 'compare-fn' returns false/nil, we go to - the next test value. - - If 'test-expr-clauses' contains an odd number of items, the last - item is the default expression evaluated if no case-value matches. - If there is no default expression and no case-value matches, fcase - returns nil. - - See specific forms of this macro in 'case' and 're-case'. - - The test expressions in 'fcase' are always evaluated linearly, in - order. For a large number of case expressions it may be more - efficient to use a hash lookup." - [compare-fn case-value & - test-expr-clauses] - (let [test-val-sym (gensym "test_val") - test-fn-sym (gensym "test_fn") - cond-loop (fn this [clauses] - (cond - (>= (count clauses) 2) - (list 'if (list test-fn-sym (first clauses) test-val-sym) - (second clauses) - (this (rest (rest clauses)))) - (= (count clauses) 1) (first clauses)))] - (list 'let [test-val-sym case-value, test-fn-sym compare-fn] - (cond-loop test-expr-clauses)))) - -(defmacro case - "Like cond, but test-value is compared against the value of each - test expression with =. If they are equal, executes the \"body\" - expression. Optional last expression is executed if none of the - test expressions match." - [test-value & clauses] - `(fcase = ~test-value ~@clauses)) - -(defmacro re-case - "Like case, but the test expressions are regular expressions, tested - with re-find." - [test-value & clauses] - `(fcase re-find ~test-value ~@clauses)) - -(defmacro instance-case - "Like case, but the test expressions are Java class names, tested with - 'instance?'." - [test-value & clauses] - `(fcase instance? ~test-value ~@clauses)) - -(defn in-case-test [test-seq case-value] - (some (fn [item] (= item case-value)) - test-seq)) - -(defmacro in-case - "Like case, but test expressions are sequences. The test expression - is true if any item in the sequence is equal (tested with '=') to - the test value." - [test-value & clauses] - `(fcase in-case-test ~test-value ~@clauses)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/find_namespaces.clj --- a/src/clojure/contrib/find_namespaces.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,136 +0,0 @@ -;;; find_namespaces.clj: search for ns declarations in dirs, JARs, or CLASSPATH - -;; by Stuart Sierra, http://stuartsierra.com/ -;; April 19, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(ns - ^{:author "Stuart Sierra", - :doc "Search for ns declarations in dirs, JARs, or CLASSPATH"} - clojure.contrib.find-namespaces - (:require [clojure.contrib.classpath :as cp] - [clojure.contrib.jar :as jar]) - (import (java.io File FileReader BufferedReader PushbackReader - InputStreamReader) - (java.util.jar JarFile))) - - -;;; Finding namespaces in a directory tree - -(defn clojure-source-file? - "Returns true if file is a normal file with a .clj extension." - [^File file] - (and (.isFile file) - (.endsWith (.getName file) ".clj"))) - -(defn find-clojure-sources-in-dir - "Searches recursively under dir for Clojure source files (.clj). - Returns a sequence of File objects, in breadth-first sort order." - [^File dir] - ;; Use sort by absolute path to get breadth-first search. - (sort-by #(.getAbsolutePath %) - (filter clojure-source-file? (file-seq dir)))) - -(defn comment? - "Returns true if form is a (comment ...)" - [form] - (and (list? form) (= 'comment (first form)))) - -(defn ns-decl? - "Returns true if form is a (ns ...) declaration." - [form] - (and (list? form) (= 'ns (first form)))) - -(defn read-ns-decl - "Attempts to read a (ns ...) declaration from rdr, and returns the - unevaluated form. Returns nil if read fails or if a ns declaration - cannot be found. The ns declaration must be the first Clojure form - in the file, except for (comment ...) forms." - [^PushbackReader rdr] - (try (let [form (read rdr)] - (cond - (ns-decl? form) form - (comment? form) (recur rdr) - :else nil)) - (catch Exception e nil))) - -(defn read-file-ns-decl - "Attempts to read a (ns ...) declaration from file, and returns the - unevaluated form. Returns nil if read fails, or if the first form - is not a ns declaration." - [^File file] - (with-open [rdr (PushbackReader. (BufferedReader. (FileReader. file)))] - (read-ns-decl rdr))) - -(defn find-ns-decls-in-dir - "Searches dir recursively for (ns ...) declarations in Clojure - source files; returns the unevaluated ns declarations." - [^File dir] - (filter identity (map read-file-ns-decl (find-clojure-sources-in-dir dir)))) - -(defn find-namespaces-in-dir - "Searches dir recursively for (ns ...) declarations in Clojure - source files; returns the symbol names of the declared namespaces." - [^File dir] - (map second (find-ns-decls-in-dir dir))) - - -;;; Finding namespaces in JAR files - -(defn clojure-sources-in-jar - "Returns a sequence of filenames ending in .clj found in the JAR file." - [^JarFile jar-file] - (filter #(.endsWith % ".clj") (jar/filenames-in-jar jar-file))) - -(defn read-ns-decl-from-jarfile-entry - "Attempts to read a (ns ...) declaration from the named entry in the - JAR file, and returns the unevaluated form. Returns nil if the read - fails, or if the first form is not a ns declaration." - [^JarFile jarfile ^String entry-name] - (with-open [rdr (PushbackReader. - (BufferedReader. - (InputStreamReader. - (.getInputStream jarfile (.getEntry jarfile entry-name)))))] - (read-ns-decl rdr))) - -(defn find-ns-decls-in-jarfile - "Searches the JAR file for Clojure source files containing (ns ...) - declarations; returns the unevaluated ns declarations." - [^JarFile jarfile] - (filter identity - (map #(read-ns-decl-from-jarfile-entry jarfile %) - (clojure-sources-in-jar jarfile)))) - -(defn find-namespaces-in-jarfile - "Searches the JAR file for Clojure source files containing (ns ...) - declarations. Returns a sequence of the symbol names of the - declared namespaces." - [^JarFile jarfile] - (map second (find-ns-decls-in-jarfile jarfile))) - - -;;; Finding namespaces anywhere on CLASSPATH - -(defn find-ns-decls-on-classpath - "Searches CLASSPATH (both directories and JAR files) for Clojure - source files containing (ns ...) declarations. Returns a sequence - of the unevaluated ns declaration forms." - [] - (concat - (mapcat find-ns-decls-in-dir (cp/classpath-directories)) - (mapcat find-ns-decls-in-jarfile (cp/classpath-jarfiles)))) - -(defn find-namespaces-on-classpath - "Searches CLASSPATH (both directories and JAR files) for Clojure - source files containing (ns ...) declarations. Returns a sequence - of the symbol names of the declared namespaces." - [] - (map second (find-ns-decls-on-classpath))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/fnmap.clj --- a/src/clojure/contrib/fnmap.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -;;; fnmap.clj: maps that dispatch get/assoc to functions - -;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(ns ^{:author "Stuart Sierra" - :doc "Maps that dispatch get/assoc to user-defined functions. - - Note: requires AOT-compilation"} - clojure.contrib.fnmap - (:require clojure.contrib.fnmap.PersistentFnMap)) - -(defn fnmap - "Creates a fnmap, or functional map. A fnmap behaves like an - ordinary Clojure map, except that calls to get and assoc are - filtered through user-defined getter and setter functions, which - operate on an internal map. - - (getter m key) should return a value for key. - - (setter m key value) should assoc key with value and return a new - map for m. - - All other map operations are passed through to the internal map." - ([getter setter] (clojure.contrib.fnmap.PersistentFnMap/create getter setter)) - ([getter setter & keyvals] - (apply assoc - (clojure.contrib.fnmap.PersistentFnMap/create getter setter) - keyvals))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/fnmap/PersistentFnMap.clj --- a/src/clojure/contrib/fnmap/PersistentFnMap.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,70 +0,0 @@ -;; PersistentFnMap.clj: implementation for clojure.contrib.fnmap - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; Thanks to Meikel Brandmeyer for his work on lazymap, which made -;; this implementation easier. - - -(ns clojure.contrib.fnmap.PersistentFnMap - (:gen-class :extends clojure.lang.APersistentMap - :state state - :init init - :constructors {[clojure.lang.IPersistentMap] [], - [clojure.lang.IPersistentMap clojure.lang.IPersistentMap] [clojure.lang.IPersistentMap]})) - -(defn -init - ([theMap] [[] theMap]) - ([theMap metadata] [[metadata] theMap])) - -(defn create [getter setter] - (clojure.contrib.fnmap.PersistentFnMap. - {::getter getter ::setter setter})) - -;; IPersistentMap - -(defn -assoc [this key value] - (clojure.contrib.fnmap.PersistentFnMap. - ((::setter (. this state)) (. this state) key value))) - -;; Associative - -(defn- -containsKey [this key] - (not (nil? ((::getter (. this state)) this key)))) - -(defn- -entryAt [this key] - (clojure.lang.MapEntry. key ((::getter (. this state)) (. this state) key))) - -(defn -valAt - ([this key] - ((::getter (. this state)) (. this state) key)) - ([this key default] - (or ((::getter (. this state)) (. this state) key) - default))) - -;; Iterable - -(defn -iterator [this] - (.. this state iterator)) - -;; IPersistentCollection - -(defn -count [this] - (count (. this state))) - -(defn -seq [this] - (seq (. this state))) - -(defn -cons [this that] - (.. this state (cons this that))) - -(defn -empty [this] - (.. this state empty)) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/gen_html_docs.clj --- a/src/clojure/contrib/gen_html_docs.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,540 +0,0 @@ -;;; gen-html-docs.clj: Generate HTML documentation for Clojure libs - -;; by Craig Andera, http://pluralsight.com/craig, candera@wangdera.com -;; February 13th, 2009 - -;; Copyright (c) Craig Andera, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -;; Generates a single HTML page that contains the documentation for -;; one or more Clojure libraries. See the comments section at the end -;; of this file for usage. - -;; TODO -;; -;; * Make symbols in the source hyperlinks to the appropriate section -;; of the documentation. -;; * Investigate issue with miglayout mentioned here: -;; http://groups.google.com/group/clojure/browse_thread/thread/5a0c4395e44f5a79/3ae483100366bd3d?lnk=gst&q=documentation+browser#3ae483100366bd3d -;; -;; DONE -;; -;; * Move to clojure.contrib -;; * Change namespace -;; * Change license as appropriate -;; * Double-check doc strings -;; * Remove doc strings from source code -;; * Add collapse/expand functionality for all namespaces -;; * Add collapse/expand functionality for each namespace -;; * See if converting to use clojure.contrib.prxml is possible -;; * Figure out why the source doesn't show up for most things -;; * Add collapsible source -;; * Add links at the top to jump to each namespace -;; * Add object type (var, function, whatever) -;; * Add argument lists for functions -;; * Add links at the top of each namespace to jump to members -;; * Add license statement -;; * Remove the whojure dependency - -(ns - ^{:author "Craig Andera", - :doc "Generates a single HTML page that contains the documentation for -one or more Clojure libraries."} - clojure.contrib.gen-html-docs - (:require [clojure.contrib.io :as io] - [clojure.contrib.string :as s]) - (:use [clojure.contrib repl-utils def prxml]) - (:import [java.lang Exception] - [java.util.regex Pattern])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Doc generation constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def *script* " // -") - -(def *style* " -.library -{ - padding: 0.5em 0 0 0 -} -.all-libs-toggle,.library-contents-toggle -{ - font-size: small; -} -.all-libs-toggle a,.library-contents-toggle a -{ - color: white -} -.library-member-doc-whitespace -{ - white-space: pre -} -.library-member-source-toggle -{ - font-size: small; - margin-top: 0.5em -} -.library-member-source -{ - display: none; - border-left: solid lightblue -} -.library-member-docs -{ - font-family:monospace -} -.library-member-arglists -{ - font-family: monospace -} -.library-member-type -{ - font-weight: bold; - font-size: small; - font-style: italic; - color: darkred -} -.lib-links -{ - margin: 0 0 1em 0 -} - -.lib-link-header -{ - color: white; - background: darkgreen; - width: 100% -} - -.library-name -{ - color: white; - background: darkblue; - width: 100% -} - -.missing-library -{ - color: darkred; - margin: 0 0 1em 0 -} - -.library-members -{ - list-style: none -} - -.library-member-name -{ - font-weight: bold; - font-size: 105% -}") - -(defn- extract-documentation - "Pulls the documentation for a var v out and turns it into HTML" - [v] - (if-let [docs (:doc (meta v))] - (map - (fn [l] - [:div {:class "library-member-doc-line"} - (if (= 0 (count l)) - [:span {:class "library-member-doc-whitespace"} " "] ; We need something here to make the blank line show up - l)]) - (s/split #"\n" docs)) - "")) - -(defn- member-type - "Figures out for a var x whether it's a macro, function, var or multifunction" - [x] - (try - (let [dx (deref x)] - (cond - (:macro (meta x)) :macro - (fn? dx) :fn - (= clojure.lang.MultiFn (:tag (meta x))) :multi - true :var)) - (catch Exception e - :unknown))) - -(defn- anchor-for-member - "Returns a suitable HTML anchor name given a library id and a member - id" - [libid memberid] - (str "member-" libid "-" memberid)) - -(defn- id-for-member-source - "Returns a suitable HTML id for a source listing given a library and - a member" - [libid memberid] - (str "membersource-" libid "-" memberid)) - -(defn- id-for-member-source-link - "Returns a suitable HTML id for a link to a source listing given a - library and a member" - [libid memberid] - (str "linkto-membersource-" libid "-" memberid)) - -(defn- symbol-for - "Given a namespace object ns and a namespaceless symbol memberid - naming a member of that namespace, returns a namespaced symbol that - identifies that member." - [ns memberid] - (symbol (name (ns-name ns)) (name memberid))) - -(defn- elide-to-one-line - "Elides a string down to one line." - [s] - (s/replace-re #"(\n.*)+" "..." s)) - -(defn- elide-string - "Returns a string that is at most the first limit characters of s" - [s limit] - (if (< (- limit 3) (count s)) - (str (subs s 0 (- limit 3)) "...") - s)) - -(defn- doc-elided-src - "Returns the src with the docs elided." - [docs src] - (s/replace-re (re-pattern (str "\"" (Pattern/quote docs) "\"")) - (str "\"" - (elide-to-one-line docs) -;; (elide-string docs 10) -;; "..." - "\"") - src)) - -(defn- format-source [libid memberid v] - (try - (let [docs (:doc (meta v)) - src (if-let [ns (find-ns libid)] - (get-source (symbol-for ns memberid)))] - (if (and src docs) - (doc-elided-src docs src) - src)) - (catch Exception ex - nil))) - -(defn- generate-lib-member [libid [n v]] - [:li {:class "library-member"} - [:a {:name (anchor-for-member libid n)}] - [:dl {:class "library-member-table"} - [:dt {:class "library-member-name"} - (str n)] - [:dd - [:div {:class "library-member-info"} - [:span {:class "library-member-type"} (name (member-type v))] - " " - [:span {:class "library-member-arglists"} (str (:arglists (meta v)))]] - (into [:div {:class "library-member-docs"}] (extract-documentation v)) - (let [member-source-id (id-for-member-source libid n) - member-source-link-id (id-for-member-source-link libid n)] - (if-let [member-source (format-source libid n v)] - [:div {:class "library-member-source-section"} - [:div {:class "library-member-source-toggle"} - "[ " - [:a {:href (format "javascript:toggleSource('%s')" member-source-id) - :id member-source-link-id} "Show Source"] - " ]"] - [:div {:class "library-member-source" :id member-source-id} - [:pre member-source]]]))]]]) - -(defn- anchor-for-library - "Given a symbol id identifying a namespace, returns an identifier -suitable for use as the name attribute of an HTML anchor tag." - [id] - (str "library-" id)) - -(defn- generate-lib-member-link - "Emits a hyperlink to a member of a namespace given libid (a symbol -identifying the namespace) and the vector [n v], where n is the symbol -naming the member in question and v is the var pointing to the -member." - [libid [n v]] - [:a {:class "lib-member-link" - :href (str "#" (anchor-for-member libid n))} (name n)]) - -(defn- anchor-for-library-contents - "Returns an HTML ID that identifies the element that holds the -documentation contents for the specified library." - [lib] - (str "library-contents-" lib)) - -(defn- anchor-for-library-contents-toggle - "Returns an HTML ID that identifies the element that toggles the -visibility of the library contents." - [lib] - (str "library-contents-toggle-" lib)) - -(defn- generate-lib-doc - "Emits the HTML that documents the namespace identified by the -symbol lib." - [lib] - [:div {:class "library"} - [:a {:name (anchor-for-library lib)}] - [:div {:class "library-name"} - [:span {:class "library-contents-toggle"} - "[ " - [:a {:id (anchor-for-library-contents-toggle lib) - :href (format "javascript:toggle('%s', '%s', '-', '+')" - (anchor-for-library-contents lib) - (anchor-for-library-contents-toggle lib))} - "-"] - " ] "] - (name lib)] - (let [ns (find-ns lib)] - (if ns - (let [lib-members (sort (ns-publics ns))] - [:a {:name (anchor-for-library lib)}] - [:div {:class "library-contents" :id (anchor-for-library-contents lib)} - (into [:div {:class "library-member-links"}] - (interpose " " (map #(generate-lib-member-link lib %) lib-members))) - (into [:ol {:class "library-members"}] - (map #(generate-lib-member lib %) lib-members))]) - [:div {:class "missing-library library-contents" :id (anchor-for-library-contents lib)} "Could not load library"]))]) - -(defn- load-lib - "Calls require on the library identified by lib, eating any -exceptions." - [lib] - (try - (require lib) - (catch java.lang.Exception x - nil))) - -(defn- generate-lib-link - "Generates a hyperlink to the documentation for a namespace given -lib, a symbol identifying that namespace." - [lib] - (let [ns (find-ns lib)] - (if ns - [:a {:class "lib-link" :href (str "#" (anchor-for-library lib))} (str (ns-name ns))]))) - -(defn- generate-lib-links - "Generates the list of hyperlinks to each namespace, given libs, a -vector of symbols naming namespaces." - [libs] - (into [:div {:class "lib-links"} - [:div {:class "lib-link-header"} "Namespaces" - [:span {:class "all-libs-toggle"} - " [ " - [:a {:href "javascript:expandAllNamespaces()"} - "Expand All"] - " ] [ " - [:a {:href "javascript:collapseAllNamespaces()"} - "Collapse All"] - " ]"]]] - (interpose " " (map generate-lib-link libs)))) - -(defn generate-toggle-namespace-script - [action toggle-text lib] - (str (format "%s('%s');\n" action (anchor-for-library-contents lib)) - (format "setLinkToggleText('%s', '%s');\n" (anchor-for-library-contents-toggle lib) toggle-text))) - -(defn generate-all-namespaces-action-script - [action toggle-text libs] - (str (format "function %sAllNamespaces()" action) - \newline - "{" - \newline - (reduce str (map #(generate-toggle-namespace-script action toggle-text %) libs)) - \newline - "}")) - -(defn generate-documentation - "Returns a string which is the HTML documentation for the libraries -named by libs. Libs is a vector of symbols identifying Clojure -libraries." - [libs] - (dorun (map load-lib libs)) - (let [writer (new java.io.StringWriter)] - (binding [*out* writer] - (prxml - [:html {:xmlns "http://www.w3.org/1999/xhtml"} - [:head - [:title "Clojure documentation browser"] - [:style *style*] - [:script {:language "JavaScript" :type "text/javascript"} [:raw! *script*]] - - [:script {:language "JavaScript" :type "text/javascript"} - [:raw! "// "]]] - (let [lib-vec (sort libs)] - (into [:body (generate-lib-links lib-vec)] - (map generate-lib-doc lib-vec)))])) - (.toString writer))) - - -(defn generate-documentation-to-file - "Calls generate-documentation on the libraries named by libs and -emits the generated HTML to the path named by path." - [path libs] - (io/spit path (generate-documentation libs))) - -(comment - (generate-documentation-to-file - "C:/TEMP/CLJ-DOCS.HTML" - ['clojure.contrib.accumulators]) - - (defn gen-all-docs [] - (generate-documentation-to-file - "C:/temp/clj-libs.html" - [ - 'clojure.set - 'clojure.main - 'clojure.core - 'clojure.zip - 'clojure.xml - 'clojure.contrib.accumulators - 'clojure.contrib.apply-macro - 'clojure.contrib.auto-agent - 'clojure.contrib.combinatorics - 'clojure.contrib.command-line - 'clojure.contrib.complex-numbers - 'clojure.contrib.cond - 'clojure.contrib.def - 'clojure.contrib.io - 'clojure.contrib.enum - 'clojure.contrib.error-kit - 'clojure.contrib.except - 'clojure.contrib.fcase - 'clojure.contrib.generic - 'clojure.contrib.generic.arithmetic - 'clojure.contrib.generic.collection - 'clojure.contrib.generic.comparison - 'clojure.contrib.generic.functor - 'clojure.contrib.generic.math-functions - 'clojure.contrib.import-static - 'clojure.contrib.javadoc - 'clojure.contrib.javalog - 'clojure.contrib.lazy-seqs - 'clojure.contrib.lazy-xml - 'clojure.contrib.macro-utils - 'clojure.contrib.macros - 'clojure.contrib.math - 'clojure.contrib.miglayout - 'clojure.contrib.mmap - 'clojure.contrib.monads - 'clojure.contrib.ns-utils - 'clojure.contrib.prxml - 'clojure.contrib.repl-ln - 'clojure.contrib.repl-utils - 'clojure.contrib.seq - 'clojure.contrib.server-socket - 'clojure.contrib.shell - 'clojure.contrib.sql - 'clojure.contrib.stream-utils - 'clojure.contrib.string - 'clojure.contrib.test-contrib - 'clojure.contrib.trace - 'clojure.contrib.types - 'clojure.contrib.zip-filter - 'clojure.contrib.javadoc.browse - 'clojure.contrib.json.read - 'clojure.contrib.json.write - 'clojure.contrib.lazy-xml.with-pull - 'clojure.contrib.miglayout.internal - 'clojure.contrib.probabilities.finite-distributions - 'clojure.contrib.probabilities.monte-carlo - 'clojure.contrib.probabilities.random-numbers - 'clojure.contrib.sql.internal - 'clojure.contrib.test-clojure.evaluation - 'clojure.contrib.test-clojure.for - 'clojure.contrib.test-clojure.numbers - 'clojure.contrib.test-clojure.printer - 'clojure.contrib.test-clojure.reader - 'clojure.contrib.test-clojure.sequences - 'clojure.contrib.test-contrib.shell - 'clojure.contrib.test-contrib.string - 'clojure.contrib.zip-filter.xml - ])) - ) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/generic.clj --- a/src/clojure/contrib/generic.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -;; Support code for generic interfaces - -;; by Konrad Hinsen -;; last updated May 4, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Generic interfaces - This library provides generic interfaces in the form of - multimethods that can be implemented for any type. - The interfaces partly duplicate existing non-generic - functions in clojure.core (arithmetic, comparison, - collections) and partly provide additional functions that - can be defined for a wide variety of types (functors, math - functions). More functions will be added in the future."} - clojure.contrib.generic - (:use [clojure.contrib.types :only (defadt)])) - -; -; A dispatch function that separates nulary, unary, binary, and -; higher arity calls and also selects on type for unary and binary -; calls. -; -(defn nary-dispatch - ([] ::nulary) - ([x] (type x)) - ([x y] - [(type x) (type y)]) - ([x y & more] ::nary)) - -; -; We can't use [::binary :default], so we need to define a root type -; of the type hierarcy. The derivation for Object covers all classes, -; but all non-class types will need an explicit derive clause. -; Ultimately, a macro might take care of this. -; -(def root-type ::any) -(derive Object root-type) - -; -; Symbols referring to ::nulary and ::n-ary -; -(def nulary-type ::nulary) -(def nary-type ::nary) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/generic/arithmetic.clj --- a/src/clojure/contrib/generic/arithmetic.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,201 +0,0 @@ -;; Generic interfaces for arithmetic operations - -;; by Konrad Hinsen -;; last updated May 5, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Generic arithmetic interface - This library defines generic versions of + - * / as multimethods - that can be defined for any type. The minimal required - implementations for a type are binary + and * plus unary - and /. - Everything else is derived from these automatically. Explicit - binary definitions for - and / can be provided for - efficiency reasons."} - clojure.contrib.generic.arithmetic - (:use [clojure.contrib.generic - :only (root-type nulary-type nary-type nary-dispatch)] - [clojure.contrib.types :only (defadt)]) - (:refer-clojure :exclude [+ - * /])) - -; -; Universal zero and one values -; -(defadt ::zero zero) -(defadt ::one one) - -(derive ::zero root-type) -(derive ::one root-type) - -; -; Addition -; -; The minimal implementation is for binary my-type. It is possible -; in principle to implement [::unary my-type] as well, though this -; doesn't make any sense. -; -(defmulti + - "Return the sum of all arguments. The minimal implementation for type - ::my-type is the binary form with dispatch value [::my-type ::my-type]." - {:arglists '([x] [x y] [x y & more])} - nary-dispatch) - -(defmethod + nulary-type - [] - zero) - -(defmethod + root-type - [x] x) - -(defmethod + [root-type ::zero] - [x y] x) - -(defmethod + [::zero root-type] - [x y] y) - -(defmethod + nary-type - [x y & more] - (if more - (recur (+ x y) (first more) (next more)) - (+ x y))) - -; -; Subtraction -; -; The minimal implementation is for unary my-type. A default binary -; implementation is provided as (+ x (- y)), but it is possible to -; implement unary my-type explicitly for efficiency reasons. -; -(defmulti - - "Return the difference of the first argument and the sum of all other - arguments. The minimal implementation for type ::my-type is the binary - form with dispatch value [::my-type ::my-type]." - {:arglists '([x] [x y] [x y & more])} - nary-dispatch) - -(defmethod - nulary-type - [] - (throw (java.lang.IllegalArgumentException. - "Wrong number of arguments passed"))) - -(defmethod - [root-type ::zero] - [x y] x) - -(defmethod - [::zero root-type] - [x y] (- y)) - -(defmethod - [root-type root-type] - [x y] (+ x (- y))) - -(defmethod - nary-type - [x y & more] - (if more - (recur (- x y) (first more) (next more)) - (- x y))) - -; -; Multiplication -; -; The minimal implementation is for binary [my-type my-type]. It is possible -; in principle to implement unary my-type as well, though this -; doesn't make any sense. -; -(defmulti * - "Return the product of all arguments. The minimal implementation for type - ::my-type is the binary form with dispatch value [::my-type ::my-type]." - {:arglists '([x] [x y] [x y & more])} - nary-dispatch) - -(defmethod * nulary-type - [] - one) - -(defmethod * root-type - [x] x) - -(defmethod * [root-type ::one] - [x y] x) - -(defmethod * [::one root-type] - [x y] y) - -(defmethod * nary-type - [x y & more] - (if more - (recur (* x y) (first more) (next more)) - (* x y))) - -; -; Division -; -; The minimal implementation is for unary my-type. A default binary -; implementation is provided as (* x (/ y)), but it is possible to -; implement binary [my-type my-type] explicitly for efficiency reasons. -; -(defmulti / - "Return the quotient of the first argument and the product of all other - arguments. The minimal implementation for type ::my-type is the binary - form with dispatch value [::my-type ::my-type]." - {:arglists '([x] [x y] [x y & more])} - nary-dispatch) - -(defmethod / nulary-type - [] - (throw (java.lang.IllegalArgumentException. - "Wrong number of arguments passed"))) - -(defmethod / [root-type ::one] - [x y] x) - -(defmethod / [::one root-type] - [x y] (/ y)) - -(defmethod / [root-type root-type] - [x y] (* x (/ y))) - -(defmethod / nary-type - [x y & more] - (if more - (recur (/ x y) (first more) (next more)) - (/ x y))) - -; -; Macros to permit access to the / multimethod via namespace qualification -; -(defmacro defmethod* - "Define a method implementation for the multimethod name in namespace ns. - Required for implementing the division function from another namespace." - [ns name & args] - (let [qsym (symbol (str ns) (str name))] - `(defmethod ~qsym ~@args))) - -(defmacro qsym - "Create the qualified symbol corresponding to sym in namespace ns. - Required to access the division function from another namespace, - e.g. as (qsym clojure.contrib.generic.arithmetic /)." - [ns sym] - (symbol (str ns) (str sym))) - -; -; Minimal implementations for java.lang.Number -; -(defmethod + [java.lang.Number java.lang.Number] - [x y] (clojure.core/+ x y)) - -(defmethod - java.lang.Number - [x] (clojure.core/- x)) - -(defmethod * [java.lang.Number java.lang.Number] - [x y] (clojure.core/* x y)) - -(defmethod / java.lang.Number - [x] (clojure.core// x)) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/generic/collection.clj --- a/src/clojure/contrib/generic/collection.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,116 +0,0 @@ -;; Generic interfaces for collection-related functions - -;; by Konrad Hinsen -;; last updated May 5, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Generic arithmetic interface - This library defines generic versions of common - collection-related functions as multimethods that can be - defined for any type."} - clojure.contrib.generic.collection - (:refer-clojure :exclude [assoc conj dissoc empty get into seq])) - -; -; assoc -; -(defmulti assoc - "Returns a new collection in which the values corresponding to the - given keys are updated by the given values. Each type of collection - can have specific restrictions on the possible keys." - {:arglists '([coll & key-val-pairs])} - (fn [coll & items] (type coll))) - -(defmethod assoc :default - [map & key-val-pairs] - (apply clojure.core/assoc map key-val-pairs)) - -; assoc-in - -; -; conj -; -(defmulti conj - "Returns a new collection resulting from adding all xs to coll." - {:arglists '([coll & xs])} - (fn [coll & xs] (type coll))) - -(defmethod conj :default - [coll & xs] - (apply clojure.core/conj coll xs)) - -; -; diassoc -; -(defmulti dissoc - "Returns a new collection in which the entries corresponding to the - given keys are removed. Each type of collection can have specific - restrictions on the possible keys." - {:arglists '([coll & keys])} - (fn [coll & keys] (type coll))) - -(defmethod dissoc :default - [map & keys] - (apply clojure.core/dissoc map keys)) - -; -; empty -; -(defmulti empty - "Returns an empty collection of the same kind as the argument" - {:arglists '([coll])} - type) - -(defmethod empty :default - [coll] - (clojure.core/empty coll)) - -; -; get -; -(defmulti get - "Returns the element of coll referred to by key. Each type of collection - can have specific restrictions on the possible keys." - {:arglists '([coll key] [coll key not-found])} - (fn [coll & args] (type coll))) - -(defmethod get :default - ([coll key] - (clojure.core/get coll key)) - ([coll key not-found] - (clojure.core/get coll key not-found))) - -; -; into -; -(defmulti into - "Returns a new coll consisting of to-coll with all of the items of - from-coll conjoined." - {:arglists '([to from])} - (fn [to from] (type to))) - -(declare seq) -(defmethod into :default - [to from] - (reduce conj to (seq from))) - -; -; seq -; -(defmulti seq - "Returns a seq on the object s." - {:arglists '([s])} - type) - -(defmethod seq :default - [s] - (clojure.core/seq s)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/generic/comparison.clj --- a/src/clojure/contrib/generic/comparison.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,214 +0,0 @@ -;; Generic interfaces for comparison operations - -;; by Konrad Hinsen -;; last updated May 25, 2010 - -;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Generic comparison interface - This library defines generic versions of = < > <= >= zero? - as multimethods that can be defined for any type. Of the - greater/less-than relations, types must minimally implement >."} - clojure.contrib.generic.comparison - (:refer-clojure :exclude [= < > <= >= zero? pos? neg? min max]) - (:use [clojure.contrib.generic - :only (root-type nulary-type nary-type nary-dispatch)])) - -; -; zero? pos? neg? -; -(defmulti zero? - "Return true of x is zero." - {:arglists '([x])} - type) - -(defmulti pos? - "Return true of x is positive." - {:arglists '([x])} - type) - -(defmulti neg? - "Return true of x is negative." - {:arglists '([x])} - type) - -; -; Equality -; -(defmulti = - "Return true if all arguments are equal. The minimal implementation for type - ::my-type is the binary form with dispatch value [::my-type ::my-type]." - {:arglists '([x] [x y] [x y & more])} - nary-dispatch) - -(defmethod = root-type - [x] true) - -(defmethod = nary-type - [x y & more] - (if (= x y) - (if (next more) - (recur y (first more) (next more)) - (= y (first more))) - false)) - -; -; Greater-than -; -(defmulti > - "Return true if each argument is larger than the following ones. - The minimal implementation for type ::my-type is the binary form - with dispatch value [::my-type ::my-type]." - {:arglists '([x] [x y] [x y & more])} - nary-dispatch) - -(defmethod > root-type - [x] true) - -(defmethod > nary-type - [x y & more] - (if (> x y) - (if (next more) - (recur y (first more) (next more)) - (> y (first more))) - false)) - -; -; Less-than defaults to greater-than with arguments inversed -; -(defmulti < - "Return true if each argument is smaller than the following ones. - The minimal implementation for type ::my-type is the binary form - with dispatch value [::my-type ::my-type]. A default implementation - is provided in terms of >." - {:arglists '([x] [x y] [x y & more])} - nary-dispatch) - -(defmethod < root-type - [x] true) - -(defmethod < [root-type root-type] - [x y] - (> y x)) - -(defmethod < nary-type - [x y & more] - (if (< x y) - (if (next more) - (recur y (first more) (next more)) - (< y (first more))) - false)) - -; -; Greater-or-equal defaults to (complement <) -; -(defmulti >= - "Return true if each argument is larger than or equal to the following - ones. The minimal implementation for type ::my-type is the binary form - with dispatch value [::my-type ::my-type]. A default implementation - is provided in terms of <." - {:arglists '([x] [x y] [x y & more])} - nary-dispatch) - -(defmethod >= root-type - [x] true) - -(defmethod >= [root-type root-type] - [x y] - (not (< x y))) - -(defmethod >= nary-type - [x y & more] - (if (>= x y) - (if (next more) - (recur y (first more) (next more)) - (>= y (first more))) - false)) - -; -; Less-than defaults to (complement >) -; -(defmulti <= - "Return true if each arguments is smaller than or equal to the following - ones. The minimal implementation for type ::my-type is the binary form - with dispatch value [::my-type ::my-type]. A default implementation - is provided in terms of >." - {:arglists '([x] [x y] [x y & more])} - nary-dispatch) - -(defmethod <= root-type - [x] true) - -(defmethod <= [root-type root-type] - [x y] - (not (> x y))) - -(defmethod <= nary-type - [x y & more] - (if (<= x y) - (if (next more) - (recur y (first more) (next more)) - (<= y (first more))) - false)) - -; -; Implementations for Clojure's built-in types -; -(defmethod zero? java.lang.Number - [x] - (clojure.core/zero? x)) - -(defmethod pos? java.lang.Number - [x] - (clojure.core/pos? x)) - -(defmethod neg? java.lang.Number - [x] - (clojure.core/neg? x)) - -(defmethod = [Object Object] - [x y] - (clojure.core/= x y)) - -(defmethod > [java.lang.Number java.lang.Number] - [x y] - (clojure.core/> x y)) - -(defmethod < [java.lang.Number java.lang.Number] - [x y] - (clojure.core/< x y)) - -(defmethod >= [java.lang.Number java.lang.Number] - [x y] - (clojure.core/>= x y)) - -(defmethod <= [java.lang.Number java.lang.Number] - [x y] - (clojure.core/<= x y)) - -; -; Functions defined in terms of the comparison operators -; -(defn max - "Returns the greatest of its arguments. Like clojure.core/max except that - is uses generic comparison functions implementable for any data type." - ([x] x) - ([x y] (if (> x y) x y)) - ([x y & more] - (reduce max (max x y) more))) - -(defn min - "Returns the least of its arguments. Like clojure.core/min except that - is uses generic comparison functions implementable for any data type." - ([x] x) - ([x y] (if (< x y) x y)) - ([x y & more] - (reduce min (min x y) more))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/generic/functor.clj --- a/src/clojure/contrib/generic/functor.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -;; Generic interface for functors - -;; by Konrad Hinsen -;; last updated May 3, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Generic functor interface (fmap)"} - clojure.contrib.generic.functor) - - -(defmulti fmap - "Applies function f to each item in the data structure s and returns - a structure of the same kind." - {:arglists '([f s])} - (fn [f s] (type s))) - -(defmethod fmap clojure.lang.IPersistentList - [f v] - (into (empty v) (map f v))) - -(defmethod fmap clojure.lang.IPersistentVector - [f v] - (into (empty v) (map f v))) - -(defmethod fmap clojure.lang.IPersistentMap - [f m] - (into (empty m) (for [[k v] m] [k (f v)]))) - -(defmethod fmap clojure.lang.IPersistentSet - [f s] - (into (empty s) (map f s))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/generic/math_functions.clj --- a/src/clojure/contrib/generic/math_functions.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,114 +0,0 @@ -;; Generic interfaces for mathematical functions - -;; by Konrad Hinsen -;; last updated May 5, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Generic math function interface - This library defines generic versions of common mathematical - functions such as sqrt or sin as multimethods that can be - defined for any type."} - clojure.contrib.generic.math-functions - (:use [clojure.contrib.def :only (defmacro-)]) - (:require [clojure.contrib.generic.arithmetic :as ga] - [clojure.contrib.generic.comparison :as gc])) - -(defmacro- defmathfn-1 - [name] - (let [java-symbol (symbol "java.lang.Math" (str name))] - `(do - (defmulti ~name - ~(str "Return the " name " of x.") - {:arglists '([~'x])} - type) - (defmethod ~name java.lang.Number - [~'x] - (~java-symbol ~'x))))) - -(defn- two-types [x y] [(type x) (type y)]) - -(defmacro- defmathfn-2 - [name] - (let [java-symbol (symbol "java.lang.Math" (str name))] - `(do - (defmulti ~name - ~(str "Return the " name " of x and y.") - {:arglists '([~'x ~'y])} - two-types) - (defmethod ~name [java.lang.Number java.lang.Number] - [~'x ~'y] - (~java-symbol ~'x ~'y))))) - -; List of math functions taken from -; http://java.sun.com/j2se/1.4.2/docs/api/java/lang/Math.html -(defmathfn-1 abs) -(defmathfn-1 acos) -(defmathfn-1 asin) -(defmathfn-1 atan) -(defmathfn-2 atan2) -(defmathfn-1 ceil) -(defmathfn-1 cos) -(defmathfn-1 exp) -(defmathfn-1 floor) -(defmathfn-1 log) -(defmathfn-2 pow) -(defmathfn-1 rint) -(defmathfn-1 round) -(defmathfn-1 sin) -(defmathfn-1 sqrt) -(defmathfn-1 tan) - -; -; Sign -; -(defmulti sgn - "Return the sign of x (-1, 0, or 1)." - {:arglists '([x])} - type) - -(defmethod sgn :default - [x] - (cond (gc/zero? x) 0 - (gc/> x 0) 1 - :else -1)) - -; -; Conjugation -; -(defmulti conjugate - "Return the conjugate of x." - {:arglists '([x])} - type) - -(defmethod conjugate :default - [x] x) - -; -; Square -; -(defmulti sqr - "Return the square of x." - {:arglists '([x])} - type) - -(defmethod sqr :default - [x] - (ga/* x x)) - -; -; Approximate equality for use with floating point types -; -(defn approx= - "Return true if the absolute value of the difference between x and y - is less than eps." - [x y eps] - (gc/< (abs (ga/- x y)) eps)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/graph.clj --- a/src/clojure/contrib/graph.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,228 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; graph -;; -;; Basic Graph Theory Algorithms -;; -;; straszheimjeffrey (gmail) -;; Created 23 June 2009 - - -(ns - ^{:author "Jeffrey Straszheim", - :doc "Basic graph theory algorithms"} - clojure.contrib.graph - (use [clojure.set :only (union)])) - - -(defstruct directed-graph - :nodes ; The nodes of the graph, a collection - :neighbors) ; A function that, given a node returns a collection - ; neighbor nodes. - -(defn get-neighbors - "Get the neighbors of a node." - [g n] - ((:neighbors g) n)) - - -;; Graph Modification - -(defn reverse-graph - "Given a directed graph, return another directed graph with the - order of the edges reversed." - [g] - (let [op (fn [rna idx] - (let [ns (get-neighbors g idx) - am (fn [m val] - (assoc m val (conj (get m val #{}) idx)))] - (reduce am rna ns))) - rn (reduce op {} (:nodes g))] - (struct directed-graph (:nodes g) rn))) - -(defn add-loops - "For each node n, add the edge n->n if not already present." - [g] - (struct directed-graph - (:nodes g) - (into {} (map (fn [n] - [n (conj (set (get-neighbors g n)) n)]) (:nodes g))))) - -(defn remove-loops - "For each node n, remove any edges n->n." - [g] - (struct directed-graph - (:nodes g) - (into {} (map (fn [n] - [n (disj (set (get-neighbors g n)) n)]) (:nodes g))))) - - -;; Graph Walk - -(defn lazy-walk - "Return a lazy sequence of the nodes of a graph starting a node n. Optionally, - provide a set of visited notes (v) and a collection of nodes to - visit (ns)." - ([g n] - (lazy-walk g [n] #{})) - ([g ns v] - (lazy-seq (let [s (seq (drop-while v ns)) - n (first s) - ns (rest s)] - (when s - (cons n (lazy-walk g (concat (get-neighbors g n) ns) (conj v n)))))))) - -(defn transitive-closure - "Returns the transitive closure of a graph. The neighbors are lazily computed. - - Note: some version of this algorithm return all edges a->a - regardless of whether such loops exist in the original graph. This - version does not. Loops will be included only if produced by - cycles in the graph. If you have code that depends on such - behavior, call (-> g transitive-closure add-loops)" - [g] - (let [nns (fn [n] - [n (delay (lazy-walk g (get-neighbors g n) #{}))]) - nbs (into {} (map nns (:nodes g)))] - (struct directed-graph - (:nodes g) - (fn [n] (force (nbs n)))))) - - -;; Strongly Connected Components - -(defn- post-ordered-visit - "Starting at node n, perform a post-ordered walk." - [g n [visited acc :as state]] - (if (visited n) - state - (let [[v2 acc2] (reduce (fn [st nd] (post-ordered-visit g nd st)) - [(conj visited n) acc] - (get-neighbors g n))] - [v2 (conj acc2 n)]))) - -(defn post-ordered-nodes - "Return a sequence of indexes of a post-ordered walk of the graph." - [g] - (fnext (reduce #(post-ordered-visit g %2 %1) - [#{} []] - (:nodes g)))) - -(defn scc - "Returns, as a sequence of sets, the strongly connected components - of g." - [g] - (let [po (reverse (post-ordered-nodes g)) - rev (reverse-graph g) - step (fn [stack visited acc] - (if (empty? stack) - acc - (let [[nv comp] (post-ordered-visit rev - (first stack) - [visited #{}]) - ns (remove nv stack)] - (recur ns nv (conj acc comp)))))] - (step po #{} []))) - -(defn component-graph - "Given a graph, perhaps with cycles, return a reduced graph that is acyclic. - Each node in the new graph will be a set of nodes from the old. - These sets are the strongly connected components. Each edge will - be the union of the corresponding edges of the prior graph." - ([g] - (component-graph g (scc g))) - ([g sccs] - (let [find-node-set (fn [n] - (some #(if (% n) % nil) sccs)) - find-neighbors (fn [ns] - (let [nbs1 (map (partial get-neighbors g) ns) - nbs2 (map set nbs1) - nbs3 (apply union nbs2)] - (set (map find-node-set nbs3)))) - nm (into {} (map (fn [ns] [ns (find-neighbors ns)]) sccs))] - (struct directed-graph (set sccs) nm)))) - -(defn recursive-component? - "Is the component (recieved from scc) self recursive?" - [g ns] - (or (> (count ns) 1) - (let [n (first ns)] - (some #(= % n) (get-neighbors g n))))) - -(defn self-recursive-sets - "Returns, as a sequence of sets, the components of a graph that are - self-recursive." - [g] - (filter (partial recursive-component? g) (scc g))) - - -;; Dependency Lists - -(defn fixed-point - "Repeatedly apply fun to data until (equal old-data new-data) - returns true. If max iterations occur, it will throw an - exception. Set max to nil for unlimited iterations." - [data fun max equal] - (let [step (fn step [data idx] - (when (and idx (= 0 idx)) - (throw (Exception. "Fixed point overflow"))) - (let [new-data (fun data)] - (if (equal data new-data) - new-data - (recur new-data (and idx (dec idx))))))] - (step data max))) - -(defn- fold-into-sets - [priorities] - (let [max (inc (apply max 0 (vals priorities))) - step (fn [acc [n dep]] - (assoc acc dep (conj (acc dep) n)))] - (reduce step - (vec (replicate max #{})) - priorities))) - -(defn dependency-list - "Similar to a topological sort, this returns a vector of sets. The - set of nodes at index 0 are independent. The set at index 1 depend - on index 0; those at 2 depend on 0 and 1, and so on. Those withing - a set have no mutual dependencies. Assume the input graph (which - much be acyclic) has an edge a->b when a depends on b." - [g] - (let [step (fn [d] - (let [update (fn [n] - (inc (apply max -1 (map d (get-neighbors g n)))))] - (into {} (map (fn [[k v]] [k (update k)]) d)))) - counts (fixed-point (zipmap (:nodes g) (repeat 0)) - step - (inc (count (:nodes g))) - =)] - (fold-into-sets counts))) - -(defn stratification-list - "Similar to dependency-list (see doc), except two graphs are - provided. The first is as dependency-list. The second (which may - have cycles) provides a partial-dependency relation. If node a - depends on node b (meaning an edge a->b exists) in the second - graph, node a must be equal or later in the sequence." - [g1 g2] - (assert (= (-> g1 :nodes set) (-> g2 :nodes set))) - (let [step (fn [d] - (let [update (fn [n] - (max (inc (apply max -1 - (map d (get-neighbors g1 n)))) - (apply max -1 (map d (get-neighbors g2 n)))))] - (into {} (map (fn [[k v]] [k (update k)]) d)))) - counts (fixed-point (zipmap (:nodes g1) (repeat 0)) - step - (inc (count (:nodes g1))) - =)] - (fold-into-sets counts))) - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/greatest_least.clj --- a/src/clojure/contrib/greatest_least.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,65 +0,0 @@ -(ns - ^{:author "Vincent Foley", - :doc "Various functions for finding greatest and least values in a collection"} - clojure.contrib.greatest-least) - -(defn- boundary - [cmp-fn f & args] - (when args - (reduce (fn [a b] (if (cmp-fn (compare (f b) (f a))) - b - a)) args))) - -(defn greatest-by - "Return the argument for which f yields the greatest value." - [f & args] - (apply boundary pos? f args)) - -(defn greatest - "Return the greatest argument." - [& args] - (apply greatest-by identity args)) - -(defn least-by - "Return the argument for which f yields the smallest value." - [f & args] - (apply boundary neg? f args)) - -(defn least - "Return the smallest element." - [& args] - (apply least-by identity args)) - - -(defn- boundary-all - [cmp-fn f & args] - (when args - (reduce (fn [a b] - (if (nil? a) - (cons b nil) - (let [x (compare (f b) (f (first a)))] - (cond (zero? x) (cons b a) - (cmp-fn x) (cons b nil) - :else a)))) - nil - args))) - -(defn all-greatest-by - "Return all the elements for which f yields the greatest value." - [f & args] - (apply boundary-all pos? f args)) - -(defn all-greatest - "Returns all the greatest elements." - [& args] - (apply all-greatest-by identity args)) - -(defn all-least-by - "Return all the elements for which f yields the least value." - [f & args] - (apply boundary-all neg? f args)) - -(defn all-least - "Returns all the least elements." - [& args] - (apply all-least-by identity args)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/http/agent.clj --- a/src/clojure/contrib/http/agent.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,386 +0,0 @@ -;;; http/agent.clj: agent-based asynchronous HTTP client - -;; by Stuart Sierra, http://stuartsierra.com/ -;; August 17, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -;; DEPRECATED IN 1.2. Use direct Java bits, or take a look at -;; http://github.com/technomancy/clojure-http-client - -(ns ^{:deprecated "1.2" - :doc "Agent-based asynchronous HTTP client. - - This is a HTTP client library based on Java's HttpURLConnection - class and Clojure's Agent system. It allows you to make multiple - HTTP requests in parallel. - - Start an HTTP request with the 'http-agent' function, which - immediately returns a Clojure Agent. You will never deref this - agent; that is handled by the accessor functions. The agent will - execute the HTTP request on a separate thread. - - If you pass a :handler function to http-agent, that function will be - called as soon as the HTTP response body is ready. The handler - function is called with one argument, the HTTP agent itself. The - handler can read the response body by calling the 'stream' function - on the agent. - - The value returned by the handler function becomes part of the state - of the agent, and you can retrieve it with the 'result' function. - If you call 'result' before the HTTP request has finished, it will - block until the handler function returns. - - If you don't provide a handler function, the default handler will - buffer the entire response body in memory, which you can retrieve - with the 'bytes', 'string', or 'stream' functions. Like 'result', - these functions will block until the HTTP request is completed. - - If you want to check if an HTTP request is finished without - blocking, use the 'done?' function. - - A single GET request could be as simple as: - - (string (http-agent \"http://www.stuartsierra.com/\")) - - A simple POST might look like: - - (http-agent \"http...\" :method \"POST\" :body \"foo=1\") - - And you could write the response directly to a file like this: - - (require '[clojure.contrib.io :as d]) - - (http-agent \"http...\" - :handler (fn [agnt] - (with-open [w (d/writer \"/tmp/out\")] - (d/copy (stream agnt) w)))) -" - :author "Stuart Sierra" - } - - clojure.contrib.http.agent - (:refer-clojure :exclude [bytes]) - (:require [clojure.contrib.http.connection :as c] - [clojure.contrib.io :as duck]) - (:import (java.io InputStream ByteArrayOutputStream - ByteArrayInputStream) - (java.net HttpURLConnection))) - - -;;; PRIVATE - -(declare result stream) - -(defn- setup-http-connection - "Sets the instance method, redirect behavior, and request headers of - the HttpURLConnection." - [^HttpURLConnection conn options] - (when-let [t (:connect-timeout options)] - (.setConnectTimeout conn t)) - (when-let [t (:read-timeout options)] - (.setReadTimeout conn t)) - (.setRequestMethod conn (:method options)) - (.setInstanceFollowRedirects conn (:follow-redirects options)) - (doseq [[name value] (:headers options)] - (.setRequestProperty conn name value))) - -(defn- start-request - "Agent action that starts sending the HTTP request." - [state options] - (let [conn (::connection state)] - (setup-http-connection conn options) - (c/start-http-connection conn (:body options)) - (assoc state ::state ::started))) - -(defn- connection-success? [^HttpURLConnection conn] - "Returns true if the HttpURLConnection response code is in the 2xx - range." - (= 2 (quot (.getResponseCode conn) 100))) - -(defn- open-response - "Agent action that opens the response body stream on the HTTP - request; this will block until the response stream is available." ; - [state options] - (let [^HttpURLConnection conn (::connection state)] - (assoc state - ::response-stream (if (connection-success? conn) - (.getInputStream conn) - (.getErrorStream conn)) - ::state ::receiving))) - -(defn- handle-response - "Agent action that calls the provided handler function, with no - arguments, and sets the ::result key of the agent to the handler's - return value." - [state handler options] - (let [conn (::connection state)] - (assoc state - ::result (handler) - ::state ::finished))) - -(defn- disconnect - "Agent action that closes the response body stream and disconnects - the HttpURLConnection." - [state options] - (when (::response-stream state) - (.close ^InputStream (::response-stream state))) - (.disconnect ^HttpURLConnection (::connection state)) - (assoc state - ::response-stream nil - ::state ::disconnected)) - -(defn- status-in-range? - "Returns true if the response status of the HTTP agent begins with - digit, an Integer." - [digit http-agnt] - (= digit (quot (.getResponseCode - ^HttpURLConnection (::connection @http-agnt)) - 100))) - -(defn- ^ByteArrayOutputStream get-byte-buffer [http-agnt] - (let [buffer (result http-agnt)] - (if (instance? ByteArrayOutputStream buffer) - buffer - (throw (Exception. "Handler result was not a ByteArrayOutputStream"))))) - - -(defn buffer-bytes - "The default HTTP agent result handler; it collects the response - body in a java.io.ByteArrayOutputStream, which can later be - retrieved with the 'stream', 'string', and 'bytes' functions." - [http-agnt] - (let [output (ByteArrayOutputStream.)] - (duck/copy (or (stream http-agnt) "") output) - output)) - - -;;; CONSTRUCTOR - -(def *http-agent-defaults* - {:method "GET" - :headers {} - :body nil - :connect-timeout 0 - :read-timeout 0 - :follow-redirects true - :handler buffer-bytes}) - -(defn http-agent - "Creates (and immediately returns) an Agent representing an HTTP - request running in a new thread. - - options are key/value pairs: - - :method string - - The HTTP method name. Default is \"GET\". - - :headers h - - HTTP headers, as a Map or a sequence of pairs like - ([key1,value1], [key2,value2]) Default is nil. - - :body b - - HTTP request entity body, one of nil, String, byte[], InputStream, - Reader, or File. Default is nil. - - :connect-timeout int - - Timeout value, in milliseconds, when opening a connection to the - URL. Default is zero, meaning no timeout. - - :read-timeout int - - Timeout value, in milliseconds, when reading data from the - connection. Default is zero, meaning no timeout. - - :follow-redirects boolean - - If true, HTTP 3xx redirects will be followed automatically. Default - is true. - - :handler f - - Function to be called when the HTTP response body is ready. If you - do not provide a handler function, the default is to buffer the - entire response body in memory. - - The handler function will be called with the HTTP agent as its - argument, and can use the 'stream' function to read the response - body. The return value of this function will be stored in the state - of the agent and can be retrieved with the 'result' function. Any - exceptions thrown by this function will be added to the agent's - error queue (see agent-errors). The default function collects the - response stream in a memory buffer. - " - ([uri & options] - (let [opts (merge *http-agent-defaults* (apply array-map options))] - (let [a (agent {::connection (c/http-connection uri) - ::state ::created - ::uri uri - ::options opts})] - (send-off a start-request opts) - (send-off a open-response opts) - (send-off a handle-response (partial (:handler opts) a) opts) - (send-off a disconnect opts))))) - - -;;; RESPONSE BODY ACCESSORS - -(defn result - "Returns the value returned by the :handler function of the HTTP - agent; blocks until the HTTP request is completed. The default - handler function returns a ByteArrayOutputStream." - [http-agnt] - (await http-agnt) - (::result @http-agnt)) - -(defn stream - "Returns an InputStream of the HTTP response body. When called by - the handler function passed to http-agent, this is the raw - HttpURLConnection stream. - - If the default handler function was used, this function returns a - ByteArrayInputStream on the buffered response body." - [http-agnt] - (let [a @http-agnt] - (if (= (::state a) ::receiving) - (::response-stream a) - (ByteArrayInputStream. - (.toByteArray (get-byte-buffer http-agnt)))))) - -(defn bytes - "Returns a Java byte array of the content returned by the server; - nil if the content is not yet available." - [http-agnt] - (.toByteArray (get-byte-buffer http-agnt))) - -(defn string - "Returns the HTTP response body as a string, using the given - encoding. - - If no encoding is given, uses the encoding specified in the server - headers, or clojure.contrib.io/*default-encoding* if it is - not specified." - ([http-agnt] - (await http-agnt) ;; have to wait for Content-Encoding - (string http-agnt (or (.getContentEncoding - ^HttpURLConnection (::connection @http-agnt)) - duck/*default-encoding*))) - ([http-agnt ^String encoding] - (.toString (get-byte-buffer http-agnt) encoding))) - - -;;; REQUEST ACCESSORS - -(defn request-uri - "Returns the URI/URL requested by this HTTP agent, as a String." - [http-agnt] - (::uri @http-agnt)) - -(defn request-headers - "Returns the request headers specified for this HTTP agent." - [http-agnt] - (:headers (::options @http-agnt))) - -(defn method - "Returns the HTTP method name used by this HTTP agent, as a String." - [http-agnt] - (:method (::options @http-agnt))) - -(defn request-body - "Returns the HTTP request body given to this HTTP agent. - - Note: if the request body was an InputStream or a Reader, it will no - longer be usable." - [http-agnt] - (:body (::options @http-agnt))) - - -;;; RESPONSE ACCESSORS - -(defn done? - "Returns true if the HTTP request/response has completed." - [http-agnt] - (if (#{::finished ::disconnected} (::state @http-agnt)) - true false)) - -(defn status - "Returns the HTTP response status code (e.g. 200, 404) for this - request, as an Integer, or nil if the status has not yet been - received." - [http-agnt] - (when (done? http-agnt) - (.getResponseCode ^HttpURLConnection (::connection @http-agnt)))) - -(defn message - "Returns the HTTP response message (e.g. 'Not Found'), for this - request, or nil if the response has not yet been received." - [http-agnt] - (when (done? http-agnt) - (.getResponseMessage ^HttpURLConnection (::connection @http-agnt)))) - -(defn headers - "Returns a map of HTTP response headers. Header names are converted - to keywords in all lower-case Header values are strings. If a - header appears more than once, only the last value is returned." - [http-agnt] - (reduce (fn [m [^String k v]] - (assoc m (when k (keyword (.toLowerCase k))) (last v))) - {} (.getHeaderFields - ^HttpURLConnection (::connection @http-agnt)))) - -(defn headers-seq - "Returns the HTTP response headers in order as a sequence of - [String,String] pairs. The first 'header' name may be null for the - HTTP status line." - [http-agnt] - (let [^HttpURLConnection conn (::connection @http-agnt) - f (fn thisfn [^Integer i] - ;; Get value first because first key may be nil. - (when-let [value (.getHeaderField conn i)] - (cons [(.getHeaderFieldKey conn i) value] - (thisfn (inc i)))))] - (lazy-seq (f 0)))) - - -;;; RESPONSE STATUS CODE ACCESSORS - -(defn success? - "Returns true if the HTTP response code was in the 200-299 range." - [http-agnt] - (status-in-range? 2 http-agnt)) - -(defn redirect? - "Returns true if the HTTP response code was in the 300-399 range. - - Note: if the :follow-redirects option was true (the default), - redirects will be followed automatically and a the agent will never - return a 3xx response code." - [http-agnt] - (status-in-range? 3 http-agnt)) - -(defn client-error? - "Returns true if the HTTP response code was in the 400-499 range." - [http-agnt] - (status-in-range? 4 http-agnt)) - -(defn server-error? - "Returns true if the HTTP response code was in the 500-599 range." - [http-agnt] - (status-in-range? 5 http-agnt)) - -(defn error? - "Returns true if the HTTP response code was in the 400-499 range OR - the 500-599 range." - [http-agnt] - (or (client-error? http-agnt) - (server-error? http-agnt))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/http/connection.clj --- a/src/clojure/contrib/http/connection.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,62 +0,0 @@ -;;; http/connection.clj: low-level HTTP client API around HttpURLConnection - -;; by Stuart Sierra, http://stuartsierra.com/ -;; June 8, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -;; DEPRECATED IN 1.2. Use direct Java bits, or take a look at -;; http://github.com/technomancy/clojure-http-client - -(ns ^{:deprecated "1.2" - :doc "Low-level HTTP client API around HttpURLConnection"} - clojure.contrib.http.connection - (:require [clojure.contrib.io :as duck]) - (:import (java.net URI URL HttpURLConnection) - (java.io File InputStream Reader))) - -(defn http-connection - "Opens an HttpURLConnection at the URL, handled by as-url." - [url] - (.openConnection (duck/as-url url))) - -(defmulti - ^{:doc "Transmits a request entity body."} - send-request-entity (fn [conn entity] (type entity))) - -(defmethod send-request-entity duck/*byte-array-type* [^HttpURLConnection conn entity] - (.setFixedLengthStreamingMode conn (count entity)) - (.connect conn) - (duck/copy entity (.getOutputStream conn))) - -(defmethod send-request-entity String [conn ^String entity] - (send-request-entity conn (.getBytes entity duck/*default-encoding*))) - -(defmethod send-request-entity File [^HttpURLConnection conn ^File entity] - (.setFixedLengthStreamingMode conn (.length entity)) - (.connect conn) - (duck/copy entity (.getOutputStream conn))) - -(defmethod send-request-entity InputStream [^HttpURLConnection conn entity] - (.setChunkedStreamingMode conn -1) - (.connect conn) - (duck/copy entity (.getOutputStream conn))) - -(defmethod send-request-entity Reader [^HttpURLConnection conn entity] - (.setChunkedStreamingMode conn -1) - (.connect conn) - (duck/copy entity (.getOutputStream conn))) - -(defn start-http-connection - ([^HttpURLConnection conn] (.connect conn)) - ([^HttpURLConnection conn request-entity-body] - (if request-entity-body - (do (.setDoOutput conn true) - (send-request-entity conn request-entity-body)) - (.connect conn)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/import_static.clj --- a/src/clojure/contrib/import_static.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,63 +0,0 @@ -;;; import_static.clj -- import static Java methods/fields into Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; June 1, 2008 - -;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - - -(ns - ^{:author "Stuart Sierra", - :doc "Import static Java methods/fields into Clojure"} - clojure.contrib.import-static - (:use clojure.set)) - -(defmacro import-static - "Imports the named static fields and/or static methods of the class - as (private) symbols in the current namespace. - - Example: - user=> (import-static java.lang.Math PI sqrt) - nil - user=> PI - 3.141592653589793 - user=> (sqrt 16) - 4.0 - - Note: The class name must be fully qualified, even if it has already - been imported. Static methods are defined as MACROS, not - first-class fns." - [class & fields-and-methods] - (let [only (set (map str fields-and-methods)) - the-class (. Class forName (str class)) - static? (fn [x] - (. java.lang.reflect.Modifier - (isStatic (. x (getModifiers))))) - statics (fn [array] - (set (map (memfn getName) - (filter static? array)))) - all-fields (statics (. the-class (getFields))) - all-methods (statics (. the-class (getMethods))) - fields-to-do (intersection all-fields only) - methods-to-do (intersection all-methods only) - make-sym (fn [string] - (with-meta (symbol string) {:private true})) - import-field (fn [name] - (list 'def (make-sym name) - (list '. class (symbol name)))) - import-method (fn [name] - (list 'defmacro (make-sym name) - '[& args] - (list 'list ''. (list 'quote class) - (list 'apply 'list - (list 'quote (symbol name)) - 'args))))] - `(do ~@(map import-field fields-to-do) - ~@(map import-method methods-to-do)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/io.clj --- a/src/clojure/contrib/io.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,564 +0,0 @@ -;;; io.clj -- duck-typed I/O streams for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; May 13, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; This file defines "duck-typed" I/O utility functions for Clojure. -;; The 'reader' and 'writer' functions will open and return an -;; instance of java.io.BufferedReader and java.io.BufferedWriter, -;; respectively, for a variety of argument types -- filenames as -;; strings, URLs, java.io.File's, etc. 'reader' even works on http -;; URLs. -;; -;; Note: this is not really "duck typing" as implemented in languages -;; like Ruby. A better name would have been "do-what-I-mean-streams" -;; or "just-give-me-a-stream", but ducks are funnier. - - -;; CHANGE LOG -;; -;; July 23, 2010: Most functions here are deprecated. Use -;; clojure.java.io -;; -;; May 13, 2009: added functions to open writers for appending -;; -;; May 3, 2009: renamed file to file-str, for compatibility with -;; clojure.contrib.java. reader/writer no longer use this -;; function. -;; -;; February 16, 2009: (lazy branch) fixed read-lines to work with lazy -;; Clojure. -;; -;; January 10, 2009: added *default-encoding*, so streams are always -;; opened as UTF-8. -;; -;; December 19, 2008: rewrote reader and writer as multimethods; added -;; slurp*, file, and read-lines -;; -;; April 8, 2008: first version - - - -(ns - ^{:author "Stuart Sierra", - :doc "This file defines polymorphic I/O utility functions for Clojure. - - The Streams protocol defines reader, writer, input-stream and - output-stream methods that return BufferedReader, BufferedWriter, - BufferedInputStream and BufferedOutputStream instances (respectively), - with default implementations extended to a variety of argument - types: URLs or filenames as strings, java.io.File's, Sockets, etc."} - clojure.contrib.io - (:refer-clojure :exclude (spit)) - (:import - (java.io Reader InputStream InputStreamReader PushbackReader - BufferedReader File OutputStream - OutputStreamWriter BufferedWriter Writer - FileInputStream FileOutputStream ByteArrayOutputStream - StringReader ByteArrayInputStream - BufferedInputStream BufferedOutputStream - CharArrayReader) - (java.net URI URL MalformedURLException Socket))) - - -(def - ^{:doc "Name of the default encoding to use when reading & writing. - Default is UTF-8." - :tag "java.lang.String"} - *default-encoding* "UTF-8") - -(def - ^{:doc "Size, in bytes or characters, of the buffer used when - copying streams."} - *buffer-size* 1024) - -(def - ^{:doc "Type object for a Java primitive byte array."} - *byte-array-type* (class (make-array Byte/TYPE 0))) - -(def - ^{:doc "Type object for a Java primitive char array."} - *char-array-type* (class (make-array Character/TYPE 0))) - - -(defn ^File file-str - "Concatenates args as strings and returns a java.io.File. Replaces - all / and \\ with File/separatorChar. Replaces ~ at the start of - the path with the user.home system property." - [& args] - (let [^String s (apply str args) - s (.replace s \\ File/separatorChar) - s (.replace s \/ File/separatorChar) - s (if (.startsWith s "~") - (str (System/getProperty "user.home") - File/separator (subs s 1)) - s)] - (File. s))) - -(def - ^{:doc "If true, writer, output-stream and spit will open files in append mode. - Defaults to false. Instead of binding this var directly, use append-writer, - append-output-stream or append-spit." - :tag "java.lang.Boolean"} - *append* false) - -(defn- assert-not-appending [] - (when *append* - (throw (Exception. "Cannot change an open stream to append mode.")))) - -;; @todo -- Both simple and elaborate methods for controlling buffering of -;; in the Streams protocol were implemented, considered, and postponed -;; see http://groups.google.com/group/clojure-dev/browse_frm/thread/3e39e9b3982f542b -(defprotocol Streams - (reader [x] - "Attempts to coerce its argument into an open java.io.Reader. - The default implementations of this protocol always return a - java.io.BufferedReader. - - Default implementations are provided for Reader, BufferedReader, - InputStream, File, URI, URL, Socket, byte arrays, character arrays, - and String. - - If argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. If this fails, a final attempt is made to resolve - the string as a resource on the CLASSPATH. - - Uses *default-encoding* as the text encoding. - - Should be used inside with-open to ensure the Reader is properly - closed.") - (writer [x] - "Attempts to coerce its argument into an open java.io.Writer. - The default implementations of this protocol always return a - java.io.BufferedWriter. - - Default implementations are provided for Writer, BufferedWriter, - OutputStream, File, URI, URL, Socket, and String. - - If the argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the Writer is properly - closed.") - (input-stream [x] - "Attempts to coerce its argument into an open java.io.InputStream. - The default implementations of this protocol always return a - java.io.BufferedInputStream. - - Default implementations are defined for OutputStream, File, URI, URL, - Socket, byte array, and String arguments. - - If the argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the InputStream is properly - closed.") - (output-stream [x] - "Attempts to coerce its argument into an open java.io.OutputStream. - The default implementations of this protocol always return a - java.io.BufferedOutputStream. - - Default implementations are defined for OutputStream, File, URI, URL, - Socket, and String arguments. - - If the argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the OutputStream is - properly closed.")) - -(def default-streams-impl - {:reader #(reader (input-stream %)) - :writer #(writer (output-stream %)) - :input-stream #(throw (Exception. (str "Cannot open <" (pr-str %) "> as an InputStream."))) - :output-stream #(throw (Exception. (str "Cannot open <" (pr-str %) "> as an OutputStream.")))}) - -(extend File - Streams - (assoc default-streams-impl - :input-stream #(input-stream (FileInputStream. ^File %)) - :output-stream #(let [stream (FileOutputStream. ^File % *append*)] - (binding [*append* false] - (output-stream stream))))) -(extend URL - Streams - (assoc default-streams-impl - :input-stream (fn [^URL x] - (input-stream (if (= "file" (.getProtocol x)) - (FileInputStream. (.getPath x)) - (.openStream x)))) - :output-stream (fn [^URL x] - (if (= "file" (.getProtocol x)) - (output-stream (File. (.getPath x))) - (throw (Exception. (str "Can not write to non-file URL <" x ">"))))))) -(extend URI - Streams - (assoc default-streams-impl - :input-stream #(input-stream (.toURL ^URI %)) - :output-stream #(output-stream (.toURL ^URI %)))) -(extend String - Streams - (assoc default-streams-impl - :input-stream #(try - (input-stream (URL. %)) - (catch MalformedURLException e - (input-stream (File. ^String %)))) - :output-stream #(try - (output-stream (URL. %)) - (catch MalformedURLException err - (output-stream (File. ^String %)))))) -(extend Socket - Streams - (assoc default-streams-impl - :input-stream #(.getInputStream ^Socket %) - :output-stream #(output-stream (.getOutputStream ^Socket %)))) -(extend *byte-array-type* - Streams - (assoc default-streams-impl :input-stream #(input-stream (ByteArrayInputStream. %)))) -(extend *char-array-type* - Streams - (assoc default-streams-impl :reader #(reader (CharArrayReader. %)))) -(extend Object - Streams - default-streams-impl) - -(extend Reader - Streams - (assoc default-streams-impl :reader #(BufferedReader. %))) -(extend BufferedReader - Streams - (assoc default-streams-impl :reader identity)) -(defn- inputstream->reader - [^InputStream is] - (reader (InputStreamReader. is *default-encoding*))) -(extend InputStream - Streams - (assoc default-streams-impl :input-stream #(BufferedInputStream. %) - :reader inputstream->reader)) -(extend BufferedInputStream - Streams - (assoc default-streams-impl - :input-stream identity - :reader inputstream->reader)) - -(extend Writer - Streams - (assoc default-streams-impl :writer #(do (assert-not-appending) - (BufferedWriter. %)))) -(extend BufferedWriter - Streams - (assoc default-streams-impl :writer #(do (assert-not-appending) %))) -(defn- outputstream->writer - [^OutputStream os] - (assert-not-appending) - (writer (OutputStreamWriter. os *default-encoding*))) -(extend OutputStream - Streams - (assoc default-streams-impl - :output-stream #(do (assert-not-appending) - (BufferedOutputStream. %)) - :writer outputstream->writer)) -(extend BufferedOutputStream - Streams - (assoc default-streams-impl - :output-stream #(do (assert-not-appending) %) - :writer outputstream->writer)) - -(defn append-output-stream - "Like output-stream but opens file for appending. Does not work on streams - that are already open." - {:deprecated "1.2"} - [x] - (binding [*append* true] - (output-stream x))) - -(defn append-writer - "Like writer but opens file for appending. Does not work on streams - that are already open." - {:deprecated "1.2"} - [x] - (binding [*append* true] - (writer x))) - -(defn write-lines - "Writes lines (a seq) to f, separated by newlines. f is opened with - writer, and automatically closed at the end of the sequence." - [f lines] - (with-open [^BufferedWriter writer (writer f)] - (loop [lines lines] - (when-let [line (first lines)] - (.write writer (str line)) - (.newLine writer) - (recur (rest lines)))))) - -(defn read-lines - "Like clojure.core/line-seq but opens f with reader. Automatically - closes the reader AFTER YOU CONSUME THE ENTIRE SEQUENCE." - [f] - (let [read-line (fn this [^BufferedReader rdr] - (lazy-seq - (if-let [line (.readLine rdr)] - (cons line (this rdr)) - (.close rdr))))] - (read-line (reader f)))) - -(defn ^String slurp* - "Like clojure.core/slurp but opens f with reader." - {:deprecated "1.2"} - [f] - (with-open [^BufferedReader r (reader f)] - (let [sb (StringBuilder.)] - (loop [c (.read r)] - (if (neg? c) - (str sb) - (do (.append sb (char c)) - (recur (.read r)))))))) - -(defn spit - "Opposite of slurp. Opens f with writer, writes content, then - closes f." - {:deprecated "1.2"} - [f content] - (with-open [^Writer w (writer f)] - (.write w content))) - -(defn append-spit - "Like spit but appends to file." - {:deprecated "1.2"} - [f content] - (with-open [^Writer w (append-writer f)] - (.write w content))) - -(defn pwd - "Returns current working directory as a String. (Like UNIX 'pwd'.) - Note: In Java, you cannot change the current working directory." - {:deprecated "1.2"} - [] - (System/getProperty "user.dir")) - -(defmacro with-out-writer - "Opens a writer on f, binds it to *out*, and evalutes body. - Anything printed within body will be written to f." - [f & body] - `(with-open [stream# (writer ~f)] - (binding [*out* stream#] - ~@body))) - -(defmacro with-out-append-writer - "Like with-out-writer but appends to file." - {:deprecated "1.2"} - [f & body] - `(with-open [stream# (append-writer ~f)] - (binding [*out* stream#] - ~@body))) - -(defmacro with-in-reader - "Opens a PushbackReader on f, binds it to *in*, and evaluates body." - [f & body] - `(with-open [stream# (PushbackReader. (reader ~f))] - (binding [*in* stream#] - ~@body))) - -(defmulti - ^{:deprecated "1.2" - :doc "Copies input to output. Returns nil. - Input may be an InputStream, Reader, File, byte[], or String. - Output may be an OutputStream, Writer, or File. - - Does not close any streams except those it opens itself - (on a File). - - Writing a File fails if the parent directory does not exist." - :arglists '([input output])} - copy - (fn [input output] [(type input) (type output)])) - -(defmethod copy [InputStream OutputStream] [^InputStream input ^OutputStream output] - (let [buffer (make-array Byte/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (do (.write output buffer 0 size) - (recur))))))) - -(defmethod copy [InputStream Writer] [^InputStream input ^Writer output] - (let [^"[B" buffer (make-array Byte/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (let [chars (.toCharArray (String. buffer 0 size *default-encoding*))] - (do (.write output chars) - (recur)))))))) - -(defmethod copy [InputStream File] [^InputStream input ^File output] - (with-open [out (FileOutputStream. output)] - (copy input out))) - -(defmethod copy [Reader OutputStream] [^Reader input ^OutputStream output] - (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (let [bytes (.getBytes (String. buffer 0 size) *default-encoding*)] - (do (.write output bytes) - (recur)))))))) - -(defmethod copy [Reader Writer] [^Reader input ^Writer output] - (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (do (.write output buffer 0 size) - (recur))))))) - -(defmethod copy [Reader File] [^Reader input ^File output] - (with-open [out (FileOutputStream. output)] - (copy input out))) - -(defmethod copy [File OutputStream] [^File input ^OutputStream output] - (with-open [in (FileInputStream. input)] - (copy in output))) - -(defmethod copy [File Writer] [^File input ^Writer output] - (with-open [in (FileInputStream. input)] - (copy in output))) - -(defmethod copy [File File] [^File input ^File output] - (with-open [in (FileInputStream. input) - out (FileOutputStream. output)] - (copy in out))) - -(defmethod copy [String OutputStream] [^String input ^OutputStream output] - (copy (StringReader. input) output)) - -(defmethod copy [String Writer] [^String input ^Writer output] - (copy (StringReader. input) output)) - -(defmethod copy [String File] [^String input ^File output] - (copy (StringReader. input) output)) - -(defmethod copy [*char-array-type* OutputStream] [input ^OutputStream output] - (copy (CharArrayReader. input) output)) - -(defmethod copy [*char-array-type* Writer] [input ^Writer output] - (copy (CharArrayReader. input) output)) - -(defmethod copy [*char-array-type* File] [input ^File output] - (copy (CharArrayReader. input) output)) - -(defmethod copy [*byte-array-type* OutputStream] [^"[B" input ^OutputStream output] - (copy (ByteArrayInputStream. input) output)) - -(defmethod copy [*byte-array-type* Writer] [^"[B" input ^Writer output] - (copy (ByteArrayInputStream. input) output)) - -(defmethod copy [*byte-array-type* File] [^"[B" input ^Writer output] - (copy (ByteArrayInputStream. input) output)) - -(defn make-parents - "Creates all parent directories of file." - [^File file] - (.mkdirs (.getParentFile file))) - -(defmulti - ^{:doc "Converts argument into a Java byte array. Argument may be - a String, File, InputStream, or Reader. If the argument is already - a byte array, returns it." - :arglists '([arg])} - to-byte-array type) - -(defmethod to-byte-array *byte-array-type* [x] x) - -(defmethod to-byte-array String [^String x] - (.getBytes x *default-encoding*)) - -(defmethod to-byte-array File [^File x] - (with-open [input (FileInputStream. x) - buffer (ByteArrayOutputStream.)] - (copy input buffer) - (.toByteArray buffer))) - -(defmethod to-byte-array InputStream [^InputStream x] - (let [buffer (ByteArrayOutputStream.)] - (copy x buffer) - (.toByteArray buffer))) - -(defmethod to-byte-array Reader [^Reader x] - (.getBytes (slurp* x) *default-encoding*)) - -(defmulti relative-path-string - "Interpret a String or java.io.File as a relative path string. - Building block for clojure.contrib.java/file." - {:deprecated "1.2"} - class) - -(defmethod relative-path-string String [^String s] - (relative-path-string (File. s))) - -(defmethod relative-path-string File [^File f] - (if (.isAbsolute f) - (throw (IllegalArgumentException. (str f " is not a relative path"))) - (.getPath f))) - -(defmulti ^File as-file - "Interpret a String or a java.io.File as a File. Building block - for clojure.contrib.java/file, which you should prefer - in most cases." - {:deprecated "1.2"} - class) -(defmethod as-file String [^String s] (File. s)) -(defmethod as-file File [f] f) - -(defn ^File file - "Returns a java.io.File from string or file args." - {:deprecated "1.2"} - ([arg] - (as-file arg)) - ([parent child] - (File. ^File (as-file parent) ^String (relative-path-string child))) - ([parent child & more] - (reduce file (file parent child) more))) - -(defn delete-file - "Delete file f. Raise an exception if it fails unless silently is true." - [f & [silently]] - (or (.delete (file f)) - silently - (throw (java.io.IOException. (str "Couldn't delete " f))))) - -(defn delete-file-recursively - "Delete file f. If it's a directory, recursively delete all its contents. -Raise an exception if any deletion fails unless silently is true." - [f & [silently]] - (let [f (file f)] - (if (.isDirectory f) - (doseq [child (.listFiles f)] - (delete-file-recursively child silently))) - (delete-file f silently))) - -(defmulti - ^{:deprecated "1.2" - :doc "Coerces argument (URL, URI, or String) to a java.net.URL." - :arglists '([arg])} - as-url type) - -(defmethod as-url URL [x] x) - -(defmethod as-url URI [^URI x] (.toURL x)) - -(defmethod as-url String [^String x] (URL. x)) - -(defmethod as-url File [^File x] (.toURL x)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/jar.clj --- a/src/clojure/contrib/jar.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -;;; jar.clj: utilities for working with Java JAR files - -;; by Stuart Sierra, http://stuartsierra.com/ -;; April 19, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(ns - ^{:author "Stuart Sierra", - :doc "Utilities for working with Java JAR files"} - clojure.contrib.jar - (:import (java.io File) - (java.util.jar JarFile))) - -(defn jar-file? - "Returns true if file is a normal file with a .jar or .JAR extension." - [^File file] - (and (.isFile file) - (or (.endsWith (.getName file) ".jar") - (.endsWith (.getName file) ".JAR")))) - -(defn filenames-in-jar - "Returns a sequence of Strings naming the non-directory entries in - the JAR file." - [^JarFile jar-file] - (map #(.getName %) - (filter #(not (.isDirectory %)) - (enumeration-seq (.entries jar-file))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/java_utils.clj --- a/src/clojure/contrib/java_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,219 +0,0 @@ -; Copyright (c) Stuart Halloway & Contributors, April 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; -;; CHANGELOG -;; -;; Most functions deprecated in 1.2. Some already exist in c.c.io, and -;; some replaced by c.c.reflections - -(ns - ^{:author "Stuart Halloway, Stephen C. Gilardi, Shawn Hoover, Perry Trolard, Stuart Sierra", - :doc "A set of utilties for dealing with Java stuff like files and properties. - - Design goals: - - (1) Ease-of-use. These APIs should be convenient. Performance is secondary. - - (2) Duck typing. I hate having to think about the difference between - a string that names a file, and a File. Ditto for a ton of other - wrapper classes in the Java world (URL, InternetAddress). With these - APIs you should be able to think about domain equivalence, not type - equivalence. - - (3) No bossiness. I am not marking any of these functions as private - the docstrings will tell you the intended usage but do what works for you. - - Feedback welcome! - - If something in this module violates the principle of least surprise, please - let me (Stu) and the Clojure community know via the mailing list. - Contributors: - - Stuart Halloway - Stephen C. Gilardi - Shawn Hoover - Perry Trolard - Stuart Sierra -"} - clojure.contrib.java-utils - (:import [java.io File FileOutputStream] - [java.util Properties] - [java.net URI URL])) - -(defmulti relative-path-string - "Interpret a String or java.io.File as a relative path string. - Building block for clojure.contrib.java-utils/file." - {:deprecated "1.2"} - class) - -(defmethod relative-path-string String [^String s] - (relative-path-string (File. s))) - -(defmethod relative-path-string File [^File f] - (if (.isAbsolute f) - (throw (IllegalArgumentException. (str f " is not a relative path"))) - (.getPath f))) - -(defmulti ^File as-file - "Interpret a String or a java.io.File as a File. Building block - for clojure.contrib.java-utils/file, which you should prefer - in most cases." - {:deprecated "1.2"} - class) -(defmethod as-file String [^String s] (File. s)) -(defmethod as-file File [f] f) - -(defn ^File file - "Returns a java.io.File from string or file args." - {:deprecated "1.2"} - ([arg] - (as-file arg)) - ([parent child] - (File. ^File (as-file parent) ^String (relative-path-string child))) - ([parent child & more] - (reduce file (file parent child) more))) - -(defn as-str - "Like clojure.core/str, but if an argument is a keyword or symbol, - its name will be used instead of its literal representation. - - Example: - (str :foo :bar) ;;=> \":foo:bar\" - (as-str :foo :bar) ;;=> \"foobar\" - - Note that this does not apply to keywords or symbols nested within - data structures; they will be rendered as with str. - - Example: - (str {:foo :bar}) ;;=> \"{:foo :bar}\" - (as-str {:foo :bar}) ;;=> \"{:foo :bar}\" " - {:deprecated "1.2"} - ([] "") - ([x] (if (instance? clojure.lang.Named x) - (name x) - (str x))) - ([x & ys] - ((fn [^StringBuilder sb more] - (if more - (recur (. sb (append (as-str (first more)))) (next more)) - (str sb))) - (new StringBuilder ^String (as-str x)) ys))) - -(defn get-system-property - "Get a system property." - ([stringable] - (System/getProperty (as-str stringable))) - ([stringable default] - (System/getProperty (as-str stringable) default))) - -(defn set-system-properties - "Set some system properties. Nil clears a property." - [settings] - (doseq [[name val] settings] - (if val - (System/setProperty (as-str name) (as-str val)) - (System/clearProperty (as-str name))))) - -(defmacro with-system-properties - "setting => property-name value - - Sets the system properties to the supplied values, executes the body, and - sets the properties back to their original values. Values of nil are - translated to a clearing of the property." - [settings & body] - `(let [settings# ~settings - current# (reduce (fn [coll# k#] - (assoc coll# k# (get-system-property k#))) - {} - (keys settings#))] - (set-system-properties settings#) - (try - ~@body - (finally - (set-system-properties current#))))) - - -; Not there is no corresponding props->map. Just destructure! -(defn ^Properties as-properties - "Convert any seq of pairs to a java.utils.Properties instance. - Uses as-str to convert both keys and values into strings." - {:tag Properties} - [m] - (let [p (Properties.)] - (doseq [[k v] m] - (.setProperty p (as-str k) (as-str v))) - p)) - -(defn read-properties - "Read properties from file-able." - [file-able] - (with-open [f (java.io.FileInputStream. (file file-able))] - (doto (Properties.) - (.load f)))) - -(defn write-properties - "Write properties to file-able." - {:tag Properties} - ([m file-able] (write-properties m file-able nil)) - ([m file-able comments] - (with-open [^FileOutputStream f (FileOutputStream. (file file-able))] - (doto (as-properties m) - (.store f ^String comments))))) - -(defn delete-file - "Delete file f. Raise an exception if it fails unless silently is true." - {:deprecated "1.2"} - [f & [silently]] - (or (.delete (file f)) - silently - (throw (java.io.IOException. (str "Couldn't delete " f))))) - -(defn delete-file-recursively - "Delete file f. If it's a directory, recursively delete all its contents. -Raise an exception if any deletion fails unless silently is true." - {:deprecated "1.2"} - [f & [silently]] - (let [f (file f)] - (if (.isDirectory f) - (doseq [child (.listFiles f)] - (delete-file-recursively child silently))) - (delete-file f silently))) - -(defmulti - ^{:deprecated "1.2" - :doc "Coerces argument (URL, URI, or String) to a java.net.URL." - :arglists '([arg])} - as-url type) - -(defmethod as-url URL [x] x) - -(defmethod as-url URI [^URI x] (.toURL x)) - -(defmethod as-url String [^String x] (URL. x)) - -(defmethod as-url File [^File x] (.toURL x)) - -(defn wall-hack-method - "Calls a private or protected method. - params is a vector of class which correspond to the arguments to the method - obj is nil for static methods, the instance object otherwise - the method name is given as a symbol or a keyword (something Named)" - {:deprecated "1.2"} - [class-name method-name params obj & args] - (-> class-name (.getDeclaredMethod (name method-name) (into-array Class params)) - (doto (.setAccessible true)) - (.invoke obj (into-array Object args)))) - -(defn wall-hack-field - "Access to private or protected field." - {:deprecated "1.2"} - [class-name field-name obj] - (-> class-name (.getDeclaredField (name field-name)) - (doto (.setAccessible true)) - (.get obj))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/javadoc.clj --- a/src/clojure/contrib/javadoc.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -(ns ^{:deprecated "1.2"} - clojure.contrib.javadoc) - -(throw (Exception. "clojure.contrib.javadoc/javadoc can now be found in clojure.java.javadoc")) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/javadoc/browse.clj --- a/src/clojure/contrib/javadoc/browse.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,51 +0,0 @@ -;;; browse.clj -- start a web browser from Clojure - -; Copyright (c) Christophe Grand, December 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this -; distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns - ^{:author "Christophe Grand", - :deprecated "1.2" - :doc "Start a web browser from Clojure"} - clojure.contrib.javadoc.browse - (:require [clojure.contrib.shell :as sh]) - (:import (java.net URI))) - -(defn- macosx? [] - (-> "os.name" System/getProperty .toLowerCase - (.startsWith "mac os x"))) - -(def *open-url-script* (when (macosx?) "/usr/bin/open")) - -(defn open-url-in-browser - "Opens url (a string) in the default system web browser. May not - work on all platforms. Returns url on success, nil if not - supported." - [url] - (try - (when (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" - "isDesktopSupported" (to-array nil)) - (-> (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" - "getDesktop" (to-array nil)) - (.browse (URI. url))) - url) - (catch ClassNotFoundException e - nil))) - -(defn open-url-in-swing - "Opens url (a string) in a Swing window." - [url] - ; the implementation of this function resides in another namespace to be loaded "on demand" - ; this fixes a bug on mac os x where requiring repl-utils turns the process into a GUI app - ; see http://code.google.com/p/clojure-contrib/issues/detail?id=32 - (require 'clojure.contrib.javadoc.browse-ui) - ((find-var 'clojure.contrib.javadoc.browse-ui/open-url-in-swing) url)) - -(defn browse-url [url] - (or (open-url-in-browser url) (when *open-url-script* (sh/sh *open-url-script* (str url)) true) (open-url-in-swing url))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/javadoc/browse_ui.clj --- a/src/clojure/contrib/javadoc/browse_ui.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,31 +0,0 @@ -;;; browse_ui.clj -- starts a swing web browser :-( - -; Copyright (c) Christophe Grand, December 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this -; distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns ^{:deprecated "1.2"} - clojure.contrib.javadoc.browse-ui) - -(defn open-url-in-swing - "Opens url (a string) in a Swing window." - [url] - (let [htmlpane (javax.swing.JEditorPane. url)] - (.setEditable htmlpane false) - (.addHyperlinkListener htmlpane - (proxy [javax.swing.event.HyperlinkListener] [] - (hyperlinkUpdate [^javax.swing.event.HyperlinkEvent e] - (when (= (.getEventType e) (. javax.swing.event.HyperlinkEvent$EventType ACTIVATED)) - (if (instance? javax.swing.text.html.HTMLFrameHyperlinkEvent e) - (-> htmlpane .getDocument (.processHTMLFrameHyperlinkEvent e)) - (.setPage htmlpane (.getURL e))))))) - (doto (javax.swing.JFrame.) - (.setContentPane (javax.swing.JScrollPane. htmlpane)) - (.setBounds 32 32 700 900) - (.show)))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/jmx.clj --- a/src/clojure/contrib/jmx.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,121 +0,0 @@ -;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(ns ^{:author "Stuart Halloway" - :doc "JMX support for Clojure - - Requires post-Clojure 1.0 git edge for clojure.test, clojure.backtrace. - This is prerelease. - This API will change. - Send reports to stu@thinkrelevance.com. - - Usage - (require '[clojure.contrib.jmx :as jmx]) - - What beans do I have? - - (jmx/mbean-names \"*:*\") - -> # (:Verbose :ObjectPendingFinalizationCount - :HeapMemoryUsage :NonHeapMemoryUsage) - - What is the value of an attribute? - - (jmx/read \"java.lang:type=Memory\" :ObjectPendingFinalizationCount) - -> 0 - - Can't I just have *all* the attributes in a Clojure map? - - (jmx/mbean \"java.lang:type=Memory\") - -> {:NonHeapMemoryUsage - {:used 16674024, :max 138412032, :init 24317952, :committed 24317952}, - :HeapMemoryUsage - {:used 18619064, :max 85393408, :init 0, :committed 83230720}, - :ObjectPendingFinalizationCount 0, - :Verbose false} - - Can I find and invoke an operation? - - (jmx/operation-names \"java.lang:type=Memory\") - -> (:gc) - (jmx/invoke \"java.lang:type=Memory\" :gc) - -> nil - - What about some other process? Just run *any* of the above code - inside a with-connection: - - (jmx/with-connection {:host \"localhost\", :port 3000} - (jmx/mbean \"java.lang:type=Memory\")) - -> {:ObjectPendingFinalizationCount 0, - :HeapMemoryUsage ... etc.} - - Can I serve my own beans? Sure, just drop a Clojure ref - into an instance of clojure.contrib.jmx.Bean, and the bean - will expose read-only attributes for every key/value pair - in the ref: - - (jmx/register-mbean - (Bean. - (ref {:string-attribute \"a-string\"})) - \"my.namespace:name=Value\")"} - clojure.contrib.jmx - (:refer-clojure :exclude [read]) - (:use clojure.contrib.def - [clojure.contrib.string :only [as-str]] - [clojure.stacktrace :only (root-cause)] - [clojure.walk :only [postwalk]]) - (:import [clojure.lang Associative] - java.lang.management.ManagementFactory - [javax.management Attribute DynamicMBean MBeanInfo ObjectName RuntimeMBeanException MBeanAttributeInfo] - [javax.management.remote JMXConnectorFactory JMXServiceURL])) - -(defvar *connection* (ManagementFactory/getPlatformMBeanServer) - "The connection to be used for JMX ops. Defaults to the local process.") - -(load "jmx/data") -(load "jmx/client") -(load "jmx/server") - -(defn mbean-names - "Finds all MBeans matching a name on the current *connection*." - [n] - (.queryNames *connection* (as-object-name n) nil)) - -(defn attribute-names - "All attribute names available on an MBean." - [n] - (doall (map #(-> % .getName keyword) - (.getAttributes (mbean-info n))))) - -(defn operation-names - "All operation names available on an MBean." - [n] - (doall (map #(-> % .getName keyword) (operations n)))) - -(defn invoke [n op & args] - (if ( seq args) - (.invoke *connection* (as-object-name n) (as-str op) - (into-array args) - (into-array String (op-param-types n op))) - (.invoke *connection* (as-object-name n) (as-str op) - nil nil))) - -(defn mbean - "Like clojure.core/bean, but for JMX beans. Returns a read-only map of - a JMX bean's attributes. If an attribute it not supported, value is - set to the exception thrown." - [n] - (into {} (map (fn [attr-name] [(keyword attr-name) (read-supported n attr-name)]) - (attribute-names n)))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/jmx/Bean.clj --- a/src/clojure/contrib/jmx/Bean.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -(ns clojure.contrib.jmx.Bean - (:gen-class - :implements [javax.management.DynamicMBean] - :init init - :state state - :constructors {[Object] []}) - (:require [clojure.contrib.jmx :as jmx]) - (:import [javax.management DynamicMBean MBeanInfo AttributeList])) - -(defn -init [derefable] - [[] derefable]) - -; TODO: rest of the arguments, as needed -(defn generate-mbean-info [clj-bean] - (MBeanInfo. (.. clj-bean getClass getName) ; class name - "Clojure Dynamic MBean" ; description - (jmx/map->attribute-infos @(.state clj-bean)) ; attributes - nil ; constructors - nil ; operations - nil)) ; notifications - -(defn -getMBeanInfo - [this] - (generate-mbean-info this)) - -(defn -getAttribute - [this attr] - (@(.state this) (keyword attr))) - -(defn -getAttributes - [this attrs] - (let [result (AttributeList.)] - (doseq [attr attrs] - (.add result (.getAttribute this attr))) - result)) \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/jmx/client.clj --- a/src/clojure/contrib/jmx/client.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ -;; JMX client APIs for Clojure -;; docs in clojure/contrib/jmx.clj!! - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(in-ns 'clojure.contrib.jmx) - -(defmacro with-connection - "Execute body with JMX connection specified by opts. opts can also - include an optional :environment key which is passed as the - environment arg to JMXConnectorFactory/connect." - [opts & body] - `(let [opts# ~opts - env# (get opts# :environment {}) - opts# (dissoc opts# :environment)] - (with-open [connector# (javax.management.remote.JMXConnectorFactory/connect - (JMXServiceURL. (jmx-url opts#)) env#)] - (binding [*connection* (.getMBeanServerConnection connector#)] - ~@body)))) - -(defn mbean-info [n] - (.getMBeanInfo *connection* (as-object-name n))) - -(defn raw-read - "Read an mbean property. Returns low-level Java object model for - composites, tabulars, etc. Most callers should use read." - [n attr] - (.getAttribute *connection* (as-object-name n) (as-str attr))) - -(defvar read - (comp jmx->clj raw-read) - "Read an mbean property.") - -(defn read-supported - "Calls read to read an mbean property, *returning* unsupported - operation exceptions instead of throwing them. Used to keep mbean - from blowing up. Note: There is no good exception that aggregates - unsupported operations, hence the overly-general catch block." - [n attr] - (try - (read n attr) - (catch Exception e - e))) - -(defn write! [n attr value] - (.setAttribute - *connection* - (as-object-name n) - (Attribute. (as-str attr) value))) - -(defn attribute-info - "Get the MBeanAttributeInfo for an attribute." - [object-name attr-name] - (filter #(= (as-str attr-name) (.getName %)) - (.getAttributes (mbean-info object-name)))) - -(defn readable? - "Is attribute readable?" - [n attr] - (.isReadable () (mbean-info n))) - -(defn operations - "All oeprations available on an MBean." - [n] - (.getOperations (mbean-info n))) - -(defn operation - "The MBeanOperationInfo for operation op on mbean n. Used by invoke." - [n op] - (first (filter #(= (-> % .getName keyword) op) (operations n)))) - -(defn op-param-types - "The parameter types (as class name strings) for operation op on n. - Used for invoke." - [n op] - (map #(-> % .getType) (.getSignature (operation n op)))) - - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/jmx/data.clj --- a/src/clojure/contrib/jmx/data.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,104 +0,0 @@ -;; Conversions between JMX data structures and idiomatic Clojure -;; docs in clojure/contrib/jmx.clj!! - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(in-ns 'clojure.contrib.jmx) - -(declare jmx->clj) - -(defn jmx-url - "Build a JMX URL from options." - ([] (jmx-url {})) - ([overrides] - (let [opts (merge {:host "localhost", :port "3000", :jndi-path "jmxrmi"} overrides)] - (format "service:jmx:rmi:///jndi/rmi://%s:%s/%s" (opts :host) (opts :port) (opts :jndi-path))))) - -(defmulti as-object-name - "Interpret an object as a JMX ObjectName." - { :arglists '([string-or-name]) } - class) -(defmethod as-object-name String [n] (ObjectName. n)) -(defmethod as-object-name ObjectName [n] n) - -(defn composite-data->map [cd] - (into {} - (map (fn [attr] [(keyword attr) (jmx->clj (.get cd attr))]) - (.. cd getCompositeType keySet)))) - -(defn maybe-keywordize - "Convert a string key to a keyword, leaving other types alone. Used to - simplify keys in the tabular data API." - [s] - (if (string? s) (keyword s) s)) - -(defn maybe-atomize - "Convert a list of length 1 into its contents, leaving other things alone. - Used to simplify keys in the tabular data API." - [k] - (if (and (instance? java.util.List k) - (= 1 (count k))) - (first k) - k)) - -(defvar simplify-tabular-data-key - (comp maybe-keywordize maybe-atomize)) - -(defn tabular-data->map [td] - (into {} - ; the need for into-array here was a surprise, and may not - ; work for all examples. Are keys always arrays? - (map (fn [k] - [(simplify-tabular-data-key k) (jmx->clj (.get td (into-array k)))]) - (.keySet td)))) - -(defmulti jmx->clj - "Coerce JMX data structures into Clojure data. - Handles CompositeData, TabularData, maps, and atoms." - { :argslists '([jmx-data-structure]) } - (fn [x] - (cond - (instance? javax.management.openmbean.CompositeData x) :composite - (instance? javax.management.openmbean.TabularData x) :tabular - (instance? clojure.lang.Associative x) :map - :default :default))) -(defmethod jmx->clj :composite [c] (composite-data->map c)) -(defmethod jmx->clj :tabular [t] (tabular-data->map t)) -(defmethod jmx->clj :map [m] (into {} (zipmap (keys m) (map jmx->clj (vals m))))) -(defmethod jmx->clj :default [obj] obj) - -(def guess-attribute-map - {"java.lang.Integer" "int" - "java.lang.Boolean" "boolean" - "java.lang.Long" "long" - }) - -(defn guess-attribute-typename - "Guess the attribute typename for MBeanAttributeInfo based on the attribute value." - [value] - (let [classname (.getName (class value))] - (get guess-attribute-map classname classname))) - -(defn build-attribute-info - "Construct an MBeanAttributeInfo. Normally called with a key/value pair from a Clojure map." - ([attr-name attr-value] - (build-attribute-info - (as-str attr-name) - (guess-attribute-typename attr-value) - (as-str attr-name) true false false)) - ([name type desc readable? writable? is?] (MBeanAttributeInfo. name type desc readable? writable? is? ))) - -(defn map->attribute-infos - "Construct an MBeanAttributeInfo[] from a Clojure associative." - [attr-map] - (into-array (map (fn [[attr-name value]] (build-attribute-info attr-name value)) - attr-map))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/jmx/server.clj --- a/src/clojure/contrib/jmx/server.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -;; JMX server APIs for Clojure -;; docs in clojure/contrib/jmx.clj!! - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(in-ns 'clojure.contrib.jmx) - -(defn register-mbean [mbean mbean-name] - (.registerMBean *connection* mbean (as-object-name mbean-name))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/json.clj --- a/src/clojure/contrib/json.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,341 +0,0 @@ -;;; json.clj: JavaScript Object Notation (JSON) parser/writer - -;; by Stuart Sierra, http://stuartsierra.com/ -;; January 30, 2010 - -;; Copyright (c) Stuart Sierra, 2010. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns ^{:author "Stuart Sierra" - :doc "JavaScript Object Notation (JSON) parser/writer. - See http://www.json.org/ - To write JSON, use json-str, write-json, or write-json. - To read JSON, use read-json."} - clojure.contrib.json - (:use [clojure.contrib.pprint :only (write formatter-out)] - [clojure.contrib.string :only (as-str)]) - (:import (java.io PrintWriter PushbackReader StringWriter - StringReader Reader EOFException))) - -;;; JSON READER - -(declare read-json-reader) - -(defn- read-json-array [^PushbackReader stream keywordize?] - ;; Expects to be called with the head of the stream AFTER the - ;; opening bracket. - (loop [i (.read stream), result (transient [])] - (let [c (char i)] - (cond - (= i -1) (throw (EOFException. "JSON error (end-of-file inside array)")) - (Character/isWhitespace c) (recur (.read stream) result) - (= c \,) (recur (.read stream) result) - (= c \]) (persistent! result) - :else (do (.unread stream (int c)) - (let [element (read-json-reader stream keywordize? true nil)] - (recur (.read stream) (conj! result element)))))))) - -(defn- read-json-object [^PushbackReader stream keywordize?] - ;; Expects to be called with the head of the stream AFTER the - ;; opening bracket. - (loop [i (.read stream), key nil, result (transient {})] - (let [c (char i)] - (cond - (= i -1) (throw (EOFException. "JSON error (end-of-file inside object)")) - - (Character/isWhitespace c) (recur (.read stream) key result) - - (= c \,) (recur (.read stream) nil result) - - (= c \:) (recur (.read stream) key result) - - (= c \}) (if (nil? key) - (persistent! result) - (throw (Exception. "JSON error (key missing value in object)"))) - - :else (do (.unread stream i) - (let [element (read-json-reader stream keywordize? true nil)] - (if (nil? key) - (if (string? element) - (recur (.read stream) element result) - (throw (Exception. "JSON error (non-string key in object)"))) - (recur (.read stream) nil - (assoc! result (if keywordize? (keyword key) key) - element))))))))) - -(defn- read-json-hex-character [^PushbackReader stream] - ;; Expects to be called with the head of the stream AFTER the - ;; initial "\u". Reads the next four characters from the stream. - (let [digits [(.read stream) - (.read stream) - (.read stream) - (.read stream)]] - (when (some neg? digits) - (throw (EOFException. "JSON error (end-of-file inside Unicode character escape)"))) - (let [chars (map char digits)] - (when-not (every? #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9 \a \b \c \d \e \f \A \B \C \D \E \F} - chars) - (throw (Exception. "JSON error (invalid hex character in Unicode character escape)"))) - (char (Integer/parseInt (apply str chars) 16))))) - -(defn- read-json-escaped-character [^PushbackReader stream] - ;; Expects to be called with the head of the stream AFTER the - ;; initial backslash. - (let [c (char (.read stream))] - (cond - (#{\" \\ \/} c) c - (= c \b) \backspace - (= c \f) \formfeed - (= c \n) \newline - (= c \r) \return - (= c \t) \tab - (= c \u) (read-json-hex-character stream)))) - -(defn- read-json-quoted-string [^PushbackReader stream] - ;; Expects to be called with the head of the stream AFTER the - ;; opening quotation mark. - (let [buffer (StringBuilder.)] - (loop [i (.read stream)] - (let [c (char i)] - (cond - (= i -1) (throw (EOFException. "JSON error (end-of-file inside string)")) - (= c \") (str buffer) - (= c \\) (do (.append buffer (read-json-escaped-character stream)) - (recur (.read stream))) - :else (do (.append buffer c) - (recur (.read stream)))))))) - -(defn- read-json-reader - ([^PushbackReader stream keywordize? eof-error? eof-value] - (loop [i (.read stream)] - (let [c (char i)] - (cond - ;; Handle end-of-stream - (= i -1) (if eof-error? - (throw (EOFException. "JSON error (end-of-file)")) - eof-value) - - ;; Ignore whitespace - (Character/isWhitespace c) (recur (.read stream)) - - ;; Read numbers, true, and false with Clojure reader - (#{\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9} c) - (do (.unread stream i) - (read stream true nil)) - - ;; Read strings - (= c \") (read-json-quoted-string stream) - - ;; Read null as nil - (= c \n) (let [ull [(char (.read stream)) - (char (.read stream)) - (char (.read stream))]] - (if (= ull [\u \l \l]) - nil - (throw (Exception. (str "JSON error (expected null): " c ull))))) - - ;; Read true - (= c \t) (let [rue [(char (.read stream)) - (char (.read stream)) - (char (.read stream))]] - (if (= rue [\r \u \e]) - true - (throw (Exception. (str "JSON error (expected true): " c rue))))) - - ;; Read false - (= c \f) (let [alse [(char (.read stream)) - (char (.read stream)) - (char (.read stream)) - (char (.read stream))]] - (if (= alse [\a \l \s \e]) - false - (throw (Exception. (str "JSON error (expected false): " c alse))))) - - ;; Read JSON objects - (= c \{) (read-json-object stream keywordize?) - - ;; Read JSON arrays - (= c \[) (read-json-array stream keywordize?) - - :else (throw (Exception. (str "JSON error (unexpected character): " c)))))))) - -(defprotocol Read-JSON-From - (read-json-from [input keywordize? eof-error? eof-value] - "Reads one JSON value from input String or Reader. - If keywordize? is true, object keys will be converted to keywords. - If eof-error? is true, empty input will throw an EOFException; if - false EOF will return eof-value. ")) - -(extend-protocol - Read-JSON-From - String - (read-json-from [input keywordize? eof-error? eof-value] - (read-json-reader (PushbackReader. (StringReader. input)) - keywordize? eof-error? eof-value)) - PushbackReader - (read-json-from [input keywordize? eof-error? eof-value] - (read-json-reader input - keywordize? eof-error? eof-value)) - Reader - (read-json-from [input keywordize? eof-error? eof-value] - (read-json-reader (PushbackReader. input) - keywordize? eof-error? eof-value))) - -(defn read-json - "Reads one JSON value from input String or Reader. - If keywordize? is true (default), object keys will be converted to - keywords. If eof-error? is true (default), empty input will throw - an EOFException; if false EOF will return eof-value. " - ([input] - (read-json-from input true true nil)) - ([input keywordize?] - (read-json-from input keywordize? true nil)) - ([input keywordize? eof-error? eof-value] - (read-json-from input keywordize? eof-error? eof-value))) - - -;;; JSON PRINTER - -(defprotocol Write-JSON - (write-json [object out] - "Print object to PrintWriter out as JSON")) - -(defn- write-json-string [^CharSequence s ^PrintWriter out] - (let [sb (StringBuilder. ^Integer (count s))] - (.append sb \") - (dotimes [i (count s)] - (let [cp (Character/codePointAt s i)] - (cond - ;; Handle printable JSON escapes before ASCII - (= cp 34) (.append sb "\\\"") - (= cp 92) (.append sb "\\\\") - (= cp 47) (.append sb "\\/") - ;; Print simple ASCII characters - (< 31 cp 127) (.append sb (.charAt s i)) - ;; Handle non-printable JSON escapes - (= cp 8) (.append sb "\\b") - (= cp 12) (.append sb "\\f") - (= cp 10) (.append sb "\\n") - (= cp 13) (.append sb "\\r") - (= cp 9) (.append sb "\\t") - ;; Any other character is Hexadecimal-escaped - :else (.append sb (format "\\u%04x" cp))))) - (.append sb \") - (.print out (str sb)))) - -(defn- write-json-object [m ^PrintWriter out] - (.print out \{) - (loop [x m] - (when (seq m) - (let [[k v] (first x)] - (when (nil? k) - (throw (Exception. "JSON object keys cannot be nil/null"))) - (.print out \") - (.print out (as-str k)) - (.print out \") - (.print out \:) - (write-json v out)) - (let [nxt (next x)] - (when (seq nxt) - (.print out \,) - (recur nxt))))) - (.print out \})) - -(defn- write-json-array [s ^PrintWriter out] - (.print out \[) - (loop [x s] - (when (seq x) - (let [fst (first x) - nxt (next x)] - (write-json fst out) - (when (seq nxt) - (.print out \,) - (recur nxt))))) - (.print out \])) - -(defn- write-json-bignum [x ^PrintWriter out] - (.print out (str x))) - -(defn- write-json-plain [x ^PrintWriter out] - (.print out x)) - -(defn- write-json-null [x ^PrintWriter out] - (.print out "null")) - -(defn- write-json-named [x ^PrintWriter out] - (write-json-string (name x) out)) - -(defn- write-json-generic [x out] - (if (.isArray (class x)) - (write-json (seq x) out) - (throw (Exception. (str "Don't know how to write JSON of " (class x)))))) - -(extend nil Write-JSON - {:write-json write-json-null}) -(extend clojure.lang.Named Write-JSON - {:write-json write-json-named}) -(extend java.lang.Boolean Write-JSON - {:write-json write-json-plain}) -(extend java.lang.Number Write-JSON - {:write-json write-json-plain}) -(extend java.math.BigInteger Write-JSON - {:write-json write-json-bignum}) -(extend java.math.BigDecimal Write-JSON - {:write-json write-json-bignum}) -(extend java.lang.CharSequence Write-JSON - {:write-json write-json-string}) -(extend java.util.Map Write-JSON - {:write-json write-json-object}) -(extend java.util.Collection Write-JSON - {:write-json write-json-array}) -(extend clojure.lang.ISeq Write-JSON - {:write-json write-json-array}) -(extend java.lang.Object Write-JSON - {:write-json write-json-generic}) - -(defn json-str - "Converts x to a JSON-formatted string." - [x] - (let [sw (StringWriter.) - out (PrintWriter. sw)] - (write-json x out) - (.toString sw))) - -(defn print-json - "Write JSON-formatted output to *out*" - [x] - (write-json x *out*)) - - -;;; JSON PRETTY-PRINTER - -;; Based on code by Tom Faulhaber - -(defn- pprint-json-array [s] - ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s)) - -(defn- pprint-json-object [m] - ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") - (for [[k v] m] [(as-str k) v]))) - -(defn- pprint-json-generic [x] - (if (.isArray (class x)) - (pprint-json-array (seq x)) - (print (json-str x)))) - -(defn- pprint-json-dispatch [x] - (cond (nil? x) (print "null") - (instance? java.util.Map x) (pprint-json-object x) - (instance? java.util.Collection x) (pprint-json-array x) - (instance? clojure.lang.ISeq x) (pprint-json-array x) - :else (pprint-json-generic x))) - -(defn pprint-json - "Pretty-prints JSON representation of x to *out*" - [x] - (write x :dispatch pprint-json-dispatch)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/lazy_seqs.clj --- a/src/clojure/contrib/lazy_seqs.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,90 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; lazy-seqs -;; -;; == Lazy sequences == -;; -;; primes - based on the "naive" implemention described in [1] plus a -;; small "wheel" which eliminates multiples of 2, 3, 5, and -;; 7 from consideration by incrementing past them. Also inspired -;; by code from Christophe Grand in [2]. -;; -;; fibs - all the Fibonacci numbers -;; -;; powers-of-2 - all the powers of 2 -;; -;; == Lazy sequence functions == -;; -;; (partition-all, shuffle moved to clojure.core) -;; (rand-elt moved to clojure.core/rand-nth) -;; (rotations, moved to seq_utils.clj) -;; (permutations and combinations moved to combinatorics.clj) -;; -;; [1] http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf -;; [2] http://clj-me.blogspot.com/2008/06/primes.html -;; -;; scgilardi (gmail) -;; Created 07 June 2008 - -(ns - ^{:author "Stephen C. Gilardi", - :doc " -==== Lazy sequences ==== - - primes - based on the \"naive\" implemention described in [1] plus a - small \"wheel\" which eliminates multiples of 2, 3, 5, and - 7 from consideration by incrementing past them. Also inspired - by code from Christophe Grand in [2]. - - fibs - all the Fibonacci numbers - - powers-of-2 - all the powers of 2 - - ==== Lazy sequence functions ==== - - (partition-all, shuffle moved to clojure.core) - (rand-elt moved to clojure.core/rand-nth) - (rotations, rand-elt moved to seq_utils.clj) - (permutations and combinations moved to combinatorics.clj) - - [1] http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf - [2] http://clj-me.blogspot.com/2008/06/primes.html -"} - clojure.contrib.lazy-seqs - (:use clojure.contrib.def)) - -; primes cannot be written efficiently as a function, because -; it needs to look back on the whole sequence. contrast with -; fibs and powers-of-2 which only need a fixed buffer of 1 or 2 -; previous values. -(defvar primes - (concat - [2 3 5 7] - (lazy-seq - (let [primes-from - (fn primes-from [n [f & r]] - (if (some #(zero? (rem n %)) - (take-while #(<= (* % %) n) primes)) - (recur (+ n f) r) - (lazy-seq (cons n (primes-from (+ n f) r))))) - wheel (cycle [2 4 2 4 6 2 6 4 2 4 6 6 2 6 4 2 - 6 4 6 8 4 2 4 2 4 8 6 4 6 2 4 6 - 2 6 6 4 2 4 6 2 6 4 2 4 2 10 2 10])] - (primes-from 11 wheel)))) - "Lazy sequence of all the prime numbers.") - -(defn fibs - "Returns a lazy sequence of all the Fibonacci numbers." - [] - (map first (iterate (fn [[a b]] [b (+ a b)]) [0 1]))) - -(defn powers-of-2 - "Returns a lazy sequence of all the powers of 2" - [] - (iterate #(bit-shift-left % 1) 1)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/lazy_xml.clj --- a/src/clojure/contrib/lazy_xml.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,215 +0,0 @@ -; Copyright (c) Chris Houser, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Functions to parse xml lazily and emit back to text. - -(ns - ^{:author "Chris Houser", - :doc "Functions to parse xml lazily and emit back to text."} - clojure.contrib.lazy-xml - (:use [clojure.xml :as xml :only []] - [clojure.contrib.seq :only [fill-queue]]) - (:import (org.xml.sax Attributes InputSource) - (org.xml.sax.helpers DefaultHandler) - (javax.xml.parsers SAXParserFactory) - (java.util.concurrent LinkedBlockingQueue TimeUnit) - (java.lang.ref WeakReference) - (java.io Reader))) - -(defstruct node :type :name :attrs :str) - -; http://www.extreme.indiana.edu/xgws/xsoap/xpp/ -(def has-pull false) -(defn- parse-seq-pull [& _]) -(try - (load "lazy_xml/with_pull") - (catch Exception e - (when-not (re-find #"XmlPullParser" (str e)) - (throw e)))) - -(defn startparse-sax [s ch] - (.. SAXParserFactory newInstance newSAXParser (parse s ch))) - -(defn parse-seq - "Parses the source s, which can be a File, InputStream or String - naming a URI. Returns a lazy sequence of maps with two or more of - the keys :type, :name, :attrs, and :str. Other SAX-compatible - parsers can be supplied by passing startparse, a fn taking a source - and a ContentHandler and returning a parser. If a parser is - specified, it will be run in a separate thread and be allowed to get - ahead by queue-size items, which defaults to maxint. If no parser - is specified and org.xmlpull.v1.XmlPullParser is in the classpath, - this superior pull parser will be used." - ([s] (if has-pull - (parse-seq-pull s) - (parse-seq s startparse-sax))) - ([s startparse] (parse-seq s startparse Integer/MAX_VALUE)) - ([s startparse queue-size] - (let [s (if (instance? Reader s) (InputSource. s) s) - f (fn filler-func [fill] - (startparse s (proxy [DefaultHandler] [] - (startElement [uri local-name q-name ^Attributes atts] - ;(prn :start-element q-name)(flush) - (let [attrs (into {} (for [i (range (.getLength atts))] - [(keyword (.getQName atts i)) - (.getValue atts i)]))] - (fill (struct node :start-element (keyword q-name) attrs)))) - (endElement [uri local-name q-name] - ;(prn :end-element q-name)(flush) - (fill (struct node :end-element (keyword q-name)))) - (characters [ch start length] - ;(prn :characters)(flush) - (let [st (String. ch start length)] - (when (seq (.trim st)) - (fill (struct node :characters nil nil st))))))))] - (fill-queue f :queue-size queue-size)))) - - -(defstruct element :tag :attrs :content) -(declare mktree) - -(defn- siblings [coll] - (lazy-seq - (when-let [s (seq coll)] - (let [event (first s)] - (condp = (:type event) - :characters (cons (:str event) (siblings (rest s))) - :start-element (let [t (mktree s)] - (cons (first t) (siblings (rest t)))) - :end-element [(rest s)]))))) - -(defn- mktree - [[elem & events]] - (lazy-seq - (let [sibs (siblings events)] - ;(prn :elem elem) - (cons - (struct element (:name elem) (:attrs elem) (drop-last sibs)) - (lazy-seq (last sibs)))))) - -(defn parse-trim - "Parses the source s, which can be a File, InputStream or String - naming a URI. Returns a lazy tree of the clojure.xml/element - struct-map, which has the keys :tag, :attrs, and :content and - accessor fns tag, attrs, and content, with the whitespace trimmed - from around each content string. This format is compatible with what - clojure.xml/parse produces, except :content is a lazy seq instead of - a vector. Other SAX-compatible parsers can be supplied by passing - startparse, a fn taking a source and a ContentHandler and returning - a parser. If a parser is specified, it will be run in a separate - thread and be allowed to get ahead by queue-size items, which - defaults to maxing. If no parser is specified and - org.xmlpull.v1.XmlPullParser is in the classpath, this superior pull - parser will be used." - ([s] (first (mktree (parse-seq s)))) - ([s startparse queue-size] - (first (mktree (parse-seq s startparse queue-size))))) - -(defn attributes [e] - (let [v (vec (:attrs e))] - (reify org.xml.sax.Attributes - (getLength [_] (count v)) - (getURI [_ i] (namespace (key (v i)))) - (getLocalName [_ i] (name (key (v i)))) - (getQName [_ i] (name (key (v i)))) - (getValue [_ uri name] (get (:attrs e) name)) - (^String getValue [_ ^int i] (val (v i))) - (^String getType [_ ^int i] "CDATA")))) - -(defn- emit-element - "Recursively prints as XML text the element struct e. To have it - print extra whitespace like clojure.xml/emit, use the :pad true - option." - [e ^org.xml.sax.ContentHandler ch] - (if (instance? String e) - (.characters ch (.toCharArray ^String e) 0 (count e)) - (let [nspace (namespace (:tag e)) - qname (name (:tag e))] - (.startElement ch (or nspace "") qname qname (attributes e)) - (doseq [c (:content e)] - (emit-element c ch)) - (.endElement ch (or nspace "") qname qname)))) - - -(defn emit - [e & {:as opts}] - (let [content-handler (atom nil) - trans (-> (javax.xml.transform.TransformerFactory/newInstance) - .newTransformer)] - - (when (:indent opts) - (.setOutputProperty trans "indent" "yes") - (.setOutputProperty trans "{http://xml.apache.org/xslt}indent-amount" - (str (:indent opts)))) - - (when (contains? opts :xml-declaration) - (.setOutputProperty trans "omit-xml-declaration" - (if (:xml-declaration opts) "no" "yes"))) - - (when (:encoding opts) - (.setOutputProperty trans "encoding" (:encoding opts))) - - (.transform - trans - (javax.xml.transform.sax.SAXSource. - (reify org.xml.sax.XMLReader - (getContentHandler [_] @content-handler) - (setDTDHandler [_ handler]) - (setFeature [_ name value]) - (setProperty [_ name value]) - (setContentHandler [_ ch] (reset! content-handler ch)) - (^void parse [_ ^org.xml.sax.InputSource _] - (when @content-handler - (.startDocument @content-handler) - (emit-element e @content-handler) - (.endDocument @content-handler)))) - (org.xml.sax.InputSource.)) - (javax.xml.transform.stream.StreamResult. *out*)))) - -(comment - -(def atomstr " - - tag:blogger.com,1999:blog-28403206 - 2008-02-14T08:00:58.567-08:00 - n01senet - - - 1 - 2008-02-13 - clojure is the best lisp yet - Chouser - - - 2 - 2008-02-07 - experimenting with vnc - agriffis - - -") - -(def tree (parse-trim (java.io.StringReader. atomstr) - startparse-sax - 1)) -(println "\nsax") -(emit tree) - -(def tree (parse-trim (java.io.StringReader. atomstr))) -(println "\ndefault") -(emit tree) - -(def tree (xml/parse (org.xml.sax.InputSource. (java.io.StringReader. atomstr)))) -(println "\norig") -(emit tree) - -; When used with zip and zip-filter, you can get do queries like this -; without parsing more than the first few tags: -; (zip/node (first (xml-> (zip/xml-zip tree) :id))) - -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/lazy_xml/with_pull.clj --- a/src/clojure/contrib/lazy_xml/with_pull.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,58 +0,0 @@ -; Copyright (c) Chris Houser, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; optional module to allow lazy-xml to use pull parser instead of sax - -(in-ns 'clojure.contrib.lazy-xml) -(import '(org.xmlpull.v1 XmlPullParser XmlPullParserFactory)) - -(defn- attrs [xpp] - (for [i (range (.getAttributeCount xpp))] - [(keyword (.getAttributeName xpp i)) - (.getAttributeValue xpp i)])) - -(defn- ns-decs [xpp] - (let [d (.getDepth xpp)] - (for [i (range (.getNamespaceCount xpp (dec d)) (.getNamespaceCount xpp d))] - (let [prefix (.getNamespacePrefix xpp i)] - [(keyword (str "xmlns" (when prefix (str ":" prefix)))) - (.getNamespaceUri xpp i)])))) - -(defn- attr-hash [xpp] - (into {} (concat (ns-decs xpp) (attrs xpp)))) - -(defn- pull-step [xpp] - (let [step (fn [xpp] - (condp = (.next xpp) - XmlPullParser/START_TAG - (cons (struct node :start-element - (keyword (.getName xpp)) - (attr-hash xpp)) - (pull-step xpp)) - XmlPullParser/END_TAG - (cons (struct node :end-element - (keyword (.getName xpp))) - (pull-step xpp)) - XmlPullParser/TEXT - (let [text (.trim (.getText xpp))] - (if (empty? text) - (recur xpp) - (cons (struct node :characters nil nil text) - (pull-step xpp))))))] - (lazy-seq (step xpp)))) - -(def ^{:private true} factory - (doto (XmlPullParserFactory/newInstance) - (.setNamespaceAware true))) - -(defn- parse-seq-pull [s] - (let [xpp (.newPullParser factory)] - (.setInput xpp s) - (pull-step xpp))) - -(def has-pull true) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/logging.clj --- a/src/clojure/contrib/logging.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,343 +0,0 @@ -;;; logging.clj -- delegated logging for Clojure - -;; by Alex Taggart -;; July 27, 2009 - -;; Copyright (c) Alex Taggart, July 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. -(ns - ^{:author "Alex Taggart, Timothy Pratley", - :doc - "Logging macros which delegate to a specific logging implementation. At - runtime a specific implementation is selected from, in order, Apache - commons-logging, log4j, and finally java.util.logging. - - Logging levels are specified by clojure keywords corresponding to the - values used in log4j and commons-logging: - :trace, :debug, :info, :warn, :error, :fatal - - Logging occurs with the log macro, or the level-specific convenience macros, - which write either directly or via an agent. For performance reasons, direct - logging is enabled by default, but setting the *allow-direct-logging* boolean - atom to false will disable it. If logging is invoked within a transaction it - will always use an agent. - - The log macros will not evaluate their 'message' unless the specific logging - level is in effect. Alternately, you can use the spy macro when you have code - that needs to be evaluated, and also want to output the code and its result to - the debug log. - - Unless otherwise specified, the current namespace (as identified by *ns*) will - be used as the log-ns (similar to how the java class name is usually used). - Note: your log configuration should display the name that was passed to the - logging implementation, and not perform stack-inspection, otherwise you'll see - something like \"fn__72$impl_write_BANG__39__auto____81\" in your logs. - - Use the enabled? macro to write conditional code against the logging level - (beyond simply whether or not to call log, which is handled automatically). - - You can redirect all java writes of System.out and System.err to the log - system by calling log-capture!. To rebind *out* and *err* to the log system - invoke with-logs. In both cases a log-ns (e.g., \"com.example.captured\") - needs to be specified to namespace the output."} - clojure.contrib.logging) - -(declare *impl-name* impl-get-log impl-enabled? impl-write!) - -;; Macros used so that implementation-specific functions all have the same meta. - -(defmacro def-impl-name - {:private true} [& body] - `(def - ^{:doc "The name of the logging implementation used."} - *impl-name* - ~@body)) - -(defmacro def-impl-get-log - {:private true} [& body] - `(def - ^{:doc - "Returns an implementation-specific log by string namespace. End-users should - not need to call this." - :arglist '([~'log-ns])} - impl-get-log - (memoize ~@body))) - -(defmacro def-impl-enabled? - {:private true} [& body] - `(def - ^{:doc - "Implementation-specific check if a particular level is enabled. End-users - should not need to call this." - :arglist '([~'log ~'level])} - impl-enabled? - ~@body)) - -(defmacro def-impl-write! - {:private true} [& body] - `(def - ^{:doc - "Implementation-specific write of a log message. End-users should not need to - call this." - :arglist '([~'log ~'level ~'message ~'throwable])} - impl-write! - ~@body)) - -(defn- commons-logging - "Defines the commons-logging-based implementations of the core logging - functions. End-users should never need to call this." - [] - (try - (import (org.apache.commons.logging LogFactory Log)) - (eval - `(do - (def-impl-name "org.apache.commons.logging") - (def-impl-get-log - (fn [log-ns#] - (org.apache.commons.logging.LogFactory/getLog ^String log-ns#))) - (def-impl-enabled? - (fn [^org.apache.commons.logging.Log log# level#] - (condp = level# - :trace (.isTraceEnabled log#) - :debug (.isDebugEnabled log#) - :info (.isInfoEnabled log#) - :warn (.isWarnEnabled log#) - :error (.isErrorEnabled log#) - :fatal (.isFatalEnabled log#)))) - (def-impl-write! - (fn [^org.apache.commons.logging.Log log# level# msg# e#] - (condp = level# - :trace (.trace log# msg# e#) - :debug (.debug log# msg# e#) - :info (.info log# msg# e#) - :warn (.warn log# msg# e#) - :error (.error log# msg# e#) - :fatal (.fatal log# msg# e#)))) - true)) - (catch Exception e nil))) - - -(defn- log4j-logging - "Defines the log4j-based implementations of the core logging functions. - End-users should never need to call this." - [] - (try - (import (org.apache.log4j Logger Level)) - (eval - '(do - (def-impl-name "org.apache.log4j") - (def-impl-get-log - (fn [log-ns#] - (org.apache.log4j.Logger/getLogger ^String log-ns#))) - (let [levels# {:trace org.apache.log4j.Level/TRACE - :debug org.apache.log4j.Level/DEBUG - :info org.apache.log4j.Level/INFO - :warn org.apache.log4j.Level/WARN - :error org.apache.log4j.Level/ERROR - :fatal org.apache.log4j.Level/FATAL}] - (def-impl-enabled? - (fn [^org.apache.log4j.Logger log# level#] - (.isEnabledFor log# (levels# level#)))) - (def-impl-write! - (fn [^org.apache.log4j.Logger log# level# msg# e#] - (if-not e# - (.log log# (levels# level#) msg#) - (.log log# (levels# level#) msg# e#))))) - true)) - (catch Exception e nil))) - - -(defn- java-logging - "Defines the java-logging-based implementations of the core logging - functions. End-users should never need to call this." - [] - (try - (import (java.util.logging Logger Level)) - (eval - `(do - (def-impl-name "java.util.logging") - (def-impl-get-log - (fn [log-ns#] - (java.util.logging.Logger/getLogger log-ns#))) - (let [levels# {:trace java.util.logging.Level/FINEST - :debug java.util.logging.Level/FINE - :info java.util.logging.Level/INFO - :warn java.util.logging.Level/WARNING - :error java.util.logging.Level/SEVERE - :fatal java.util.logging.Level/SEVERE}] - (def-impl-enabled? - (fn [^java.util.logging.Logger log# level#] - (.isLoggable log# (levels# level#)))) - (def-impl-write! - (fn [^java.util.logging.Logger log# level# msg# e#] - (if-not e# - (.log log# ^java.util.logging.Level (levels# level#) - ^String (str msg#)) - (.log log# ^java.util.logging.Level (levels# level#) - ^String (str msg#) ^Throwable e#))))) - true)) - (catch Exception e nil))) - - -;; Initialize implementation-specific functions -(or (commons-logging) - (log4j-logging) - (java-logging) - (throw ; this should never happen in 1.5+ - (RuntimeException. - "Valid logging implementation could not be found."))) - - -(def ^{:doc - "The default agent used for performing logging durng a transaction or when - direct logging is disabled."} - *logging-agent* (agent nil)) - - -(def ^{:doc - "A boolean indicating whether direct logging (as opposed to via an agent) is - allowed when not operating from within a transaction. Defaults to true."} - *allow-direct-logging* (atom true)) - - -(defmacro log - "Logs a message, either directly or via an agent. Also see the level-specific - convenience macros." - ([level message] - `(log ~level ~message nil)) - ([level message throwable] - `(log ~level ~message ~throwable ~(str *ns*))) - ([level message throwable log-ns] - `(let [log# (impl-get-log ~log-ns)] - (if (impl-enabled? log# ~level) - (if (and @*allow-direct-logging* - (not (clojure.lang.LockingTransaction/isRunning))) - (impl-write! log# ~level ~message ~throwable) - (send-off *logging-agent* - (fn [_# l# v# m# t#] (impl-write! l# v# m# t#)) - log# ~level ~message ~throwable)))))) - - -(defmacro enabled? - "Returns true if the specific logging level is enabled. Use of this function - should only be necessary if one needs to execute alternate code paths beyond - whether the log should be written to." - ([level] - `(enabled? ~level ~(str *ns*))) - ([level log-ns] - `(impl-enabled? (impl-get-log ~log-ns) ~level))) - - -(defmacro spy - "Evaluates expr and outputs the form and its result to the debug log; returns - the result of expr." - [expr] - `(let [a# ~expr] (log :debug (str '~expr " => " a#)) a#)) - - -(defn log-stream - "Creates a PrintStream that will output to the log. End-users should not need - to invoke this." - [level log-ns] - (java.io.PrintStream. - (proxy [java.io.ByteArrayOutputStream] [] - (flush [] - (proxy-super flush) - (let [s (.trim (.toString ^java.io.ByteArrayOutputStream this))] - (proxy-super reset) - (if (> (.length s) 0) - (log level s nil log-ns))))) - true)) - - -(def ^{:doc - "A ref used by log-capture! to maintain a reference to the original System.out - and System.err streams." - :private true} - *old-std-streams* (ref nil)) - - -(defn log-capture! - "Captures System.out and System.err, redirecting all writes of those streams - to :info and :error logging, respectively. The specified log-ns value will - be used to namespace all redirected logging. NOTE: this will not redirect - output of *out* or *err*; for that, use with-logs." - [log-ns] - (dosync - (let [new-out (log-stream :info log-ns) - new-err (log-stream :error log-ns)] - ; don't overwrite the original values - (if (nil? @*old-std-streams*) - (ref-set *old-std-streams* {:out System/out :err System/err})) - (System/setOut new-out) - (System/setErr new-err)))) - - -(defn log-uncapture! - "Restores System.out and System.err to their original values." - [] - (dosync - (when-let [{old-out :out old-err :err} @*old-std-streams*] - (ref-set *old-std-streams* nil) - (System/setOut old-out) - (System/setErr old-err)))) - - -(defmacro with-logs - "Evaluates exprs in a context in which *out* and *err* are bound to :info and - :error logging, respectively. The specified log-ns value will be used to - namespace all redirected logging." - [log-ns & body] - (if (and log-ns (seq body)) - `(binding [*out* (java.io.OutputStreamWriter. - (log-stream :info ~log-ns)) - *err* (java.io.OutputStreamWriter. - (log-stream :error ~log-ns))] - ~@body))) - -(defmacro trace - "Logs a message at the trace level." - ([message] - `(log :trace ~message)) - ([message throwable] - `(log :trace ~message ~throwable))) - -(defmacro debug - "Logs a message at the debug level." - ([message] - `(log :debug ~message)) - ([message throwable] - `(log :debug ~message ~throwable))) - -(defmacro info - "Logs a message at the info level." - ([message] - `(log :info ~message)) - ([message throwable] - `(log :info ~message ~throwable))) - -(defmacro warn - "Logs a message at the warn level." - ([message] - `(log :warn ~message)) - ([message throwable] - `(log :warn ~message ~throwable))) - -(defmacro error - "Logs a message at the error level." - ([message] - `(log :error ~message)) - ([message throwable] - `(log :error ~message ~throwable))) - -(defmacro fatal - "Logs a message at the fatal level." - ([message] - `(log :fatal ~message)) - ([message throwable] - `(log :fatal ~message ~throwable))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/macro_utils.clj --- a/src/clojure/contrib/macro_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,270 +0,0 @@ -;; Macrolet and symbol-macrolet - -;; by Konrad Hinsen -;; last updated January 14, 2010 - -;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Local macros and symbol macros - - Local macros are defined by a macrolet form. They are usable only - inside its body. Symbol macros can be defined globally - (defsymbolmacro) or locally (symbol-macrolet). A symbol - macro defines a form that replaces a symbol during macro - expansion. Function arguments and symbols bound in let - forms are not subject to symbol macro expansion. - - Local macros are most useful in the definition of the expansion - of another macro, they may be used anywhere. Global symbol - macros can be used only inside a with-symbol-macros form."} - clojure.contrib.macro-utils - (:use [clojure.contrib.def :only (defvar-)])) - -; A set of all special forms. Special forms are not macro-expanded, making -; it impossible to shadow them by macro definitions. For most special -; forms, all the arguments are simply macro-expanded, but some forms -; get special treatment. -(defvar- special-forms - (into #{} (keys clojure.lang.Compiler/specials))) -; Value in the Clojure 1.2 branch: -; #{deftype* new quote & var set! monitor-enter recur . case* clojure.core/import* reify* do fn* throw monitor-exit letfn* finally let* loop* try catch if def} - -; The following three vars are constantly redefined using the binding -; form, imitating dynamic scoping. -; -; Local macros. -(defvar- macro-fns {}) -; Local symbol macros. -(defvar- macro-symbols {}) -; Symbols defined inside let forms or function arguments. -(defvar- protected-symbols #{}) - -(defn- reserved? - [symbol] - "Return true if symbol is a reserved symbol (starting or ending with a dot)." - (let [s (str symbol)] - (or (= "." (subs s 0 1)) - (= "." (subs s (dec (count s))))))) - -(defn- expand-symbol - "Expand symbol macros" - [symbol] - (cond (contains? protected-symbols symbol) symbol - (reserved? symbol) symbol - (contains? macro-symbols symbol) (get macro-symbols symbol) - :else (let [v (resolve symbol) - m (meta v)] - (if (:symbol-macro m) - (var-get v) - symbol)))) - -(defn- expand-1 - "Perform a single non-recursive macro expansion of form." - [form] - (cond - (seq? form) - (let [f (first form)] - (cond (contains? special-forms f) form - (contains? macro-fns f) (apply (get macro-fns f) (rest form)) - (symbol? f) (let [exp (expand-symbol f)] - (if (= exp f) - (clojure.core/macroexpand-1 form) - (cons exp (rest form)))) - ; handle defmacro macros and Java method special forms - :else (clojure.core/macroexpand-1 form))) - (symbol? form) - (expand-symbol form) - :else - form)) - -(defn- expand - "Perform repeated non-recursive macro expansion of form, until it no - longer changes." - [form] - (let [ex (expand-1 form)] - (if (identical? ex form) - form - (recur ex)))) - -(declare expand-all) - -(defn- expand-args - "Recursively expand the arguments of form, leaving its first - n elements unchanged." - ([form] - (expand-args form 1)) - ([form n] - (doall (concat (take n form) (map expand-all (drop n form)))))) - -(defn- expand-bindings - [bindings exprs] - (if (empty? bindings) - (list (doall (map expand-all exprs))) - (let [[[s b] & bindings] bindings] - (let [b (expand-all b)] - (binding [protected-symbols (conj protected-symbols s)] - (doall (cons [s b] (expand-bindings bindings exprs)))))))) - -(defn- expand-with-bindings - "Handle let* and loop* forms. The symbols defined in them are protected - from symbol macro expansion, the definitions and the body expressions - are expanded recursively." - [form] - (let [f (first form) - bindings (partition 2 (second form)) - exprs (rest (rest form)) - expanded (expand-bindings bindings exprs) - bindings (vec (apply concat (butlast expanded))) - exprs (last expanded)] - (cons f (cons bindings exprs)))) - -(defn- expand-fn-body - [[args & exprs]] - (binding [protected-symbols (reduce conj protected-symbols - (filter #(not (= % '&)) args))] - (cons args (doall (map expand-all exprs))))) - -(defn- expand-fn - "Handle fn* forms. The arguments are protected from symbol macro - expansion, the bodies are expanded recursively." - [form] - (let [[f & bodies] form - name (when (symbol? (first bodies)) (first bodies)) - bodies (if (symbol? (first bodies)) (rest bodies) bodies) - bodies (if (vector? (first bodies)) (list bodies) bodies) - bodies (doall (map expand-fn-body bodies))] - (if (nil? name) - (cons f bodies) - (cons f (cons name bodies))))) - -(defn- expand-method - "Handle a method in a deftype* or reify* form." - [m] - (rest (expand-fn (cons 'fn* m)))) - -(defn- expand-deftype - "Handle deftype* forms." - [[symbol typename classname fields implements interfaces & methods]] - (assert (= implements :implements)) - (let [expanded-methods (map expand-method methods)] - (concat - (list symbol typename classname fields implements interfaces) - expanded-methods))) - -(defn- expand-reify - "Handle reify* forms." - [[symbol interfaces & methods]] - (let [expanded-methods (map expand-method methods)] - (cons symbol (cons interfaces expanded-methods)))) - -; Handlers for special forms that require special treatment. The default -; is expand-args. -(defvar- special-form-handlers - {'quote identity - 'var identity - 'def #(expand-args % 2) - 'new #(expand-args % 2) - 'let* expand-with-bindings - 'loop* expand-with-bindings - 'fn* expand-fn - 'deftype* expand-deftype - 'reify* expand-reify}) - -(defn- expand-list - "Recursively expand a form that is a list or a cons." - [form] - (let [f (first form)] - (if (symbol? f) - (if (contains? special-forms f) - ((get special-form-handlers f expand-args) form) - (expand-args form)) - (doall (map expand-all form))))) - -(defn- expand-all - "Expand a form recursively." - [form] - (let [exp (expand form)] - (cond (symbol? exp) exp - (seq? exp) (expand-list exp) - (vector? exp) (into [] (map expand-all exp)) - (map? exp) (into {} (map expand-all (seq exp))) - :else exp))) - -(defmacro macrolet - "Define local macros that are used in the expansion of exprs. The - syntax is the same as for letfn forms." - [fn-bindings & exprs] - (let [names (map first fn-bindings) - name-map (into {} (map (fn [n] [(list 'quote n) n]) names)) - macro-map (eval `(letfn ~fn-bindings ~name-map))] - (binding [macro-fns (merge macro-fns macro-map) - macro-symbols (apply dissoc macro-symbols names)] - `(do ~@(doall (map expand-all exprs)))))) - -(defmacro symbol-macrolet - "Define local symbol macros that are used in the expansion of exprs. - The syntax is the same as for let forms." - [symbol-bindings & exprs] - (let [symbol-map (into {} (map vec (partition 2 symbol-bindings))) - names (keys symbol-map)] - (binding [macro-fns (apply dissoc macro-fns names) - macro-symbols (merge macro-symbols symbol-map)] - `(do ~@(doall (map expand-all exprs)))))) - -(defmacro defsymbolmacro - "Define a symbol macro. Because symbol macros are not part of - Clojure's built-in macro expansion system, they can be used only - inside a with-symbol-macros form." - [symbol expansion] - (let [meta-map (if (meta symbol) (meta symbol) {}) - meta-map (assoc meta-map :symbol-macro true)] - `(def ~(with-meta symbol meta-map) (quote ~expansion)))) - -(defmacro with-symbol-macros - "Fully expand exprs, including symbol macros." - [& exprs] - `(do ~@(doall (map expand-all exprs)))) - -(defmacro deftemplate - "Define a macro that expands into forms after replacing the - symbols in params (a vector) by the corresponding parameters - given in the macro call." - [name params & forms] - (let [param-map (for [p params] (list (list 'quote p) (gensym))) - template-params (vec (map second param-map)) - param-map (vec (apply concat param-map)) - expansion (list 'list (list 'quote `symbol-macrolet) param-map - (list 'quote (cons 'do forms)))] - `(defmacro ~name ~template-params ~expansion))) - -(defn mexpand-1 - "Like clojure.core/macroexpand-1, but takes into account symbol macros." - [form] - (binding [macro-fns {} - macro-symbols {} - protected-symbols #{}] - (expand-1 form))) - -(defn mexpand - "Like clojure.core/macroexpand, but takes into account symbol macros." - [form] - (binding [macro-fns {} - macro-symbols {} - protected-symbols #{}] - (expand form))) - -(defn mexpand-all - "Perform a full recursive macro expansion of a form." - [form] - (binding [macro-fns {} - macro-symbols {} - protected-symbols #{}] - (expand-all form))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/macros.clj --- a/src/clojure/contrib/macros.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,84 +0,0 @@ -;; Various useful macros -;; -;; Everybody is invited to add their own little macros here! -;; -;; The use and distribution terms for this software are covered by the -;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Various small macros"} - clojure.contrib.macros) - -;; By Konrad Hinsen -(defmacro const - "Evaluate the constant expression expr at compile time." - [expr] - (eval expr)) - -;; By Konrad Hinsen -; This macro is made obsolete by Clojure's built-in letfn. I renamed it to -; letfn- (to avoid a name clash) but leave it in for a while, since its -; syntax is not quite the same as Clojure's. Expect this to disappear -; in the long run! -(defmacro letfn- - "OBSOLETE: use clojure.core/letfn - A variant of let for local function definitions. fn-bindings consists - of name/args/body triples, with (letfn [name args body] ...) - being equivalent to (let [name (fn name args body)] ...)." - [fn-bindings & exprs] - (let [makefn (fn [[name args body]] (list name (list 'fn name args body))) - fns (vec (apply concat (map makefn (partition 3 fn-bindings))))] - `(let ~fns ~@exprs))) - - ;; By Konrad Hinsen - - (defn- unqualified-symbol - [s] - (let [s-str (str s)] - (symbol (subs s-str (inc (.indexOf s-str (int \/))))))) - -(defn- bound-var? - [var] - (try - (do (deref var) true) - (catch java.lang.IllegalStateException e false))) - -(defn- fns-from-ns - [ns ns-symbol] - (apply concat - (for [[k v] (ns-publics ns) - :when (and (bound-var? v) - (fn? @v) - (not (:macro (meta v))))] - [k (symbol (str ns-symbol) (str k))]))) - -(defn- expand-symbol - [ns-or-var-sym] - (if (= ns-or-var-sym '*ns*) - (fns-from-ns *ns* (ns-name *ns*)) - (if-let [ns (find-ns ns-or-var-sym)] - (fns-from-ns ns ns-or-var-sym) - (list (unqualified-symbol ns-or-var-sym) ns-or-var-sym)))) - -(defmacro with-direct-linking - "EXPERIMENTAL! - Compiles the functions in body with direct links to the functions - named in symbols, i.e. without a var lookup for each invocation. - Symbols is a vector of symbols that name either vars or namespaces. - A namespace reference is replaced by the list of all symbols in the - namespace that are bound to functions. If symbols is not provided, - the default value ['clojure.core] is used. The symbol *ns* can be - used to refer to the current namespace." - {:arglists '([symbols? & body])} - [& body] - (let [[symbols body] (if (vector? (first body)) - [(first body) (rest body)] - [['clojure.core] body]) - bindings (vec (mapcat expand-symbol symbols))] - `(let ~bindings ~@body))) - \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/map_utils.clj --- a/src/clojure/contrib/map_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -;; Copyright (c) Jason Wolfe. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; map_utils.clj -;; -;; Utilities for operating on Clojure maps. -;; -;; jason at w01fe dot com -;; Created 25 Feb 2009 - -(ns - ^{:author "Jason Wolfe, Chris Houser", - :doc "Utilities for operating on Clojure maps."} - clojure.contrib.map-utils) - - -(defmacro lazy-get - "Like get, but doesn't evaluate not-found unless it is needed." - [map key not-found] - `(if-let [pair# (find ~map ~key)] - (val pair#) - ~not-found)) - -(defn safe-get - "Like get, but throws an exception if the key is not found." - [map key] - (lazy-get map key - (throw (IllegalArgumentException. (format "Key %s not found in %s" key map))))) - -(defn safe-get-in - "Like get-in, but throws an exception if any key is not found." - [map ks] - (reduce safe-get map ks)) - -; by Chouser: -(defn deep-merge-with - "Like merge-with, but merges maps recursively, applying the given fn - only when there's a non-map at a particular level. - - (deepmerge + {:a {:b {:c 1 :d {:x 1 :y 2}} :e 3} :f 4} - {:a {:b {:c 2 :d {:z 9} :z 3} :e 100}}) - -> {:a {:b {:z 3, :c 3, :d {:z 9, :x 1, :y 2}}, :e 103}, :f 4}" - [f & maps] - (apply - (fn m [& maps] - (if (every? map? maps) - (apply merge-with m maps) - (apply f maps))) - maps)) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/math.clj --- a/src/clojure/contrib/math.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,247 +0,0 @@ -;;; math.clj: math functions that deal intelligently with the various -;;; types in Clojure's numeric tower, as well as math functions -;;; commonly found in Scheme implementations. - -;; by Mark Engelberg (mark.engelberg@gmail.com) -;; January 17, 2009 - -;; expt - (expt x y) is x to the yth power, returns an exact number -;; if the base is an exact number, and the power is an integer, -;; otherwise returns a double. -;; abs - (abs n) is the absolute value of n -;; gcd - (gcd m n) returns the greatest common divisor of m and n -;; lcm - (lcm m n) returns the least common multiple of m and n - -;; The behavior of the next three functions on doubles is consistent -;; with the behavior of the corresponding functions -;; in Java's Math library, but on exact numbers, returns an integer. - -;; floor - (floor n) returns the greatest integer less than or equal to n. -;; If n is an exact number, floor returns an integer, -;; otherwise a double. -;; ceil - (ceil n) returns the least integer greater than or equal to n. -;; If n is an exact number, ceil returns an integer, -;; otherwise a double. -;; round - (round n) rounds to the nearest integer. -;; round always returns an integer. round rounds up for values -;; exactly in between two integers. - - -;; sqrt - Implements the sqrt behavior I'm accustomed to from PLT Scheme, -;; specifically, if the input is an exact number, and is a square -;; of an exact number, the output will be exact. The downside -;; is that for the common case (inexact square root), some extra -;; computation is done to look for an exact square root first. -;; So if you need blazingly fast square root performance, and you -;; know you're just going to need a double result, you're better -;; off calling java's Math/sqrt, or alternatively, you could just -;; convert your input to a double before calling this sqrt function. -;; If Clojure ever gets complex numbers, then this function will -;; need to be updated (so negative inputs yield complex outputs). -;; exact-integer-sqrt - Implements a math function from the R6RS Scheme -;; standard. (exact-integer-sqrt k) where k is a non-negative integer, -;; returns [s r] where k = s^2+r and k < (s+1)^2. In other words, it -;; returns the floor of the square root and the "remainder". - -(ns - ^{:author "Mark Engelberg", - :doc "Math functions that deal intelligently with the various -types in Clojure's numeric tower, as well as math functions -commonly found in Scheme implementations. - -expt - (expt x y) is x to the yth power, returns an exact number - if the base is an exact number, and the power is an integer, - otherwise returns a double. -abs - (abs n) is the absolute value of n -gcd - (gcd m n) returns the greatest common divisor of m and n -lcm - (lcm m n) returns the least common multiple of m and n - -The behavior of the next three functions on doubles is consistent -with the behavior of the corresponding functions -in Java's Math library, but on exact numbers, returns an integer. - -floor - (floor n) returns the greatest integer less than or equal to n. - If n is an exact number, floor returns an integer, - otherwise a double. -ceil - (ceil n) returns the least integer greater than or equal to n. - If n is an exact number, ceil returns an integer, - otherwise a double. -round - (round n) rounds to the nearest integer. - round always returns an integer. round rounds up for values - exactly in between two integers. - - -sqrt - Implements the sqrt behavior I'm accustomed to from PLT Scheme, - specifically, if the input is an exact number, and is a square - of an exact number, the output will be exact. The downside - is that for the common case (inexact square root), some extra - computation is done to look for an exact square root first. - So if you need blazingly fast square root performance, and you - know you're just going to need a double result, you're better - off calling java's Math/sqrt, or alternatively, you could just - convert your input to a double before calling this sqrt function. - If Clojure ever gets complex numbers, then this function will - need to be updated (so negative inputs yield complex outputs). -exact-integer-sqrt - Implements a math function from the R6RS Scheme - standard. (exact-integer-sqrt k) where k is a non-negative integer, - returns [s r] where k = s^2+r and k < (s+1)^2. In other words, it - returns the floor of the square root and the "remainder". -"} - clojure.contrib.math) - -(derive ::integer ::exact) -(derive java.lang.Integer ::integer) -(derive java.math.BigInteger ::integer) -(derive java.lang.Long ::integer) -(derive java.math.BigDecimal ::exact) -(derive clojure.lang.Ratio ::exact) -(derive java.lang.Double ::inexact) -(derive java.lang.Float ::inexact) - -(defmulti ^{:arglists '([base pow]) - :doc "(expt base pow) is base to the pow power. -Returns an exact number if the base is an exact number and the power is an integer, otherwise returns a double."} - expt (fn [x y] [(class x) (class y)])) - -(defn- expt-int [base pow] - (loop [n pow, y (num 1), z base] - (let [t (bit-and n 1), n (bit-shift-right n 1)] - (cond - (zero? t) (recur n y (* z z)) - (zero? n) (* z y) - :else (recur n (* z y) (* z z)))))) - -(defmethod expt [::exact ::integer] [base pow] - (cond - (pos? pow) (expt-int base pow) - (zero? pow) 1 - :else (/ 1 (expt-int base (- pow))))) - -(defmethod expt :default [base pow] (Math/pow base pow)) - -(defn abs "(abs n) is the absolute value of n" [n] - (cond - (not (number? n)) (throw (IllegalArgumentException. - "abs requires a number")) - (neg? n) (- n) - :else n)) - -(defmulti ^{:arglists '([n]) - :doc "(floor n) returns the greatest integer less than or equal to n. -If n is an exact number, floor returns an integer, otherwise a double."} - floor class) -(defmethod floor ::integer [n] n) -(defmethod floor java.math.BigDecimal [n] (.. n (setScale 0 BigDecimal/ROUND_FLOOR) (toBigInteger))) -(defmethod floor clojure.lang.Ratio [n] - (if (pos? n) (quot (. n numerator) (. n denominator)) - (dec (quot (. n numerator) (. n denominator))))) -(defmethod floor :default [n] - (Math/floor n)) - -(defmulti ^{:arglists '([n]) - :doc "(ceil n) returns the least integer greater than or equal to n. -If n is an exact number, ceil returns an integer, otherwise a double."} - ceil class) -(defmethod ceil ::integer [n] n) -(defmethod ceil java.math.BigDecimal [n] (.. n (setScale 0 BigDecimal/ROUND_CEILING) (toBigInteger))) -(defmethod ceil clojure.lang.Ratio [n] - (if (pos? n) (inc (quot (. n numerator) (. n denominator))) - (quot (. n numerator) (. n denominator)))) -(defmethod ceil :default [n] - (Math/ceil n)) - -(defmulti ^{:arglists '([n]) - :doc "(round n) rounds to the nearest integer. -round always returns an integer. Rounds up for values exactly in between two integers."} - round class) -(defmethod round ::integer [n] n) -(defmethod round java.math.BigDecimal [n] (floor (+ n 0.5M))) -(defmethod round clojure.lang.Ratio [n] (floor (+ n 1/2))) -(defmethod round :default [n] (Math/round n)) - -(defn gcd "(gcd a b) returns the greatest common divisor of a and b" [a b] - (if (or (not (integer? a)) (not (integer? b))) - (throw (IllegalArgumentException. "gcd requires two integers")) - (loop [a (abs a) b (abs b)] - (if (zero? b) a, - (recur b (mod a b)))))) - -(defn lcm - "(lcm a b) returns the least common multiple of a and b" - [a b] - (when (or (not (integer? a)) (not (integer? b))) - (throw (IllegalArgumentException. "lcm requires two integers"))) - (cond (zero? a) 0 - (zero? b) 0 - :else (abs (* b (quot a (gcd a b)))))) - -; Length of integer in binary, used as helper function for sqrt. -(defmulti ^{:private true} integer-length class) -(defmethod integer-length java.lang.Integer [n] - (count (Integer/toBinaryString n))) -(defmethod integer-length java.lang.Long [n] - (count (Long/toBinaryString n))) -(defmethod integer-length java.math.BigInteger [n] - (count (. n toString 2))) - -;; Produces the largest integer less than or equal to the square root of n -;; Input n must be a non-negative integer -(defn- integer-sqrt [n] - (cond - (> n 24) - (let [n-len (integer-length n)] - (loop [init-value (if (even? n-len) - (bit-shift-left 1 (bit-shift-right n-len 1)) - (bit-shift-left 2 (bit-shift-right n-len 1)))] - (let [iterated-value (bit-shift-right (+ init-value (quot n init-value)) 1)] - (if (>= iterated-value init-value) - init-value - (recur iterated-value))))) - (> n 15) 4 - (> n 8) 3 - (> n 3) 2 - (> n 0) 1 - (> n -1) 0)) - -(defn exact-integer-sqrt "(exact-integer-sqrt n) expects a non-negative integer n, and returns [s r] where n = s^2+r and n < (s+1)^2. In other words, it returns the floor of the square root and the 'remainder'. -For example, (exact-integer-sqrt 15) is [3 6] because 15 = 3^2+6." - [n] - (if (or (not (integer? n)) (neg? n)) - (throw (IllegalArgumentException. "exact-integer-sqrt requires a non-negative integer")) - (let [isqrt (integer-sqrt n), - error (- n (* isqrt isqrt))] - [isqrt error]))) - -(defmulti ^{:arglists '([n]) - :doc "Square root, but returns exact number if possible."} - sqrt class) -(defmethod sqrt ::integer [n] - (if (neg? n) Double/NaN - (let [isqrt (integer-sqrt n), - error (- n (* isqrt isqrt))] - (if (zero? error) isqrt - (Math/sqrt n))))) - -(defmethod sqrt clojure.lang.Ratio [n] - (if (neg? n) Double/NaN - (let [numerator (.numerator n), - denominator (.denominator n), - sqrtnum (sqrt numerator)] - (if (float? sqrtnum) - (Math/sqrt n) - (let [sqrtden (sqrt denominator)] - (if (float? sqrtnum) - (Math/sqrt n) - (/ sqrtnum sqrtden))))))) - -(defmethod sqrt java.math.BigDecimal [n] - (if (neg? n) Double/NaN - (let [frac (rationalize n), - sqrtfrac (sqrt frac)] - (if (ratio? sqrtfrac) - (/ (BigDecimal. (.numerator sqrtfrac)) - (BigDecimal. (.denominator sqrtfrac))) - sqrtfrac)))) - -(defmethod sqrt :default [n] - (Math/sqrt n)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/miglayout.clj --- a/src/clojure/contrib/miglayout.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; clojure.contrib.miglayout -;; -;; Clojure support for the MiGLayout layout manager -;; http://www.miglayout.com/ -;; -;; Example: -;; -;; (use '[clojure.contrib.miglayout.test :as mlt :only ()]) -;; (dotimes [i 5] (mlt/run-test i)) -;; -;; scgilardi (gmail) -;; Created 5 October 2008 - -(ns - ^{:author "Stephen C. Gilardi", - :doc "Clojure support for the MiGLayout layout manager -http://www.miglayout.com/ - -Example: - - (use '[clojure.contrib.miglayout.test :as mlt :only ()]) - (dotimes [i 5] (mlt/run-test i)) - -"} - clojure.contrib.miglayout - (:import javax.swing.JComponent) - (:use clojure.contrib.miglayout.internal)) - -(defn miglayout - "Adds java.awt.Components to a javax.swing.JComponent with constraints - formatted for the MiGLayout layout manager. - - Arguments: container [item constraint*]* - - - container: the container for the specified components, its layout - manager will be set to a new instance of MigLayout - - - an inline series of items and constraints--each item may be followed - by zero or more constraints. - - Item: - - - An item is either a Component or one of the keywords :layout - :column or :row. Constraints for a keyword item affect the entire - layout. - - Constraint: string, keyword, vector, map, or set - - - A string specifies one or more constraints each with zero or more - arguments. - - A keyword specifies a single constraint without arguments - - A vector specifies a single constraint with one or more arguments - - A map specifies one or more constraints as keys, each mapped to a - single argument - - A set groups two or more constraints, each a string, keyword, - vector, map, or set - - Any items marked with an \"id\" constraint will be included in a map from - id to component attached to the container. The map can be retrieved using - clojure.contrib.miglayout/components." - [^JComponent container & args] - (let [item-constraints (apply parse-item-constraints args) - {:keys [keywords components]} item-constraints - {:keys [layout column row]} keywords] - (do-layout container layout column row components))) - -(defn components - "Returns a map from id (a keyword) to component for all components with - an id constraint set" - [^JComponent container] - (get-components container)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/miglayout/internal.clj --- a/src/clojure/contrib/miglayout/internal.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,120 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; clojure.contrib.miglayout.internal -;; -;; Internal functions for 'clojure.contrib.miglayout -;; -;; scgilardi (gmail) -;; Created 13 October 2008 - -(ns clojure.contrib.miglayout.internal - (:import (clojure.lang RT Reflector) - java.awt.Component - javax.swing.JComponent) - (:use (clojure.contrib - [core :only (new-by-name)] - [except :only (throwf)] - [fcase :only (fcase)] - [string :only (as-str)]))) - -(def MigLayout "net.miginfocom.swing.MigLayout") -(def LayoutCallback "net.miginfocom.layout.LayoutCallback") -(def ConstraintParser "net.miginfocom.layout.ConstraintParser") - -(declare format-constraints) - -(defn format-constraint - "Returns a vector of vectors representing one or more constraints - separated by commas. Constraints may be specified in Clojure using - strings, keywords, vectors, maps, and/or sets." - [c] - [[", "] - (fcase #(%1 %2) c - string? [c] - keyword? [c] - vector? (interpose " " c) - map? (apply concat (interpose [", "] (map #(interpose " " %) c))) - set? (apply concat (interpose [", "] (map format-constraints c))) - (throwf IllegalArgumentException - "unrecognized constraint: %s (%s)" c (class c)))]) - -(defn format-constraints - "Returns a string representing all the constraints for one keyword-item - or component formatted for miglayout." - [& constraints] - (let [formatted - (apply str - (map as-str - (rest (reduce concat [] - (mapcat format-constraint constraints)))))] -;; (prn formatted) - formatted)) - -(defn component? - "Returns true if x is a java.awt.Component" - [x] - (instance? Component x)) - -(defn constraint? - "Returns true if x is not a keyword-item or component" - [x] - (not - (or (component? x) - (#{:layout :column :row} x)))) - -(defn parse-item-constraints - "Iterates over args and builds a map containing values associated with - :keywords and :components. The value for :keywords is a map from keyword - items to constraints strings. The value for :components is a vector of - vectors each associating a component with its constraints string." - [& args] - (loop [[item & args] args - item-constraints {:keywords {} :components []}] - (if item - (let [[constraints args] (split-with constraint? args)] - (recur args - (update-in - item-constraints - [(if (component? item) :components :keywords)] - conj [item (apply format-constraints constraints)]))) - item-constraints))) - -(defn parse-component-constraint - "Parses a component constraint string returning a CC object" - [constraint] - (Reflector/invokeStaticMethod - ConstraintParser "parseComponentConstraint" (into-array [constraint]))) - -(defn add-components - "Adds components with constraints to a container" - [^JComponent container components] - (loop [[[^Component component constraint] & components] components - id-map nil] - (if component - (let [cc (parse-component-constraint constraint)] - (.add container component cc) - (recur - components - (if-let [id (.getId cc)] - (assoc id-map (keyword id) component) - id-map))) - (doto container (.putClientProperty ::components id-map))))) - -(defn get-components - "Returns a map from id to component for all components with an id" - [^JComponent container] - (.getClientProperty container ::components)) - -(defn do-layout - "Attaches a MigLayout layout manager to container and adds components - with constraints" - [^JComponent container layout column row components] - (doto container - (.setLayout (new-by-name MigLayout layout column row)) - (add-components components))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/mmap.clj --- a/src/clojure/contrib/mmap.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,90 +0,0 @@ -; Copyright (c) Chris Houser, April 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Functions for memory-mapping files, plus some functions that use a -; mmaped file for "normal" activies -- slurp, load-file, etc. - -(ns - ^{:author "Chris Houser", - :doc "Functions for memory-mapping files, plus some functions that use a -mmaped file for \"normal\" activies -- slurp, load-file, etc."} - clojure.contrib.mmap - (:refer-clojure :exclude (slurp load-file)) - (:import (java.nio ByteBuffer CharBuffer) - (java.io PushbackReader InputStream InputStreamReader - FileInputStream))) - -;(set! *warn-on-reflection* true) - -(def READ_ONLY ^{:private true} - (java.nio.channels.FileChannel$MapMode/READ_ONLY)) - -(defn mmap - "Memory-map the file named f. Returns a ByteBuffer." - [f] - (let [channel (.getChannel (FileInputStream. f))] - (.map channel READ_ONLY 0 (.size channel)))) - -(defn slurp - "Reads the file named by f and returns it as a string." - [^String f] - (.. java.nio.charset.Charset (forName "UTF-8") - (newDecoder) (decode (mmap f)))) - -(defn buffer-stream - "Returns an InputStream for a ByteBuffer, such as returned by mmap." - [^ByteBuffer buf] - (proxy [InputStream] [] - (available [] (.remaining buf)) - (read - ([] (if (.hasRemaining buf) (.get buf) -1)) - ([dst offset len] (let [actlen (min (.remaining buf) len)] - (.get buf dst offset actlen) - (if (< actlen 1) -1 actlen)))))) - -(defn load-file [f] - "Like clojure.lang/load-file, but uses mmap internally." - (with-open [rdr (-> f mmap buffer-stream InputStreamReader. PushbackReader.)] - (load-reader rdr))) - - -(comment - -(alias 'mmap 'clojure.contrib.mmap) -(alias 'core 'clojure.core) - -;--- -; zip_filter.clj is 95KB -(def tf "/home/chouser/build/clojure/src/clj/clojure/core.clj") -(println "\nload-file" tf) -(time (dotimes [_ 5] (core/load-file tf))) ; 5420.177813 msecs -(time (dotimes [_ 5] (mmap/load-file tf))) ; 7946.854434 msecs -- not so good - -;--- -; kern.log.0 is 961KB -(def tf "/var/log/kern.log.0") -(println "\nslurp" tf) -(time (dotimes [_ 10] (.length (core/slurp tf)))) ; 435.767226 msecs -(time (dotimes [_ 10] (.length (mmap/slurp tf)))) ; 93.176858 msecs - -;--- -; kern.log.0 is 961KB -(def tf "/var/log/kern.log.0") -(println "\nregex slurp large" tf) -(time (dotimes [_ 10] (count (re-seq #"EXT3.*" (core/slurp tf))))) ; 416 -(time (dotimes [_ 10] (count (re-seq #"EXT3.*" (mmap/slurp tf))))) ; 101 - -;--- -; mmap.clj is about 3.1KB -(def tf "/home/chouser/proj/clojure-contrib/src/clojure/contrib/mmap.clj") -(println "\nregex slurp small" tf) - -(time (dotimes [_ 1000] (count (re-seq #"defn \S*" (core/slurp tf))))) ; 308 -(time (dotimes [_ 1000] (count (re-seq #"defn \S*" (mmap/slurp tf))))) ; 198 - -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/mock.clj --- a/src/clojure/contrib/mock.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,285 +0,0 @@ -;;; clojure.contrib.mock.clj: mocking/expectation framework for Clojure - -;; by Matt Clark - -;; Copyright (c) Matt Clark, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php). -;; By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. -;;------------------------------------------------------------------------------ - -(comment - ;; This is a simple function mocking library I accidentally wrote as a side - ;; effect of trying to write an opengl library in clojure. This is loosely - ;; based on various ruby and java mocking frameworks I have used in the past - ;; such as mockito, easymock, and whatever rspec uses. - ;; - ;; expect uses bindings to wrap the functions that are being tested and - ;; then validates the invocation count at the end. The expect macro is the - ;; main entry point and it is given a vector of binding pairs. - ;; The first of each pair names the dependent function you want to override, - ;; while the second is a hashmap containing the mock description, usually - ;; created via the simple helper methods described below. - ;; - ;; Usage: - ;; - ;; there are one or more dependent functions: - - (defn dep-fn1 [] "time consuming calculation in 3rd party library") - (defn dep-fn2 [x] "function with undesirable side effects while testing") - - ;; then we have the code under test that calls these other functions: - - (defn my-code-under-test [] (dep-fn1) (dep-fn2 "a") (+ 2 2)) - - ;; to test this code, we simply surround it with an expect macro within - ;; the test: - - (expect [dep-fn1 (times 1) - dep-fn2 (times 1 (has-args [#(= "a" %)]))] - (my-code-under-test)) - - ;; When an expectation fails during execution of the function under test, - ;; an error condition function is called with the name of the function - ;; being mocked, the expected form and the actual value. These - ;; error functions can be overridden to allow easy integration into - ;; test frameworks such as test-is by reporting errors in the function - ;; overrides. - - ) ;; end comment - -(ns clojure.contrib.mock - ^{:author "Matt Clark", - :doc "function mocking/expectations for Clojure" } - (:use [clojure.contrib.seq :only (positions)] - [clojure.contrib.def :only (defmacro-)])) - - -;;------------------------------------------------------------------------------ -;; These are the error condition functions. Override them to integrate into -;; the test framework of your choice, or to simply customize error handling. - -(defn report-problem - {:dynamic true} - ([function expected actual] - (report-problem function expected actual "Expectation not met.")) - ([function expected actual message] - (prn (str message " Function name: " function - " expected: " expected " actual: " actual)))) - -(defn no-matching-function-signature - {:dynamic true} - [function expected actual] - (report-problem function expected actual - "No matching real function signature for given argument count.")) - -(defn unexpected-args - {:dynamic true} - [function expected actual i] - (report-problem function expected actual - (str "Argument " i " has an unexpected value for function."))) - -(defn incorrect-invocation-count - {:dynamic true} - [function expected actual] - (report-problem function expected actual "Unexpected invocation count.")) - - -;;------------------------------------------------------------------------------ -;; Internal Functions - ignore these - - -(defn- has-arg-count-match? - "Given the sequence of accepted argument vectors for a function, -returns true if at least one matches the given-count value." - [arg-lists given-count] - (some #(let [[ind] (positions #{'&} %)] - (if ind - (>= given-count ind) - (= (count %) given-count))) - arg-lists)) - - -(defn has-matching-signature? - "Calls no-matching-function-signature if no match is found for the given -function. If no argslist meta data is available for the function, it is -not called." - [fn-name args] - (let [arg-count (count args) - arg-lists (:arglists (meta (resolve fn-name)))] - (if (and arg-lists (not (has-arg-count-match? arg-lists arg-count))) - (no-matching-function-signature fn-name arg-lists args)))) - - -(defn make-arg-checker - "Creates the argument verifying function for a replaced dependency within -the expectation bound scope. These functions take the additional argument -of the name of the replaced function, then the rest of their args. It is -designed to be called from the mock function generated in the first argument -of the mock info object created by make-mock." - [arg-preds arg-pred-forms] - (let [sanitized-preds (map (fn [v] (if (fn? v) v #(= v %))) arg-preds)] - (fn [fn-name & args] - (every? true? - (map (fn [pred arg pred-form i] (if (pred arg) true - (unexpected-args fn-name pred-form arg i))) - sanitized-preds args arg-pred-forms (iterate inc 0)))))) - - -(defn make-count-checker - "creates the count checker that is invoked at the end of an expectation, after -the code under test has all been executed. The function returned takes the -name of the associated dependency and the invocation count as arguments." - [pred pred-form] - (let [pred-fn (if (integer? pred) #(= pred %) pred)] - (fn [fn-name v] (if (pred-fn v) true - (incorrect-invocation-count fn-name pred-form v))))) - -; Borrowed from clojure core. Remove if this ever becomes public there. -(defmacro- assert-args - [fnname & pairs] - `(do (when-not ~(first pairs) - (throw (IllegalArgumentException. - ~(str fnname " requires " (second pairs))))) - ~(let [more (nnext pairs)] - (when more - (list* `assert-args fnname more))))) - -(defn make-mock - "creates a vector containing the following information for the named function: -1. dependent function replacement - verifies signature, calls arg checker, -increases count, returns return value. -2. an atom containing the invocation count -3. the invocation count checker function -4. a symbol of the name of the function being replaced." - [fn-name expectation-hash] - (assert-args make-mock - (map? expectation-hash) "a map of expectations") - (let [arg-checker (or (expectation-hash :has-args) (fn [& args] true)) - count-atom (atom 0) - ret-fn (or - (expectation-hash :calls) - (fn [& args] (expectation-hash :returns)))] - [(fn [& args] - (has-matching-signature? fn-name args) - (apply arg-checker fn-name args) - (swap! count-atom inc) - (apply ret-fn args)) - count-atom - (or (expectation-hash :times) (fn [fn-name v] true)) - fn-name])) - - -(defn validate-counts - "given the sequence of all mock data for the expectation, simply calls the -count checker for each dependency." - [mock-data] (doseq [[mfn i checker fn-name] mock-data] (checker fn-name @i))) - -(defn ^{:private true} make-bindings [expect-bindings mock-data-sym] - `[~@(interleave (map #(first %) (partition 2 expect-bindings)) - (map (fn [i] `(nth (nth ~mock-data-sym ~i) 0)) - (range (quot (count expect-bindings) 2))))]) - - -;;------------------------------------------------------------------------------ -;; These are convenience functions to improve the readability and use of this -;; library. Useful in expressions such as: -;; (expect [dep-fn1 (times (more-than 1) (returns 15)) etc) - -(defn once [x] (= 1 x)) - -(defn never [x] (zero? x)) - -(defn more-than [x] #(< x %)) - -(defn less-than [x] #(> x %)) - -(defn between [x y] #(and (< x %) (> y %))) - - -;;------------------------------------------------------------------------------ -;; The following functions can be used to build up the expectation hash. - -(defn returns - "Creates or associates to an existing expectation hash the :returns key with -a value to be returned by the expectation after a successful invocation -matching its expected arguments (if applicable). -Usage: -(returns ret-value expectation-hash?)" - - ([val] (returns val {})) - ([val expectation-hash] (assoc expectation-hash :returns val))) - - -(defn calls - "Creates or associates to an existing expectation hash the :calls key with a -function that will be called with the given arguments. The return value from -this function will be returned returned by the expected function. If both this -and returns are specified, the return value of \"calls\" will have precedence. -Usage: -(calls some-fn expectation-hash?)" - - ([val] (calls val {})) - ([val expectation-hash] (assoc expectation-hash :calls val))) - - -(defmacro has-args - "Creates or associates to an existing expectation hash the :has-args key with -a value corresponding to a function that will either return true if its -argument expectations are met or throw an exception with the details of the -first failed argument it encounters. -Only specify as many predicates as you are interested in verifying. The rest -of the values are safely ignored. -Usage: -(has-args [arg-pred-1 arg-pred-2 ... arg-pred-n] expectation-hash?)" - - ([arg-pred-forms] `(has-args ~arg-pred-forms {})) - ([arg-pred-forms expect-hash-form] - (assert-args has-args - (vector? arg-pred-forms) "a vector of argument predicates") - `(assoc ~expect-hash-form :has-args - (make-arg-checker ~arg-pred-forms '~arg-pred-forms)))) - - -(defmacro times - "Creates or associates to an existing expectation hash the :times key with a -value corresponding to a predicate function which expects an integer value. -This function can either be specified as the first argument to times or can be -the result of calling times with an integer argument, in which case the -predicate will default to being an exact match. This predicate is called at -the end of an expect expression to validate that an expected dependency -function was called the expected number of times. -Usage: -(times n) -(times #(> n %)) -(times n expectation-hash)" - ([times-fn] `(times ~times-fn {})) - ([times-fn expectation-hash] - `(assoc ~expectation-hash :times (make-count-checker ~times-fn '~times-fn)))) - - -;------------------------------------------------------------------------------- -; The main expect macro. -(defmacro expect - "Use expect to redirect calls to dependent functions that are made within the -code under test. Instead of calling the functions that would normally be used, -temporary stubs are used, which can verify function parameters and call counts. -Return values can also be specified as needed. -Usage: -(expect [dep-fn (has-args [arg-pred1] (times n (returns x)))] - (function-under-test a b c))" - - [expect-bindings & body] - (assert-args expect - (vector? expect-bindings) "a vector of expectation bindings" - (even? (count expect-bindings)) - "an even number of forms in expectation bindings") - (let [mock-data (gensym "mock-data_")] - `(let [~mock-data (map (fn [args#] - (apply clojure.contrib.mock/make-mock args#)) - ~(cons 'list (map (fn [[n m]] (vector (list 'quote n) m)) - (partition 2 expect-bindings))))] - (binding ~(make-bindings expect-bindings mock-data) ~@body) - (clojure.contrib.mock/validate-counts ~mock-data) true))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/mock.clj.rej --- a/src/clojure/contrib/mock.clj.rej Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,569 +0,0 @@ -diff a/src/main/clojure/clojure/contrib/mock.clj b/src/main/clojure/clojure/contrib/mock.clj (rejected hunks) -@@ -1,285 +1,282 @@ --;;; clojure.contrib.mock.clj: mocking/expectation framework for Clojure -- --;; by Matt Clark -- --;; Copyright (c) Matt Clark, 2009. All rights reserved. The use --;; and distribution terms for this software are covered by the Eclipse --;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php). --;; By using this software in any fashion, you are --;; agreeing to be bound by the terms of this license. You must not --;; remove this notice, or any other, from this software. --;;------------------------------------------------------------------------------ -- --(comment -- ;; This is a simple function mocking library I accidentally wrote as a side -- ;; effect of trying to write an opengl library in clojure. This is loosely -- ;; based on various ruby and java mocking frameworks I have used in the past -- ;; such as mockito, easymock, and whatever rspec uses. -- ;; -- ;; expect uses bindings to wrap the functions that are being tested and -- ;; then validates the invocation count at the end. The expect macro is the -- ;; main entry point and it is given a vector of binding pairs. -- ;; The first of each pair names the dependent function you want to override, -- ;; while the second is a hashmap containing the mock description, usually -- ;; created via the simple helper methods described below. -- ;; -- ;; Usage: -- ;; -- ;; there are one or more dependent functions: -- -- (defn dep-fn1 [] "time consuming calculation in 3rd party library") -- (defn dep-fn2 [x] "function with undesirable side effects while testing") -- -- ;; then we have the code under test that calls these other functions: -- -- (defn my-code-under-test [] (dep-fn1) (dep-fn2 "a") (+ 2 2)) -- -- ;; to test this code, we simply surround it with an expect macro within -- ;; the test: -- -- (expect [dep-fn1 (times 1) -- dep-fn2 (times 1 (has-args [#(= "a" %)]))] -- (my-code-under-test)) -- -- ;; When an expectation fails during execution of the function under test, -- ;; an error condition function is called with the name of the function -- ;; being mocked, the expected form and the actual value. These -- ;; error functions can be overridden to allow easy integration into -- ;; test frameworks such as test-is by reporting errors in the function -- ;; overrides. -- -- ) ;; end comment -- --(ns clojure.contrib.mock -- ^{:author "Matt Clark", -- :doc "function mocking/expectations for Clojure" } -- (:use [clojure.contrib.seq :only (positions)] -- [clojure.contrib.def :only (defmacro-)])) -- -- --;;------------------------------------------------------------------------------ --;; These are the error condition functions. Override them to integrate into --;; the test framework of your choice, or to simply customize error handling. -- --(defn report-problem -- {:dynamic true} -- ([function expected actual] -- (report-problem function expected actual "Expectation not met.")) -- ([function expected actual message] -- (prn (str message " Function name: " function -- " expected: " expected " actual: " actual)))) -- --(defn no-matching-function-signature -- {:dynamic true} -- [function expected actual] -- (report-problem function expected actual -- "No matching real function signature for given argument count.")) -- --(defn unexpected-args -- {:dynamic true} -- [function expected actual i] -- (report-problem function expected actual -- (str "Argument " i " has an unexpected value for function."))) -- --(defn incorrect-invocation-count -- {:dynamic true} -- [function expected actual] -- (report-problem function expected actual "Unexpected invocation count.")) -- -- --;;------------------------------------------------------------------------------ --;; Internal Functions - ignore these -- -- --(defn- has-arg-count-match? -- "Given the sequence of accepted argument vectors for a function, --returns true if at least one matches the given-count value." -- [arg-lists given-count] -- (some #(let [[ind] (positions #{'&} %)] -- (if ind -- (>= given-count ind) -- (= (count %) given-count))) -- arg-lists)) -- -- --(defn has-matching-signature? -- "Calls no-matching-function-signature if no match is found for the given --function. If no argslist meta data is available for the function, it is --not called." -- [fn-name args] -- (let [arg-count (count args) -- arg-lists (:arglists (meta (resolve fn-name)))] -- (if (and arg-lists (not (has-arg-count-match? arg-lists arg-count))) -- (no-matching-function-signature fn-name arg-lists args)))) -- -- --(defn make-arg-checker -- "Creates the argument verifying function for a replaced dependency within --the expectation bound scope. These functions take the additional argument --of the name of the replaced function, then the rest of their args. It is --designed to be called from the mock function generated in the first argument --of the mock info object created by make-mock." -- [arg-preds arg-pred-forms] -- (let [sanitized-preds (map (fn [v] (if (fn? v) v #(= v %))) arg-preds)] -- (fn [fn-name & args] -- (every? true? -- (map (fn [pred arg pred-form i] (if (pred arg) true -- (unexpected-args fn-name pred-form arg i))) -- sanitized-preds args arg-pred-forms (iterate inc 0)))))) -- -- --(defn make-count-checker -- "creates the count checker that is invoked at the end of an expectation, after --the code under test has all been executed. The function returned takes the --name of the associated dependency and the invocation count as arguments." -- [pred pred-form] -- (let [pred-fn (if (integer? pred) #(= pred %) pred)] -- (fn [fn-name v] (if (pred-fn v) true -- (incorrect-invocation-count fn-name pred-form v))))) -- --; Borrowed from clojure core. Remove if this ever becomes public there. --(defmacro- assert-args -- [fnname & pairs] -- `(do (when-not ~(first pairs) -- (throw (IllegalArgumentException. -- ~(str fnname " requires " (second pairs))))) -- ~(let [more (nnext pairs)] -- (when more -- (list* `assert-args fnname more))))) -- --(defn make-mock -- "creates a vector containing the following information for the named function: --1. dependent function replacement - verifies signature, calls arg checker, --increases count, returns return value. --2. an atom containing the invocation count --3. the invocation count checker function --4. a symbol of the name of the function being replaced." -- [fn-name expectation-hash] -- (assert-args make-mock -- (map? expectation-hash) "a map of expectations") -- (let [arg-checker (or (expectation-hash :has-args) (fn [& args] true)) -- count-atom (atom 0) -- ret-fn (or -- (expectation-hash :calls) -- (fn [& args] (expectation-hash :returns)))] -- [(fn [& args] -- (has-matching-signature? fn-name args) -- (apply arg-checker fn-name args) -- (swap! count-atom inc) -- (apply ret-fn args)) -- count-atom -- (or (expectation-hash :times) (fn [fn-name v] true)) -- fn-name])) -- -- --(defn validate-counts -- "given the sequence of all mock data for the expectation, simply calls the --count checker for each dependency." -- [mock-data] (doseq [[mfn i checker fn-name] mock-data] (checker fn-name @i))) -- --(defn ^{:private true} make-bindings [expect-bindings mock-data-sym] -- `[~@(interleave (map #(first %) (partition 2 expect-bindings)) -- (map (fn [i] `(nth (nth ~mock-data-sym ~i) 0)) -- (range (quot (count expect-bindings) 2))))]) -- -- --;;------------------------------------------------------------------------------ --;; These are convenience functions to improve the readability and use of this --;; library. Useful in expressions such as: --;; (expect [dep-fn1 (times (more-than 1) (returns 15)) etc) -- --(defn once [x] (= 1 x)) -- --(defn never [x] (zero? x)) -- --(defn more-than [x] #(< x %)) -- --(defn less-than [x] #(> x %)) -- --(defn between [x y] #(and (< x %) (> y %))) -- -- --;;------------------------------------------------------------------------------ --;; The following functions can be used to build up the expectation hash. -- --(defn returns -- "Creates or associates to an existing expectation hash the :returns key with --a value to be returned by the expectation after a successful invocation --matching its expected arguments (if applicable). --Usage: --(returns ret-value expectation-hash?)" -- -- ([val] (returns val {})) -- ([val expectation-hash] (assoc expectation-hash :returns val))) -- -- --(defn calls -- "Creates or associates to an existing expectation hash the :calls key with a --function that will be called with the given arguments. The return value from --this function will be returned returned by the expected function. If both this --and returns are specified, the return value of \"calls\" will have precedence. --Usage: --(calls some-fn expectation-hash?)" -- -- ([val] (calls val {})) -- ([val expectation-hash] (assoc expectation-hash :calls val))) -- -- --(defmacro has-args -- "Creates or associates to an existing expectation hash the :has-args key with --a value corresponding to a function that will either return true if its --argument expectations are met or throw an exception with the details of the --first failed argument it encounters. --Only specify as many predicates as you are interested in verifying. The rest --of the values are safely ignored. --Usage: --(has-args [arg-pred-1 arg-pred-2 ... arg-pred-n] expectation-hash?)" -- -- ([arg-pred-forms] `(has-args ~arg-pred-forms {})) -- ([arg-pred-forms expect-hash-form] -- (assert-args has-args -- (vector? arg-pred-forms) "a vector of argument predicates") -- `(assoc ~expect-hash-form :has-args -- (make-arg-checker ~arg-pred-forms '~arg-pred-forms)))) -- -- --(defmacro times -- "Creates or associates to an existing expectation hash the :times key with a --value corresponding to a predicate function which expects an integer value. --This function can either be specified as the first argument to times or can be --the result of calling times with an integer argument, in which case the --predicate will default to being an exact match. This predicate is called at --the end of an expect expression to validate that an expected dependency --function was called the expected number of times. --Usage: --(times n) --(times #(> n %)) --(times n expectation-hash)" -- ([times-fn] `(times ~times-fn {})) -- ([times-fn expectation-hash] -- `(assoc ~expectation-hash :times (make-count-checker ~times-fn '~times-fn)))) -- -- --;------------------------------------------------------------------------------- --; The main expect macro. --(defmacro expect -- "Use expect to redirect calls to dependent functions that are made within the --code under test. Instead of calling the functions that would normally be used, --temporary stubs are used, which can verify function parameters and call counts. --Return values can also be specified as needed. --Usage: --(expect [dep-fn (has-args [arg-pred1] (times n (returns x)))] -- (function-under-test a b c))" -- -- [expect-bindings & body] -- (assert-args expect -- (vector? expect-bindings) "a vector of expectation bindings" -- (even? (count expect-bindings)) -- "an even number of forms in expectation bindings") -- (let [mock-data (gensym "mock-data_")] -- `(let [~mock-data (map (fn [args#] -- (apply clojure.contrib.mock/make-mock args#)) -- ~(cons 'list (map (fn [[n m]] (vector (list 'quote n) m)) -- (partition 2 expect-bindings))))] -- (binding ~(make-bindings expect-bindings mock-data) ~@body) -- (clojure.contrib.mock/validate-counts ~mock-data) true))) -+;;; clojure.contrib.mock.clj: mocking/expectation framework for Clojure -+ -+;; by Matt Clark -+ -+;; Copyright (c) Matt Clark, 2009. All rights reserved. The use and -+;; distribution terms for this software are covered by the Eclipse Public -+;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -+;; be found in the file epl-v10.html at the root of this distribution. By -+;; using this software in any fashion, you are agreeing to be bound by the -+;; terms of this license. You must not remove this notice, or any other -+;; from this software. -+;;------------------------------------------------------------------------------ -+ -+(comment -+ ;; Mock is a function mocking utility loosely based on various ruby and java -+ ;; mocking frameworks such as mockito, easymock, and rspec yet adapted to -+ ;; fit the functional style of clojure. -+ ;; -+ ;; Mock uses bindings to wrap the functions that are being tested and -+ ;; then validates the invocation count at the end. The expect macro is the -+ ;; main entry point and it is given a vector of binding pairs. -+ ;; The first of each pair names the dependent function you want to override -+ ;; while the second is a hashmap containing the mock description, usually -+ ;; created via the simple helper methods described below. -+ ;; -+ ;; Usage: -+ ;; -+ ;; there are one or more dependent functions: -+ -+ (defn dep-fn1 [] "time consuming calculation in 3rd party library") -+ (defn dep-fn2 [x] "function with undesirable side effects while testing") -+ -+ ;; then we have the code under test that calls these other functions: -+ -+ (defn my-code-under-test [] (dep-fn1) (dep-fn2 "a") (+ 2 2)) -+ -+ ;; to test this code, we simply surround it with an expect macro within -+ ;; the test: -+ -+ (expect [dep-fn1 (times 1) -+ dep-fn2 (times 1 (has-args [#(= "a" %)]))] -+ (my-code-under-test)) -+ -+ ;; When an expectation fails during execution of the function under test -+ ;; an error condition function is called with the name of the function -+ ;; being mocked, the expected form and the actual value. These -+ ;; error functions can be overridden to allow easy integration into -+ ;; test frameworks such as test-is by reporting errors in the function -+ ;; overrides. -+ -+ ) ;; end comment -+ -+(ns clojure.contrib.mock -+ ^{:author "Matt Clark" -+ :doc "function mocking/expectations for Clojure" } -+ (:use [clojure.contrib.seq :only (positions)] -+ [clojure.contrib.def :only (defmacro-)])) -+ -+ -+;;------------------------------------------------------------------------------ -+;; These are the error condition functions. Override them to integrate into -+;; the test framework of your choice, or to simply customize error handling. -+ -+(defn report-problem -+ {:dynamic true} -+ ([function expected actual] -+ (report-problem function expected actual "Expectation not met.")) -+ ([function expected actual message] -+ (prn (str message " Function name: " function -+ " expected: " expected " actual: " actual)))) -+ -+(defn no-matching-function-signature -+ {:dynamic true} -+ [function expected actual] -+ (report-problem function expected actual -+ "No matching real function signature for given argument count.")) -+ -+(defn unexpected-args -+ {:dynamic true} -+ [function expected actual i] -+ (report-problem function expected actual -+ (str "Argument " i " has an unexpected value for function."))) -+ -+(defn incorrect-invocation-count -+ {:dynamic true} -+ [function expected actual] -+ (report-problem function expected actual "Unexpected invocation count.")) -+ -+ -+;;------------------------------------------------------------------------------ -+;; Internal Functions - ignore these -+ -+ -+(defn- has-arg-count-match? -+ "Given the sequence of accepted argument vectors for a function -+returns true if at least one matches the given-count value." -+ [arg-lists given-count] -+ (some #(let [[ind] (positions #{'&} %)] -+ (if ind -+ (>= given-count ind) -+ (= (count %) given-count))) -+ arg-lists)) -+ -+ -+(defn has-matching-signature? -+ "Calls no-matching-function-signature if no match is found for the given -+function. If no argslist meta data is available for the function, it is -+not called." -+ [fn-name args] -+ (let [arg-count (count args) -+ arg-lists (:arglists (meta (resolve fn-name)))] -+ (if (and arg-lists (not (has-arg-count-match? arg-lists arg-count))) -+ (no-matching-function-signature fn-name arg-lists args)))) -+ -+ -+(defn make-arg-checker -+ "Creates the argument verifying function for a replaced dependency within -+the expectation bound scope. These functions take the additional argument -+of the name of the replaced function, then the rest of their args. It is -+designed to be called from the mock function generated in the first argument -+of the mock info object created by make-mock." -+ [arg-preds arg-pred-forms] -+ (let [sanitized-preds (map (fn [v] (if (fn? v) v #(= v %))) arg-preds)] -+ (fn [fn-name & args] -+ (every? true? -+ (map (fn [pred arg pred-form i] (if (pred arg) true -+ (unexpected-args fn-name -+ pred-form arg i))) -+ sanitized-preds args arg-pred-forms (iterate inc 0)))))) -+ -+ -+(defn make-count-checker -+ "creates the count checker that is invoked at the end of an expectation, after -+the code under test has all been executed. The function returned takes the -+name of the associated dependency and the invocation count as arguments." -+ [pred pred-form] -+ (let [pred-fn (if (integer? pred) #(= pred %) pred)] -+ (fn [fn-name v] (if (pred-fn v) true -+ (incorrect-invocation-count fn-name pred-form v))))) -+ -+(defn make-mock -+ "creates a vector containing the following information for the named function: -+1. dependent function replacement - verifies signature, calls arg checker -+increases count, returns return value. -+2. an atom containing the invocation count -+3. the invocation count checker function -+4. a symbol of the name of the function being replaced." -+ [fn-name expectation-hash] -+ {:pre [(map? expectation-hash) -+ (symbol? fn-name)]} -+ (let [arg-checker (or (expectation-hash :has-args) (fn [& args] true)) -+ count-atom (atom 0) -+ ret-fn (or -+ (expectation-hash :calls) -+ (fn [& args] (expectation-hash :returns)))] -+ [(fn [& args] -+ (has-matching-signature? fn-name args) -+ (apply arg-checker fn-name args) -+ (swap! count-atom inc) -+ (apply ret-fn args)) -+ count-atom -+ (or (expectation-hash :times) (fn [fn-name v] true)) -+ fn-name])) -+ -+ -+(defn validate-counts -+ "given the sequence of all mock data for the expectation, simply calls the -+count checker for each dependency." -+ [mock-data] (doseq [[mfn i checker fn-name] mock-data] (checker fn-name @i))) -+ -+(defn- make-bindings [expect-bindings mock-data-sym] -+ `[~@(interleave (map #(first %) (partition 2 expect-bindings)) -+ (map (fn [i] `(nth (nth ~mock-data-sym ~i) 0)) -+ (range (quot (count expect-bindings) 2))))]) -+ -+ -+;;------------------------------------------------------------------------------ -+;; These are convenience functions to improve the readability and use of this -+;; library. Useful in expressions such as: -+;; (expect [dep-fn1 (times (more-than 1) (returns 15)) etc) -+ -+;; best used in the times function -+(defn once [x] (= 1 x)) -+ -+(defn never [x] (zero? x)) -+ -+(defn more-than [x] #(< x %)) -+ -+(defn less-than [x] #(> x %)) -+ -+(defn between [x y] #(and (< x %) (> y %))) -+ -+;;best used in the has-args function -+(defn anything [x] true) -+ -+ -+;;------------------------------------------------------------------------------ -+;; The following functions can be used to build up the expectation hash. -+ -+(defn returns -+ "Creates or associates to an existing expectation hash the :returns key with -+a value to be returned by the expectation after a successful invocation -+matching its expected arguments (if applicable). -+Usage: -+(returns ret-value expectation-hash?)" -+ -+ ([val] (returns val {})) -+ ([val expectation-hash] -+ {:pre [(map? expectation-hash)]} -+ (assoc expectation-hash :returns val))) -+ -+ -+(defn calls -+ "Creates or associates to an existing expectation hash the :calls key with a -+function that will be called with the given arguments. The return value from -+this function will be returned by the expected function. If both this -+and returns are specified, the return value of \"calls\" will have precedence. -+Usage: -+(calls some-fn expectation-hash?)" -+ -+ ([val] (calls val {})) -+ ([val expectation-hash] -+ {:pre [(map? expectation-hash)]} -+ (assoc expectation-hash :calls val))) -+ -+ -+(defmacro has-args -+ "Creates or associates to an existing expectation hash the :has-args key with -+a value corresponding to a function that will either return true if its -+argument expectations are met or throw an exception with the details of the -+first failed argument it encounters. -+Only specify as many predicates as you are interested in verifying. The rest -+of the values are safely ignored. -+Usage: -+(has-args [arg-pred-1 arg-pred-2 ... arg-pred-n] expectation-hash?)" -+ -+ ([arg-pred-forms] `(has-args ~arg-pred-forms {})) -+ ([arg-pred-forms expectation-hash] -+ {:pre [(vector? arg-pred-forms) -+ (map? expectation-hash)]} -+ `(assoc ~expectation-hash :has-args -+ (make-arg-checker ~arg-pred-forms '~arg-pred-forms)))) -+ -+ -+(defmacro times -+ "Creates or associates to an existing expectation hash the :times key with a -+value corresponding to a predicate function which expects an integer value. -+Also, an integer can be specified, in which case the times will only be an -+exact match. The times check is called at the end of an expect expression to -+validate that an expected dependency function was called the expected -+number of times. -+Usage: -+(times n) -+(times #(> n %)) -+(times n expectation-hash)" -+ ([times-fn] `(times ~times-fn {})) -+ ([times-fn expectation-hash] -+ {:pre [(map? expectation-hash)]} -+ `(assoc ~expectation-hash :times (make-count-checker ~times-fn '~times-fn)))) -+ -+ -+;------------------------------------------------------------------------------- -+; The main expect macro. -+(defmacro expect -+ "Use expect to redirect calls to dependent functions that are made within the -+code under test. Instead of calling the functions that would normally be used -+temporary stubs are used, which can verify function parameters and call counts. -+Return values of overridden functions can also be specified as needed. -+Usage: -+(expect [dep-fn (has-args [arg-pred1] (times n (returns x)))] -+ (function-under-test a b c))" -+ -+ [expect-bindings & body] -+ {:pre [(vector? expect-bindings) -+ (even? (count expect-bindings))]} -+ (let [mock-data (gensym "mock-data_")] -+ `(let [~mock-data (map (fn [args#] -+ (apply clojure.contrib.mock/make-mock args#)) -+ ~(cons 'list (map (fn [[n m]] (vector (list 'quote n) m)) -+ (partition 2 expect-bindings))))] -+ (binding ~(make-bindings expect-bindings mock-data) ~@body) -+ (clojure.contrib.mock/validate-counts ~mock-data) true))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/mock/test_adapter.clj --- a/src/clojure/contrib/mock/test_adapter.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -;;; test_adapter.clj: clojure.test adapter for mocking/expectation framework for Clojure - -;; by Matt Clark - -;; Copyright (c) Matt Clark, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php). -;; By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns clojure.contrib.mock.test-adapter - (:require [clojure.contrib.mock :as mock]) - (:use clojure.test - clojure.contrib.ns-utils)) - -(immigrate 'clojure.contrib.mock) - -(defn report-problem - "This function is designed to be used in a binding macro to override -the report-problem function in clojure.contrib.mock. Instead of printing -the error to the console, the error is logged via clojure.test." - {:dynamic true} - [fn-name expected actual msg] - (report {:type :fail, - :message (str msg " Function name: " fn-name), - :expected expected, - :actual actual})) - - -(defmacro expect [& body] - "Use this macro instead of the standard c.c.mock expect macro to have -failures reported through clojure.test." - `(binding [mock/report-problem report-problem] - (mock/expect ~@body))) - - - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/monadic_io_streams.clj --- a/src/clojure/contrib/monadic_io_streams.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,145 +0,0 @@ -;; Monadic I/O - -;; by Konrad Hinsen -;; last updated June 24, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Monadic I/O with Java input/output streams - Defines monadic I/O statements to be used in a state monad - with an input or output stream as the state. The macro - monadic-io creates a stream, runs a monadic I/O statement - on it, and closes the stream. This structure permits the - definition of purely functional compound I/O statements - which are applied to streams that can never escape from the - monadic statement sequence."} - clojure.contrib.monadic-io-streams - (:refer-clojure :exclude (read-line print println flush)) - (:use [clojure.contrib.monads - :only (with-monad domonad state-m state-m-until)]) - (:use [clojure.contrib.generic.functor :only (fmap)]) - (:use [clojure.java.io :only (reader writer)])) - -; -; Wrap the state into a closure to make sure that "evil" code -; can't obtain the stream using fetch-state and manipulate it. -; -(let [key (Object.) - lock (fn [state] (fn [x] (if (identical? x key) state nil))) - unlock (fn [state] (state key))] - - ; - ; Basic stream I/O statements as provided by Java - ; - (defn read-char - "Read a single character" - [] - (fn [s] [(.read (unlock s)) s])) - - (defn read-line - "Read a single line" - [] - (fn [s] [(.readLine (unlock s)) s])) - - (defn skip-chars - "Skip n characters" - [n] - (fn [s] [(.skip (unlock s) n) s])) - - (defn write - "Write text (a string)" - [^String text] - (fn [s] [(.write (unlock s) text) s])) - - (defn flush - "Flush" - [] - (fn [s] [(.flush (unlock s)) s])) - - (defn print - "Print obj" - [obj] - (fn [s] [(.print (unlock s) obj) s])) - - (defn println - "Print obj followed by a newline" - ([] - (fn [s] [(.println (unlock s)) s])) - ([obj] - (fn [s] [(.println (unlock s) obj) s]))) - - ; - ; Inject I/O streams into monadic I/O statements - ; - (defn with-reader - "Create a reader from reader-spec, run the monadic I/O statement - on it, and close the reader. reader-spec can be any object accepted - by clojure.contrib.io/reader." - [reader-spec statement] - (with-open [r (reader reader-spec)] - (first (statement (lock r))))) - - (defn with-writer - "Create a writer from writer-spec, run the monadic I/O statement - on it, and close the writer. writer-spec can be any object accepted - by clojure.contrib.io/writer." - [writer-spec statement] - (with-open [w (writer writer-spec)] - (first (statement (lock w))))) - - (defn with-io-streams - "Open one or more streams as specified by io-spec, run a monadic - I/O statement on them, and close the streams. io-spec is - a binding-like vector in which each stream is specified by - three element: a keyword by which the stream can be referred to, - the stream mode (:read or :write), and a stream specification as - accepted by clojure.contrib.io/reader (mode :read) or - clojure.contrib.io/writer (mode :write). The statement - is run on a state which is a map from keywords to corresponding - streams. Single-stream monadic I/O statements must be wrapped - with clojure.contrib.monads/with-state-field." - [io-specs statement] - (letfn [(run-io [io-specs state statement] - (if (zero? (count io-specs)) - (first (statement state)) - (let [[[key mode stream-spec] & r] io-specs - opener (cond (= mode :read) reader - (= mode :write) writer - :else (throw - (Exception. - "Mode must be :read or :write")))] - (with-open [stream (opener stream-spec)] - (run-io r (assoc state key (lock stream)) statement)))))] - (run-io (partition 3 io-specs) {} statement)))) - -; -; Compound I/O statements -; -(with-monad state-m - - (defn- add-line - "Read one line and add it to the end of the vector lines. Return - [lines eof], where eof is an end-of-file flag. The input eof argument - is not used." - [[lines eof]] - (domonad - [line (read-line)] - (if (nil? line) - [lines true] - [(conj lines line) false]))) - - (defn read-lines - "Read all lines and return them in a vector" - [] - (domonad - [[lines eof] (state-m-until second add-line [[] false])] - lines))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/monads.clj --- a/src/clojure/contrib/monads.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,580 +0,0 @@ -;; Monads in Clojure - -;; by Konrad Hinsen -;; last updated June 30, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :see-also [["http://onclojure.com/2009/03/05/a-monad-tutorial-for-clojure-programmers-part-1/" "Monad tutorial part 1"] - ["http://onclojure.com/2009/03/06/a-monad-tutorial-for-clojure-programmers-part-2/" "Monad tutorial part 2"] - ["http://onclojure.com/2009/03/23/a-monad-tutorial-for-clojure-programmers-part-3/" "Monad tutorial part 3"] - ["http://onclojure.com/2009/04/24/a-monad-tutorial-for-clojure-programmers-part-4/" "Monad tutorial part 4"] - ["http://intensivesystems.net/tutorials/monads_101.html" "Monads in Clojure part 1"] - ["http://intensivesystems.net/tutorials/monads_201.html" "Monads in Clojure part 2"]] - :doc "This library contains the most commonly used monads as well - as macros for defining and using monads and useful monadic - functions."} - clojure.contrib.monads - (:require [clojure.contrib.accumulators]) - (:use [clojure.contrib.macro-utils :only (with-symbol-macros defsymbolmacro)]) - (:use [clojure.contrib.def :only (name-with-attributes)])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Defining monads -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro monad - "Define a monad by defining the monad operations. The definitions - are written like bindings to the monad operations m-bind and - m-result (required) and m-zero and m-plus (optional)." - [operations] - `(let [~'m-bind ::undefined - ~'m-result ::undefined - ~'m-zero ::undefined - ~'m-plus ::undefined - ~@operations] - {:m-result ~'m-result - :m-bind ~'m-bind - :m-zero ~'m-zero - :m-plus ~'m-plus})) - -(defmacro defmonad - "Define a named monad by defining the monad operations. The definitions - are written like bindings to the monad operations m-bind and - m-result (required) and m-zero and m-plus (optional)." - - ([name doc-string operations] - (let [doc-name (with-meta name {:doc doc-string})] - `(defmonad ~doc-name ~operations))) - - ([name operations] - `(def ~name (monad ~operations)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Using monads -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- add-monad-step - "Add a monad comprehension step before the already transformed - monad comprehension expression mexpr." - [mexpr step] - (let [[bform expr] step] - (cond (identical? bform :when) `(if ~expr ~mexpr ~'m-zero) - (identical? bform :let) `(let ~expr ~mexpr) - :else (list 'm-bind expr (list 'fn [bform] mexpr))))) - -(defn- monad-expr - "Transforms a monad comprehension, consisting of a list of steps - and an expression defining the final value, into an expression - chaining together the steps using :bind and returning the final value - using :result. The steps are given as a vector of - binding-variable/monadic-expression pairs." - [steps expr] - (when (odd? (count steps)) - (throw (Exception. "Odd number of elements in monad comprehension steps"))) - (let [rsteps (reverse (partition 2 steps)) - [lr ls] (first rsteps)] - (if (= lr expr) - ; Optimization: if the result expression is equal to the result - ; of the last computation step, we can eliminate an m-bind to - ; m-result. - (reduce add-monad-step - ls - (rest rsteps)) - ; The general case. - (reduce add-monad-step - (list 'm-result expr) - rsteps)))) - -(defmacro with-monad - "Evaluates an expression after replacing the keywords defining the - monad operations by the functions associated with these keywords - in the monad definition given by name." - [monad & exprs] - `(let [name# ~monad - ~'m-bind (:m-bind name#) - ~'m-result (:m-result name#) - ~'m-zero (:m-zero name#) - ~'m-plus (:m-plus name#)] - (with-symbol-macros ~@exprs))) - -(defmacro domonad - "Monad comprehension. Takes the name of a monad, a vector of steps - given as binding-form/monadic-expression pairs, and a result value - specified by expr. The monadic-expression terms can use the binding - variables of the previous steps. - If the monad contains a definition of m-zero, the step list can also - contain conditions of the form :when p, where the predicate p can - contain the binding variables from all previous steps. - A clause of the form :let [binding-form expr ...], where the bindings - are given as a vector as for the use in let, establishes additional - bindings that can be used in the following steps." - ([steps expr] - (monad-expr steps expr)) - ([name steps expr] - (let [mexpr (monad-expr steps expr)] - `(with-monad ~name ~mexpr)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Defining functions used with monads -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro defmonadfn - "Like defn, but for functions that use monad operations and are used inside - a with-monad block." - {:arglists '([name docstring? attr-map? args expr] - [name docstring? attr-map? (args expr) ...])} - [name & options] - (let [[name options] (name-with-attributes name options) - fn-name (symbol (str *ns*) (format "m+%s+m" (str name))) - make-fn-body (fn [args expr] - (list (vec (concat ['m-bind 'm-result - 'm-zero 'm-plus] args)) - (list `with-symbol-macros expr)))] - (if (list? (first options)) - ; multiple arities - (let [arglists (map first options) - exprs (map second options) - ] - `(do - (defsymbolmacro ~name (partial ~fn-name ~'m-bind ~'m-result - ~'m-zero ~'m-plus)) - (defn ~fn-name ~@(map make-fn-body arglists exprs)))) - ; single arity - (let [[args expr] options] - `(do - (defsymbolmacro ~name (partial ~fn-name ~'m-bind ~'m-result - ~'m-zero ~'m-plus)) - (defn ~fn-name ~@(make-fn-body args expr))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Commonly used monad functions -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; Define the four basic monad operations as symbol macros that -; expand to their unqualified symbol equivalents. This makes it possible -; to use them inside macro templates without having to quote them. -(defsymbolmacro m-result m-result) -(defsymbolmacro m-bind m-bind) -(defsymbolmacro m-zero m-zero) -(defsymbolmacro m-plus m-plus) - -(defmacro m-lift - "Converts a function f of n arguments into a function of n - monadic arguments returning a monadic value." - [n f] - (let [expr (take n (repeatedly #(gensym "x_"))) - vars (vec (take n (repeatedly #(gensym "mv_")))) - steps (vec (interleave expr vars))] - (list `fn vars (monad-expr steps (cons f expr))))) - -(defmonadfn m-join - "Converts a monadic value containing a monadic value into a 'simple' - monadic value." - [m] - (m-bind m identity)) - -(defmonadfn m-fmap - "Bind the monadic value m to the function returning (f x) for argument x" - [f m] - (m-bind m (fn [x] (m-result (f x))))) - -(defmonadfn m-seq - "'Executes' the monadic values in ms and returns a sequence of the - basic values contained in them." - [ms] - (reduce (fn [q p] - (m-bind p (fn [x] - (m-bind q (fn [y] - (m-result (cons x y)))) ))) - (m-result '()) - (reverse ms))) - -(defmonadfn m-map - "'Executes' the sequence of monadic values resulting from mapping - f onto the values xs. f must return a monadic value." - [f xs] - (m-seq (map f xs))) - -(defmonadfn m-chain - "Chains together monadic computation steps that are each functions - of one parameter. Each step is called with the result of the previous - step as its argument. (m-chain (step1 step2)) is equivalent to - (fn [x] (domonad [r1 (step1 x) r2 (step2 r1)] r2))." - [steps] - (reduce (fn m-chain-link [chain-expr step] - (fn [v] (m-bind (chain-expr v) step))) - m-result - steps)) - -(defmonadfn m-reduce - "Return the reduction of (m-lift 2 f) over the list of monadic values mvs - with initial value (m-result val)." - ([f mvs] - (if (empty? mvs) - (m-result (f)) - (let [m-f (m-lift 2 f)] - (reduce m-f mvs)))) - ([f val mvs] - (let [m-f (m-lift 2 f) - m-val (m-result val)] - (reduce m-f m-val mvs)))) - -(defmonadfn m-until - "While (p x) is false, replace x by the value returned by the - monadic computation (f x). Return (m-result x) for the first - x for which (p x) is true." - [p f x] - (if (p x) - (m-result x) - (domonad - [y (f x) - z (m-until p f y)] - z))) - -(defmacro m-when - "If test is logical true, return monadic value m-expr, else return - (m-result nil)." - [test m-expr] - `(if ~test ~m-expr (~'m-result nil))) - -(defmacro m-when-not - "If test if logical false, return monadic value m-expr, else return - (m-result nil)." - [test m-expr] - `(if ~test (~'m-result nil) ~m-expr)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Utility functions used in monad definitions -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- flatten* - "Like #(apply concat %), but fully lazy: it evaluates each sublist - only when it is needed." - [ss] - (lazy-seq - (when-let [s (seq ss)] - (concat (first s) (flatten* (rest s)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Commonly used monads -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; Identity monad -(defmonad identity-m - "Monad describing plain computations. This monad does in fact nothing - at all. It is useful for testing, for combination with monad - transformers, and for code that is parameterized with a monad." - [m-result identity - m-bind (fn m-result-id [mv f] - (f mv)) - ]) - -; Maybe monad -(defmonad maybe-m - "Monad describing computations with possible failures. Failure is - represented by nil, any other value is considered valid. As soon as - a step returns nil, the whole computation will yield nil as well." - [m-zero nil - m-result (fn m-result-maybe [v] v) - m-bind (fn m-bind-maybe [mv f] - (if (nil? mv) nil (f mv))) - m-plus (fn m-plus-maybe [& mvs] - (first (drop-while nil? mvs))) - ]) - -; Sequence monad (called "list monad" in Haskell) -(defmonad sequence-m - "Monad describing multi-valued computations, i.e. computations - that can yield multiple values. Any object implementing the seq - protocol can be used as a monadic value." - [m-result (fn m-result-sequence [v] - (list v)) - m-bind (fn m-bind-sequence [mv f] - (flatten* (map f mv))) - m-zero (list) - m-plus (fn m-plus-sequence [& mvs] - (flatten* mvs)) - ]) - -; Set monad -(defmonad set-m - "Monad describing multi-valued computations, like sequence-m, - but returning sets of results instead of sequences of results." - [m-result (fn m-result-set [v] - #{v}) - m-bind (fn m-bind-set [mv f] - (apply clojure.set/union (map f mv))) - m-zero #{} - m-plus (fn m-plus-set [& mvs] - (apply clojure.set/union mvs)) - ]) - -; State monad -(defmonad state-m - "Monad describing stateful computations. The monadic values have the - structure (fn [old-state] [result new-state])." - [m-result (fn m-result-state [v] - (fn [s] [v s])) - m-bind (fn m-bind-state [mv f] - (fn [s] - (let [[v ss] (mv s)] - ((f v) ss)))) - ]) - -(defn update-state - "Return a state-monad function that replaces the current state by the - result of f applied to the current state and that returns the old state." - [f] - (fn [s] [s (f s)])) - -(defn set-state - "Return a state-monad function that replaces the current state by s and - returns the previous state." - [s] - (update-state (fn [_] s))) - -(defn fetch-state - "Return a state-monad function that returns the current state and does not - modify it." - [] - (update-state identity)) - -(defn fetch-val - "Return a state-monad function that assumes the state to be a map and - returns the value corresponding to the given key. The state is not modified." - [key] - (domonad state-m - [s (fetch-state)] - (key s))) - -(defn update-val - "Return a state-monad function that assumes the state to be a map and - replaces the value associated with the given key by the return value - of f applied to the old value. The old value is returned." - [key f] - (fn [s] - (let [old-val (get s key) - new-s (assoc s key (f old-val))] - [old-val new-s]))) - -(defn set-val - "Return a state-monad function that assumes the state to be a map and - replaces the value associated with key by val. The old value is returned." - [key val] - (update-val key (fn [_] val))) - -(defn with-state-field - "Returns a state-monad function that expects a map as its state and - runs statement (another state-monad function) on the state defined by - the map entry corresponding to key. The map entry is updated with the - new state returned by statement." - [key statement] - (fn [s] - (let [substate (get s key nil) - [result new-substate] (statement substate) - new-state (assoc s key new-substate)] - [result new-state]))) - -(defn state-m-until - "An optimized implementation of m-until for the state monad that - replaces recursion by a loop." - [p f x] - (letfn [(until [p f x s] - (if (p x) - [x s] - (let [[x s] ((f x) s)] - (recur p f x s))))] - (fn [s] (until p f x s)))) - -; Writer monad -(defn writer-m - "Monad describing computations that accumulate data on the side, e.g. for - logging. The monadic values have the structure [value log]. Any of the - accumulators from clojure.contrib.accumulators can be used for storing the - log data. Its empty value is passed as a parameter." - [empty-accumulator] - (monad - [m-result (fn m-result-writer [v] - [v empty-accumulator]) - m-bind (fn m-bind-writer [mv f] - (let [[v1 a1] mv - [v2 a2] (f v1)] - [v2 (clojure.contrib.accumulators/combine a1 a2)])) - ])) - -(defmonadfn write [v] - (let [[_ a] (m-result nil)] - [nil (clojure.contrib.accumulators/add a v)])) - -(defn listen [mv] - (let [[v a] mv] [[v a] a])) - -(defn censor [f mv] - (let [[v a] mv] [v (f a)])) - -; Continuation monad - -(defmonad cont-m - "Monad describing computations in continuation-passing style. The monadic - values are functions that are called with a single argument representing - the continuation of the computation, to which they pass their result." - [m-result (fn m-result-cont [v] - (fn [c] (c v))) - m-bind (fn m-bind-cont [mv f] - (fn [c] - (mv (fn [v] ((f v) c))))) - ]) - -(defn run-cont - "Execute the computation c in the cont monad and return its result." - [c] - (c identity)) - -(defn call-cc - "A computation in the cont monad that calls function f with a single - argument representing the current continuation. The function f should - return a continuation (which becomes the return value of call-cc), - or call the passed-in current continuation to terminate." - [f] - (fn [c] - (let [cc (fn cc [a] (fn [_] (c a))) - rc (f cc)] - (rc c)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Monad transformers -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro monad-transformer - "Define a monad transforer in terms of the monad operations and the base - monad. The argument which-m-plus chooses if m-zero and m-plus are taken - from the base monad or from the transformer." - [base which-m-plus operations] - `(let [which-m-plus# (cond (= ~which-m-plus :m-plus-default) - (if (= ::undefined (with-monad ~base ~'m-plus)) - :m-plus-from-transformer - :m-plus-from-base) - (or (= ~which-m-plus :m-plus-from-base) - (= ~which-m-plus :m-plus-from-transformer)) - ~which-m-plus - :else - (throw (java.lang.IllegalArgumentException. - "undefined m-plus choice"))) - combined-monad# (monad ~operations)] - (if (= which-m-plus# :m-plus-from-base) - (assoc combined-monad# - :m-zero (with-monad ~base ~'m-zero) - :m-plus (with-monad ~base ~'m-plus)) - combined-monad#))) - -(defn maybe-t - "Monad transformer that transforms a monad m into a monad in which - the base values can be invalid (represented by nothing, which defaults - to nil). The third argument chooses if m-zero and m-plus are inherited - from the base monad (use :m-plus-from-base) or adopt maybe-like - behaviour (use :m-plus-from-transformer). The default is :m-plus-from-base - if the base monad m has a definition for m-plus, and - :m-plus-from-transformer otherwise." - ([m] (maybe-t m nil :m-plus-default)) - ([m nothing] (maybe-t m nothing :m-plus-default)) - ([m nothing which-m-plus] - (monad-transformer m which-m-plus - [m-result (with-monad m m-result) - m-bind (with-monad m - (fn m-bind-maybe-t [mv f] - (m-bind mv - (fn [x] - (if (identical? x nothing) - (m-result nothing) - (f x)))))) - m-zero (with-monad m (m-result nothing)) - m-plus (with-monad m - (fn m-plus-maybe-t [& mvs] - (if (empty? mvs) - (m-result nothing) - (m-bind (first mvs) - (fn [v] - (if (= v nothing) - (apply m-plus-maybe-t (rest mvs)) - (m-result v))))))) - ]))) - -(defn sequence-t - "Monad transformer that transforms a monad m into a monad in which - the base values are sequences. The argument which-m-plus chooses - if m-zero and m-plus are inherited from the base monad - (use :m-plus-from-base) or adopt sequence-like - behaviour (use :m-plus-from-transformer). The default is :m-plus-from-base - if the base monad m has a definition for m-plus, and - :m-plus-from-transformer otherwise." - ([m] (sequence-t m :m-plus-default)) - ([m which-m-plus] - (monad-transformer m which-m-plus - [m-result (with-monad m - (fn m-result-sequence-t [v] - (m-result (list v)))) - m-bind (with-monad m - (fn m-bind-sequence-t [mv f] - (m-bind mv - (fn [xs] - (m-fmap flatten* - (m-map f xs)))))) - m-zero (with-monad m (m-result (list))) - m-plus (with-monad m - (fn m-plus-sequence-t [& mvs] - (m-reduce concat (list) mvs))) - ]))) - -;; Contributed by Jim Duey -(defn state-t - "Monad transformer that transforms a monad m into a monad of stateful - computations that have the base monad type as their result." - [m] - (monad [m-result (with-monad m - (fn m-result-state-t [v] - (fn [s] - (m-result [v s])))) - m-bind (with-monad m - (fn m-bind-state-t [stm f] - (fn [s] - (m-bind (stm s) - (fn [[v ss]] - ((f v) ss)))))) - m-zero (with-monad m - (if (= ::undefined m-zero) - ::undefined - (fn [s] - m-zero))) - m-plus (with-monad m - (if (= ::undefined m-plus) - ::undefined - (fn [& stms] - (fn [s] - (apply m-plus (map #(% s) stms)))))) - ])) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/ns_utils.clj --- a/src/clojure/contrib/ns_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,100 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. - -;; scgilardi (gmail) -;; 23 April 2008 - -;; DEPRECATED in 1.2: dir and print-dir. Use dir and dir-fn in -;; clojure.repl. - -(ns - ^{:author "Stephen C. Gilardi", - :doc "Namespace utilities - - get-ns returns the namespace named by a symbol or throws - if the namespace does not exist - - ns-vars returns a sorted seq of symbols naming public vars - in a namespace - - print-docs prints documentation for the public vars in a - namespace - - immigrate Create a public var in this namespace for each - public var in the namespaces named by ns-names. - From James Reeves - - vars returns a sorted seq of symbols naming public vars - in a namespace (macro) - - docs prints documentation for the public vars in a - namespace (macro)"} - clojure.contrib.ns-utils - (:use clojure.contrib.except)) - -;; Namespace Utilities - -(defn get-ns - "Returns the namespace named by ns-sym or throws if the - namespace does not exist" - [ns-sym] - (let [ns (find-ns ns-sym)] - (throw-if (not ns) "Unable to find namespace: %s" ns-sym) - ns)) - -(defn ns-vars - "Returns a sorted seq of symbols naming public vars in - a namespace" - [ns] - (sort (map first (ns-publics ns)))) - -(defn print-dir - "Prints a sorted directory of public vars in a namespace" - {:deprecated "1.2"} - [ns] - (doseq [item (ns-vars ns)] - (println item))) - -(defn print-docs - "Prints documentation for the public vars in a namespace" - [ns] - (doseq [item (ns-vars ns)] - (print-doc (ns-resolve ns item)))) - -;; Convenience - -(defmacro vars - "Returns a sorted seq of symbols naming public vars in - a namespace" - [nsname] - `(ns-vars (get-ns '~nsname))) - -(defmacro dir - "Prints a sorted directory of public vars in a namespace" - {:deprecated "1.2"} - [nsname] - `(print-dir (get-ns '~nsname))) - -(defmacro docs - "Prints documentation for the public vars in a namespace" - [nsname] - `(print-docs (get-ns '~nsname))) - -(defn immigrate - "Create a public var in this namespace for each public var in the - namespaces named by ns-names. The created vars have the same name, root - binding, and metadata as the original except that their :ns metadata - value is this namespace." - [& ns-names] - (doseq [ns ns-names] - (require ns) - (doseq [[sym var] (ns-publics ns)] - (let [sym (with-meta sym (assoc (meta var) :ns *ns*))] - (if (.hasRoot var) - (intern *ns* sym (.getRoot var)) - (intern *ns* sym)))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/pprint.clj --- a/src/clojure/contrib/pprint.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -;;; pprint.clj -- Pretty printer and Common Lisp compatible format function (cl-format) for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -;; Copyright (c) Tom Faulhaber, April 2009. All rights reserved. -;; The use and distribution terms for this software are covered by the -;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this distribution. -;; By using this software in any fashion, you are agreeing to be bound by -;; the terms of this license. -;; You must not remove this notice, or any other, from this -;; software. - -;; DEPRECATED in 1.2. Promoted to clojure.pprint - -(ns - ^{:author "Tom Faulhaber", - :deprecated "1.2" - :doc "This module comprises two elements: -1) A pretty printer for Clojure data structures, implemented in the - function \"pprint\" -2) A Common Lisp compatible format function, implemented as - \"cl-format\" because Clojure is using the name \"format\" - for its Java-based format function. - -See documentation for those functions for more information or complete -documentation on the the clojure-contrib web site on github.", - } - clojure.contrib.pprint - (:use clojure.contrib.pprint.utilities) - (:use clojure.contrib.pprint.pretty-writer - clojure.contrib.pprint.column-writer)) - - -(load "pprint/pprint_base") -(load "pprint/cl_format") -(load "pprint/dispatch") - -nil diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/pprint/cl_format.clj --- a/src/clojure/contrib/pprint/cl_format.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1844 +0,0 @@ -;;; cl_format.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This module implements the Common Lisp compatible format function as documented -;; in "Common Lisp the Language, 2nd edition", Chapter 22 (available online at: -;; http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) - -(in-ns 'clojure.contrib.pprint) - -;;; Forward references -(declare compile-format) -(declare execute-format) -(declare init-navigator) -;;; End forward references - -(defn cl-format - "An implementation of a Common Lisp compatible format function. cl-format formats its -arguments to an output stream or string based on the format control string given. It -supports sophisticated formatting of structured data. - -Writer is an instance of java.io.Writer, true to output to *out* or nil to output -to a string, format-in is the format control string and the remaining arguments -are the data to be formatted. - -The format control string is a string to be output with embedded 'format directives' -describing how to format the various arguments passed in. - -If writer is nil, cl-format returns the formatted result string. Otherwise, cl-format -returns nil. - -For example: - (let [results [46 38 22]] - (cl-format true \"There ~[are~;is~:;are~]~:* ~d result~:p: ~{~d~^, ~}~%\" - (count results) results)) - -Prints to *out*: - There are 3 results: 46, 38, 22 - -Detailed documentation on format control strings is available in the \"Common Lisp the -Language, 2nd edition\", Chapter 22 (available online at: -http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) -and in the Common Lisp HyperSpec at -http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm -" - {:see-also [["http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000" - "Common Lisp the Language"] - ["http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm" - "Common Lisp HyperSpec"]]} - [writer format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format writer compiled-format navigator))) - -(def ^{:private true} *format-str* nil) - -(defn- format-error [message offset] - (let [full-message (str message \newline *format-str* \newline - (apply str (repeat offset \space)) "^" \newline)] - (throw (RuntimeException. full-message)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Argument navigators manage the argument list -;;; as the format statement moves through the list -;;; (possibly going forwards and backwards as it does so) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defstruct ^{:private true} - arg-navigator :seq :rest :pos ) - -(defn init-navigator - "Create a new arg-navigator from the sequence with the position set to 0" - {:skip-wiki true} - [s] - (let [s (seq s)] - (struct arg-navigator s s 0))) - -;; TODO call format-error with offset -(defn- next-arg [ navigator ] - (let [ rst (:rest navigator) ] - (if rst - [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] - (throw (new Exception "Not enough arguments for format definition"))))) - -(defn- next-arg-or-nil [navigator] - (let [rst (:rest navigator)] - (if rst - [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] - [nil navigator]))) - -;; Get an argument off the arg list and compile it if it's not already compiled -(defn- get-format-arg [navigator] - (let [[raw-format navigator] (next-arg navigator) - compiled-format (if (instance? String raw-format) - (compile-format raw-format) - raw-format)] - [compiled-format navigator])) - -(declare relative-reposition) - -(defn- absolute-reposition [navigator position] - (if (>= position (:pos navigator)) - (relative-reposition navigator (- (:pos navigator) position)) - (struct arg-navigator (:seq navigator) (drop position (:seq navigator)) position))) - -(defn- relative-reposition [navigator position] - (let [newpos (+ (:pos navigator) position)] - (if (neg? position) - (absolute-reposition navigator newpos) - (struct arg-navigator (:seq navigator) (drop position (:rest navigator)) newpos)))) - -(defstruct ^{:private true} - compiled-directive :func :def :params :offset) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; When looking at the parameter list, we may need to manipulate -;;; the argument list as well (for 'V' and '#' parameter types). -;;; We hide all of this behind a function, but clients need to -;;; manage changing arg navigator -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: validate parameters when they come from arg list -(defn- realize-parameter [[param [raw-val offset]] navigator] - (let [[real-param new-navigator] - (cond - (contains? #{ :at :colon } param) ;pass flags through unchanged - this really isn't necessary - [raw-val navigator] - - (= raw-val :parameter-from-args) - (next-arg navigator) - - (= raw-val :remaining-arg-count) - [(count (:rest navigator)) navigator] - - true - [raw-val navigator])] - [[param [real-param offset]] new-navigator])) - -(defn- realize-parameter-list [parameter-map navigator] - (let [[pairs new-navigator] - (map-passing-context realize-parameter navigator parameter-map)] - [(into {} pairs) new-navigator])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions that support individual directives -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Common handling code for ~A and ~S -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare opt-base-str) - -(def ^{:private true} - special-radix-markers {2 "#b" 8 "#o", 16 "#x"}) - -(defn- format-simple-number [n] - (cond - (integer? n) (if (= *print-base* 10) - (str n (if *print-radix* ".")) - (str - (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) - (opt-base-str *print-base* n))) - (ratio? n) (str - (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) - (opt-base-str *print-base* (.numerator n)) - "/" - (opt-base-str *print-base* (.denominator n))) - :else nil)) - -(defn- format-ascii [print-func params arg-navigator offsets] - (let [ [arg arg-navigator] (next-arg arg-navigator) - ^String base-output (or (format-simple-number arg) (print-func arg)) - base-width (.length base-output) - min-width (+ base-width (:minpad params)) - width (if (>= min-width (:mincol params)) - min-width - (+ min-width - (* (+ (quot (- (:mincol params) min-width 1) - (:colinc params) ) - 1) - (:colinc params)))) - chars (apply str (repeat (- width base-width) (:padchar params)))] - (if (:at params) - (print (str chars base-output)) - (print (str base-output chars))) - arg-navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the integer directives ~D, ~X, ~O, ~B and some -;;; of ~R -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- integral? - "returns true if a number is actually an integer (that is, has no fractional part)" - [x] - (cond - (integer? x) true - (decimal? x) (>= (.ulp (.stripTrailingZeros (bigdec 0))) 1) ; true iff no fractional part - (float? x) (= x (Math/floor x)) - (ratio? x) (let [^clojure.lang.Ratio r x] - (= 0 (rem (.numerator r) (.denominator r)))) - :else false)) - -(defn- remainders - "Return the list of remainders (essentially the 'digits') of val in the given base" - [base val] - (reverse - (first - (consume #(if (pos? %) - [(rem % base) (quot % base)] - [nil nil]) - val)))) - -;;; TODO: xlated-val does not seem to be used here. -(defn- base-str - "Return val as a string in the given base" - [base val] - (if (zero? val) - "0" - (let [xlated-val (cond - (float? val) (bigdec val) - (ratio? val) (let [^clojure.lang.Ratio r val] - (/ (.numerator r) (.denominator r))) - :else val)] - (apply str - (map - #(if (< % 10) (char (+ (int \0) %)) (char (+ (int \a) (- % 10)))) - (remainders base val)))))) - -(def ^{:private true} - java-base-formats {8 "%o", 10 "%d", 16 "%x"}) - -(defn- opt-base-str - "Return val as a string in the given base, using clojure.core/format if supported -for improved performance" - [base val] - (let [format-str (get java-base-formats base)] - (if (and format-str (integer? val) (-> val class .getName (.startsWith "java."))) - (clojure.core/format format-str val) - (base-str base val)))) - -(defn- group-by* [unit lis] - (reverse - (first - (consume (fn [x] [(seq (reverse (take unit x))) (seq (drop unit x))]) (reverse lis))))) - -(defn- format-integer [base params arg-navigator offsets] - (let [[arg arg-navigator] (next-arg arg-navigator)] - (if (integral? arg) - (let [neg (neg? arg) - pos-arg (if neg (- arg) arg) - raw-str (opt-base-str base pos-arg) - group-str (if (:colon params) - (let [groups (map #(apply str %) (group-by* (:commainterval params) raw-str)) - commas (repeat (count groups) (:commachar params))] - (apply str (next (interleave commas groups)))) - raw-str) - ^String signed-str (cond - neg (str "-" group-str) - (:at params) (str "+" group-str) - true group-str) - padded-str (if (< (.length signed-str) (:mincol params)) - (str (apply str (repeat (- (:mincol params) (.length signed-str)) - (:padchar params))) - signed-str) - signed-str)] - (print padded-str)) - (format-ascii print-str {:mincol (:mincol params) :colinc 1 :minpad 0 - :padchar (:padchar params) :at true} - (init-navigator [arg]) nil)) - arg-navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for english formats (~R and ~:R) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - english-cardinal-units - ["zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" - "ten" "eleven" "twelve" "thirteen" "fourteen" - "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"]) - -(def ^{:private true} - english-ordinal-units - ["zeroth" "first" "second" "third" "fourth" "fifth" "sixth" "seventh" "eighth" "ninth" - "tenth" "eleventh" "twelfth" "thirteenth" "fourteenth" - "fifteenth" "sixteenth" "seventeenth" "eighteenth" "nineteenth"]) - -(def ^{:private true} - english-cardinal-tens - ["" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"]) - -(def ^{:private true} - english-ordinal-tens - ["" "" "twentieth" "thirtieth" "fortieth" "fiftieth" - "sixtieth" "seventieth" "eightieth" "ninetieth"]) - -;; We use "short scale" for our units (see http://en.wikipedia.org/wiki/Long_and_short_scales) -;; Number names from http://www.jimloy.com/math/billion.htm -;; We follow the rules for writing numbers from the Blue Book -;; (http://www.grammarbook.com/numbers/numbers.asp) -(def ^{:private true} - english-scale-numbers - ["" "thousand" "million" "billion" "trillion" "quadrillion" "quintillion" - "sextillion" "septillion" "octillion" "nonillion" "decillion" - "undecillion" "duodecillion" "tredecillion" "quattuordecillion" - "quindecillion" "sexdecillion" "septendecillion" - "octodecillion" "novemdecillion" "vigintillion"]) - -(defn- format-simple-cardinal - "Convert a number less than 1000 to a cardinal english string" - [num] - (let [hundreds (quot num 100) - tens (rem num 100)] - (str - (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) - (if (and (pos? hundreds) (pos? tens)) " ") - (if (pos? tens) - (if (< tens 20) - (nth english-cardinal-units tens) - (let [ten-digit (quot tens 10) - unit-digit (rem tens 10)] - (str - (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) - (if (and (pos? ten-digit) (pos? unit-digit)) "-") - (if (pos? unit-digit) (nth english-cardinal-units unit-digit))))))))) - -(defn- add-english-scales - "Take a sequence of parts, add scale numbers (e.g., million) and combine into a string -offset is a factor of 10^3 to multiply by" - [parts offset] - (let [cnt (count parts)] - (loop [acc [] - pos (dec cnt) - this (first parts) - remainder (next parts)] - (if (nil? remainder) - (str (apply str (interpose ", " acc)) - (if (and (not (empty? this)) (not (empty? acc))) ", ") - this - (if (and (not (empty? this)) (pos? (+ pos offset))) - (str " " (nth english-scale-numbers (+ pos offset))))) - (recur - (if (empty? this) - acc - (conj acc (str this " " (nth english-scale-numbers (+ pos offset))))) - (dec pos) - (first remainder) - (next remainder)))))) - -(defn- format-cardinal-english [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (= 0 arg) - (print "zero") - (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs - parts (remainders 1000 abs-arg)] - (if (<= (count parts) (count english-scale-numbers)) - (let [parts-strs (map format-simple-cardinal parts) - full-str (add-english-scales parts-strs 0)] - (print (str (if (neg? arg) "minus ") full-str))) - (format-integer ;; for numbers > 10^63, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})))) - navigator)) - -(defn- format-simple-ordinal - "Convert a number less than 1000 to a ordinal english string -Note this should only be used for the last one in the sequence" - [num] - (let [hundreds (quot num 100) - tens (rem num 100)] - (str - (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) - (if (and (pos? hundreds) (pos? tens)) " ") - (if (pos? tens) - (if (< tens 20) - (nth english-ordinal-units tens) - (let [ten-digit (quot tens 10) - unit-digit (rem tens 10)] - (if (and (pos? ten-digit) (not (pos? unit-digit))) - (nth english-ordinal-tens ten-digit) - (str - (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) - (if (and (pos? ten-digit) (pos? unit-digit)) "-") - (if (pos? unit-digit) (nth english-ordinal-units unit-digit)))))) - (if (pos? hundreds) "th"))))) - -(defn- format-ordinal-english [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (= 0 arg) - (print "zeroth") - (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs - parts (remainders 1000 abs-arg)] - (if (<= (count parts) (count english-scale-numbers)) - (let [parts-strs (map format-simple-cardinal (drop-last parts)) - head-str (add-english-scales parts-strs 1) - tail-str (format-simple-ordinal (last parts))] - (print (str (if (neg? arg) "minus ") - (cond - (and (not (empty? head-str)) (not (empty? tail-str))) - (str head-str ", " tail-str) - - (not (empty? head-str)) (str head-str "th") - :else tail-str)))) - (do (format-integer ;; for numbers > 10^63, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0}) - (let [low-two-digits (rem arg 100) - not-teens (or (< 11 low-two-digits) (> 19 low-two-digits)) - low-digit (rem low-two-digits 10)] - (print (cond - (and (== low-digit 1) not-teens) "st" - (and (== low-digit 2) not-teens) "nd" - (and (== low-digit 3) not-teens) "rd" - :else "th"))))))) - navigator)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for roman numeral formats (~@R and ~@:R) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - old-roman-table - [[ "I" "II" "III" "IIII" "V" "VI" "VII" "VIII" "VIIII"] - [ "X" "XX" "XXX" "XXXX" "L" "LX" "LXX" "LXXX" "LXXXX"] - [ "C" "CC" "CCC" "CCCC" "D" "DC" "DCC" "DCCC" "DCCCC"] - [ "M" "MM" "MMM"]]) - -(def ^{:private true} - new-roman-table - [[ "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX"] - [ "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC"] - [ "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM"] - [ "M" "MM" "MMM"]]) - -(defn- format-roman - "Format a roman numeral using the specified look-up table" - [table params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (and (number? arg) (> arg 0) (< arg 4000)) - (let [digits (remainders 10 arg)] - (loop [acc [] - pos (dec (count digits)) - digits digits] - (if (empty? digits) - (print (apply str acc)) - (let [digit (first digits)] - (recur (if (= 0 digit) - acc - (conj acc (nth (nth table pos) (dec digit)))) - (dec pos) - (next digits)))))) - (format-integer ;; for anything <= 0 or > 3999, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})) - navigator)) - -(defn- format-old-roman [params navigator offsets] - (format-roman old-roman-table params navigator offsets)) - -(defn- format-new-roman [params navigator offsets] - (format-roman new-roman-table params navigator offsets)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for character formats (~C) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - special-chars { 8 "Backspace", 9 "Tab", 10 "Newline", 13 "Return", 32 "Space"}) - -(defn- pretty-character [params navigator offsets] - (let [[c navigator] (next-arg navigator) - as-int (int c) - base-char (bit-and as-int 127) - meta (bit-and as-int 128) - special (get special-chars base-char)] - (if (> meta 0) (print "Meta-")) - (print (cond - special special - (< base-char 32) (str "Control-" (char (+ base-char 64))) - (= base-char 127) "Control-?" - :else (char base-char))) - navigator)) - -(defn- readable-character [params navigator offsets] - (let [[c navigator] (next-arg navigator)] - (condp = (:char-format params) - \o (cl-format true "\\o~3,'0o" (int c)) - \u (cl-format true "\\u~4,'0x" (int c)) - nil (pr c)) - navigator)) - -(defn- plain-character [params navigator offsets] - (let [[char navigator] (next-arg navigator)] - (print char) - navigator)) - -;; Check to see if a result is an abort (~^) construct -;; TODO: move these funcs somewhere more appropriate -(defn- abort? [context] - (let [token (first context)] - (or (= :up-arrow token) (= :colon-up-arrow token)))) - -;; Handle the execution of "sub-clauses" in bracket constructions -(defn- execute-sub-format [format args base-args] - (second - (map-passing-context - (fn [element context] - (if (abort? context) - [nil context] ; just keep passing it along - (let [[params args] (realize-parameter-list (:params element) context) - [params offsets] (unzip-map params) - params (assoc params :base-args base-args)] - [nil (apply (:func element) [params args offsets])]))) - args - format))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for real number formats -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO - return exponent as int to eliminate double conversion -(defn- float-parts-base - "Produce string parts for the mantissa (normalized 1-9) and exponent" - [^Object f] - (let [^String s (.toLowerCase (.toString f)) - exploc (.indexOf s (int \e))] - (if (neg? exploc) - (let [dotloc (.indexOf s (int \.))] - (if (neg? dotloc) - [s (str (dec (count s)))] - [(str (subs s 0 dotloc) (subs s (inc dotloc))) (str (dec dotloc))])) - [(str (subs s 0 1) (subs s 2 exploc)) (subs s (inc exploc))]))) - - -(defn- float-parts - "Take care of leading and trailing zeros in decomposed floats" - [f] - (let [[m ^String e] (float-parts-base f) - m1 (rtrim m \0) - m2 (ltrim m1 \0) - delta (- (count m1) (count m2)) - ^String e (if (and (pos? (count e)) (= (nth e 0) \+)) (subs e 1) e)] - (if (empty? m2) - ["0" 0] - [m2 (- (Integer/valueOf e) delta)]))) - -(defn- round-str [m e d w] - (if (or d w) - (let [len (count m) - round-pos (if d (+ e d 1)) - round-pos (if (and w (< (inc e) (dec w)) - (or (nil? round-pos) (< (dec w) round-pos))) - (dec w) - round-pos) - [m1 e1 round-pos len] (if (= round-pos 0) - [(str "0" m) (inc e) 1 (inc len)] - [m e round-pos len])] - (if round-pos - (if (neg? round-pos) - ["0" 0 false] - (if (> len round-pos) - (let [round-char (nth m1 round-pos) - ^String result (subs m1 0 round-pos)] - (if (>= (int round-char) (int \5)) - (let [result-val (Integer/valueOf result) - leading-zeros (subs result 0 (min (prefix-count result \0) (- round-pos 1))) - round-up-result (str leading-zeros - (String/valueOf (+ result-val - (if (neg? result-val) -1 1)))) - expanded (> (count round-up-result) (count result))] - [round-up-result e1 expanded]) - [result e1 false])) - [m e false])) - [m e false])) - [m e false])) - -(defn- expand-fixed [m e d] - (let [m1 (if (neg? e) (str (apply str (repeat (dec (- e)) \0)) m) m) - len (count m1) - target-len (if d (+ e d 1) (inc e))] - (if (< len target-len) - (str m1 (apply str (repeat (- target-len len) \0))) - m1))) - -(defn- insert-decimal - "Insert the decimal point at the right spot in the number to match an exponent" - [m e] - (if (neg? e) - (str "." m) - (let [loc (inc e)] - (str (subs m 0 loc) "." (subs m loc))))) - -(defn- get-fixed [m e d] - (insert-decimal (expand-fixed m e d) e)) - -(defn- insert-scaled-decimal - "Insert the decimal point at the right spot in the number to match an exponent" - [m k] - (if (neg? k) - (str "." m) - (str (subs m 0 k) "." (subs m k)))) - -;; the function to render ~F directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -(defn- fixed-float [params navigator offsets] - (let [w (:w params) - d (:d params) - [arg navigator] (next-arg navigator) - [sign abs] (if (neg? arg) ["-" (- arg)] ["+" arg]) - [mantissa exp] (float-parts abs) - scaled-exp (+ exp (:k params)) - add-sign (or (:at params) (neg? arg)) - append-zero (and (not d) (<= (dec (count mantissa)) scaled-exp)) - [rounded-mantissa scaled-exp expanded] (round-str mantissa scaled-exp - d (if w (- w (if add-sign 1 0)))) - fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) - prepend-zero (= (first fixed-repr) \.)] - (if w - (let [len (count fixed-repr) - signed-len (if add-sign (inc len) len) - prepend-zero (and prepend-zero (not (>= signed-len w))) - append-zero (and append-zero (not (>= signed-len w))) - full-len (if (or prepend-zero append-zero) - (inc signed-len) - signed-len)] - (if (and (> full-len w) (:overflowchar params)) - (print (apply str (repeat w (:overflowchar params)))) - (print (str - (apply str (repeat (- w full-len) (:padchar params))) - (if add-sign sign) - (if prepend-zero "0") - fixed-repr - (if append-zero "0"))))) - (print (str - (if add-sign sign) - (if prepend-zero "0") - fixed-repr - (if append-zero "0")))) - navigator)) - - -;; the function to render ~E directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -;; TODO: define ~E representation for Infinity -(defn- exponential-float [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (loop [[mantissa exp] (float-parts (if (neg? arg) (- arg) arg))] - (let [w (:w params) - d (:d params) - e (:e params) - k (:k params) - expchar (or (:exponentchar params) \E) - add-sign (or (:at params) (neg? arg)) - prepend-zero (<= k 0) - ^Integer scaled-exp (- exp (dec k)) - scaled-exp-str (str (Math/abs scaled-exp)) - scaled-exp-str (str expchar (if (neg? scaled-exp) \- \+) - (if e (apply str - (repeat - (- e - (count scaled-exp-str)) - \0))) - scaled-exp-str) - exp-width (count scaled-exp-str) - base-mantissa-width (count mantissa) - scaled-mantissa (str (apply str (repeat (- k) \0)) - mantissa - (if d - (apply str - (repeat - (- d (dec base-mantissa-width) - (if (neg? k) (- k) 0)) \0)))) - w-mantissa (if w (- w exp-width)) - [rounded-mantissa _ incr-exp] (round-str - scaled-mantissa 0 - (cond - (= k 0) (dec d) - (pos? k) d - (neg? k) (dec d)) - (if w-mantissa - (- w-mantissa (if add-sign 1 0)))) - full-mantissa (insert-scaled-decimal rounded-mantissa k) - append-zero (and (= k (count rounded-mantissa)) (nil? d))] - (if (not incr-exp) - (if w - (let [len (+ (count full-mantissa) exp-width) - signed-len (if add-sign (inc len) len) - prepend-zero (and prepend-zero (not (= signed-len w))) - full-len (if prepend-zero (inc signed-len) signed-len) - append-zero (and append-zero (< full-len w))] - (if (and (or (> full-len w) (and e (> (- exp-width 2) e))) - (:overflowchar params)) - (print (apply str (repeat w (:overflowchar params)))) - (print (str - (apply str - (repeat - (- w full-len (if append-zero 1 0) ) - (:padchar params))) - (if add-sign (if (neg? arg) \- \+)) - (if prepend-zero "0") - full-mantissa - (if append-zero "0") - scaled-exp-str)))) - (print (str - (if add-sign (if (neg? arg) \- \+)) - (if prepend-zero "0") - full-mantissa - (if append-zero "0") - scaled-exp-str))) - (recur [rounded-mantissa (inc exp)])))) - navigator)) - -;; the function to render ~G directives -;; This just figures out whether to pass the request off to ~F or ~E based -;; on the algorithm in CLtL. -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -;; TODO: refactor so that float-parts isn't called twice -(defn- general-float [params navigator offsets] - (let [[arg _] (next-arg navigator) - [mantissa exp] (float-parts (if (neg? arg) (- arg) arg)) - w (:w params) - d (:d params) - e (:e params) - n (if (= arg 0.0) 0 (inc exp)) - ee (if e (+ e 2) 4) - ww (if w (- w ee)) - d (if d d (max (count mantissa) (min n 7))) - dd (- d n)] - (if (<= 0 dd d) - (let [navigator (fixed-float {:w ww, :d dd, :k 0, - :overflowchar (:overflowchar params), - :padchar (:padchar params), :at (:at params)} - navigator offsets)] - (print (apply str (repeat ee \space))) - navigator) - (exponential-float params navigator offsets)))) - -;; the function to render ~$ directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -(defn- dollar-float [params navigator offsets] - (let [[^Double arg navigator] (next-arg navigator) - [mantissa exp] (float-parts (Math/abs arg)) - d (:d params) ; digits after the decimal - n (:n params) ; minimum digits before the decimal - w (:w params) ; minimum field width - add-sign (or (:at params) (neg? arg)) - [rounded-mantissa scaled-exp expanded] (round-str mantissa exp d nil) - ^String fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) - full-repr (str (apply str (repeat (- n (.indexOf fixed-repr (int \.))) \0)) fixed-repr) - full-len (+ (count full-repr) (if add-sign 1 0))] - (print (str - (if (and (:colon params) add-sign) (if (neg? arg) \- \+)) - (apply str (repeat (- w full-len) (:padchar params))) - (if (and (not (:colon params)) add-sign) (if (neg? arg) \- \+)) - full-repr)) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~[...~]' conditional construct in its -;;; different flavors -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; ~[...~] without any modifiers chooses one of the clauses based on the param or -;; next argument -;; TODO check arg is positive int -(defn- choice-conditional [params arg-navigator offsets] - (let [arg (:selector params) - [arg navigator] (if arg [arg arg-navigator] (next-arg arg-navigator)) - clauses (:clauses params) - clause (if (or (neg? arg) (>= arg (count clauses))) - (first (:else params)) - (nth clauses arg))] - (if clause - (execute-sub-format clause navigator (:base-args params)) - navigator))) - -;; ~:[...~] with the colon reads the next argument treating it as a truth value -(defn- boolean-conditional [params arg-navigator offsets] - (let [[arg navigator] (next-arg arg-navigator) - clauses (:clauses params) - clause (if arg - (second clauses) - (first clauses))] - (if clause - (execute-sub-format clause navigator (:base-args params)) - navigator))) - -;; ~@[...~] with the at sign executes the conditional if the next arg is not -;; nil/false without consuming the arg -(defn- check-arg-conditional [params arg-navigator offsets] - (let [[arg navigator] (next-arg arg-navigator) - clauses (:clauses params) - clause (if arg (first clauses))] - (if arg - (if clause - (execute-sub-format clause arg-navigator (:base-args params)) - arg-navigator) - navigator))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~{...~}' iteration construct in its -;;; different flavors -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;; ~{...~} without any modifiers uses the next argument as an argument list that -;; is consumed by all the iterations -(defn- iterate-sublist [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator]) - [arg-list navigator] (next-arg navigator) - args (init-navigator arg-list)] - (loop [count 0 - args args - last-pos (num -1)] - (if (and (not max-count) (= (:pos args) last-pos) (> count 1)) - ;; TODO get the offset in here and call format exception - (throw (RuntimeException. "%{ construct not consuming any arguments: Infinite loop!"))) - (if (or (and (empty? (:rest args)) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [iter-result (execute-sub-format clause args (:base-args params))] - (if (= :up-arrow (first iter-result)) - navigator - (recur (inc count) iter-result (:pos args)))))))) - -;; ~:{...~} with the colon treats the next argument as a list of sublists. Each of the -;; sublists is used as the arglist for a single iteration. -(defn- iterate-list-of-sublists [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator]) - [arg-list navigator] (next-arg navigator)] - (loop [count 0 - arg-list arg-list] - (if (or (and (empty? arg-list) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [iter-result (execute-sub-format - clause - (init-navigator (first arg-list)) - (init-navigator (next arg-list)))] - (if (= :colon-up-arrow (first iter-result)) - navigator - (recur (inc count) (next arg-list)))))))) - -;; ~@{...~} with the at sign uses the main argument list as the arguments to the iterations -;; is consumed by all the iterations -(defn- iterate-main-list [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator])] - (loop [count 0 - navigator navigator - last-pos (num -1)] - (if (and (not max-count) (= (:pos navigator) last-pos) (> count 1)) - ;; TODO get the offset in here and call format exception - (throw (RuntimeException. "%@{ construct not consuming any arguments: Infinite loop!"))) - (if (or (and (empty? (:rest navigator)) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [iter-result (execute-sub-format clause navigator (:base-args params))] - (if (= :up-arrow (first iter-result)) - (second iter-result) - (recur - (inc count) iter-result (:pos navigator)))))))) - -;; ~@:{...~} with both colon and at sign uses the main argument list as a set of sublists, one -;; of which is consumed with each iteration -(defn- iterate-main-sublists [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator]) - ] - (loop [count 0 - navigator navigator] - (if (or (and (empty? (:rest navigator)) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [[sublist navigator] (next-arg-or-nil navigator) - iter-result (execute-sub-format clause (init-navigator sublist) navigator)] - (if (= :colon-up-arrow (first iter-result)) - navigator - (recur (inc count) navigator))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The '~< directive has two completely different meanings -;;; in the '~<...~>' form it does justification, but with -;;; ~<...~:>' it represents the logical block operation of the -;;; pretty printer. -;;; -;;; Unfortunately, the current architecture decides what function -;;; to call at form parsing time before the sub-clauses have been -;;; folded, so it is left to run-time to make the decision. -;;; -;;; TODO: make it possible to make these decisions at compile-time. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare format-logical-block) -(declare justify-clauses) - -(defn- logical-block-or-justify [params navigator offsets] - (if (:colon (:right-params params)) - (format-logical-block params navigator offsets) - (justify-clauses params navigator offsets))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~<...~>' justification directive -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- render-clauses [clauses navigator base-navigator] - (loop [clauses clauses - acc [] - navigator navigator] - (if (empty? clauses) - [acc navigator] - (let [clause (first clauses) - [iter-result result-str] (binding [*out* (java.io.StringWriter.)] - [(execute-sub-format clause navigator base-navigator) - (.toString *out*)])] - (if (= :up-arrow (first iter-result)) - [acc (second iter-result)] - (recur (next clauses) (conj acc result-str) iter-result)))))) - -;; TODO support for ~:; constructions -(defn- justify-clauses [params navigator offsets] - (let [[[eol-str] new-navigator] (when-let [else (:else params)] - (render-clauses else navigator (:base-args params))) - navigator (or new-navigator navigator) - [else-params new-navigator] (when-let [p (:else-params params)] - (realize-parameter-list p navigator)) - navigator (or new-navigator navigator) - min-remaining (or (first (:min-remaining else-params)) 0) - max-columns (or (first (:max-columns else-params)) - (get-max-column *out*)) - clauses (:clauses params) - [strs navigator] (render-clauses clauses navigator (:base-args params)) - slots (max 1 - (+ (dec (count strs)) (if (:colon params) 1 0) (if (:at params) 1 0))) - chars (reduce + (map count strs)) - mincol (:mincol params) - minpad (:minpad params) - colinc (:colinc params) - minout (+ chars (* slots minpad)) - result-columns (if (<= minout mincol) - mincol - (+ mincol (* colinc - (+ 1 (quot (- minout mincol 1) colinc))))) - total-pad (- result-columns chars) - pad (max minpad (quot total-pad slots)) - extra-pad (- total-pad (* pad slots)) - pad-str (apply str (repeat pad (:padchar params)))] - (if (and eol-str (> (+ (get-column (:base @@*out*)) min-remaining result-columns) - max-columns)) - (print eol-str)) - (loop [slots slots - extra-pad extra-pad - strs strs - pad-only (or (:colon params) - (and (= (count strs) 1) (not (:at params))))] - (if (seq strs) - (do - (print (str (if (not pad-only) (first strs)) - (if (or pad-only (next strs) (:at params)) pad-str) - (if (pos? extra-pad) (:padchar params)))) - (recur - (dec slots) - (dec extra-pad) - (if pad-only strs (next strs)) - false)))) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for case modification with ~(...~). -;;; We do this by wrapping the underlying writer with -;;; a special writer to do the appropriate modification. This -;;; allows us to support arbitrary-sized output and sources -;;; that may block. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- downcase-writer - "Returns a proxy that wraps writer, converting all characters to lower case" - [^java.io.Writer writer] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s ^String x] - (.write writer (.toLowerCase s))) - - Integer - (let [c ^Character x] - (.write writer (int (Character/toLowerCase (char c)))))))))) - -(defn- upcase-writer - "Returns a proxy that wraps writer, converting all characters to upper case" - [^java.io.Writer writer] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s ^String x] - (.write writer (.toUpperCase s))) - - Integer - (let [c ^Character x] - (.write writer (int (Character/toUpperCase (char c)))))))))) - -(defn- capitalize-string - "Capitalizes the words in a string. If first? is false, don't capitalize the - first character of the string even if it's a letter." - [s first?] - (let [^Character f (first s) - s (if (and first? f (Character/isLetter f)) - (str (Character/toUpperCase f) (subs s 1)) - s)] - (apply str - (first - (consume - (fn [s] - (if (empty? s) - [nil nil] - (let [m (re-matcher #"\W\w" s) - match (re-find m) - offset (and match (inc (.start m)))] - (if offset - [(str (subs s 0 offset) - (Character/toUpperCase ^Character (nth s offset))) - (subs s (inc offset))] - [s nil])))) - s))))) - -(defn- capitalize-word-writer - "Returns a proxy that wraps writer, captializing all words" - [^java.io.Writer writer] - (let [last-was-whitespace? (ref true)] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write - ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s ^String x] - (.write writer - ^String (capitalize-string (.toLowerCase s) @last-was-whitespace?)) - (dosync - (ref-set last-was-whitespace? - (Character/isWhitespace - ^Character (nth s (dec (count s))))))) - - Integer - (let [c (char x)] - (let [mod-c (if @last-was-whitespace? (Character/toUpperCase ^Character (char x)) c)] - (.write writer (int mod-c)) - (dosync (ref-set last-was-whitespace? (Character/isWhitespace ^Character (char x)))))))))))) - -(defn- init-cap-writer - "Returns a proxy that wraps writer, capitalizing the first word" - [^java.io.Writer writer] - (let [capped (ref false)] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s (.toLowerCase ^String x)] - (if (not @capped) - (let [m (re-matcher #"\S" s) - match (re-find m) - offset (and match (.start m))] - (if offset - (do (.write writer - (str (subs s 0 offset) - (Character/toUpperCase ^Character (nth s offset)) - (.toLowerCase ^String (subs s (inc offset))))) - (dosync (ref-set capped true))) - (.write writer s))) - (.write writer (.toLowerCase s)))) - - Integer - (let [c ^Character (char x)] - (if (and (not @capped) (Character/isLetter c)) - (do - (dosync (ref-set capped true)) - (.write writer (int (Character/toUpperCase c)))) - (.write writer (int (Character/toLowerCase c))))))))))) - -(defn- modify-case [make-writer params navigator offsets] - (let [clause (first (:clauses params))] - (binding [*out* (make-writer *out*)] - (execute-sub-format clause navigator (:base-args params))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; If necessary, wrap the writer in a PrettyWriter object -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn get-pretty-writer [writer] - (if (pretty-writer? writer) - writer - (pretty-writer writer *print-right-margin* *print-miser-width*))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for column-aware operations ~&, ~T -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: make an automatic newline for non-ColumnWriters -(defn fresh-line - "Make a newline if the Writer is not already at the beginning of the line. -N.B. Only works on ColumnWriters right now." - [] - (if (not (= 0 (get-column (:base @@*out*)))) - (prn))) - -(defn- absolute-tabulation [params navigator offsets] - (let [colnum (:colnum params) - colinc (:colinc params) - current (get-column (:base @@*out*)) - space-count (cond - (< current colnum) (- colnum current) - (= colinc 0) 0 - :else (- colinc (rem (- current colnum) colinc)))] - (print (apply str (repeat space-count \space)))) - navigator) - -(defn- relative-tabulation [params navigator offsets] - (let [colrel (:colnum params) - colinc (:colinc params) - start-col (+ colrel (get-column (:base @@*out*))) - offset (if (pos? colinc) (rem start-col colinc) 0) - space-count (+ colrel (if (= 0 offset) 0 (- colinc offset)))] - (print (apply str (repeat space-count \space)))) - navigator) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for accessing the pretty printer from a format -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: support ~@; per-line-prefix separator -;; TODO: get the whole format wrapped so we can start the lb at any column -(defn- format-logical-block [params navigator offsets] - (let [clauses (:clauses params) - clause-count (count clauses) - prefix (cond - (> clause-count 1) (:string (:params (first (first clauses)))) - (:colon params) "(") - body (nth clauses (if (> clause-count 1) 1 0)) - suffix (cond - (> clause-count 2) (:string (:params (first (nth clauses 2)))) - (:colon params) ")") - [arg navigator] (next-arg navigator)] - (pprint-logical-block :prefix prefix :suffix suffix - (execute-sub-format - body - (init-navigator arg) - (:base-args params))) - navigator)) - -(defn- set-indent [params navigator offsets] - (let [relative-to (if (:colon params) :current :block)] - (pprint-indent relative-to (:n params)) - navigator)) - -;;; TODO: support ~:T section options for ~T - -(defn- conditional-newline [params navigator offsets] - (let [kind (if (:colon params) - (if (:at params) :mandatory :fill) - (if (:at params) :miser :linear))] - (pprint-newline kind) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The table of directives we support, each with its params, -;;; properties, and the compilation function -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; We start with a couple of helpers -(defn- process-directive-table-element [ [ char params flags bracket-info & generator-fn ] ] - [char, - {:directive char, - :params `(array-map ~@params), - :flags flags, - :bracket-info bracket-info, - :generator-fn (concat '(fn [ params offset]) generator-fn) }]) - -(defmacro ^{:private true} - defdirectives - [ & directives ] - `(def ^{:private true} - directive-table (hash-map ~@(mapcat process-directive-table-element directives)))) - -(defdirectives - (\A - [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] - #{ :at :colon :both} {} - #(format-ascii print-str %1 %2 %3)) - - (\S - [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] - #{ :at :colon :both} {} - #(format-ascii pr-str %1 %2 %3)) - - (\D - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 10 %1 %2 %3)) - - (\B - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 2 %1 %2 %3)) - - (\O - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 8 %1 %2 %3)) - - (\X - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 16 %1 %2 %3)) - - (\R - [:base [nil Integer] :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - (do - (cond ; ~R is overloaded with bizareness - (first (:base params)) #(format-integer (:base %1) %1 %2 %3) - (and (:at params) (:colon params)) #(format-old-roman %1 %2 %3) - (:at params) #(format-new-roman %1 %2 %3) - (:colon params) #(format-ordinal-english %1 %2 %3) - true #(format-cardinal-english %1 %2 %3)))) - - (\P - [ ] - #{ :at :colon :both } {} - (fn [params navigator offsets] - (let [navigator (if (:colon params) (relative-reposition navigator -1) navigator) - strs (if (:at params) ["y" "ies"] ["" "s"]) - [arg navigator] (next-arg navigator)] - (print (if (= arg 1) (first strs) (second strs))) - navigator))) - - (\C - [:char-format [nil Character]] - #{ :at :colon :both } {} - (cond - (:colon params) pretty-character - (:at params) readable-character - :else plain-character)) - - (\F - [ :w [nil Integer] :d [nil Integer] :k [0 Integer] :overflowchar [nil Character] - :padchar [\space Character] ] - #{ :at } {} - fixed-float) - - (\E - [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] - :overflowchar [nil Character] :padchar [\space Character] - :exponentchar [nil Character] ] - #{ :at } {} - exponential-float) - - (\G - [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] - :overflowchar [nil Character] :padchar [\space Character] - :exponentchar [nil Character] ] - #{ :at } {} - general-float) - - (\$ - [ :d [2 Integer] :n [1 Integer] :w [0 Integer] :padchar [\space Character]] - #{ :at :colon :both} {} - dollar-float) - - (\% - [ :count [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (dotimes [i (:count params)] - (prn)) - arg-navigator)) - - (\& - [ :count [1 Integer] ] - #{ :pretty } {} - (fn [params arg-navigator offsets] - (let [cnt (:count params)] - (if (pos? cnt) (fresh-line)) - (dotimes [i (dec cnt)] - (prn))) - arg-navigator)) - - (\| - [ :count [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (dotimes [i (:count params)] - (print \formfeed)) - arg-navigator)) - - (\~ - [ :n [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (let [n (:n params)] - (print (apply str (repeat n \~))) - arg-navigator))) - - (\newline ;; Whitespace supression is handled in the compilation loop - [ ] - #{:colon :at} {} - (fn [params arg-navigator offsets] - (if (:at params) - (prn)) - arg-navigator)) - - (\T - [ :colnum [1 Integer] :colinc [1 Integer] ] - #{ :at :pretty } {} - (if (:at params) - #(relative-tabulation %1 %2 %3) - #(absolute-tabulation %1 %2 %3))) - - (\* - [ :n [1 Integer] ] - #{ :colon :at } {} - (fn [params navigator offsets] - (let [n (:n params)] - (if (:at params) - (absolute-reposition navigator n) - (relative-reposition navigator (if (:colon params) (- n) n))) - ))) - - (\? - [ ] - #{ :at } {} - (if (:at params) - (fn [params navigator offsets] ; args from main arg list - (let [[subformat navigator] (get-format-arg navigator)] - (execute-sub-format subformat navigator (:base-args params)))) - (fn [params navigator offsets] ; args from sub-list - (let [[subformat navigator] (get-format-arg navigator) - [subargs navigator] (next-arg navigator) - sub-navigator (init-navigator subargs)] - (execute-sub-format subformat sub-navigator (:base-args params)) - navigator)))) - - - (\( - [ ] - #{ :colon :at :both} { :right \), :allows-separator nil, :else nil } - (let [mod-case-writer (cond - (and (:at params) (:colon params)) - upcase-writer - - (:colon params) - capitalize-word-writer - - (:at params) - init-cap-writer - - :else - downcase-writer)] - #(modify-case mod-case-writer %1 %2 %3))) - - (\) [] #{} {} nil) - - (\[ - [ :selector [nil Integer] ] - #{ :colon :at } { :right \], :allows-separator true, :else :last } - (cond - (:colon params) - boolean-conditional - - (:at params) - check-arg-conditional - - true - choice-conditional)) - - (\; [:min-remaining [nil Integer] :max-columns [nil Integer]] - #{ :colon } { :separator true } nil) - - (\] [] #{} {} nil) - - (\{ - [ :max-iterations [nil Integer] ] - #{ :colon :at :both} { :right \}, :allows-separator false } - (cond - (and (:at params) (:colon params)) - iterate-main-sublists - - (:colon params) - iterate-list-of-sublists - - (:at params) - iterate-main-list - - true - iterate-sublist)) - - - (\} [] #{:colon} {} nil) - - (\< - [:mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character]] - #{:colon :at :both :pretty} { :right \>, :allows-separator true, :else :first } - logical-block-or-justify) - - (\> [] #{:colon} {} nil) - - ;; TODO: detect errors in cases where colon not allowed - (\^ [:arg1 [nil Integer] :arg2 [nil Integer] :arg3 [nil Integer]] - #{:colon} {} - (fn [params navigator offsets] - (let [arg1 (:arg1 params) - arg2 (:arg2 params) - arg3 (:arg3 params) - exit (if (:colon params) :colon-up-arrow :up-arrow)] - (cond - (and arg1 arg2 arg3) - (if (<= arg1 arg2 arg3) [exit navigator] navigator) - - (and arg1 arg2) - (if (= arg1 arg2) [exit navigator] navigator) - - arg1 - (if (= arg1 0) [exit navigator] navigator) - - true ; TODO: handle looking up the arglist stack for info - (if (if (:colon params) - (empty? (:rest (:base-args params))) - (empty? (:rest navigator))) - [exit navigator] navigator))))) - - (\W - [] - #{:at :colon :both} {} - (if (or (:at params) (:colon params)) - (let [bindings (concat - (if (:at params) [:level nil :length nil] []) - (if (:colon params) [:pretty true] []))] - (fn [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (apply write arg bindings) - [:up-arrow navigator] - navigator)))) - (fn [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (write-out arg) - [:up-arrow navigator] - navigator))))) - - (\_ - [] - #{:at :colon :both} {} - conditional-newline) - - (\I - [:n [0 Integer]] - #{:colon} {} - set-indent) - ) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Code to manage the parameters and flags associated with each -;;; directive in the format string. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - param-pattern #"^([vV]|#|('.)|([+-]?\d+)|(?=,))") -(def ^{:private true} - special-params #{ :parameter-from-args :remaining-arg-count }) - -(defn- extract-param [[s offset saw-comma]] - (let [m (re-matcher param-pattern s) - param (re-find m)] - (if param - (let [token-str (first (re-groups m)) - remainder (subs s (.end m)) - new-offset (+ offset (.end m))] - (if (not (= \, (nth remainder 0))) - [ [token-str offset] [remainder new-offset false]] - [ [token-str offset] [(subs remainder 1) (inc new-offset) true]])) - (if saw-comma - (format-error "Badly formed parameters in format directive" offset) - [ nil [s offset]])))) - - -(defn- extract-params [s offset] - (consume extract-param [s offset false])) - -(defn- translate-param - "Translate the string representation of a param to the internalized - representation" - [[^String p offset]] - [(cond - (= (.length p) 0) nil - (and (= (.length p) 1) (contains? #{\v \V} (nth p 0))) :parameter-from-args - (and (= (.length p) 1) (= \# (nth p 0))) :remaining-arg-count - (and (= (.length p) 2) (= \' (nth p 0))) (nth p 1) - true (new Integer p)) - offset]) - -(def ^{:private true} - flag-defs { \: :colon, \@ :at }) - -(defn- extract-flags [s offset] - (consume - (fn [[s offset flags]] - (if (empty? s) - [nil [s offset flags]] - (let [flag (get flag-defs (first s))] - (if flag - (if (contains? flags flag) - (format-error - (str "Flag \"" (first s) "\" appears more than once in a directive") - offset) - [true [(subs s 1) (inc offset) (assoc flags flag [true offset])]]) - [nil [s offset flags]])))) - [s offset {}])) - -(defn- check-flags [def flags] - (let [allowed (:flags def)] - (if (and (not (:at allowed)) (:at flags)) - (format-error (str "\"@\" is an illegal flag for format directive \"" (:directive def) "\"") - (nth (:at flags) 1))) - (if (and (not (:colon allowed)) (:colon flags)) - (format-error (str "\":\" is an illegal flag for format directive \"" (:directive def) "\"") - (nth (:colon flags) 1))) - (if (and (not (:both allowed)) (:at flags) (:colon flags)) - (format-error (str "Cannot combine \"@\" and \":\" flags for format directive \"" - (:directive def) "\"") - (min (nth (:colon flags) 1) (nth (:at flags) 1)))))) - -(defn- map-params - "Takes a directive definition and the list of actual parameters and -a map of flags and returns a map of the parameters and flags with defaults -filled in. We check to make sure that there are the right types and number -of parameters as well." - [def params flags offset] - (check-flags def flags) - (if (> (count params) (count (:params def))) - (format-error - (cl-format - nil - "Too many parameters for directive \"~C\": ~D~:* ~[were~;was~:;were~] specified but only ~D~:* ~[are~;is~:;are~] allowed" - (:directive def) (count params) (count (:params def))) - (second (first params)))) - (doall - (map #(let [val (first %1)] - (if (not (or (nil? val) (contains? special-params val) - (instance? (second (second %2)) val))) - (format-error (str "Parameter " (name (first %2)) - " has bad type in directive \"" (:directive def) "\": " - (class val)) - (second %1))) ) - params (:params def))) - - (merge ; create the result map - (into (array-map) ; start with the default values, make sure the order is right - (reverse (for [[name [default]] (:params def)] [name [default offset]]))) - (reduce #(apply assoc %1 %2) {} (filter #(first (nth % 1)) (zipmap (keys (:params def)) params))) ; add the specified parameters, filtering out nils - flags)) ; and finally add the flags - -(defn- compile-directive [s offset] - (let [[raw-params [rest offset]] (extract-params s offset) - [_ [rest offset flags]] (extract-flags rest offset) - directive (first rest) - def (get directive-table (Character/toUpperCase ^Character directive)) - params (if def (map-params def (map translate-param raw-params) flags offset))] - (if (not directive) - (format-error "Format string ended in the middle of a directive" offset)) - (if (not def) - (format-error (str "Directive \"" directive "\" is undefined") offset)) - [(struct compiled-directive ((:generator-fn def) params offset) def params offset) - (let [remainder (subs rest 1) - offset (inc offset) - trim? (and (= \newline (:directive def)) - (not (:colon params))) - trim-count (if trim? (prefix-count remainder [\space \tab]) 0) - remainder (subs remainder trim-count) - offset (+ offset trim-count)] - [remainder offset])])) - -(defn- compile-raw-string [s offset] - (struct compiled-directive (fn [_ a _] (print s) a) nil { :string s } offset)) - -(defn- right-bracket [this] (:right (:bracket-info (:def this)))) -(defn- separator? [this] (:separator (:bracket-info (:def this)))) -(defn- else-separator? [this] - (and (:separator (:bracket-info (:def this))) - (:colon (:params this)))) - - -(declare collect-clauses) - -(defn- process-bracket [this remainder] - (let [[subex remainder] (collect-clauses (:bracket-info (:def this)) - (:offset this) remainder)] - [(struct compiled-directive - (:func this) (:def this) - (merge (:params this) (tuple-map subex (:offset this))) - (:offset this)) - remainder])) - -(defn- process-clause [bracket-info offset remainder] - (consume - (fn [remainder] - (if (empty? remainder) - (format-error "No closing bracket found." offset) - (let [this (first remainder) - remainder (next remainder)] - (cond - (right-bracket this) - (process-bracket this remainder) - - (= (:right bracket-info) (:directive (:def this))) - [ nil [:right-bracket (:params this) nil remainder]] - - (else-separator? this) - [nil [:else nil (:params this) remainder]] - - (separator? this) - [nil [:separator nil nil remainder]] ;; TODO: check to make sure that there are no params on ~; - - true - [this remainder])))) - remainder)) - -(defn- collect-clauses [bracket-info offset remainder] - (second - (consume - (fn [[clause-map saw-else remainder]] - (let [[clause [type right-params else-params remainder]] - (process-clause bracket-info offset remainder)] - (cond - (= type :right-bracket) - [nil [(merge-with concat clause-map - {(if saw-else :else :clauses) [clause] - :right-params right-params}) - remainder]] - - (= type :else) - (cond - (:else clause-map) - (format-error "Two else clauses (\"~:;\") inside bracket construction." offset) - - (not (:else bracket-info)) - (format-error "An else clause (\"~:;\") is in a bracket type that doesn't support it." - offset) - - (and (= :first (:else bracket-info)) (seq (:clauses clause-map))) - (format-error - "The else clause (\"~:;\") is only allowed in the first position for this directive." - offset) - - true ; if the ~:; is in the last position, the else clause - ; is next, this was a regular clause - (if (= :first (:else bracket-info)) - [true [(merge-with concat clause-map { :else [clause] :else-params else-params}) - false remainder]] - [true [(merge-with concat clause-map { :clauses [clause] }) - true remainder]])) - - (= type :separator) - (cond - saw-else - (format-error "A plain clause (with \"~;\") follows an else clause (\"~:;\") inside bracket construction." offset) - - (not (:allows-separator bracket-info)) - (format-error "A separator (\"~;\") is in a bracket type that doesn't support it." - offset) - - true - [true [(merge-with concat clause-map { :clauses [clause] }) - false remainder]])))) - [{ :clauses [] } false remainder]))) - -(defn- process-nesting - "Take a linearly compiled format and process the bracket directives to give it - the appropriate tree structure" - [format] - (first - (consume - (fn [remainder] - (let [this (first remainder) - remainder (next remainder) - bracket (:bracket-info (:def this))] - (if (:right bracket) - (process-bracket this remainder) - [this remainder]))) - format))) - -(defn compile-format - "Compiles format-str into a compiled format which can be used as an argument -to cl-format just like a plain format string. Use this function for improved -performance when you're using the same format string repeatedly" - [ format-str ] -; (prlabel compiling format-str) - (binding [*format-str* format-str] - (process-nesting - (first - (consume - (fn [[^String s offset]] - (if (empty? s) - [nil s] - (let [tilde (.indexOf s (int \~))] - (cond - (neg? tilde) [(compile-raw-string s offset) ["" (+ offset (.length s))]] - (zero? tilde) (compile-directive (subs s 1) (inc offset)) - true - [(compile-raw-string (subs s 0 tilde) offset) [(subs s tilde) (+ tilde offset)]])))) - [format-str 0]))))) - -(defn- needs-pretty - "determine whether a given compiled format has any directives that depend on the -column number or pretty printing" - [format] - (loop [format format] - (if (empty? format) - false - (if (or (:pretty (:flags (:def (first format)))) - (some needs-pretty (first (:clauses (:params (first format))))) - (some needs-pretty (first (:else (:params (first format)))))) - true - (recur (next format)))))) - -(defn execute-format - "Executes the format with the arguments. This should never be used directly, but is public -because the formatter macro uses it." - {:skip-wiki true} - ([stream format args] - (let [^java.io.Writer real-stream (cond - (not stream) (java.io.StringWriter.) - (true? stream) *out* - :else stream) - ^java.io.Writer wrapped-stream (if (and (needs-pretty format) - (not (pretty-writer? real-stream))) - (get-pretty-writer real-stream) - real-stream)] - (binding [*out* wrapped-stream] - (try - (execute-format format args) - (finally - (if-not (identical? real-stream wrapped-stream) - (.flush wrapped-stream)))) - (if (not stream) (.toString real-stream))))) - ([format args] - (map-passing-context - (fn [element context] - (if (abort? context) - [nil context] - (let [[params args] (realize-parameter-list - (:params element) context) - [params offsets] (unzip-map params) - params (assoc params :base-args args)] - [nil (apply (:func element) [params args offsets])]))) - args - format))) - - -(defmacro formatter - "Makes a function which can directly run format-in. The function is -fn [stream & args] ... and returns nil unless the stream is nil (meaning -output to a string) in which case it returns the resulting string. - -format-in can be either a control string or a previously compiled format." - [format-in] - (let [cf (gensym "compiled-format")] - `(let [format-in# ~format-in] - (do (defonce ~cf (if (string? format-in#) (compile-format format-in#) format-in#)) - (fn [stream# & args#] - (let [navigator# (init-navigator args#)] - (execute-format stream# ~cf navigator#))))))) - -(defmacro formatter-out - "Makes a function which can directly run format-in. The function is -fn [& args] ... and returns nil. This version of the formatter macro is -designed to be used with *out* set to an appropriate Writer. In particular, -this is meant to be used as part of a pretty printer dispatch method. - -format-in can be either a control string or a previously compiled format." - [format-in] - (let [cf (gensym "compiled-format")] - `(let [format-in# ~format-in] - (do (defonce ~cf (if (string? format-in#) (compile-format format-in#) format-in#)) - (fn [& args#] - (let [navigator# (init-navigator args#)] - (execute-format ~cf navigator#))))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/pprint/column_writer.clj --- a/src/clojure/contrib/pprint/column_writer.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,80 +0,0 @@ -;;; column_writer.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 -;; Revised to use proxy instead of gen-class April 2010 - -; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This module implements a column-aware wrapper around an instance of java.io.Writer - -(ns clojure.contrib.pprint.column-writer - (:import - [clojure.lang IDeref] - [java.io Writer])) - -(def *default-page-width* 72) - -(defn- get-field [^Writer this sym] - (sym @@this)) - -(defn- set-field [^Writer this sym new-val] - (alter @this assoc sym new-val)) - -(defn get-column [this] - (get-field this :cur)) - -(defn get-line [this] - (get-field this :line)) - -(defn get-max-column [this] - (get-field this :max)) - -(defn set-max-column [this new-max] - (dosync (set-field this :max new-max)) - nil) - -(defn get-writer [this] - (get-field this :base)) - -(defn- write-char [^Writer this ^Integer c] - (dosync (if (= c (int \newline)) - (do - (set-field this :cur 0) - (set-field this :line (inc (get-field this :line)))) - (set-field this :cur (inc (get-field this :cur))))) - (.write ^Writer (get-field this :base) c)) - -(defn column-writer - ([writer] (column-writer writer *default-page-width*)) - ([writer max-columns] - (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})] - (proxy [Writer IDeref] [] - (deref [] fields) - (write - ([^chars cbuf ^Integer off ^Integer len] - (let [^Writer writer (get-field this :base)] - (.write writer cbuf off len))) - ([x] - (condp = (class x) - String - (let [^String s x - nl (.lastIndexOf s (int \newline))] - (dosync (if (neg? nl) - (set-field this :cur (+ (get-field this :cur) (count s))) - (do - (set-field this :cur (- (count s) nl 1)) - (set-field this :line (+ (get-field this :line) - (count (filter #(= % \newline) s))))))) - (.write ^Writer (get-field this :base) s)) - - Integer - (write-char this x) - Long - (write-char this x)))))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/pprint/dispatch.clj --- a/src/clojure/contrib/pprint/dispatch.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,447 +0,0 @@ -;; dispatch.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Feb 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This module implements the default dispatch tables for pretty printing code and -;; data. - -(in-ns 'clojure.contrib.pprint) - -(defn use-method - "Installs a function as a new method of multimethod associated with dispatch-value. " - [multifn dispatch-val func] - (. multifn addMethod dispatch-val func)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Implementations of specific dispatch table entries -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Handle forms that can be "back-translated" to reader macros -;;; Not all reader macros can be dealt with this way or at all. -;;; Macros that we can't deal with at all are: -;;; ; - The comment character is aborbed by the reader and never is part of the form -;;; ` - Is fully processed at read time into a lisp expression (which will contain concats -;;; and regular quotes). -;;; ~@ - Also fully eaten by the processing of ` and can't be used outside. -;;; , - is whitespace and is lost (like all other whitespace). Formats can generate commas -;;; where they deem them useful to help readability. -;;; ^ - Adding metadata completely disappears at read time and the data appears to be -;;; completely lost. -;;; -;;; Most other syntax stuff is dealt with directly by the formats (like (), [], {}, and #{}) -;;; or directly by printing the objects using Clojure's built-in print functions (like -;;; :keyword, \char, or ""). The notable exception is #() which is special-cased. - -(def reader-macros - {'quote "'", 'clojure.core/deref "@", - 'var "#'", 'clojure.core/unquote "~"}) - -(defn pprint-reader-macro [alis] - (let [^String macro-char (reader-macros (first alis))] - (when (and macro-char (= 2 (count alis))) - (.write ^java.io.Writer *out* macro-char) - (write-out (second alis)) - true))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dispatch for the basic data types when interpreted -;; as data (as opposed to code). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; TODO: inline these formatter statements into funcs so that we -;;; are a little easier on the stack. (Or, do "real" compilation, a -;;; la Common Lisp) - -;;; (def pprint-simple-list (formatter-out "~:<~@{~w~^ ~_~}~:>")) -(defn pprint-simple-list [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (loop [alis (seq alis)] - (when alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next alis))))))) - -(defn pprint-list [alis] - (if-not (pprint-reader-macro alis) - (pprint-simple-list alis))) - -;;; (def pprint-vector (formatter-out "~<[~;~@{~w~^ ~_~}~;]~:>")) -(defn pprint-vector [avec] - (pprint-logical-block :prefix "[" :suffix "]" - (loop [aseq (seq avec)] - (when aseq - (write-out (first aseq)) - (when (next aseq) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next aseq))))))) - -(def pprint-array (formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>")) - -;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>")) -(defn pprint-map [amap] - (pprint-logical-block :prefix "{" :suffix "}" - (loop [aseq (seq amap)] - (when aseq - (pprint-logical-block - (write-out (ffirst aseq)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (write-out (fnext (first aseq)))) - (when (next aseq) - (.write ^java.io.Writer *out* ", ") - (pprint-newline :linear) - (recur (next aseq))))))) - -(def pprint-set (formatter-out "~<#{~;~@{~w~^ ~:_~}~;}~:>")) -(defn pprint-ref [ref] - (pprint-logical-block :prefix "#" - (write-out @ref))) -(defn pprint-atom [ref] - (pprint-logical-block :prefix "#" - (write-out @ref))) -(defn pprint-agent [ref] - (pprint-logical-block :prefix "#" - (write-out @ref))) - -(defn pprint-simple-default [obj] - (cond - (.isArray (class obj)) (pprint-array obj) - (and *print-suppress-namespaces* (symbol? obj)) (print (name obj)) - :else (pr obj))) - - -(defmulti - *simple-dispatch* - "The pretty print dispatch function for simple data structure format." - {:arglists '[[object]]} - class) - -(use-method *simple-dispatch* clojure.lang.ISeq pprint-list) -(use-method *simple-dispatch* clojure.lang.IPersistentVector pprint-vector) -(use-method *simple-dispatch* clojure.lang.IPersistentMap pprint-map) -(use-method *simple-dispatch* clojure.lang.IPersistentSet pprint-set) -(use-method *simple-dispatch* clojure.lang.Ref pprint-ref) -(use-method *simple-dispatch* clojure.lang.Atom pprint-atom) -(use-method *simple-dispatch* clojure.lang.Agent pprint-agent) -(use-method *simple-dispatch* nil pr) -(use-method *simple-dispatch* :default pprint-simple-default) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Dispatch for the code table -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare pprint-simple-code-list) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like a simple def (sans metadata, since the reader -;;; won't give it to us now). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def pprint-hold-first (formatter-out "~:<~w~^ ~@_~w~^ ~_~@{~w~^ ~_~}~:>")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like a defn or defmacro -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Format the params and body of a defn with a single arity -(defn- single-defn [alis has-doc-str?] - (if (seq alis) - (do - (if has-doc-str? - ((formatter-out " ~_")) - ((formatter-out " ~@_"))) - ((formatter-out "~{~w~^ ~_~}") alis)))) - -;;; Format the param and body sublists of a defn with multiple arities -(defn- multi-defn [alis has-doc-str?] - (if (seq alis) - ((formatter-out " ~_~{~w~^ ~_~}") alis))) - -;;; TODO: figure out how to support capturing metadata in defns (we might need a -;;; special reader) -(defn pprint-defn [alis] - (if (next alis) - (let [[defn-sym defn-name & stuff] alis - [doc-str stuff] (if (string? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff]) - [attr-map stuff] (if (map? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff])] - (pprint-logical-block :prefix "(" :suffix ")" - ((formatter-out "~w ~1I~@_~w") defn-sym defn-name) - (if doc-str - ((formatter-out " ~_~w") doc-str)) - (if attr-map - ((formatter-out " ~_~w") attr-map)) - ;; Note: the multi-defn case will work OK for malformed defns too - (cond - (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) - :else (multi-defn stuff (or doc-str attr-map))))) - (pprint-simple-code-list alis))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something with a binding form -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn pprint-binding-form [binding-vec] - (pprint-logical-block :prefix "[" :suffix "]" - (loop [binding binding-vec] - (when (seq binding) - (pprint-logical-block binding - (write-out (first binding)) - (when (next binding) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second binding)))) - (when (next (rest binding)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest binding)))))))) - -(defn pprint-let [alis] - (let [base-sym (first alis)] - (pprint-logical-block :prefix "(" :suffix ")" - (if (and (next alis) (vector? (second alis))) - (do - ((formatter-out "~w ~1I~@_") base-sym) - (pprint-binding-form (second alis)) - ((formatter-out " ~_~{~w~^ ~_~}") (next (rest alis)))) - (pprint-simple-code-list alis))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like "if" -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def pprint-if (formatter-out "~:<~1I~w~^ ~@_~w~@{ ~_~w~}~:>")) - -(defn pprint-cond [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (loop [alis (next alis)] - (when alis - (pprint-logical-block alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second alis)))) - (when (next (rest alis)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest alis))))))))) - -(defn pprint-condp [alis] - (if (> (count alis) 3) - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (apply (formatter-out "~w ~@_~w ~@_~w ~_") alis) - (loop [alis (seq (drop 3 alis))] - (when alis - (pprint-logical-block alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second alis)))) - (when (next (rest alis)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest alis))))))) - (pprint-simple-code-list alis))) - -;;; The map of symbols that are defined in an enclosing #() anonymous function -(def *symbol-map* {}) - -(defn pprint-anon-func [alis] - (let [args (second alis) - nlis (first (rest (rest alis)))] - (if (vector? args) - (binding [*symbol-map* (if (= 1 (count args)) - {(first args) "%"} - (into {} - (map - #(vector %1 (str \% %2)) - args - (range 1 (inc (count args))))))] - ((formatter-out "~<#(~;~@{~w~^ ~_~}~;)~:>") nlis)) - (pprint-simple-code-list alis)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The master definitions for formatting lists in code (that is, (fn args...) or -;;; special forms). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; This is the equivalent of (formatter-out "~:<~1I~@{~w~^ ~_~}~:>"), but is -;;; easier on the stack. - -(defn pprint-simple-code-list [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (loop [alis (seq alis)] - (when alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next alis))))))) - -;;; Take a map with symbols as keys and add versions with no namespace. -;;; That is, if ns/sym->val is in the map, add sym->val to the result. -(defn two-forms [amap] - (into {} - (mapcat - identity - (for [x amap] - [x [(symbol (name (first x))) (second x)]])))) - -(defn add-core-ns [amap] - (let [core "clojure.core"] - (into {} - (map #(let [[s f] %] - (if (not (or (namespace s) (special-symbol? s))) - [(symbol core (name s)) f] - %)) - amap)))) - -(def *code-table* - (two-forms - (add-core-ns - {'def pprint-hold-first, 'defonce pprint-hold-first, - 'defn pprint-defn, 'defn- pprint-defn, 'defmacro pprint-defn, 'fn pprint-defn, - 'let pprint-let, 'loop pprint-let, 'binding pprint-let, - 'with-local-vars pprint-let, 'with-open pprint-let, 'when-let pprint-let, - 'if-let pprint-let, 'doseq pprint-let, 'dotimes pprint-let, - 'when-first pprint-let, - 'if pprint-if, 'if-not pprint-if, 'when pprint-if, 'when-not pprint-if, - 'cond pprint-cond, 'condp pprint-condp, - 'fn* pprint-anon-func, - '. pprint-hold-first, '.. pprint-hold-first, '-> pprint-hold-first, - 'locking pprint-hold-first, 'struct pprint-hold-first, - 'struct-map pprint-hold-first, - }))) - -(defn pprint-code-list [alis] - (if-not (pprint-reader-macro alis) - (if-let [special-form (*code-table* (first alis))] - (special-form alis) - (pprint-simple-code-list alis)))) - -(defn pprint-code-symbol [sym] - (if-let [arg-num (sym *symbol-map*)] - (print arg-num) - (if *print-suppress-namespaces* - (print (name sym)) - (pr sym)))) - -(defmulti - *code-dispatch* - "The pretty print dispatch function for pretty printing Clojure code." - {:arglists '[[object]]} - class) - -(use-method *code-dispatch* clojure.lang.ISeq pprint-code-list) -(use-method *code-dispatch* clojure.lang.Symbol pprint-code-symbol) - -;; The following are all exact copies of *simple-dispatch* -(use-method *code-dispatch* clojure.lang.IPersistentVector pprint-vector) -(use-method *code-dispatch* clojure.lang.IPersistentMap pprint-map) -(use-method *code-dispatch* clojure.lang.IPersistentSet pprint-set) -(use-method *code-dispatch* clojure.lang.Ref pprint-ref) -(use-method *code-dispatch* clojure.lang.Atom pprint-atom) -(use-method *code-dispatch* clojure.lang.Agent pprint-agent) -(use-method *code-dispatch* nil pr) -(use-method *code-dispatch* :default pprint-simple-default) - -(set-pprint-dispatch *simple-dispatch*) - - -;;; For testing -(comment - -(with-pprint-dispatch *code-dispatch* - (pprint - '(defn cl-format - "An implementation of a Common Lisp compatible format function" - [stream format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format stream compiled-format navigator))))) - -(with-pprint-dispatch *code-dispatch* - (pprint - '(defn cl-format - [stream format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format stream compiled-format navigator))))) - -(with-pprint-dispatch *code-dispatch* - (pprint - '(defn- -write - ([this x] - (condp = (class x) - String - (let [s0 (write-initial-lines this x) - s (.replaceFirst s0 "\\s+$" "") - white-space (.substring s0 (count s)) - mode (getf :mode)] - (if (= mode :writing) - (dosync - (write-white-space this) - (.col_write this s) - (setf :trailing-white-space white-space)) - (add-to-buffer this (make-buffer-blob s white-space)))) - - Integer - (let [c ^Character x] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (.col_write this x)) - (if (= c (int \newline)) - (write-initial-lines this "\n") - (add-to-buffer this (make-buffer-blob (str (char c)) nil)))))))))) - -(with-pprint-dispatch *code-dispatch* - (pprint - '(defn pprint-defn [writer alis] - (if (next alis) - (let [[defn-sym defn-name & stuff] alis - [doc-str stuff] (if (string? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff]) - [attr-map stuff] (if (map? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff])] - (pprint-logical-block writer :prefix "(" :suffix ")" - (cl-format true "~w ~1I~@_~w" defn-sym defn-name) - (if doc-str - (cl-format true " ~_~w" doc-str)) - (if attr-map - (cl-format true " ~_~w" attr-map)) - ;; Note: the multi-defn case will work OK for malformed defns too - (cond - (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) - :else (multi-defn stuff (or doc-str attr-map))))) - (pprint-simple-code-list writer alis))))) -) -nil - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/pprint/pprint_base.clj --- a/src/clojure/contrib/pprint/pprint_base.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,342 +0,0 @@ -;;; pprint_base.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Jan 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This module implements the generic pretty print functions and special variables - -(in-ns 'clojure.contrib.pprint) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Variables that control the pretty printer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; -;;; *print-length*, *print-level* and *print-dup* are defined in clojure.core -;;; TODO: use *print-dup* here (or is it supplanted by other variables?) -;;; TODO: make dispatch items like "(let..." get counted in *print-length* -;;; constructs - - -(def - ^{ :doc "Bind to true if you want write to use pretty printing"} - *print-pretty* true) - -(defonce ; If folks have added stuff here, don't overwrite - ^{ :doc "The pretty print dispatch function. Use with-pprint-dispatch or set-pprint-dispatch -to modify."} - *print-pprint-dispatch* nil) - -(def - ^{ :doc "Pretty printing will try to avoid anything going beyond this column. -Set it to nil to have pprint let the line be arbitrarily long. This will ignore all -non-mandatory newlines."} - *print-right-margin* 72) - -(def - ^{ :doc "The column at which to enter miser style. Depending on the dispatch table, -miser style add newlines in more places to try to keep lines short allowing for further -levels of nesting."} - *print-miser-width* 40) - -;;; TODO implement output limiting -(def - ^{ :doc "Maximum number of lines to print in a pretty print instance (N.B. This is not yet used)"} - *print-lines* nil) - -;;; TODO: implement circle and shared -(def - ^{ :doc "Mark circular structures (N.B. This is not yet used)"} - *print-circle* nil) - -;;; TODO: should we just use *print-dup* here? -(def - ^{ :doc "Mark repeated structures rather than repeat them (N.B. This is not yet used)"} - *print-shared* nil) - -(def - ^{ :doc "Don't print namespaces with symbols. This is particularly useful when -pretty printing the results of macro expansions"} - *print-suppress-namespaces* nil) - -;;; TODO: support print-base and print-radix in cl-format -;;; TODO: support print-base and print-radix in rationals -(def - ^{ :doc "Print a radix specifier in front of integers and rationals. If *print-base* is 2, 8, -or 16, then the radix specifier used is #b, #o, or #x, respectively. Otherwise the -radix specifier is in the form #XXr where XX is the decimal value of *print-base* "} - *print-radix* nil) - -(def - ^{ :doc "The base to use for printing integers and rationals."} - *print-base* 10) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Internal variables that keep track of where we are in the -;; structure -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{ :private true } *current-level* 0) - -(def ^{ :private true } *current-length* nil) - -;; TODO: add variables for length, lines. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Support for the write function -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare format-simple-number) - -(def ^{:private true} orig-pr pr) - -(defn- pr-with-base [x] - (if-let [s (format-simple-number x)] - (print s) - (orig-pr x))) - -(def ^{:private true} write-option-table - {;:array *print-array* - :base 'clojure.contrib.pprint/*print-base*, - ;;:case *print-case*, - :circle 'clojure.contrib.pprint/*print-circle*, - ;;:escape *print-escape*, - ;;:gensym *print-gensym*, - :length 'clojure.core/*print-length*, - :level 'clojure.core/*print-level*, - :lines 'clojure.contrib.pprint/*print-lines*, - :miser-width 'clojure.contrib.pprint/*print-miser-width*, - :dispatch 'clojure.contrib.pprint/*print-pprint-dispatch*, - :pretty 'clojure.contrib.pprint/*print-pretty*, - :radix 'clojure.contrib.pprint/*print-radix*, - :readably 'clojure.core/*print-readably*, - :right-margin 'clojure.contrib.pprint/*print-right-margin*, - :suppress-namespaces 'clojure.contrib.pprint/*print-suppress-namespaces*}) - - -(defmacro ^{:private true} binding-map [amap & body] - (let [] - `(do - (. clojure.lang.Var (pushThreadBindings ~amap)) - (try - ~@body - (finally - (. clojure.lang.Var (popThreadBindings))))))) - -(defn- table-ize [t m] - (apply hash-map (mapcat - #(when-let [v (get t (key %))] [(find-var v) (val %)]) - m))) - -(defn- pretty-writer? - "Return true iff x is a PrettyWriter" - [x] (and (instance? clojure.lang.IDeref x) (:pretty-writer @@x))) - -(defn- make-pretty-writer - "Wrap base-writer in a PrettyWriter with the specified right-margin and miser-width" - [base-writer right-margin miser-width] - (pretty-writer base-writer right-margin miser-width)) - -(defmacro ^{:private true} with-pretty-writer [base-writer & body] - `(let [base-writer# ~base-writer - new-writer# (not (pretty-writer? base-writer#))] - (binding [*out* (if new-writer# - (make-pretty-writer base-writer# *print-right-margin* *print-miser-width*) - base-writer#)] - ~@body - (.flush *out*)))) - - -;;;TODO: if pretty print is not set, don't use pr but rather something that respects *print-base*, etc. -(defn write-out - "Write an object to *out* subject to the current bindings of the printer control -variables. Use the kw-args argument to override individual variables for this call (and -any recursive calls). - -*out* must be a PrettyWriter if pretty printing is enabled. This is the responsibility -of the caller. - -This method is primarily intended for use by pretty print dispatch functions that -already know that the pretty printer will have set up their environment appropriately. -Normal library clients should use the standard \"write\" interface. " - [object] - (let [length-reached (and - *current-length* - *print-length* - (>= *current-length* *print-length*))] - (if-not *print-pretty* - (pr object) - (if length-reached - (print "...") - (do - (if *current-length* (set! *current-length* (inc *current-length*))) - (*print-pprint-dispatch* object)))) - length-reached)) - -(defn write - "Write an object subject to the current bindings of the printer control variables. -Use the kw-args argument to override individual variables for this call (and any -recursive calls). Returns the string result if :stream is nil or nil otherwise. - -The following keyword arguments can be passed with values: - Keyword Meaning Default value - :stream Writer for output or nil true (indicates *out*) - :base Base to use for writing rationals Current value of *print-base* - :circle* If true, mark circular structures Current value of *print-circle* - :length Maximum elements to show in sublists Current value of *print-length* - :level Maximum depth Current value of *print-level* - :lines* Maximum lines of output Current value of *print-lines* - :miser-width Width to enter miser mode Current value of *print-miser-width* - :dispatch The pretty print dispatch function Current value of *print-pprint-dispatch* - :pretty If true, do pretty printing Current value of *print-pretty* - :radix If true, prepend a radix specifier Current value of *print-radix* - :readably* If true, print readably Current value of *print-readably* - :right-margin The column for the right margin Current value of *print-right-margin* - :suppress-namespaces If true, no namespaces in symbols Current value of *print-suppress-namespaces* - - * = not yet supported -" - [object & kw-args] - (let [options (merge {:stream true} (apply hash-map kw-args))] - (binding-map (table-ize write-option-table options) - (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) - (let [optval (if (contains? options :stream) - (:stream options) - true) - base-writer (condp = optval - nil (java.io.StringWriter.) - true *out* - optval)] - (if *print-pretty* - (with-pretty-writer base-writer - (write-out object)) - (binding [*out* base-writer] - (pr object))) - (if (nil? optval) - (.toString ^java.io.StringWriter base-writer))))))) - - -(defn pprint - "Pretty print object to the optional output writer. If the writer is not provided, -print the object to the currently bound value of *out*." - ([object] (pprint object *out*)) - ([object writer] - (with-pretty-writer writer - (binding [*print-pretty* true] - (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) - (write-out object))) - (if (not (= 0 (get-column *out*))) - (.write *out* (int \newline)))))) - -(defmacro pp - "A convenience macro that pretty prints the last thing output. This is -exactly equivalent to (pprint *1)." - [] `(pprint *1)) - -(defn set-pprint-dispatch - "Set the pretty print dispatch function to a function matching (fn [obj] ...) -where obj is the object to pretty print. That function will be called with *out* set -to a pretty printing writer to which it should do its printing. - -For example functions, see *simple-dispatch* and *code-dispatch* in -clojure.contrib.pprint.dispatch.clj." - [function] - (let [old-meta (meta #'*print-pprint-dispatch*)] - (alter-var-root #'*print-pprint-dispatch* (constantly function)) - (alter-meta! #'*print-pprint-dispatch* (constantly old-meta))) - nil) - -(defmacro with-pprint-dispatch - "Execute body with the pretty print dispatch function bound to function." - [function & body] - `(binding [*print-pprint-dispatch* ~function] - ~@body)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Support for the functional interface to the pretty printer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- parse-lb-options [opts body] - (loop [body body - acc []] - (if (opts (first body)) - (recur (drop 2 body) (concat acc (take 2 body))) - [(apply hash-map acc) body]))) - -(defn- check-enumerated-arg [arg choices] - (if-not (choices arg) - (throw - (IllegalArgumentException. - ;; TODO clean up choices string - (str "Bad argument: " arg ". It must be one of " choices))))) - -(defn level-exceeded [] - (and *print-level* (>= *current-level* *print-level*))) - -(defmacro pprint-logical-block - "Execute the body as a pretty printing logical block with output to *out* which -must be a pretty printing writer. When used from pprint or cl-format, this can be -assumed. - -Before the body, the caller can optionally specify options: :prefix, :per-line-prefix, -and :suffix." - {:arglists '[[options* body]]} - [& args] - (let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)] - `(do (if (level-exceeded) - (.write ^java.io.Writer *out* "#") - (binding [*current-level* (inc *current-level*) - *current-length* 0] - (start-block *out* - ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options)) - ~@body - (end-block *out*))) - nil))) - -(defn pprint-newline - "Print a conditional newline to a pretty printing stream. kind specifies if the -newline is :linear, :miser, :fill, or :mandatory. - -Output is sent to *out* which must be a pretty printing writer." - [kind] - (check-enumerated-arg kind #{:linear :miser :fill :mandatory}) - (nl *out* kind)) - -(defn pprint-indent - "Create an indent at this point in the pretty printing stream. This defines how -following lines are indented. relative-to can be either :block or :current depending -whether the indent should be computed relative to the start of the logical block or -the current column position. n is an offset. - -Output is sent to *out* which must be a pretty printing writer." - [relative-to n] - (check-enumerated-arg relative-to #{:block :current}) - (indent *out* relative-to n)) - -;; TODO a real implementation for pprint-tab -(defn pprint-tab - "Tab at this point in the pretty printing stream. kind specifies whether the tab -is :line, :section, :line-relative, or :section-relative. - -Colnum and colinc specify the target column and the increment to move the target -forward if the output is already past the original target. - -Output is sent to *out* which must be a pretty printing writer. - -THIS FUNCTION IS NOT YET IMPLEMENTED." - [kind colnum colinc] - (check-enumerated-arg kind #{:line :section :line-relative :section-relative}) - (throw (UnsupportedOperationException. "pprint-tab is not yet implemented"))) - - -nil diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/pprint/pretty_writer.clj --- a/src/clojure/contrib/pprint/pretty_writer.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,488 +0,0 @@ -;;; pretty_writer.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 -;; Revised to use proxy instead of gen-class April 2010 - -; Copyright (c) Tom Faulhaber, Jan 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This module implements a wrapper around a java.io.Writer which implements the -;; core of the XP algorithm. - -(ns clojure.contrib.pprint.pretty-writer - (:refer-clojure :exclude (deftype)) - (:use clojure.contrib.pprint.utilities) - (:use [clojure.contrib.pprint.column-writer - :only (column-writer get-column get-max-column)]) - (:import - [clojure.lang IDeref] - [java.io Writer])) - -;; TODO: Support for tab directives - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Forward declarations -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare get-miser-width) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Macros to simplify dealing with types and classes. These are -;;; really utilities, but I'm experimenting with them here. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro ^{:private true} - getf - "Get the value of the field a named by the argument (which should be a keyword)." - [sym] - `(~sym @@~'this)) - -(defmacro ^{:private true} - setf [sym new-val] - "Set the value of the field SYM to NEW-VAL" - `(alter @~'this assoc ~sym ~new-val)) - -(defmacro ^{:private true} - deftype [type-name & fields] - (let [name-str (name type-name)] - `(do - (defstruct ~type-name :type-tag ~@fields) - (defn- ~(symbol (str "make-" name-str)) - [& vals#] (apply struct ~type-name ~(keyword name-str) vals#)) - (defn- ~(symbol (str name-str "?")) [x#] (= (:type-tag x#) ~(keyword name-str)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The data structures used by pretty-writer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defstruct ^{:private true} logical-block - :parent :section :start-col :indent - :done-nl :intra-block-nl - :prefix :per-line-prefix :suffix - :logical-block-callback) - -(defn ancestor? [parent child] - (loop [child (:parent child)] - (cond - (nil? child) false - (identical? parent child) true - :else (recur (:parent child))))) - -(defstruct ^{:private true} section :parent) - -(defn buffer-length [l] - (let [l (seq l)] - (if l - (- (:end-pos (last l)) (:start-pos (first l))) - 0))) - -; A blob of characters (aka a string) -(deftype buffer-blob :data :trailing-white-space :start-pos :end-pos) - -; A newline -(deftype nl-t :type :logical-block :start-pos :end-pos) - -(deftype start-block-t :logical-block :start-pos :end-pos) - -(deftype end-block-t :logical-block :start-pos :end-pos) - -(deftype indent-t :logical-block :relative-to :offset :start-pos :end-pos) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions to write tokens in the output buffer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare emit-nl) - -(defmulti write-token #(:type-tag %2)) -(defmethod write-token :start-block-t [^Writer this token] - (when-let [cb (getf :logical-block-callback)] (cb :start)) - (let [lb (:logical-block token)] - (dosync - (when-let [^String prefix (:prefix lb)] - (.write (getf :base) prefix)) - (let [col (get-column (getf :base))] - (ref-set (:start-col lb) col) - (ref-set (:indent lb) col))))) - -(defmethod write-token :end-block-t [^Writer this token] - (when-let [cb (getf :logical-block-callback)] (cb :end)) - (when-let [^String suffix (:suffix (:logical-block token))] - (.write (getf :base) suffix))) - -(defmethod write-token :indent-t [^Writer this token] - (let [lb (:logical-block token)] - (ref-set (:indent lb) - (+ (:offset token) - (condp = (:relative-to token) - :block @(:start-col lb) - :current (get-column (getf :base))))))) - -(defmethod write-token :buffer-blob [^Writer this token] - (.write (getf :base) ^String (:data token))) - -(defmethod write-token :nl-t [^Writer this token] -; (prlabel wt @(:done-nl (:logical-block token))) -; (prlabel wt (:type token) (= (:type token) :mandatory)) - (if (or (= (:type token) :mandatory) - (and (not (= (:type token) :fill)) - @(:done-nl (:logical-block token)))) - (emit-nl this token) - (if-let [^String tws (getf :trailing-white-space)] - (.write (getf :base) tws))) - (dosync (setf :trailing-white-space nil))) - -(defn- write-tokens [^Writer this tokens force-trailing-whitespace] - (doseq [token tokens] - (if-not (= (:type-tag token) :nl-t) - (if-let [^String tws (getf :trailing-white-space)] - (.write (getf :base) tws))) - (write-token this token) - (setf :trailing-white-space (:trailing-white-space token))) - (let [^String tws (getf :trailing-white-space)] - (when (and force-trailing-whitespace tws) - (.write (getf :base) tws) - (setf :trailing-white-space nil)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; emit-nl? method defs for each type of new line. This makes -;;; the decision about whether to print this type of new line. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defn- tokens-fit? [^Writer this tokens] -;;; (prlabel tf? (get-column (getf :base) (buffer-length tokens)) - (let [maxcol (get-max-column (getf :base))] - (or - (nil? maxcol) - (< (+ (get-column (getf :base)) (buffer-length tokens)) maxcol)))) - -(defn- linear-nl? [this lb section] -; (prlabel lnl? @(:done-nl lb) (tokens-fit? this section)) - (or @(:done-nl lb) - (not (tokens-fit? this section)))) - -(defn- miser-nl? [^Writer this lb section] - (let [miser-width (get-miser-width this) - maxcol (get-max-column (getf :base))] - (and miser-width maxcol - (>= @(:start-col lb) (- maxcol miser-width)) - (linear-nl? this lb section)))) - -(defmulti emit-nl? (fn [t _ _ _] (:type t))) - -(defmethod emit-nl? :linear [newl this section _] - (let [lb (:logical-block newl)] - (linear-nl? this lb section))) - -(defmethod emit-nl? :miser [newl this section _] - (let [lb (:logical-block newl)] - (miser-nl? this lb section))) - -(defmethod emit-nl? :fill [newl this section subsection] - (let [lb (:logical-block newl)] - (or @(:intra-block-nl lb) - (not (tokens-fit? this subsection)) - (miser-nl? this lb section)))) - -(defmethod emit-nl? :mandatory [_ _ _ _] - true) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Various support functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defn- get-section [buffer] - (let [nl (first buffer) - lb (:logical-block nl) - section (seq (take-while #(not (and (nl-t? %) (ancestor? (:logical-block %) lb))) - (next buffer)))] - [section (seq (drop (inc (count section)) buffer))])) - -(defn- get-sub-section [buffer] - (let [nl (first buffer) - lb (:logical-block nl) - section (seq (take-while #(let [nl-lb (:logical-block %)] - (not (and (nl-t? %) (or (= nl-lb lb) (ancestor? nl-lb lb))))) - (next buffer)))] - section)) - -(defn- update-nl-state [lb] - (dosync - (ref-set (:intra-block-nl lb) false) - (ref-set (:done-nl lb) true) - (loop [lb (:parent lb)] - (if lb - (do (ref-set (:done-nl lb) true) - (ref-set (:intra-block-nl lb) true) - (recur (:parent lb))))))) - -(defn emit-nl [^Writer this nl] - (.write (getf :base) (int \newline)) - (dosync (setf :trailing-white-space nil)) - (let [lb (:logical-block nl) - ^String prefix (:per-line-prefix lb)] - (if prefix - (.write (getf :base) prefix)) - (let [^String istr (apply str (repeat (- @(:indent lb) (count prefix)) - \space))] - (.write (getf :base) istr)) - (update-nl-state lb))) - -(defn- split-at-newline [tokens] - (let [pre (seq (take-while #(not (nl-t? %)) tokens))] - [pre (seq (drop (count pre) tokens))])) - -;;; Methods for showing token strings for debugging - -(defmulti tok :type-tag) -(defmethod tok :nl-t [token] - (:type token)) -(defmethod tok :buffer-blob [token] - (str \" (:data token) (:trailing-white-space token) \")) -(defmethod tok :default [token] - (:type-tag token)) -(defn toks [toks] (map tok toks)) - -;;; write-token-string is called when the set of tokens in the buffer -;;; is longer than the available space on the line - -(defn- write-token-string [this tokens] - (let [[a b] (split-at-newline tokens)] -;; (prlabel wts (toks a) (toks b)) - (if a (write-tokens this a false)) - (if b - (let [[section remainder] (get-section b) - newl (first b)] -;; (prlabel wts (toks section)) (prlabel wts (:type newl)) (prlabel wts (toks remainder)) - (let [do-nl (emit-nl? newl this section (get-sub-section b)) - result (if do-nl - (do -;; (prlabel emit-nl (:type newl)) - (emit-nl this newl) - (next b)) - b) - long-section (not (tokens-fit? this result)) - result (if long-section - (let [rem2 (write-token-string this section)] -;;; (prlabel recurse (toks rem2)) - (if (= rem2 section) - (do ; If that didn't produce any output, it has no nls - ; so we'll force it - (write-tokens this section false) - remainder) - (into [] (concat rem2 remainder)))) - result) -;; ff (prlabel wts (toks result)) - ] - result))))) - -(defn- write-line [^Writer this] - (dosync - (loop [buffer (getf :buffer)] -;; (prlabel wl1 (toks buffer)) - (setf :buffer (into [] buffer)) - (if (not (tokens-fit? this buffer)) - (let [new-buffer (write-token-string this buffer)] -;; (prlabel wl new-buffer) - (if-not (identical? buffer new-buffer) - (recur new-buffer))))))) - -;;; Add a buffer token to the buffer and see if it's time to start -;;; writing -(defn- add-to-buffer [^Writer this token] -; (prlabel a2b token) - (dosync - (setf :buffer (conj (getf :buffer) token)) - (if (not (tokens-fit? this (getf :buffer))) - (write-line this)))) - -;;; Write all the tokens that have been buffered -(defn- write-buffered-output [^Writer this] - (write-line this) - (if-let [buf (getf :buffer)] - (do - (write-tokens this buf true) - (setf :buffer [])))) - -;;; If there are newlines in the string, print the lines up until the last newline, -;;; making the appropriate adjustments. Return the remainder of the string -(defn- write-initial-lines - [^Writer this ^String s] - (let [lines (.split s "\n" -1)] - (if (= (count lines) 1) - s - (dosync - (let [^String prefix (:per-line-prefix (first (getf :logical-blocks))) - ^String l (first lines)] - (if (= :buffering (getf :mode)) - (let [oldpos (getf :pos) - newpos (+ oldpos (count l))] - (setf :pos newpos) - (add-to-buffer this (make-buffer-blob l nil oldpos newpos)) - (write-buffered-output this)) - (.write (getf :base) l)) - (.write (getf :base) (int \newline)) - (doseq [^String l (next (butlast lines))] - (.write (getf :base) l) - (.write (getf :base) (int \newline)) - (if prefix - (.write (getf :base) prefix))) - (setf :buffering :writing) - (last lines)))))) - - -(defn write-white-space [^Writer this] - (if-let [^String tws (getf :trailing-white-space)] - (dosync - (.write (getf :base) tws) - (setf :trailing-white-space nil)))) - -(defn- write-char [^Writer this ^Integer c] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (.write (getf :base) c)) - (if (= c \newline) - (write-initial-lines this "\n") - (let [oldpos (getf :pos) - newpos (inc oldpos)] - (dosync - (setf :pos newpos) - (add-to-buffer this (make-buffer-blob (str (char c)) nil oldpos newpos))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Initialize the pretty-writer instance -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defn pretty-writer [writer max-columns miser-width] - (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false)) - fields (ref {:pretty-writer true - :base (column-writer writer max-columns) - :logical-blocks lb - :sections nil - :mode :writing - :buffer [] - :buffer-block lb - :buffer-level 1 - :miser-width miser-width - :trailing-white-space nil - :pos 0})] - (proxy [Writer IDeref] [] - (deref [] fields) - - (write - ([x] - ;; (prlabel write x (getf :mode)) - (condp = (class x) - String - (let [^String s0 (write-initial-lines this x) - ^String s (.replaceFirst s0 "\\s+$" "") - white-space (.substring s0 (count s)) - mode (getf :mode)] - (dosync - (if (= mode :writing) - (do - (write-white-space this) - (.write (getf :base) s) - (setf :trailing-white-space white-space)) - (let [oldpos (getf :pos) - newpos (+ oldpos (count s0))] - (setf :pos newpos) - (add-to-buffer this (make-buffer-blob s white-space oldpos newpos)))))) - - Integer - (write-char this x) - Long - (write-char this x)))) - - (flush [] - (if (= (getf :mode) :buffering) - (dosync - (write-tokens this (getf :buffer) true) - (setf :buffer [])) - (write-white-space this))) - - (close [] - (.flush this))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Methods for pretty-writer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn start-block - [^Writer this - ^String prefix ^String per-line-prefix ^String suffix] - (dosync - (let [lb (struct logical-block (getf :logical-blocks) nil (ref 0) (ref 0) - (ref false) (ref false) - prefix per-line-prefix suffix)] - (setf :logical-blocks lb) - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (when-let [cb (getf :logical-block-callback)] (cb :start)) - (if prefix - (.write (getf :base) prefix)) - (let [col (get-column (getf :base))] - (ref-set (:start-col lb) col) - (ref-set (:indent lb) col))) - (let [oldpos (getf :pos) - newpos (+ oldpos (if prefix (count prefix) 0))] - (setf :pos newpos) - (add-to-buffer this (make-start-block-t lb oldpos newpos))))))) - -(defn end-block [^Writer this] - (dosync - (let [lb (getf :logical-blocks) - ^String suffix (:suffix lb)] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (if suffix - (.write (getf :base) suffix)) - (when-let [cb (getf :logical-block-callback)] (cb :end))) - (let [oldpos (getf :pos) - newpos (+ oldpos (if suffix (count suffix) 0))] - (setf :pos newpos) - (add-to-buffer this (make-end-block-t lb oldpos newpos)))) - (setf :logical-blocks (:parent lb))))) - -(defn nl [^Writer this type] - (dosync - (setf :mode :buffering) - (let [pos (getf :pos)] - (add-to-buffer this (make-nl-t type (getf :logical-blocks) pos pos))))) - -(defn indent [^Writer this relative-to offset] - (dosync - (let [lb (getf :logical-blocks)] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (ref-set (:indent lb) - (+ offset (condp = relative-to - :block @(:start-col lb) - :current (get-column (getf :base)))))) - (let [pos (getf :pos)] - (add-to-buffer this (make-indent-t lb relative-to offset pos pos))))))) - -(defn get-miser-width [^Writer this] - (getf :miser-width)) - -(defn set-miser-width [^Writer this new-miser-width] - (dosync (setf :miser-width new-miser-width))) - -(defn set-logical-block-callback [^Writer this f] - (dosync (setf :logical-block-callback f))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/pprint/utilities.clj --- a/src/clojure/contrib/pprint/utilities.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,104 +0,0 @@ -;;; utilities.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Jan 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This module implements some utility function used in formatting and pretty -;; printing. The functions here could go in a more general purpose library, -;; perhaps. - -(ns clojure.contrib.pprint.utilities) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Helper functions for digesting formats in the various -;;; phases of their lives. -;;; These functions are actually pretty general. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn map-passing-context [func initial-context lis] - (loop [context initial-context - lis lis - acc []] - (if (empty? lis) - [acc context] - (let [this (first lis) - remainder (next lis) - [result new-context] (apply func [this context])] - (recur new-context remainder (conj acc result)))))) - -(defn consume [func initial-context] - (loop [context initial-context - acc []] - (let [[result new-context] (apply func [context])] - (if (not result) - [acc new-context] - (recur new-context (conj acc result)))))) - -(defn consume-while [func initial-context] - (loop [context initial-context - acc []] - (let [[result continue new-context] (apply func [context])] - (if (not continue) - [acc context] - (recur new-context (conj acc result)))))) - -(defn unzip-map [m] - "Take a map that has pairs in the value slots and produce a pair of maps, - the first having all the first elements of the pairs and the second all - the second elements of the pairs" - [(into {} (for [[k [v1 v2]] m] [k v1])) - (into {} (for [[k [v1 v2]] m] [k v2]))]) - -(defn tuple-map [m v1] - "For all the values, v, in the map, replace them with [v v1]" - (into {} (for [[k v] m] [k [v v1]]))) - -(defn rtrim [s c] - "Trim all instances of c from the end of sequence s" - (let [len (count s)] - (if (and (pos? len) (= (nth s (dec (count s))) c)) - (loop [n (dec len)] - (cond - (neg? n) "" - (not (= (nth s n) c)) (subs s 0 (inc n)) - true (recur (dec n)))) - s))) - -(defn ltrim [s c] - "Trim all instances of c from the beginning of sequence s" - (let [len (count s)] - (if (and (pos? len) (= (nth s 0) c)) - (loop [n 0] - (if (or (= n len) (not (= (nth s n) c))) - (subs s n) - (recur (inc n)))) - s))) - -(defn prefix-count [aseq val] - "Return the number of times that val occurs at the start of sequence aseq, -if val is a seq itself, count the number of times any element of val occurs at the -beginning of aseq" - (let [test (if (coll? val) (set val) #{val})] - (loop [pos 0] - (if (or (= pos (count aseq)) (not (test (nth aseq pos)))) - pos - (recur (inc pos)))))) - -(defn prerr [& args] - "Println to *err*" - (binding [*out* *err*] - (apply println args))) - -(defmacro prlabel [prefix arg & more-args] - "Print args to *err* in name = value format" - `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) - (cons arg (seq more-args)))))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/probabilities/finite_distributions.clj --- a/src/clojure/contrib/probabilities/finite_distributions.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,203 +0,0 @@ -;; Finite probability distributions - -;; by Konrad Hinsen -;; last updated January 8, 2010 - -;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Finite probability distributions - This library defines a monad for combining finite probability - distributions."} - clojure.contrib.probabilities.finite-distributions - (:use [clojure.contrib.monads - :only (defmonad domonad with-monad maybe-t m-lift m-chain)] - [clojure.contrib.def :only (defvar)])) - -; The probability distribution monad. It is limited to finite probability -; distributions (e.g. there is a finite number of possible value), which -; are represented as maps from values to probabilities. - -(defmonad dist-m - "Monad describing computations on fuzzy quantities, represented by a finite - probability distribution for the possible values. A distribution is - represented by a map from values to probabilities." - [m-result (fn m-result-dist [v] - {v 1}) - m-bind (fn m-bind-dist [mv f] - (reduce (partial merge-with +) - (for [[x p] mv [y q] (f x)] - {y (* q p)}))) - ]) - -; Applying the monad transformer maybe-t to the basic dist monad results -; in the cond-dist monad that can handle invalid values. The total probability -; for invalid values ends up as the probability of m-zero (which is nil). -; The function normalize takes this probability out of the distribution and -; re-distributes its weight over the valid values. - -(defvar cond-dist-m - (maybe-t dist-m) - "Variant of the dist monad that can handle undefined values.") - -; Normalization - -(defn- scale-by - "Multiply each entry in dist by the scale factor s and remove zero entries." - [dist s] - (into {} - (for [[val p] dist :when (> p 0)] - [val (* p s)]))) - -(defn normalize-cond [cdist] - "Normalize a probability distribution resulting from a computation in - the cond-dist monad by re-distributing the weight of the invalid values - over the valid ones." - (let [missing (get cdist nil 0) - dist (dissoc cdist nil)] - (cond (zero? missing) dist - (= 1 missing) {} - :else (let [scale (/ 1 (- 1 missing))] - (scale-by dist scale))))) - -(defn normalize - "Convert a weight map (e.g. a map of counter values) to a distribution - by multiplying with a normalization factor. If the map has a key - :total, its value is assumed to be the sum over all the other values and - it is used for normalization. Otherwise, the sum is calculated - explicitly. The :total key is removed from the resulting distribution." - [weights] - (let [total (:total weights) - w (dissoc weights :total) - s (/ 1 (if (nil? total) (reduce + (vals w)) total))] - (scale-by w s))) - -; Functions that construct distributions - -(defn uniform - "Return a distribution in which each of the elements of coll - has the same probability." - [coll] - (let [n (count coll) - p (/ 1 n)] - (into {} (for [x (seq coll)] [x p])))) - -(defn choose - "Construct a distribution from an explicit list of probabilities - and values. They are given in the form of a vector of probability-value - pairs. In the last pair, the probability can be given by the keyword - :else, which stands for 1 minus the total of the other probabilities." - [& choices] - (letfn [(add-choice [dist [p v]] - (cond (nil? p) dist - (= p :else) - (let [total-p (reduce + (vals dist))] - (assoc dist v (- 1 total-p))) - :else (assoc dist v p)))] - (reduce add-choice {} (partition 2 choices)))) - -(defn bernoulli - [p] - "Returns the Bernoulli distribution for probability p." - (choose p 1 :else 0)) - -(defn- bc - [n] - "Returns the binomial coefficients for a given n." - (let [r (inc n)] - (loop [c 1 - f (list 1)] - (if (> c n) - f - (recur (inc c) (cons (* (/ (- r c) c) (first f)) f)))))) - -(defn binomial - [n p] - "Returns the binomial distribution, which is the distribution of the - number of successes in a series of n experiments whose individual - success probability is p." - (let [q (- 1 p) - n1 (inc n) - k (range n1) - pk (take n1 (iterate #(* p %) 1)) - ql (reverse (take n1 (iterate #(* q %) 1))) - f (bc n)] - (into {} (map vector k (map * f pk ql))))) - -(defn make-distribution - "Returns the distribution in which each element x of the collection - has a probability proportional to (f x)" - [coll f] - (normalize (into {} (for [k coll] [k (f k)])))) - -(defn zipf - "Returns the Zipf distribution in which the numbers k=1..n have - probabilities proportional to 1/k^s." - [s n] - (make-distribution (range 1 (inc n)) #(/ (java.lang.Math/pow % s)))) - -(defn certainly - "Returns a distribution in which the single value v has probability 1." - [v] - {v 1}) - -(with-monad dist-m - - (defn join-with - "Returns the distribution of (f x y) with x from dist1 and y from dist2." - [f dist1 dist2] - ((m-lift 2 f) dist1 dist2)) - -) - -(with-monad cond-dist-m - (defn cond-prob - "Returns the conditional probability for the values in dist that satisfy - the predicate pred." - [pred dist] - (normalize-cond - (domonad - [v dist - :when (pred v)] - v)))) - -; Select (with equal probability) N items from a sequence - -(defn- nth-and-rest [n xs] - "Return a list containing the n-th value of xs and the sequence - obtained by removing the n-th value from xs." - (let [[h t] (split-at n xs)] - (list (first t) (concat h (rest t))))) - -(with-monad dist-m - - (defn- select-n [n xs] - (letfn [(select-1 [[s xs]] - (uniform (for [i (range (count xs))] - (let [[nth rest] (nth-and-rest i xs)] - (list (cons nth s) rest)))))] - ((m-chain (replicate n select-1)) (list '() xs)))) - - (defn select [n xs] - "Return the distribution for all possible ordered selections of n elements - out of xs." - ((m-lift 1 first) (select-n n xs))) - -) - -; Find the probability that a given predicate is satisfied - -(defn prob - "Return the probability that the predicate pred is satisfied in the - distribution dist, i.e. the sum of the probabilities of the values - that satisfy pred." - [pred dist] - (apply + (for [[x p] dist :when (pred x)] p))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/probabilities/monte_carlo.clj --- a/src/clojure/contrib/probabilities/monte_carlo.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,240 +0,0 @@ -;; Monte-Carlo algorithms - -;; by Konrad Hinsen -;; last updated May 3, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Monte-Carlo method support - - Monte-Carlo methods transform an input random number stream - (usually having a continuous uniform distribution in the - interval [0, 1)) into a random number stream whose distribution - satisfies certain conditions (usually the expectation value - is equal to some desired quantity). They are thus - transformations from one probability distribution to another one. - - This library represents a Monte-Carlo method by a function that - takes as input the state of a random number stream with - uniform distribution (see - clojure.contrib.probabilities.random-numbers) and returns a - vector containing one sample value of the desired output - distribution and the final state of the input random number - stream. Such functions are state monad values and can be - composed using operations defined in clojure.contrib.monads."} - clojure.contrib.probabilities.monte-carlo - (:refer-clojure :exclude (deftype)) - (:use [clojure.contrib.macros :only (const)]) - (:use [clojure.contrib.types :only (deftype)]) - (:use [clojure.contrib.stream-utils :only (defstream stream-next)]) - (:use [clojure.contrib.monads - :only (with-monad state-m m-lift m-seq m-fmap)]) - (:require [clojure.contrib.generic.arithmetic :as ga]) - (:require [clojure.contrib.accumulators :as acc])) - -;; Random number transformers and random streams -;; -;; A random number transformer is a function that takes a random stream -;; state as input and returns the next value from the transformed stream -;; plus the new state of the input stream. Random number transformers -;; are thus state monad values. -;; -;; Distributions are implemented as random number transformers that -;; transform a uniform distribution in the interval [0, 1) to the -;; desired distribution. Composition of such distributions allows -;; the realization of any kind of Monte-Carlo algorithm. The result -;; of such a composition is always again a distribution. -;; -;; Random streams are defined by a random number transformer and an -;; input random number stream. If the randon number transformer represents -;; a distribution, the input stream must have a uniform distribution -;; in the interval [0, 1). - -; Random stream definition -(deftype ::random-stream random-stream - "Define a random stream by a distribution and the state of a - random number stream with uniform distribution in [0, 1)." - {:arglists '([distribution random-stream-state])} - (fn [d rs] (list d rs))) - -(defstream ::random-stream - [[d rs]] - (let [[r nrs] (d rs)] - [r (random-stream d nrs)])) - -; Rejection of values is used in the construction of distributions -(defn reject - "Return the distribution that results from rejecting the values from - dist that do not satisfy predicate p." - [p dist] - (fn [rs] - (let [[r nrs] (dist rs)] - (if (p r) - (recur nrs) - [r nrs])))) - -; Draw a value from a discrete distribution given as a map from -; values to probabilities. -; (see clojure.contrib.probabilities.finite-distributions) -(with-monad state-m - (defn discrete - "A discrete distribution, defined by a map dist mapping values - to probabilities. The sum of probabilities must be one." - [dist] - (letfn [(pick-at-level [l dist-items] - (let [[[x p] & rest-dist] dist-items] - (if (> p l) - x - (recur (- l p) rest-dist))))] - (m-fmap #(pick-at-level % (seq dist)) stream-next)))) - -; Uniform distribution in an finite half-open interval -(with-monad state-m - (defn interval - [a b] - "Transform a sequence of uniform random numbers in the interval [0, 1) - into a sequence of uniform random numbers in the interval [a, b)." - (let [d (- b a) - f (if (zero? a) - (if (= d 1) - identity - (fn [r] (* d r))) - (if (= d 1) - (fn [r] (+ a r)) - (fn [r] (+ a (* d r)))))] - (m-fmap f stream-next)))) - -; Normal (Gaussian) distribution -(defn normal - "Transform a sequence urs of uniform random number in the interval [0, 1) - into a sequence of normal random numbers with mean mu and standard - deviation sigma." - [mu sigma] - ; This function implements the Kinderman-Monahan ratio method: - ; A.J. Kinderman & J.F. Monahan - ; Computer Generation of Random Variables Using the Ratio of Uniform Deviates - ; ACM Transactions on Mathematical Software 3(3) 257-260, 1977 - (fn [rs] - (let [[u1 rs] (stream-next rs) - [u2* rs] (stream-next rs) - u2 (- 1. u2*) - s (const (* 4 (/ (. Math exp (- 0.5)) (. Math sqrt 2.)))) - z (* s (/ (- u1 0.5) u2)) - zz (+ (* 0.25 z z) (. Math log u2))] - (if (> zz 0) - (recur rs) - [(+ mu (* sigma z)) rs])))) - -; Lognormal distribution -(with-monad state-m - (defn lognormal - "Transform a sequence of uniform random numbesr in the interval [0, 1) - into a sequence of lognormal random numbers with mean mu and standard - deviation sigma." - [mu sigma] - (m-fmap #(. Math exp %) (normal mu sigma)))) - -; Exponential distribution -(with-monad state-m - (defn exponential - "Transform a sequence of uniform random numbers in the interval [0, 1) - into a sequence of exponential random numbers with parameter lambda." - [lambda] - (when (<= lambda 0) - (throw (IllegalArgumentException. - "exponential distribution requires a positive argument"))) - (let [neg-inv-lambda (- (/ lambda)) - ; remove very small numbers to prevent log from returning -Infinity - not-too-small (reject #(< % 1e-323) stream-next)] - (m-fmap #(* (. Math log %) neg-inv-lambda) not-too-small)))) - -; Another implementation of the normal distribution. It uses the -; Box-Muller transform, but discards one of the two result values -; at each cycle because the random number transformer interface cannot -; handle two outputs at the same time. -(defn normal-box-muller - "Transform a sequence of uniform random numbers in the interval [0, 1) - into a sequence of normal random numbers with mean mu and standard - deviation sigma." - [mu sigma] - (fn [rs] - (let [[u1 rs] (stream-next rs) - [u2 rs] (stream-next rs) - v1 (- (* 2.0 u1) 1.0) - v2 (- (* 2.0 u2) 1.0) - s (+ (* v1 v1) (* v2 v2)) - ls (. Math sqrt (/ (* -2.0 (. Math log s)) s)) - x1 (* v1 ls) - x2 (* v2 ls)] - (if (or (>= s 1) (= s 0)) - (recur rs) - [x1 rs])))) - -; Finite samples from a distribution -(with-monad state-m - - (defn sample - "Return the distribution of samples of length n from the - distribution dist" - [n dist] - (m-seq (replicate n dist))) - - (defn sample-reduce - "Returns the distribution of the reduction of f over n samples from the - distribution dist." - ([f n dist] - (if (zero? n) - (m-result (f)) - (let [m-f (m-lift 2 f) - sample (replicate n dist)] - (reduce m-f sample)))) - ([f val n dist] - (let [m-f (m-lift 2 f) - m-val (m-result val) - sample (replicate n dist)] - (reduce m-f m-val sample)))) - - (defn sample-sum - "Return the distribution of the sum over n samples from the - distribution dist." - [n dist] - (sample-reduce ga/+ n dist)) - - (defn sample-mean - "Return the distribution of the mean over n samples from the - distribution dist" - [n dist] - (let [div-by-n (m-lift 1 #(ga/* % (/ n)))] - (div-by-n (sample-sum n dist)))) - - (defn sample-mean-variance - "Return the distribution of the mean-and-variance (a vector containing - the mean and the variance) over n samples from the distribution dist" - [n dist] - (let [extract (m-lift 1 (fn [mv] [(:mean mv) (:variance mv)]))] - (extract (sample-reduce acc/add acc/empty-mean-variance n dist)))) - -) - -; Uniform distribution inside an n-sphere -(with-monad state-m - (defn n-sphere - "Return a uniform distribution of n-dimensional vectors inside an - n-sphere of radius r." - [n r] - (let [box-dist (sample n (interval (- r) r)) - sq #(* % %) - r-sq (sq r) - vec-sq #(apply + (map sq %)) - sphere-dist (reject #(> (vec-sq %) r-sq) box-dist) - as-vectors (m-lift 1 vec)] - (as-vectors sphere-dist)))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/probabilities/random_numbers.clj --- a/src/clojure/contrib/probabilities/random_numbers.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,63 +0,0 @@ -;; Random number generators - -;; by Konrad Hinsen -;; last updated May 3, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Random number streams - - This library provides random number generators with a common - stream interface. They all produce pseudo-random numbers that are - uniformly distributed in the interval [0, 1), i.e. 0 is a - possible value but 1 isn't. For transformations to other - distributions, see clojure.contrib.probabilities.monte-carlo. - - At the moment, the only generator provided is a rather simple - linear congruential generator."} - clojure.contrib.probabilities.random-numbers - (:refer-clojure :exclude (deftype)) - (:use [clojure.contrib.types :only (deftype)]) - (:use [clojure.contrib.stream-utils :only (defstream)]) - (:use [clojure.contrib.def :only (defvar)])) - -;; Linear congruential generator -;; http://en.wikipedia.org/wiki/Linear_congruential_generator - -(deftype ::lcg lcg - "Create a linear congruential generator" - {:arglists '([modulus multiplier increment seed])} - (fn [modulus multiplier increment seed] - {:m modulus :a multiplier :c increment :seed seed}) - (fn [s] (map s (list :m :a :c :seed)))) - -(defstream ::lcg - [lcg-state] - (let [{m :m a :a c :c seed :seed} lcg-state - value (/ (float seed) (float m)) - new-seed (rem (+ c (* a seed)) m)] - [value (assoc lcg-state :seed new-seed)])) - -;; A generator based on Clojure's built-in rand function -;; (and thus random from java.lang.Math) -;; Note that this generator uses an internal mutable state. -;; -;; The state is *not* stored in the stream object and can thus -;; *not* be restored! - -(defvar rand-stream (with-meta 'rand {:type ::rand-stream}) - "A random number stream based on clojure.core/rand. Note that this - generator uses an internal mutable state. The state is thus not stored - in the stream object and cannot be restored.") - -(defstream ::rand-stream - [dummy-state] - [(rand) dummy-state]) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/profile.clj --- a/src/clojure/contrib/profile.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,110 +0,0 @@ -;;; profile.clj: simple code profiling & timing - -;; by Stuart Sierra, http://stuartsierra.com/ -;; May 9, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(ns ^{:author "Stuart Sierra" - :doc "Simple code profiling & timing measurement. - -Wrap any section of code in the prof macro, giving it a name, like this: - - (defn my-function [x y] - (let [sum (prof :addition (+ x y)) - product (prof :multiplication (* x y))] - [sum product])) - -The run your code in the profile macro, like this: - - (profile (dotimes [i 10000] (my-function 3 4))) - -Which prints a report for each named section of code: - - Name mean min max count sum - addition 265 0 37000 10000 2655000 -multiplication 274 0 53000 10000 2747000 - -Times are measured in nanoseconds, to the maximum precision available -under the JVM. See the function documentation for more details. -"} - clojure.contrib.profile) - -(def *profile-data* nil) - -(def ^{:doc "Set this to false before loading/compiling to omit -profiling code."} *enable-profiling* true) - -(defmacro prof - "If *enable-profiling* is true, wraps body in profiling code. - Returns the result of body. Profile timings will be stored in - *profile-data* using name, which must be a keyword, as the key. - Timings are measured with System/nanoTime." - [name & body] - (assert (keyword? name)) - (if *enable-profiling* - `(if *profile-data* - (let [start-time# (System/nanoTime) - value# (do ~@body) - elapsed# (- (System/nanoTime) start-time#)] - (swap! *profile-data* assoc ~name - (conj (get @*profile-data* ~name) elapsed#)) - value#) - ~@body) - `(do ~@body))) - -(defmacro with-profile-data - "Executes body with *profile-data* bound to an atom of a new map. - Returns the raw profile data as a map. Keys in the map are profile - names (keywords), and values are lists of elapsed time, in - nanoseconds." - [& body] - `(binding [*profile-data* (atom {})] - ~@body - @*profile-data*)) - -(defn summarize - "Takes the raw data returned by with-profile-data and returns a map - from names to summary statistics. Each value in the map will look - like: - - {:mean ..., :min ..., :max ..., :count ..., :sum ...} - - :mean, :min, and :max are how long the profiled section took to run, - in nanoseconds. :count is the total number of times the profiled - section was executed. :sum is the total amount of time spent in the - profiled section, in nanoseconds." - [profile-data] - (reduce (fn [m [k v]] - (let [cnt (count v) - sum (reduce + v)] - (assoc m k {:mean (int (/ sum cnt)) - :min (apply min v) - :max (apply max v) - :count cnt - :sum sum}))) - {} profile-data)) - -(defn print-summary - "Prints a table of the results returned by summarize." - [profile-summary] - (let [name-width (apply max 1 (map (comp count name) (keys profile-summary))) - fmt-string (str "%" name-width "s %8d %8d %8d %8d %8d%n")] - (printf (.replace fmt-string \d \s) - "Name" "mean" "min" "max" "count" "sum") - (doseq [k (sort (keys profile-summary))] - (let [v (get profile-summary k)] - (printf fmt-string (name k) (:mean v) (:min v) (:max v) (:count v) (:sum v)))))) - -(defmacro profile - "Runs body with profiling enabled, then prints a summary of - results. Returns nil." - [& body] - `(print-summary (summarize (with-profile-data (do ~@body))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/properties.clj --- a/src/clojure/contrib/properties.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,77 +0,0 @@ -; Copyright (c) Stuart Halloway & Contributors, April 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; DEPRECATED in 1.2. Moved to c.c.java-utils - -(ns ^{:deprecated "1.2"} - clojure.contrib.properties - (:use [clojure.contrib.string :only (as-str)] - [clojure.contrib.io :only (file)]) - (:import (java.util Properties) - (java.io FileInputStream FileOutputStream))) - -(defn get-system-property - "Get a system property." - ([stringable] - (System/getProperty (as-str stringable))) - ([stringable default] - (System/getProperty (as-str stringable) default))) - -(defn set-system-properties - "Set some system properties. Nil clears a property." - [settings] - (doseq [[name val] settings] - (if val - (System/setProperty (as-str name) (as-str val)) - (System/clearProperty (as-str name))))) - -(defmacro with-system-properties - "setting => property-name value - - Sets the system properties to the supplied values, executes the body, and - sets the properties back to their original values. Values of nil are - translated to a clearing of the property." - [settings & body] - `(let [settings# ~settings - current# (reduce (fn [coll# k#] - (assoc coll# k# (get-system-property k#))) - {} - (keys settings#))] - (set-system-properties settings#) - (try - ~@body - (finally - (set-system-properties current#))))) - - -; Not there is no corresponding props->map. Just destructure! -(defn ^Properties as-properties - "Convert any seq of pairs to a java.utils.Properties instance. - Uses as-str to convert both keys and values into strings." - {:tag Properties} - [m] - (let [p (Properties.)] - (doseq [[k v] m] - (.setProperty p (as-str k) (as-str v))) - p)) - -(defn read-properties - "Read properties from file-able." - [file-able] - (with-open [f (java.io.FileInputStream. (file file-able))] - (doto (Properties.) - (.load f)))) - -(defn write-properties - "Write properties to file-able." - {:tag Properties} - ([m file-able] (write-properties m file-able nil)) - ([m file-able comments] - (with-open [^FileOutputStream f (FileOutputStream. (file file-able))] - (doto (as-properties m) - (.store f ^String comments))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/prxml.clj --- a/src/clojure/contrib/prxml.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,170 +0,0 @@ -;;; prxml.clj -- compact syntax for generating XML - -;; by Stuart Sierra, http://stuartsierra.com/ -;; March 29, 2009 - -;; Copyright (c) 2009 Stuart Sierra. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; Change Log -;; -;; March 29, 2009: added *prxml-indent* -;; -;; January 4, 2009: initial version - - -;; See function "prxml" at the bottom of this file for documentation. - - -(ns - ^{:author "Stuart Sierra", - :doc "Compact syntax for generating XML. See the documentation of \"prxml\" -for details."} - clojure.contrib.prxml - (:use [clojure.contrib.string :only (escape as-str)])) - -(def - ^{:doc "If true, empty tags will have a space before the closing />"} - *html-compatible* false) - -(def - ^{:doc "The number of spaces to indent sub-tags. nil for no indent - and no extra line-breaks."} - *prxml-indent* nil) - -(def ^{:private true} *prxml-tag-depth* 0) - -(def ^{:private true} print-xml) ; forward declaration - -(defn- escape-xml [s] - (escape {\< "<" - \> ">" - \& "&" - \' "'" - \" """} s)) - -(defn- prxml-attribute [name value] - (print " ") - (print (as-str name)) - (print "=\"") - (print (escape-xml (str value))) - (print "\"")) - -(defmulti ^{:private true} print-xml-tag (fn [tag attrs content] tag)) - -(defmethod print-xml-tag :raw! [tag attrs contents] - (doseq [c contents] (print c))) - -(defmethod print-xml-tag :comment! [tag attrs contents] - (print "")) - -(defmethod print-xml-tag :decl! [tag attrs contents] - (let [attrs (merge {:version "1.0" :encoding "UTF-8"} - attrs)] - ;; Must enforce ordering of pseudo-attributes: - (print ""))) - -(defmethod print-xml-tag :cdata! [tag attrs contents] - (print "")) - -(defmethod print-xml-tag :doctype! [tag attrs contents] - (print "")) - -(defmethod print-xml-tag :default [tag attrs contents] - (let [tag-name (as-str tag)] - (when *prxml-indent* - (newline) - (dotimes [n (* *prxml-tag-depth* *prxml-indent*)] (print " "))) - (print "<") - (print tag-name) - (doseq [[name value] attrs] - (prxml-attribute name value)) - (if (seq contents) - (do ;; not an empty tag - (print ">") - (if (every? string? contents) - ;; tag only contains strings: - (do (doseq [c contents] (print-xml c)) - (print "")) - ;; tag contains sub-tags: - (do (binding [*prxml-tag-depth* (inc *prxml-tag-depth*)] - (doseq [c contents] (print-xml c))) - (when *prxml-indent* - (newline) - (dotimes [n (* *prxml-tag-depth* *prxml-indent*)] (print " "))) - (print "")))) - ;; empty tag: - (print (if *html-compatible* " />" "/>"))))) - - -(defmulti ^{:private true} print-xml class) - -(defmethod print-xml clojure.lang.IPersistentVector [x] - (let [[tag & contents] x - [attrs content] (if (map? (first contents)) - [(first contents) (rest contents)] - [{} contents])] - (print-xml-tag tag attrs content))) - -(defmethod print-xml clojure.lang.ISeq [x] - ;; Recurse into sequences, so we can use (map ...) inside prxml. - (doseq [c x] (print-xml c))) - -(defmethod print-xml clojure.lang.Keyword [x] - (print-xml-tag x {} nil)) - -(defmethod print-xml String [x] - (print (escape-xml x))) - -(defmethod print-xml nil [x]) - -(defmethod print-xml :default [x] - (print x)) - - -(defn prxml - "Print XML to *out*. Vectors become XML tags: the first item is the - tag name; optional second item is a map of attributes. - - Sequences are processed recursively, so you can use map and other - sequence functions inside prxml. - - (prxml [:p {:class \"greet\"} [:i \"Ladies & gentlemen\"]]) - ; =>

Ladies & gentlemen

- - PSEUDO-TAGS: some keywords have special meaning: - - :raw! do not XML-escape contents - :comment! create an XML comment - :decl! create an XML declaration, with attributes - :cdata! create a CDATA section - :doctype! create a DOCTYPE! - - (prxml [:p [:raw! \"here & gone\"]]) - ; =>

here & gone

- - (prxml [:decl! {:version \"1.1\"}]) - ; => " - [& args] - (doseq [arg args] (print-xml arg))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/reflect.clj --- a/src/clojure/contrib/reflect.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -; Copyright (c) 2010 Stuart Halloway & Contributors. All rights -; reserved. The use and distribution terms for this software are -; covered by the Eclipse Public License 1.0 -; (http://opensource.org/licenses/eclipse-1.0.php) which can be -; found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be -; bound by the terms of this license. You must not remove this -; notice, or any other, from this software. - -(ns clojure.contrib.reflect) - -(defn call-method - "Calls a private or protected method. - - params is a vector of classes which correspond to the arguments to - the method e - - obj is nil for static methods, the instance object otherwise. - - The method-name is given a symbol or a keyword (something Named)." - [klass method-name params obj & args] - (-> klass (.getDeclaredMethod (name method-name) - (into-array Class params)) - (doto (.setAccessible true)) - (.invoke obj (into-array Object args)))) - -(defn get-field - "Access to private or protected field. field-name is a symbol or - keyword." - [klass field-name obj] - (-> klass (.getDeclaredField (name field-name)) - (doto (.setAccessible true)) - (.get obj))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/repl_ln.clj --- a/src/clojure/contrib/repl_ln.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,274 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; A repl with that provides support for lines and line numbers in the -;; input stream. -;; -;; scgilardi (gmail) -;; Created 28 November 2008 - -(ns - ^{:author "Stephen C. Gilardi", - :doc "A repl with that provides support for lines and line numbers in the - input stream."} - clojure.contrib.repl-ln - (:gen-class) - (:import (clojure.lang Compiler LineNumberingPushbackReader RT Var) - (java.io InputStreamReader OutputStreamWriter PrintWriter) - java.util.Date) - (:require clojure.main) - (:use [clojure.contrib.def - :only (defmacro- defonce- defstruct- defvar-)])) - -;; Private - -(declare repl) - -(defstruct- repl-info - :name :started :name-fmt :prompt-fmt :serial :thread :depth) - -(defvar- +name-formats+ - {"%S" "%1$d" "%T" "%2$d" "%D" "%3$d"} - "For set-name, maps our dynamic value codes to arg positions in - the call to format in repl-name") - -(defvar- +prompt-formats+ - {"%S" "%1$d" "%T" "%2$d" "%D" "%3$d" "%L" "%4$d" "%N" "%5$s"} - "For set-prompt, maps our dynamic value codes to arg positions in - the call to format in repl-prompt") - -(defvar- +info-format+ - ["Name: %s" - "Started: %s" - "Name-fmt: \"%s\"" - "Prompt-fmt: \"%s\"" - "Serial: %d" - "Thread: %d" - "Depth: %d" - "Line: %d"]) - -(defvar- +info-defaults+ - (struct-map repl-info - :name-fmt "repl-%S" - :prompt-fmt "%S:%L %N=> " - :depth 0) - "Default/root values for repl info") - -(defonce- *serial-number* (atom 0) - "Serial number counter") - -(defonce- *info* +info-defaults+ - "Public info for this repl") - -(defonce- *private* {} - "Private info for this repl") - -(defmacro- update - "Replaces the map thread-locally bound to map-var with a copy that - includes updated and/or new values from keys and vals." - [map-var & key-vals] - `(set! ~map-var (assoc ~map-var ~@key-vals))) - -(defn- repl-name - "Returns the repl name based on this repl's name-fmt" - [] - (let [{:keys [name-fmt]} *private* - {:keys [serial thread depth]} *info*] - (format name-fmt serial thread depth))) - -(defn- prompt-hook - [] - (let [prompt (*private* :prompt)] - (var-set Compiler/LINE (.getLineNumber *in*)) - (prompt))) - -(defn- process-inits - "Processes initial pairs of args of the form: - - -i filepath, or - --init filepath - - by loading the referenced files, then accepts an optional terminating arg - of the form: - - -r, or - --repl - - Returns a seq of any remaining args." - [args] - (loop [[init filename & more :as args] args] - (if (#{"-i" "--init"} init) - (do - (clojure.main/load-script filename) - (recur more)) - (if (#{"-r" "--repl"} init) - (rest args) - args)))) - -(defn- process-command-line - "Args are strings passed in from the command line. Loads any requested - init files and binds *command-line-args* to a seq of the remaining args" - [args] - (set! *command-line-args* (process-inits args))) - -(defn stream-repl - "Repl entry point that provides convenient overriding of input, output, - and err streams via sequential keyword-value pairs. Default values - for :in, :out, and :err are streams associated with System/in, - System/out, and System/err using UTF-8 encoding. Also supports all the - options provided by clojure.contrib.repl-ln/repl." - [& options] - (let [enc RT/UTF8 - {:keys [in out err] - :or {in (LineNumberingPushbackReader. - (InputStreamReader. System/in enc)) - out (OutputStreamWriter. System/out enc) - err (PrintWriter. (OutputStreamWriter. System/err enc))}} - (apply hash-map options)] - (binding [*in* in *out* out *err* err] - (apply repl options)))) - -(defn- -main - "Main entry point, starts a repl enters the user namespace and processes - command line args." - [& args] - (repl :init - (fn [] - (println "Clojure" (clojure-version)) - (in-ns 'user) - (process-command-line args)))) - -;; Public - -(defn repl-prompt - "Returns the current repl prompt based on this repl's prompt-fmt" - [] - (let [{:keys [prompt-fmt]} *private* - {:keys [serial thread depth]} *info* - line (.getLineNumber *in*) - namespace (ns-name *ns*)] - (format prompt-fmt serial thread depth line namespace))) - -(defn set-repl-name - "Sets the repl name format to the string name-fmt. Include the following - codes in the name to make the corresponding dynamic values part of it: - - %S - repl serial number - %T - thread id - %D - nesting depth in this thread - - With no arguments, resets the repl name to its default: \"repl-%S\"" - ([] - (set-repl-name (+info-defaults+ :name-fmt))) - ([name-fmt] - (update *info* :name-fmt name-fmt) - (loop [[[code fmt] & more] (seq +name-formats+) - name-fmt name-fmt] - (if code - (recur more (.replace name-fmt code fmt)) - (update *private* :name-fmt name-fmt))) - (let [name (repl-name)] - (update *info* :name name) - (var-set Compiler/SOURCE name)) - nil)) - -(defn set-repl-prompt - "Sets the repl prompt. Include the following codes in the prompt to make - the corresponding dynamic values part of it: - - %S - repl serial number - %T - thread id - %D - nesting depth in this thread - %L - input line number - %N - namespace name - - With no arguments, resets the repl pompt to its default: \"%S:%L %N=> \"" - ([] - (set-repl-prompt (+info-defaults+ :prompt-fmt))) - ([prompt-fmt] - (update *info* :prompt-fmt prompt-fmt) - (loop [[[code fmt] & more] (seq +prompt-formats+) - prompt-fmt prompt-fmt] - (if code - (recur more (.replace prompt-fmt code fmt)) - (update *private* :prompt-fmt prompt-fmt))) - nil)) - -(defn repl-info - "Returns a map of info about the current repl" - [] - (let [line (.getLineNumber *in*)] - (assoc *info* :line line))) - -(defn print-repl-info - "Prints info about the current repl" - [] - (let [{:keys [name started name-fmt prompt-fmt serial thread depth line]} - (repl-info)] - (printf - (apply str (interleave +info-format+ (repeat "\n"))) - name started name-fmt prompt-fmt serial thread depth line))) - -(defn repl - "A repl that supports line numbers. For definitions and evaluations made - at the repl, the repl-name and line number will be reported as the - origin. Use set-repl-name and set-repl-prompt to customize the repl name - and prompt. This repl supports all of the keyword arguments documented - for clojure.main/repl with the following change and additions: - - - :prompt has a new default - default: #(clojure.core/print (repl-prompt)) - - - :name-fmt, Name format string - default: the name-fmt of the parent repl, or \"repl-%S\" - - - :prompt-fmt, Prompt format string - default: the prompt-fmt of the parent repl, or \"%S:%L %N=> \"" - [& options] - (let [{:keys [init need-prompt prompt flush read eval print caught - name-fmt prompt-fmt] - :or {init #() - need-prompt (if (instance? LineNumberingPushbackReader *in*) - #(.atLineStart *in*) - #(identity true)) - prompt #(clojure.core/print (repl-prompt)) - flush flush - read clojure.main/repl-read - eval eval - print prn - caught clojure.main/repl-caught - name-fmt (*info* :name-fmt) - prompt-fmt (*info* :prompt-fmt)}} - (apply hash-map options)] - (try - (Var/pushThreadBindings - {Compiler/SOURCE (var-get Compiler/SOURCE) - Compiler/LINE (var-get Compiler/LINE) - (var *info*) *info* - (var *private*) {}}) - (update *info* - :started (Date.) - :serial (swap! *serial-number* inc) - :thread (.getId (Thread/currentThread)) - :depth (inc (*info* :depth))) - (update *private* - :prompt prompt) - (set-repl-name name-fmt) - (set-repl-prompt prompt-fmt) - (clojure.main/repl - :init init - :need-prompt need-prompt - :prompt prompt-hook - :flush flush - :read read - :eval eval - :print print - :caught caught) - (finally - (Var/popThreadBindings) - (prn))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/repl_utils.clj --- a/src/clojure/contrib/repl_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,213 +0,0 @@ -; Copyright (c) Chris Houser, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) -; which can be found in the file CPL.TXT at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Utilities meant to be used interactively at the REPL - -;; Deprecated in 1.2: source, get-source, and apropos. These are -;; available in clojure.repl as source, source-fn, and apropos, respectively. - -(ns - ^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim", - :doc "Utilities meant to be used interactively at the REPL"} - clojure.contrib.repl-utils - (:import (java.io File LineNumberReader InputStreamReader PushbackReader) - (java.lang.reflect Modifier Method Constructor) - (clojure.lang RT Compiler Compiler$C)) - (:require [clojure.contrib.string :as s]) - (:use [clojure.contrib.seq :only (indexed)] - [clojure.contrib.javadoc.browse :only (browse-url)])) - -;; ---------------------------------------------------------------------- -;; Examine Java classes - -(defn- sortable [t] - (apply str (map (fn [[a b]] (str a (format "%04d" (Integer. b)))) - (partition 2 (concat (s/partition #"\d+" t) [0]))))) - -(defn- param-str [m] - (str " (" (s/join - "," (map (fn [[c i]] - (if (> i 3) - (str (.getSimpleName c) "*" i) - (s/join "," (replicate i (.getSimpleName c))))) - (reduce (fn [pairs y] (let [[x i] (peek pairs)] - (if (= x y) - (conj (pop pairs) [y (inc i)]) - (conj pairs [y 1])))) - [] (.getParameterTypes m)))) - ")")) - -(defn- member-details [m] - (let [static? (Modifier/isStatic (.getModifiers m)) - method? (instance? Method m) - ctor? (instance? Constructor m) - text (if ctor? - (str "" (param-str m)) - (str - (when static? "static ") - (.getName m) " : " - (if method? - (str (.getSimpleName (.getReturnType m)) (param-str m)) - (str (.getSimpleName (.getType m))))))] - (assoc (bean m) - :sort-val [(not static?) method? (sortable text)] - :text text - :member m))) - -(defn show - "With one arg prints all static and instance members of x or (class x). - Each member is listed with a number which can be given as 'selector' - to return the member object -- the REPL will print more details for - that member. - - The selector also may be a string or regex, in which case only - members whose names match 'selector' as a case-insensitive regex - will be printed. - - Finally, the selector also may be a predicate, in which case only - members for which the predicate returns true will be printed. The - predicate will be passed a single argument, a map that includes the - :text that will be printed and the :member object itself, as well as - all the properies of the member object as translated by 'bean'. - - Examples: (show Integer) (show []) (show String 23) (show String \"case\")" - ([x] (show x (constantly true))) - ([x selector] - (let [c (if (class? x) x (class x)) - members (sort-by :sort-val - (map member-details - (concat (.getFields c) - (.getMethods c) - (.getConstructors c))))] - (if (number? selector) - (:member (nth members selector)) - (let [pred (if (ifn? selector) - selector - #(re-find (re-pattern (str "(?i)" selector)) (:name %)))] - (println "=== " (Modifier/toString (.getModifiers c)) c " ===") - (doseq [[i m] (indexed members)] - (when (pred m) - (printf "[%2d] %s\n" i (:text m))))))))) - -;; ---------------------------------------------------------------------- -;; Examine Clojure functions (Vars, really) - -(defn get-source - "Returns a string of the source code for the given symbol, if it can - find it. This requires that the symbol resolve to a Var defined in - a namespace for which the .clj is in the classpath. Returns nil if - it can't find the source. For most REPL usage, 'source' is more - convenient. - - Example: (get-source 'filter)" - {:deprecated "1.2"} - [x] - (when-let [v (resolve x)] - (when-let [filepath (:file (meta v))] - (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)] - (with-open [rdr (LineNumberReader. (InputStreamReader. strm))] - (dotimes [_ (dec (:line (meta v)))] (.readLine rdr)) - (let [text (StringBuilder.) - pbr (proxy [PushbackReader] [rdr] - (read [] (let [i (proxy-super read)] - (.append text (char i)) - i)))] - (read (PushbackReader. pbr)) - (str text))))))) - -(defmacro source - "Prints the source code for the given symbol, if it can find it. - This requires that the symbol resolve to a Var defined in a - namespace for which the .clj is in the classpath. - - Example: (source filter)" - {:deprecated "1.2"} - [n] - `(println (or (get-source '~n) (str "Source not found")))) - -(defn apropos - "Given a regular expression or stringable thing, return a seq of -all definitions in all currently-loaded namespaces that match the -str-or-pattern." - {:deprecated "1.2"} - [str-or-pattern] - (let [matches? (if (instance? java.util.regex.Pattern str-or-pattern) - #(re-find str-or-pattern (str %)) - #(s/substring? (str str-or-pattern) (str %)))] - (mapcat (fn [ns] - (filter matches? (keys (ns-publics ns)))) - (all-ns)))) - -;; ---------------------------------------------------------------------- -;; Handle Ctrl-C keystrokes - -(def ^{:doc "Threads to stop when Ctrl-C is pressed. See 'add-break-thread!'"} - break-threads (atom {})) - -(let [first-time (atom true)] - (defn start-handling-break - "Register INT signal handler. After calling this, Ctrl-C will cause - all break-threads to be stopped. See 'add-break-thread!'" - [] - (when (= :need-init - (swap! first-time - {:need-init false, false false, true :need-init})) - (sun.misc.Signal/handle - (sun.misc.Signal. "INT") - (proxy [sun.misc.SignalHandler] [] - (handle [sig] - (let [exc (Exception. (str sig))] - (doseq [tref (vals @break-threads) :when (.get tref)] - (.stop (.get tref) exc))))))))) - -(defn add-break-thread! - "Add the given thread to break-threads so that it will be stopped - any time the user presses Ctrl-C. Calls start-handling-break for - you. Adds the current thread if none is given." - ([] (add-break-thread! (Thread/currentThread))) - ([t] - (start-handling-break) - (let [tref (java.lang.ref.WeakReference. t)] - (swap! break-threads assoc (.getId t) tref)))) - -;; ---------------------------------------------------------------------- -;; Compiler hooks - -(defn expression-info - "Uses the Clojure compiler to analyze the given s-expr. Returns - a map with keys :class and :primitive? indicating what the compiler - concluded about the return value of the expression. Returns nil if - not type info can be determined at compile-time. - - Example: (expression-info '(+ (int 5) (float 10))) - Returns: {:class float, :primitive? true}" - [expr] - (let [fn-ast (Compiler/analyze Compiler$C/EXPRESSION `(fn [] ~expr)) - expr-ast (.body (first (.methods fn-ast)))] - (when (.hasJavaClass expr-ast) - {:class (.getJavaClass expr-ast) - :primitive? (.isPrimitive (.getJavaClass expr-ast))}))) - -;; ---------------------------------------------------------------------- -;; scgilardi at gmail - -(defn run* - "Loads the specified namespace and invokes its \"main\" function with - optional args." - [ns-sym & args] - (require ns-sym :reload-all) - (apply (ns-resolve ns-sym 'main) args)) - -(defmacro run - "Loads the specified namespace and invokes its \"main\" function with - optional args. ns-name is not evaluated." - [ns-name & args] - `(run* '~ns-name ~@args)) - - -(load "repl_utils/javadoc") diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/repl_utils/javadoc.clj --- a/src/clojure/contrib/repl_utils/javadoc.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,83 +0,0 @@ -; Copyright (c) Christophe Grand, November 2008. All rights reserved. - -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this -; distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; thanks to Stuart Sierra - -; a repl helper to quickly open javadocs. - -(def *feeling-lucky-url* "http://www.google.com/search?btnI=I%27m%20Feeling%20Lucky&q=allinurl:") -(def *feeling-lucky* true) - -(def - ^{:doc "Ref to a list of local paths for Javadoc-generated HTML - files."} - *local-javadocs* (ref (list))) - -(def *core-java-api* - (if (= "1.5" (System/getProperty "java.specification.version")) - "http://java.sun.com/j2se/1.5.0/docs/api/" - "http://java.sun.com/javase/6/docs/api/")) - -(def - ^{:doc "Ref to a map from package name prefixes to URLs for remote - Javadocs."} - *remote-javadocs* - (ref (sorted-map - "java." *core-java-api* - "javax." *core-java-api* - "org.ietf.jgss." *core-java-api* - "org.omg." *core-java-api* - "org.w3c.dom." *core-java-api* - "org.xml.sax." *core-java-api* - "org.apache.commons.codec." "http://commons.apache.org/codec/api-release/" - "org.apache.commons.io." "http://commons.apache.org/io/api-release/" - "org.apache.commons.lang." "http://commons.apache.org/lang/api-release/"))) - -(defn add-local-javadoc - "Adds to the list of local Javadoc paths." - [path] - (dosync (commute *local-javadocs* conj path))) - -(defn add-remote-javadoc - "Adds to the list of remote Javadoc URLs. package-prefix is the - beginning of the package name that has docs at this URL." - [package-prefix url] - (dosync (commute *remote-javadocs* assoc package-prefix url))) - -(defn find-javadoc-url - "Searches for a URL for the given class name. Tries - *local-javadocs* first, then *remote-javadocs*. Returns a string." - {:tag String} - [^String classname] - (let [file-path (.replace classname \. File/separatorChar) - url-path (.replace classname \. \/)] - (if-let [file ^File (first - (filter #(.exists ^File %) - (map #(File. (str %) (str file-path ".html")) - @*local-javadocs*)))] - (-> file .toURI str) - ;; If no local file, try remote URLs: - (or (some (fn [[prefix url]] - (when (.startsWith classname prefix) - (str url url-path ".html"))) - @*remote-javadocs*) - ;; if *feeling-lucky* try a web search - (when *feeling-lucky* (str *feeling-lucky-url* url-path ".html")))))) - -(defn javadoc - "Opens a browser window displaying the javadoc for the argument. - Tries *local-javadocs* first, then *remote-javadocs*." - [class-or-object] - (let [^Class c (if (instance? Class class-or-object) - class-or-object - (class class-or-object))] - (if-let [url (find-javadoc-url (.getName c))] - (browse-url url) - (println "Could not find Javadoc for" c)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/seq.clj --- a/src/clojure/contrib/seq.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,238 +0,0 @@ -;;; seq_utils.clj -- Sequence utilities for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; last updated March 2, 2009 - -;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; Change Log -;; -;; January 10, 2009 (Stuart Sierra): -;; -;; * BREAKING CHANGE: "includes?" now takes collection as first -;; argument. This is more consistent with Clojure collection -;; functions; see discussion at http://groups.google.com/group/clojure/browse_thread/thread/8b2c8dc96b39ddd7/a8866d34b601ff43 - - -(ns - ^{:author "Stuart Sierra (and others)", - :doc "Sequence utilities for Clojure"} - clojure.contrib.seq - (:import (java.util.concurrent LinkedBlockingQueue TimeUnit) - (java.lang.ref WeakReference)) - (:refer-clojure :exclude [frequencies shuffle partition-by reductions partition-all group-by flatten])) - - -;; 'flatten' written by Rich Hickey, -;; see http://groups.google.com/group/clojure/msg/385098fabfcaad9b -(defn flatten - "DEPRECATED. Prefer clojure.core version. - Takes any nested combination of sequential things (lists, vectors, - etc.) and returns their contents as a single, flat sequence. - (flatten nil) returns nil." - {:deprecated "1.2"} - [x] - (filter (complement sequential?) - (rest (tree-seq sequential? seq x)))) - -(defn separate - "Returns a vector: - [ (filter f s), (filter (complement f) s) ]" - [f s] - [(filter f s) (filter (complement f) s)]) - -(defn indexed - "Returns a lazy sequence of [index, item] pairs, where items come - from 's' and indexes count up from zero. - - (indexed '(a b c d)) => ([0 a] [1 b] [2 c] [3 d])" - [s] - (map vector (iterate inc 0) s)) - -;; group-by written by Rich Hickey; -;; see http://paste.lisp.org/display/64190 -(defn group-by - "DEPRECATED. Prefer clojure.core version. - Returns a sorted map of the elements of coll keyed by the result of - f on each element. The value at each key will be a vector of the - corresponding elements, in the order they appeared in coll." - {:deprecated "1.2"} - [f coll] - (reduce - (fn [ret x] - (let [k (f x)] - (assoc ret k (conj (get ret k []) x)))) - (sorted-map) coll)) - -;; partition-by originally written by Rich Hickey; -;; modified by Stuart Sierra -(defn partition-by - "DEPRECATED. Prefer clojure.core version. - Applies f to each value in coll, splitting it each time f returns - a new value. Returns a lazy seq of lazy seqs." - {:deprecated "1.2"} - [f coll] - (when-let [s (seq coll)] - (let [fst (first s) - fv (f fst) - run (cons fst (take-while #(= fv (f %)) (rest s)))] - (lazy-seq - (cons run (partition-by f (drop (count run) s))))))) - -(defn frequencies - "DEPRECATED. Prefer clojure.core version. - Returns a map from distinct items in coll to the number of times - they appear." - {:deprecated "1.2"} - [coll] - (reduce (fn [counts x] - (assoc counts x (inc (get counts x 0)))) - {} coll)) - -;; recursive sequence helpers by Christophe Grand -;; see http://clj-me.blogspot.com/2009/01/recursive-seqs.html -(defmacro rec-seq - "Similar to lazy-seq but binds the resulting seq to the supplied - binding-name, allowing for recursive expressions." - [binding-name & body] - `(let [s# (atom nil)] - (reset! s# (lazy-seq (let [~binding-name @s#] ~@body))))) - -(defmacro rec-cat - "Similar to lazy-cat but binds the resulting sequence to the supplied - binding-name, allowing for recursive expressions." - [binding-name & exprs] - `(rec-seq ~binding-name (lazy-cat ~@exprs))) - - -;; reductions by Chris Houser -;; see http://groups.google.com/group/clojure/browse_thread/thread/3edf6e82617e18e0/58d9e319ad92aa5f?#58d9e319ad92aa5f -(defn reductions - "DEPRECATED. Prefer clojure.core version. - Returns a lazy seq of the intermediate values of the reduction (as - per reduce) of coll by f, starting with init." - {:deprecated "1.2"} - ([f coll] - (if (seq coll) - (rec-seq self (cons (first coll) (map f self (rest coll)))) - (cons (f) nil))) - ([f init coll] - (rec-seq self (cons init (map f self coll))))) - -(defn rotations - "Returns a lazy seq of all rotations of a seq" - [x] - (if (seq x) - (map - (fn [n _] - (lazy-cat (drop n x) (take n x))) - (iterate inc 0) x) - (list nil))) - -(defn partition-all - "DEPRECATED. Prefer clojure.core version. - Returns a lazy sequence of lists like clojure.core/partition, but may - include lists with fewer than n items at the end." - {:deprecated "1.2"} - ([n coll] - (partition-all n n coll)) - ([n step coll] - (lazy-seq - (when-let [s (seq coll)] - (cons (take n s) (partition-all n step (drop step s))))))) - -(defn shuffle - "DEPRECATED. Prefer clojure.core version. - Return a random permutation of coll" - {:deprecated "1.2"} - [coll] - (let [l (java.util.ArrayList. coll)] - (java.util.Collections/shuffle l) - (seq l))) - -(defn rand-elt - "DEPRECATED. Prefer clojure.core/rand-nth. - Return a random element of this seq" - {:deprecated "1.2"} - [s] - (nth s (rand-int (count s)))) - -;; seq-on written by Konrad Hinsen -(defmulti seq-on - "Returns a seq on the object s. Works like the built-in seq but as - a multimethod that can have implementations for new classes and types." - {:arglists '([s])} - type) - -(defmethod seq-on :default - [s] - (seq s)) - - -(defn find-first - "Returns the first item of coll for which (pred item) returns logical true. - Consumes sequences up to the first match, will consume the entire sequence - and return nil if no match is found." - [pred coll] - (first (filter pred coll))) - -; based on work related to Rich Hickey's seque. -; blame Chouser for anything broken or ugly. -(defn fill-queue - "filler-func will be called in another thread with a single arg - 'fill'. filler-func may call fill repeatedly with one arg each - time which will be pushed onto a queue, blocking if needed until - this is possible. fill-queue will return a lazy seq of the values - filler-func has pushed onto the queue, blocking if needed until each - next element becomes available. filler-func's return value is ignored." - ([filler-func & optseq] - (let [opts (apply array-map optseq) - apoll (:alive-poll opts 1) - q (LinkedBlockingQueue. (:queue-size opts 1)) - NIL (Object.) ;nil sentinel since LBQ doesn't support nils - weak-target (Object.) - alive? (WeakReference. weak-target) - fill (fn fill [x] - (if (.get alive?) - (if (.offer q (if (nil? x) NIL x) apoll TimeUnit/SECONDS) - x - (recur x)) - (throw (Exception. "abandoned")))) - f (future - (try - (filler-func fill) - (finally - (.put q q))) ;q itself is eos sentinel - nil)] ; set future's value to nil - ((fn drain [] - weak-target ; force closing over this object - (lazy-seq - (let [x (.take q)] - (if (identical? x q) - @f ;will be nil, touch just to propagate errors - (cons (if (identical? x NIL) nil x) - (drain)))))))))) - -(defn positions - "Returns a lazy sequence containing the positions at which pred - is true for items in coll." - [pred coll] - (for [[idx elt] (indexed coll) :when (pred elt)] idx)) - -(defn includes? - "Returns true if coll contains something equal (with =) to x, - in linear time. Deprecated. Prefer 'contains?' for key testing, - or 'some' for ad hoc linear searches." - {:deprecated "1.2"} - [coll x] - (boolean (some (fn [y] (= y x)) coll))) - - - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/seq_utils.clj --- a/src/clojure/contrib/seq_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,244 +0,0 @@ -;;; seq_utils.clj -- Sequence utilities for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; last updated March 2, 2009 - -;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; Change Log -;; -;; DEPRECATED in 1.2. Some functions promoted to clojure.core and some -;; moved to c.c.seq -;; -;; January 10, 2009 (Stuart Sierra): -;; -;; * BREAKING CHANGE: "includes?" now takes collection as first -;; argument. This is more consistent with Clojure collection -;; functions; see discussion at http://groups.google.com/group/clojure/browse_thread/thread/8b2c8dc96b39ddd7/a8866d34b601ff43 -;; - -(ns - ^{:author "Stuart Sierra (and others)", - :deprecated "1.2" - :doc "Sequence utilities for Clojure"} - clojure.contrib.seq-utils - (:import (java.util.concurrent LinkedBlockingQueue TimeUnit) - (java.lang.ref WeakReference)) - (:refer-clojure :exclude [frequencies shuffle partition-by reductions partition-all group-by flatten])) - - -;; 'flatten' written by Rich Hickey, -;; see http://groups.google.com/group/clojure/msg/385098fabfcaad9b -(defn flatten - "DEPRECATED. Prefer clojure.core version. - Takes any nested combination of sequential things (lists, vectors, - etc.) and returns their contents as a single, flat sequence. - (flatten nil) returns nil." - {:deprecated "1.2"} - [x] - (filter (complement sequential?) - (rest (tree-seq sequential? seq x)))) - -(defn separate - "Returns a vector: - [ (filter f s), (filter (complement f) s) ]" - [f s] - [(filter f s) (filter (complement f) s)]) - -(defn indexed - "Returns a lazy sequence of [index, item] pairs, where items come - from 's' and indexes count up from zero. - - (indexed '(a b c d)) => ([0 a] [1 b] [2 c] [3 d])" - [s] - (map vector (iterate inc 0) s)) - -;; group-by written by Rich Hickey; -;; see http://paste.lisp.org/display/64190 -(defn group-by - "DEPRECATED. Prefer clojure.core version. - Returns a sorted map of the elements of coll keyed by the result of - f on each element. The value at each key will be a vector of the - corresponding elements, in the order they appeared in coll." - {:deprecated "1.2"} - [f coll] - (reduce - (fn [ret x] - (let [k (f x)] - (assoc ret k (conj (get ret k []) x)))) - (sorted-map) coll)) - -;; partition-by originally written by Rich Hickey; -;; modified by Stuart Sierra -(defn partition-by - "DEPRECATED. Prefer clojure.core version. - Applies f to each value in coll, splitting it each time f returns - a new value. Returns a lazy seq of lazy seqs." - {:deprecated "1.2"} - [f coll] - (when-let [s (seq coll)] - (let [fst (first s) - fv (f fst) - run (cons fst (take-while #(= fv (f %)) (rest s)))] - (lazy-seq - (cons run (partition-by f (drop (count run) s))))))) - -(defn frequencies - "DEPRECATED. Prefer clojure.core version. - Returns a map from distinct items in coll to the number of times - they appear." - {:deprecated "1.2"} - [coll] - (reduce (fn [counts x] - (assoc counts x (inc (get counts x 0)))) - {} coll)) - -;; recursive sequence helpers by Christophe Grand -;; see http://clj-me.blogspot.com/2009/01/recursive-seqs.html -(defmacro rec-seq - "Similar to lazy-seq but binds the resulting seq to the supplied - binding-name, allowing for recursive expressions." - [binding-name & body] - `(let [s# (atom nil)] - (reset! s# (lazy-seq (let [~binding-name @s#] ~@body))))) - -(defmacro rec-cat - "Similar to lazy-cat but binds the resulting sequence to the supplied - binding-name, allowing for recursive expressions." - [binding-name & exprs] - `(rec-seq ~binding-name (lazy-cat ~@exprs))) - - -;; reductions by Chris Houser -;; see http://groups.google.com/group/clojure/browse_thread/thread/3edf6e82617e18e0/58d9e319ad92aa5f?#58d9e319ad92aa5f -(defn reductions - "DEPRECATED. Prefer clojure.core version. - Returns a lazy seq of the intermediate values of the reduction (as - per reduce) of coll by f, starting with init." - {:deprecated "1.2"} - ([f coll] - (if (seq coll) - (rec-seq self (cons (first coll) (map f self (rest coll)))) - (cons (f) nil))) - ([f init coll] - (rec-seq self (cons init (map f self coll))))) - -(defn rotations - "Returns a lazy seq of all rotations of a seq" - [x] - (if (seq x) - (map - (fn [n _] - (lazy-cat (drop n x) (take n x))) - (iterate inc 0) x) - (list nil))) - -(defn partition-all - "DEPRECATED. Prefer clojure.core version. - Returns a lazy sequence of lists like clojure.core/partition, but may - include lists with fewer than n items at the end." - {:deprecated "1.2"} - ([n coll] - (partition-all n n coll)) - ([n step coll] - (lazy-seq - (when-let [s (seq coll)] - (cons (take n s) (partition-all n step (drop step s))))))) - -(defn shuffle - "DEPRECATED. Prefer clojure.core version. - Return a random permutation of coll" - {:deprecated "1.2"} - [coll] - (let [l (java.util.ArrayList. coll)] - (java.util.Collections/shuffle l) - (seq l))) - -(defn rand-elt - "DEPRECATED. Prefer clojure.core/rand-nth. - Return a random element of this seq" - {:deprecated "1.2"} - [s] - (nth s (rand-int (count s)))) - - -;; seq-on written by Konrad Hinsen -(defmulti seq-on - "Returns a seq on the object s. Works like the built-in seq but as - a multimethod that can have implementations for new classes and types." - {:arglists '([s])} - type) - -(defmethod seq-on :default - [s] - (seq s)) - - -(defn find-first - "Returns the first item of coll for which (pred item) returns logical true. - Consumes sequences up to the first match, will consume the entire sequence - and return nil if no match is found." - [pred coll] - (first (filter pred coll))) - -; based on work related to Rich Hickey's seque. -; blame Chouser for anything broken or ugly. -(defn fill-queue - "filler-func will be called in another thread with a single arg - 'fill'. filler-func may call fill repeatedly with one arg each - time which will be pushed onto a queue, blocking if needed until - this is possible. fill-queue will return a lazy seq of the values - filler-func has pushed onto the queue, blocking if needed until each - next element becomes available. filler-func's return value is ignored." - ([filler-func & optseq] - (let [opts (apply array-map optseq) - apoll (:alive-poll opts 1) - q (LinkedBlockingQueue. (:queue-size opts 1)) - NIL (Object.) ;nil sentinel since LBQ doesn't support nils - weak-target (Object.) - alive? (WeakReference. weak-target) - fill (fn fill [x] - (if (.get alive?) - (if (.offer q (if (nil? x) NIL x) apoll TimeUnit/SECONDS) - x - (recur x)) - (throw (Exception. "abandoned")))) - f (future - (try - (filler-func fill) - (finally - (.put q q))) ;q itself is eos sentinel - nil)] ; set future's value to nil - ((fn drain [] - weak-target ; force closing over this object - (lazy-seq - (let [x (.take q)] - (if (identical? x q) - @f ;will be nil, touch just to propagate errors - (cons (if (identical? x NIL) nil x) - (drain)))))))))) - -(defn positions - "Returns a lazy sequence containing the positions at which pred - is true for items in coll." - [pred coll] - (for [[idx elt] (indexed coll) :when (pred elt)] idx)) - -(defn includes? - "Returns true if coll contains something equal (with =) to x, - in linear time. Deprecated. Prefer 'contains?' for key testing, - or 'some' for ad hoc linear searches." - {:deprecated "1.2"} - [coll x] - (boolean (some (fn [y] (= y x)) coll))) - - - - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/server_socket.clj --- a/src/clojure/contrib/server_socket.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,94 +0,0 @@ -;; Copyright (c) Craig McDaniel, Jan 2009. All rights reserved. -;; The use and distribution terms for this software are covered by the -;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this distribution. -;; By using this software in any fashion, you are agreeing to be bound by -;; the terms of this license. -;; You must not remove this notice, or any other, from this software. - -;; Server socket library - includes REPL on socket - -(ns - ^{:author "Craig McDaniel", - :doc "Server socket library - includes REPL on socket"} - clojure.contrib.server-socket - (:import (java.net InetAddress ServerSocket Socket SocketException) - (java.io InputStreamReader OutputStream OutputStreamWriter PrintWriter) - (clojure.lang LineNumberingPushbackReader)) - (:use [clojure.main :only (repl)])) - -(defn- on-thread [f] - (doto (Thread. ^Runnable f) - (.start))) - -(defn- close-socket [^Socket s] - (when-not (.isClosed s) - (doto s - (.shutdownInput) - (.shutdownOutput) - (.close)))) - -(defn- accept-fn [^Socket s connections fun] - (let [ins (.getInputStream s) - outs (.getOutputStream s)] - (on-thread #(do - (dosync (commute connections conj s)) - (try - (fun ins outs) - (catch SocketException e)) - (close-socket s) - (dosync (commute connections disj s)))))) - -(defstruct server-def :server-socket :connections) - -(defn- create-server-aux [fun ^ServerSocket ss] - (let [connections (ref #{})] - (on-thread #(when-not (.isClosed ss) - (try - (accept-fn (.accept ss) connections fun) - (catch SocketException e)) - (recur))) - (struct-map server-def :server-socket ss :connections connections))) - -(defn create-server - "Creates a server socket on port. Upon accept, a new thread is - created which calls: - - (fun input-stream output-stream) - - Optional arguments support specifying a listen backlog and binding - to a specific endpoint." - ([port fun backlog ^InetAddress bind-addr] - (create-server-aux fun (ServerSocket. port backlog bind-addr))) - ([port fun backlog] - (create-server-aux fun (ServerSocket. port backlog))) - ([port fun] - (create-server-aux fun (ServerSocket. port)))) - -(defn close-server [server] - (doseq [s @(:connections server)] - (close-socket s)) - (dosync (ref-set (:connections server) #{})) - (.close ^ServerSocket (:server-socket server))) - -(defn connection-count [server] - (count @(:connections server))) - -;;;; -;;;; REPL on a socket -;;;; - -(defn- socket-repl [ins outs] - (binding [*in* (LineNumberingPushbackReader. (InputStreamReader. ins)) - *out* (OutputStreamWriter. outs) - *err* (PrintWriter. ^OutputStream outs true)] - (repl))) - -(defn create-repl-server - "create a repl on a socket" - ([port backlog ^InetAddress bind-addr] - (create-server port socket-repl backlog bind-addr)) - ([port backlog] - (create-server port socket-repl backlog)) - ([port] - (create-server port socket-repl))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/set.clj --- a/src/clojure/contrib/set.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -;; Copyright (c) Jason Wolfe. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; set.clj -;; -;; Clojure functions for operating on sets (supplemental to clojure.set) -;; -;; jason at w01fe dot com -;; Created 2 Feb 2009 - -;; Deprecations in 1.2: subset and superset have been promoted to -;; clojure.set - -(ns - ^{:author "Jason Wolfe", - :doc "Clojure functions for operating on sets (supplemental to clojure.set)"} - clojure.contrib.set) - -(defn subset? - "Is set1 a subset of set2?" - {:deprecated "1.2"} - [set1 set2] - {:tag Boolean} - (and (<= (count set1) (count set2)) - (every? set2 set1))) - -(defn superset? - "Is set1 a superset of set2?" - {:deprecated "1.2"} - [set1 set2] - {:tag Boolean} - (and (>= (count set1) (count set2)) - (every? set1 set2))) - -(defn proper-subset? - "Is s1 a proper subset of s2?" - [set1 set2] - {:tag Boolean} - (and (< (count set1) (count set2)) - (every? set2 set1))) - -(defn proper-superset? - "Is s1 a proper superset of s2?" - [set1 set2] - {:tag Boolean} - (and (> (count set1) (count set2)) - (every? set1 set2))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/shell.clj --- a/src/clojure/contrib/shell.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -; Copyright (c) Chris Houser, Jan 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; :dir and :env options added by Stuart Halloway - -; Conveniently launch a sub-process providing to its stdin and -; collecting its stdout - -;; DEPRECATED in 1.2: Promoted to clojure.java.shell - -(ns - ^{:author "Chris Houser", - :deprecated "1.2" - :doc "Conveniently launch a sub-process providing to its stdin and -collecting its stdout"} - clojure.contrib.shell - (:import (java.io InputStreamReader OutputStreamWriter))) - -(def *sh-dir* nil) -(def *sh-env* nil) - -(defmacro with-sh-dir [dir & forms] - "Sets the directory for use with sh, see sh for details." - `(binding [*sh-dir* ~dir] - ~@forms)) - -(defmacro with-sh-env [env & forms] - "Sets the environment for use with sh, see sh for details." - `(binding [*sh-env* ~env] - ~@forms)) - -(defn- stream-seq - "Takes an InputStream and returns a lazy seq of integers from the stream." - [stream] - (take-while #(>= % 0) (repeatedly #(.read stream)))) - -(defn- aconcat - "Concatenates arrays of given type." - [type & xs] - (let [target (make-array type (apply + (map count xs)))] - (loop [i 0 idx 0] - (when-let [a (nth xs i nil)] - (System/arraycopy a 0 target idx (count a)) - (recur (inc i) (+ idx (count a))))) - target)) - -(defn- parse-args - "Takes a seq of 'sh' arguments and returns a map of option keywords - to option values." - [args] - (loop [[arg :as args] args opts {:cmd [] :out "UTF-8" :dir *sh-dir* :env *sh-env*}] - (if-not args - opts - (if (keyword? arg) - (recur (nnext args) (assoc opts arg (second args))) - (recur (next args) (update-in opts [:cmd] conj arg)))))) - -(defn- as-env-key [arg] - "Helper so that callers can use symbols, keywords, or strings - when building an environment map." - (cond - (symbol? arg) (name arg) - (keyword? arg) (name arg) - (string? arg) arg)) - -(defn- as-file [arg] - "Helper so that callers can pass a String for the :dir to sh." - (cond - (string? arg) (java.io.File. arg) - (nil? arg) nil - (instance? java.io.File arg) arg)) - -(defn- as-env-string [arg] - "Helper so that callers can pass a Clojure map for the :env to sh." - (cond - (nil? arg) nil - (map? arg) (into-array String (map (fn [[k v]] (str (as-env-key k) "=" v)) arg)) - true arg)) - - -(defn sh - "Passes the given strings to Runtime.exec() to launch a sub-process. - - Options are - - :in may be given followed by a String specifying text to be fed to the - sub-process's stdin. - :out option may be given followed by :bytes or a String. If a String - is given, it will be used as a character encoding name (for - example \"UTF-8\" or \"ISO-8859-1\") to convert the - sub-process's stdout to a String which is returned. - If :bytes is given, the sub-process's stdout will be stored in - a byte array and returned. Defaults to UTF-8. - :return-map - when followed by boolean true, sh returns a map of - :exit => sub-process's exit code - :out => sub-process's stdout (as byte[] or String) - :err => sub-process's stderr (as byte[] or String) - when not given or followed by false, sh returns a single - array or String of the sub-process's stdout followed by its - stderr - :env override the process env with a map (or the underlying Java - String[] if you are a masochist). - :dir override the process dir with a String or java.io.File. - - You can bind :env or :dir for multiple operations using with-sh-env - and with-sh-dir." - [& args] - (let [opts (parse-args args) - proc (.exec (Runtime/getRuntime) - (into-array (:cmd opts)) - (as-env-string (:env opts)) - (as-file (:dir opts)))] - (if (:in opts) - (with-open [osw (OutputStreamWriter. (.getOutputStream proc))] - (.write osw (:in opts))) - (.close (.getOutputStream proc))) - (with-open [stdout (.getInputStream proc) - stderr (.getErrorStream proc)] - (let [[[out err] combine-fn] - (if (= (:out opts) :bytes) - [(for [strm [stdout stderr]] - (into-array Byte/TYPE (map byte (stream-seq strm)))) - #(aconcat Byte/TYPE %1 %2)] - [(for [strm [stdout stderr]] - (apply str (map char (stream-seq - (InputStreamReader. strm (:out opts)))))) - str]) - exit-code (.waitFor proc)] - (if (:return-map opts) - {:exit exit-code :out out :err err} - (combine-fn out err)))))) - -(comment - -(println (sh "ls" "-l")) -(println (sh "ls" "-l" "/no-such-thing")) -(println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n")) -(println (sh "cat" :in "x\u25bax\n")) -(println (sh "echo" "x\u25bax")) -(println (sh "echo" "x\u25bax" :out "ISO-8859-1")) ; reads 4 single-byte chars -(println (sh "cat" "myimage.png" :out :bytes)) ; reads binary file into bytes[] - -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/shell_out.clj --- a/src/clojure/contrib/shell_out.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -; Copyright (c) Chris Houser, Jan 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; :dir and :env options added by Stuart Halloway - -; Conveniently launch a sub-process providing to its stdin and -; collecting its stdout - -;; DEPRECATED in 1.2: Promoted to clojure.java.shell - -(ns - ^{:author "Chris Houser", - :deprecated "1.2" - :doc "Conveniently launch a sub-process providing to its stdin and -collecting its stdout"} - clojure.contrib.shell-out - (:import (java.io InputStreamReader OutputStreamWriter))) - -(def *sh-dir* nil) -(def *sh-env* nil) - -(defmacro with-sh-dir [dir & forms] - "Sets the directory for use with sh, see sh for details." - `(binding [*sh-dir* ~dir] - ~@forms)) - -(defmacro with-sh-env [env & forms] - "Sets the environment for use with sh, see sh for details." - `(binding [*sh-env* ~env] - ~@forms)) - -(defn- stream-seq - "Takes an InputStream and returns a lazy seq of integers from the stream." - [stream] - (take-while #(>= % 0) (repeatedly #(.read stream)))) - -(defn- aconcat - "Concatenates arrays of given type." - [type & xs] - (let [target (make-array type (apply + (map count xs)))] - (loop [i 0 idx 0] - (when-let [a (nth xs i nil)] - (System/arraycopy a 0 target idx (count a)) - (recur (inc i) (+ idx (count a))))) - target)) - -(defn- parse-args - "Takes a seq of 'sh' arguments and returns a map of option keywords - to option values." - [args] - (loop [[arg :as args] args opts {:cmd [] :out "UTF-8" :dir *sh-dir* :env *sh-env*}] - (if-not args - opts - (if (keyword? arg) - (recur (nnext args) (assoc opts arg (second args))) - (recur (next args) (update-in opts [:cmd] conj arg)))))) - -(defn- as-env-key [arg] - "Helper so that callers can use symbols, keywords, or strings - when building an environment map." - (cond - (symbol? arg) (name arg) - (keyword? arg) (name arg) - (string? arg) arg)) - -(defn- as-file [arg] - "Helper so that callers can pass a String for the :dir to sh." - (cond - (string? arg) (java.io.File. arg) - (nil? arg) nil - (instance? java.io.File arg) arg)) - -(defn- as-env-string [arg] - "Helper so that callers can pass a Clojure map for the :env to sh." - (cond - (nil? arg) nil - (map? arg) (into-array String (map (fn [[k v]] (str (as-env-key k) "=" v)) arg)) - true arg)) - - -(defn sh - "Passes the given strings to Runtime.exec() to launch a sub-process. - - Options are - - :in may be given followed by a String specifying text to be fed to the - sub-process's stdin. - :out option may be given followed by :bytes or a String. If a String - is given, it will be used as a character encoding name (for - example \"UTF-8\" or \"ISO-8859-1\") to convert the - sub-process's stdout to a String which is returned. - If :bytes is given, the sub-process's stdout will be stored in - a byte array and returned. Defaults to UTF-8. - :return-map - when followed by boolean true, sh returns a map of - :exit => sub-process's exit code - :out => sub-process's stdout (as byte[] or String) - :err => sub-process's stderr (as byte[] or String) - when not given or followed by false, sh returns a single - array or String of the sub-process's stdout followed by its - stderr - :env override the process env with a map (or the underlying Java - String[] if you are a masochist). - :dir override the process dir with a String or java.io.File. - - You can bind :env or :dir for multiple operations using with-sh-env - and with-sh-dir." - [& args] - (let [opts (parse-args args) - proc (.exec (Runtime/getRuntime) - (into-array (:cmd opts)) - (as-env-string (:env opts)) - (as-file (:dir opts)))] - (if (:in opts) - (with-open [osw (OutputStreamWriter. (.getOutputStream proc))] - (.write osw (:in opts))) - (.close (.getOutputStream proc))) - (with-open [stdout (.getInputStream proc) - stderr (.getErrorStream proc)] - (let [[[out err] combine-fn] - (if (= (:out opts) :bytes) - [(for [strm [stdout stderr]] - (into-array Byte/TYPE (map byte (stream-seq strm)))) - #(aconcat Byte/TYPE %1 %2)] - [(for [strm [stdout stderr]] - (apply str (map char (stream-seq - (InputStreamReader. strm (:out opts)))))) - str]) - exit-code (.waitFor proc)] - (if (:return-map opts) - {:exit exit-code :out out :err err} - (combine-fn out err)))))) - -(comment - -(println (sh "ls" "-l")) -(println (sh "ls" "-l" "/no-such-thing")) -(println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n")) -(println (sh "cat" :in "x\u25bax\n")) -(println (sh "echo" "x\u25bax")) -(println (sh "echo" "x\u25bax" :out "ISO-8859-1")) ; reads 4 single-byte chars -(println (sh "cat" "myimage.png" :out :bytes)) ; reads binary file into bytes[] - -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/singleton.clj --- a/src/clojure/contrib/singleton.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -;;; singleton.clj: singleton functions - -;; by Stuart Sierra, http://stuartsierra.com/ -;; April 14, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; Change Log: -;; -;; April 14, 2009: added per-thread-singleton, renamed singleton to -;; global-singleton -;; -;; April 9, 2009: initial version - - -(ns - ^{:author "Stuart Sierra", - :doc "Singleton functions"} - clojure.contrib.singleton) - -(defn global-singleton - "Returns a global singleton function. f is a function of no - arguments that creates and returns some object. The singleton - function will call f just once, the first time it is needed, and - cache the value for all subsequent calls. - - Warning: global singletons are often unsafe in multi-threaded code. - Consider per-thread-singleton instead." - [f] - (let [instance (atom nil) - make-instance (fn [_] (f))] - (fn [] (or @instance (swap! instance make-instance))))) - -(defn per-thread-singleton - "Returns a per-thread singleton function. f is a function of no - arguments that creates and returns some object. The singleton - function will call f only once for each thread, and cache its value - for subsequent calls from the same thread. This allows you to - safely and lazily initialize shared objects on a per-thread basis. - - Warning: due to a bug in JDK 5, it may not be safe to use a - per-thread-singleton in the initialization function for another - per-thread-singleton. See - http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=5025230" - [f] - (let [thread-local (proxy [ThreadLocal] [] (initialValue [] (f)))] - (fn [] (.get thread-local)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/sql.clj --- a/src/clojure/contrib/sql.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,201 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; sql.clj -;; -;; A Clojure interface to sql databases via jdbc -;; -;; See clojure.contrib.sql.test for an example -;; -;; scgilardi (gmail) -;; Created 2 April 2008 - -(ns - ^{:author "Stephen C. Gilardi", - :doc "A Clojure interface to sql databases via jdbc." - :see-also [["http://github.com/richhickey/clojure-contrib/blob/master/src/test/clojure/clojure/contrib/test_sql.clj" - "Example code"]]} - clojure.contrib.sql - (:use (clojure.contrib - [def :only (defalias)] - [string :only (as-str)]) - clojure.contrib.sql.internal)) - -(defalias find-connection find-connection*) -(defalias connection connection*) - -(defmacro with-connection - "Evaluates body in the context of a new connection to a database then - closes the connection. db-spec is a map containing values for one of the - following parameter sets: - - Factory: - :factory (required) a function of one argument, a map of params - (others) (optional) passed to the factory function in a map - - DriverManager: - :classname (required) a String, the jdbc driver class name - :subprotocol (required) a String, the jdbc subprotocol - :subname (required) a String, the jdbc subname - (others) (optional) passed to the driver as properties. - - DataSource: - :datasource (required) a javax.sql.DataSource - :username (optional) a String - :password (optional) a String, required if :username is supplied - - JNDI: - :name (required) a String or javax.naming.Name - :environment (optional) a java.util.Map" - [db-spec & body] - `(with-connection* ~db-spec (fn [] ~@body))) - -(defmacro transaction - "Evaluates body as a transaction on the open database connection. Any - nested transactions are absorbed into the outermost transaction. By - default, all database updates are committed together as a group after - evaluating the outermost body, or rolled back on any uncaught - exception. If set-rollback-only is called within scope of the outermost - transaction, the entire transaction will be rolled back rather than - committed when complete." - [& body] - `(transaction* (fn [] ~@body))) - -(defn set-rollback-only - "Marks the outermost transaction such that it will rollback rather than - commit when complete" - [] - (rollback true)) - -(defn is-rollback-only - "Returns true if the outermost transaction will rollback rather than - commit when complete" - [] - (rollback)) - -(defn do-commands - "Executes SQL commands on the open database connection." - [& commands] - (with-open [stmt (.createStatement (connection))] - (doseq [cmd commands] - (.addBatch stmt cmd)) - (transaction - (seq (.executeBatch stmt))))) - -(defn do-prepared - "Executes an (optionally parameterized) SQL prepared statement on the - open database connection. Each param-group is a seq of values for all of - the parameters." - [sql & param-groups] - (with-open [stmt (.prepareStatement (connection) sql)] - (doseq [param-group param-groups] - (doseq [[index value] (map vector (iterate inc 1) param-group)] - (.setObject stmt index value)) - (.addBatch stmt)) - (transaction - (seq (.executeBatch stmt))))) - -(defn create-table - "Creates a table on the open database connection given a table name and - specs. Each spec is either a column spec: a vector containing a column - name and optionally a type and other constraints, or a table-level - constraint: a vector containing words that express the constraint. All - words used to describe the table may be supplied as strings or keywords." - [name & specs] - (do-commands - (format "CREATE TABLE %s (%s)" - (as-str name) - (apply str - (map as-str - (apply concat - (interpose [", "] - (map (partial interpose " ") specs)))))))) - -(defn drop-table - "Drops a table on the open database connection given its name, a string - or keyword" - [name] - (do-commands - (format "DROP TABLE %s" (as-str name)))) - -(defn insert-values - "Inserts rows into a table with values for specified columns only. - column-names is a vector of strings or keywords identifying columns. Each - value-group is a vector containing a values for each column in - order. When inserting complete rows (all columns), consider using - insert-rows instead." - [table column-names & value-groups] - (let [column-strs (map as-str column-names) - n (count (first value-groups)) - template (apply str (interpose "," (replicate n "?"))) - columns (if (seq column-names) - (format "(%s)" (apply str (interpose "," column-strs))) - "")] - (apply do-prepared - (format "INSERT INTO %s %s VALUES (%s)" - (as-str table) columns template) - value-groups))) - -(defn insert-rows - "Inserts complete rows into a table. Each row is a vector of values for - each of the table's columns in order." - [table & rows] - (apply insert-values table nil rows)) - -(defn insert-records - "Inserts records into a table. records are maps from strings or - keywords (identifying columns) to values." - [table & records] - (doseq [record records] - (insert-values table (keys record) (vals record)))) - -(defn delete-rows - "Deletes rows from a table. where-params is a vector containing a string - providing the (optionally parameterized) selection criteria followed by - values for any parameters." - [table where-params] - (let [[where & params] where-params] - (do-prepared - (format "DELETE FROM %s WHERE %s" - (as-str table) where) - params))) - -(defn update-values - "Updates values on selected rows in a table. where-params is a vector - containing a string providing the (optionally parameterized) selection - criteria followed by values for any parameters. record is a map from - strings or keywords (identifying columns) to updated values." - [table where-params record] - (let [[where & params] where-params - column-strs (map as-str (keys record)) - columns (apply str (concat (interpose "=?, " column-strs) "=?"))] - (do-prepared - (format "UPDATE %s SET %s WHERE %s" - (as-str table) columns where) - (concat (vals record) params)))) - -(defn update-or-insert-values - "Updates values on selected rows in a table, or inserts a new row when no - existing row matches the selection criteria. where-params is a vector - containing a string providing the (optionally parameterized) selection - criteria followed by values for any parameters. record is a map from - strings or keywords (identifying columns) to updated values." - [table where-params record] - (transaction - (let [result (update-values table where-params record)] - (if (zero? (first result)) - (insert-values table (keys record) (vals record)) - result)))) - -(defmacro with-query-results - "Executes a query, then evaluates body with results bound to a seq of the - results. sql-params is a vector containing a string providing - the (optionally parameterized) SQL query followed by values for any - parameters." - [results sql-params & body] - `(with-query-results* ~sql-params (fn [~results] ~@body))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/sql/internal.clj --- a/src/clojure/contrib/sql/internal.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,194 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; internal definitions for clojure.contrib.sql -;; -;; scgilardi (gmail) -;; Created 3 October 2008 - -(ns clojure.contrib.sql.internal - (:use - (clojure.contrib - [except :only (throwf throw-arg)] - [properties :only (as-properties)] - [seq :only (indexed)])) - (:import - (clojure.lang RT) - (java.sql BatchUpdateException DriverManager SQLException Statement) - (java.util Hashtable Map) - (javax.naming InitialContext Name) - (javax.sql DataSource))) - -(def *db* {:connection nil :level 0}) - -(def special-counts - {Statement/EXECUTE_FAILED "EXECUTE_FAILED" - Statement/SUCCESS_NO_INFO "SUCCESS_NO_INFO"}) - -(defn find-connection* - "Returns the current database connection (or nil if there is none)" - [] - (:connection *db*)) - -(defn connection* - "Returns the current database connection (or throws if there is none)" - [] - (or (find-connection*) - (throwf "no current database connection"))) - -(defn rollback - "Accessor for the rollback flag on the current connection" - ([] - (deref (:rollback *db*))) - ([val] - (swap! (:rollback *db*) (fn [_] val)))) - -(defn get-connection - "Creates a connection to a database. db-spec is a map containing values - for one of the following parameter sets: - - Factory: - :factory (required) a function of one argument, a map of params - (others) (optional) passed to the factory function in a map - - DriverManager: - :classname (required) a String, the jdbc driver class name - :subprotocol (required) a String, the jdbc subprotocol - :subname (required) a String, the jdbc subname - (others) (optional) passed to the driver as properties. - - DataSource: - :datasource (required) a javax.sql.DataSource - :username (optional) a String - :password (optional) a String, required if :username is supplied - - JNDI: - :name (required) a String or javax.naming.Name - :environment (optional) a java.util.Map" - [{:keys [factory - classname subprotocol subname - datasource username password - name environment] - :as db-spec}] - (cond - factory - (factory (dissoc db-spec :factory)) - (and classname subprotocol subname) - (let [url (format "jdbc:%s:%s" subprotocol subname) - etc (dissoc db-spec :classname :subprotocol :subname)] - (RT/loadClassForName classname) - (DriverManager/getConnection url (as-properties etc))) - (and datasource username password) - (.getConnection datasource username password) - datasource - (.getConnection datasource) - name - (let [env (and environment (Hashtable. environment)) - context (InitialContext. env) - datasource (.lookup context name)] - (.getConnection datasource)) - :else - (throw-arg "db-spec %s is missing a required parameter" db-spec))) - -(defn with-connection* - "Evaluates func in the context of a new connection to a database then - closes the connection." - [db-spec func] - (with-open [con (get-connection db-spec)] - (binding [*db* (assoc *db* - :connection con :level 0 :rollback (atom false))] - (func)))) - -(defn print-sql-exception - "Prints the contents of an SQLException to stream" - [stream exception] - (.println - stream - (format (str "%s:" \newline - " Message: %s" \newline - " SQLState: %s" \newline - " Error Code: %d") - (.getSimpleName (class exception)) - (.getMessage exception) - (.getSQLState exception) - (.getErrorCode exception)))) - -(defn print-sql-exception-chain - "Prints a chain of SQLExceptions to stream" - [stream exception] - (loop [e exception] - (when e - (print-sql-exception stream e) - (recur (.getNextException e))))) - -(defn print-update-counts - "Prints the update counts from a BatchUpdateException to stream" - [stream exception] - (.println stream "Update counts:") - (doseq [[index count] (indexed (.getUpdateCounts exception))] - (.println stream (format " Statement %d: %s" - index - (get special-counts count count))))) - -(defn throw-rollback - "Sets rollback and throws a wrapped exception" - [e] - (rollback true) - (throwf e "transaction rolled back: %s" (.getMessage e))) - -(defn transaction* - "Evaluates func as a transaction on the open database connection. Any - nested transactions are absorbed into the outermost transaction. By - default, all database updates are committed together as a group after - evaluating the outermost body, or rolled back on any uncaught - exception. If rollback is set within scope of the outermost transaction, - the entire transaction will be rolled back rather than committed when - complete." - [func] - (binding [*db* (update-in *db* [:level] inc)] - (if (= (:level *db*) 1) - (let [con (connection*) - auto-commit (.getAutoCommit con)] - (io! - (.setAutoCommit con false) - (try - (func) - (catch BatchUpdateException e - (print-update-counts *err* e) - (print-sql-exception-chain *err* e) - (throw-rollback e)) - (catch SQLException e - (print-sql-exception-chain *err* e) - (throw-rollback e)) - (catch Exception e - (throw-rollback e)) - (finally - (if (rollback) - (.rollback con) - (.commit con)) - (rollback false) - (.setAutoCommit con auto-commit))))) - (func)))) - -(defn with-query-results* - "Executes a query, then evaluates func passing in a seq of the results as - an argument. The first argument is a vector containing the (optionally - parameterized) sql query string followed by values for any parameters." - [[sql & params :as sql-params] func] - (when-not (vector? sql-params) - (throw-arg "\"%s\" expected %s %s, found %s %s" - "sql-params" - "vector" - "[sql param*]" - (.getName (class sql-params)) - (pr-str sql-params))) - (with-open [stmt (.prepareStatement (connection*) sql)] - (doseq [[index value] (map vector (iterate inc 1) params)] - (.setObject stmt index value)) - (with-open [rset (.executeQuery stmt)] - (func (resultset-seq rset))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/str_utils.clj --- a/src/clojure/contrib/str_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,103 +0,0 @@ -;;; str_utils.clj -- string utilities for Clojure - -;; by Stuart Sierra -;; April 8, 2008 - -;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -;; DEPRECATED in 1.2: Promoted to clojure.java.string. Note that -;; many function names and semantics have changed - -(ns - ^{:author "Stuart Sierra", - :deprecated "1.2" - :doc "String utilities for Clojure"} - clojure.contrib.str-utils - (:import (java.util.regex Pattern))) - -(defn re-split - "Splits the string on instances of 'pattern'. Returns a sequence of - strings. Optional 'limit' argument is the maximum number of - splits. Like Perl's 'split'." - ([^Pattern pattern string] (seq (. pattern (split string)))) - ([^Pattern pattern string limit] (seq (. pattern (split string limit))))) - -(defn re-partition - "Splits the string into a lazy sequence of substrings, alternating - between substrings that match the patthern and the substrings - between the matches. The sequence always starts with the substring - before the first match, or an empty string if the beginning of the - string matches. - - For example: (re-partition #\"[a-z]+\" \"abc123def\") - - Returns: (\"\" \"abc\" \"123\" \"def\")" - [^Pattern re string] - (let [m (re-matcher re string)] - ((fn step [prevend] - (lazy-seq - (if (.find m) - (cons (.subSequence string prevend (.start m)) - (cons (re-groups m) - (step (+ (.start m) (count (.group m)))))) - (when (< prevend (.length string)) - (list (.subSequence string prevend (.length string))))))) - 0))) - -(defn re-gsub - "Replaces all instances of 'pattern' in 'string' with - 'replacement'. Like Ruby's 'String#gsub'. - - If (ifn? replacment) is true, the replacement is called with the - match. - " - [^java.util.regex.Pattern regex replacement ^String string] - (if (ifn? replacement) - (let [parts (vec (re-partition regex string))] - (apply str - (reduce (fn [parts match-idx] - (update-in parts [match-idx] replacement)) - parts (range 1 (count parts) 2)))) - (.. regex (matcher string) (replaceAll replacement)))) - -(defn re-sub - "Replaces the first instance of 'pattern' in 'string' with - 'replacement'. Like Ruby's 'String#sub'. - - If (ifn? replacement) is true, the replacement is called with - the match. - " - [^Pattern regex replacement ^String string] - (if (ifn? replacement) - (let [m (re-matcher regex string)] - (if (.find m) - (str (.subSequence string 0 (.start m)) - (replacement (re-groups m)) - (.subSequence string (.end m) (.length string))) - string)) - (.. regex (matcher string) (replaceFirst replacement)))) - - -(defn str-join - "Returns a string of all elements in 'sequence', separated by - 'separator'. Like Perl's 'join'." - [separator sequence] - (apply str (interpose separator sequence))) - - -(defn chop - "Removes the last character of string." - [s] - (subs s 0 (dec (count s)))) - -(defn chomp - "Removes all trailing newline \\n or return \\r characters from - string. Note: String.trim() is similar and faster." - [s] - (re-sub #"[\r\n]+$" "" s)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/str_utils2.clj --- a/src/clojure/contrib/str_utils2.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,376 +0,0 @@ -;;; str_utils2.clj -- functional string utilities for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; August 19, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -;; DEPRECATED in 1.2: Promoted to clojure.java.string. Note that -;; many function names and semantics have changed - -(ns ^{:author "Stuart Sierra" - :deprecated "1.2" - :doc "This is a library of string manipulation functions. It - is intented as a replacement for clojure.contrib.str-utils. - - You cannot (use 'clojure.contrib.str-utils2) because it defines - functions with the same names as functions in clojure.core. - Instead, do (require '[clojure.contrib.str-utils2 :as s]) - or something similar. - - Goals: - 1. Be functional - 2. String argument first, to work with -> - 3. Performance linear in string length - - Some ideas are borrowed from - http://github.com/francoisdevlin/devlinsf-clojure-utils/"} - clojure.contrib.str-utils2 - (:refer-clojure :exclude (take replace drop butlast partition - contains? get repeat reverse partial)) - (:import (java.util.regex Pattern))) - - -(defmacro dochars - "bindings => [name string] - - Repeatedly executes body, with name bound to each character in - string. Does NOT handle Unicode supplementary characters (above - U+FFFF)." - [bindings & body] - (assert (vector bindings)) - (assert (= 2 (count bindings))) - ;; This seems to be the fastest way to iterate over characters. - `(let [^String s# ~(second bindings)] - (dotimes [i# (.length s#)] - (let [~(first bindings) (.charAt s# i#)] - ~@body)))) - - -(defmacro docodepoints - "bindings => [name string] - - Repeatedly executes body, with name bound to the integer code point - of each Unicode character in the string. Handles Unicode - supplementary characters (above U+FFFF) correctly." - [bindings & body] - (assert (vector bindings)) - (assert (= 2 (count bindings))) - (let [character (first bindings) - string (second bindings)] - `(let [^String s# ~string - len# (.length s#)] - (loop [i# 0] - (when (< i# len#) - (let [~character (.charAt s# i#)] - (if (Character/isHighSurrogate ~character) - (let [~character (.codePointAt s# i#)] - ~@body - (recur (+ 2 i#))) - (let [~character (int ~character)] - ~@body - (recur (inc i#)))))))))) - -(defn codepoints - "Returns a sequence of integer Unicode code points in s. Handles - Unicode supplementary characters (above U+FFFF) correctly." - [^String s] - (let [len (.length s) - f (fn thisfn [^String s i] - (when (< i len) - (let [c (.charAt s i)] - (if (Character/isHighSurrogate c) - (cons (.codePointAt s i) (thisfn s (+ 2 i))) - (cons (int c) (thisfn s (inc i)))))))] - (lazy-seq (f s 0)))) - -(defn ^String escape - "Returns a new String by applying cmap (a function or a map) to each - character in s. If cmap returns nil, the original character is - added to the output unchanged." - [^String s cmap] - (let [buffer (StringBuilder. (.length s))] - (dochars [c s] - (if-let [r (cmap c)] - (.append buffer r) - (.append buffer c))) - (.toString buffer))) - -(defn blank? - "True if s is nil, empty, or contains only whitespace." - [^String s] - (every? (fn [^Character c] (Character/isWhitespace c)) s)) - -(defn ^String take - "Take first n characters from s, up to the length of s. - - Note the argument order is the opposite of clojure.core/take; this - is to keep the string as the first argument for use with ->" - [^String s n] - (if (< (count s) n) - s - (.substring s 0 n))) - -(defn ^String drop - "Drops first n characters from s. Returns an empty string if n is - greater than the length of s. - - Note the argument order is the opposite of clojure.core/drop; this - is to keep the string as the first argument for use with ->" - [^String s n] - (if (< (count s) n) - "" - (.substring s n))) - -(defn ^String butlast - "Returns s without the last n characters. Returns an empty string - if n is greater than the length of s. - - Note the argument order is the opposite of clojure.core/butlast; - this is to keep the string as the first argument for use with ->" - [^String s n] - (if (< (count s) n) - "" - (.substring s 0 (- (count s) n)))) - -(defn ^String tail - "Returns the last n characters of s." - [^String s n] - (if (< (count s) n) - s - (.substring s (- (count s) n)))) - -(defn ^String repeat - "Returns a new String containing s repeated n times." - [^String s n] - (apply str (clojure.core/repeat n s))) - -(defn ^String reverse - "Returns s with its characters reversed." - [^String s] - (.toString (.reverse (StringBuilder. s)))) - -(defmulti - ^{:doc "Replaces all instances of pattern in string with replacement. - - Allowed argument types for pattern and replacement are: - 1. String and String - 2. Character and Character - 3. regex Pattern and String - (Uses java.util.regex.Matcher.replaceAll) - 4. regex Pattern and function - (Calls function with re-groups of each match, uses return - value as replacement.)" - :arglists '([string pattern replacement]) - :tag String} - replace - (fn [^String string pattern replacement] - [(class pattern) (class replacement)])) - -(defmethod replace [String String] [^String s ^String a ^String b] - (.replace s a b)) - -(defmethod replace [Character Character] [^String s ^Character a ^Character b] - (.replace s a b)) - -(defmethod replace [Pattern String] [^String s re replacement] - (.replaceAll (re-matcher re s) replacement)) - -(defmethod replace [Pattern clojure.lang.IFn] [^String s re replacement] - (let [m (re-matcher re s)] - (let [buffer (StringBuffer. (.length s))] - (loop [] - (if (.find m) - (do (.appendReplacement m buffer (replacement (re-groups m))) - (recur)) - (do (.appendTail m buffer) - (.toString buffer))))))) - -(defmulti - ^{:doc "Replaces the first instance of pattern in s with replacement. - - Allowed argument types for pattern and replacement are: - 1. String and String - 2. regex Pattern and String - (Uses java.util.regex.Matcher.replaceAll) - 3. regex Pattern and function -" - :arglists '([s pattern replacement]) - :tag String} - replace-first - (fn [s pattern replacement] - [(class pattern) (class replacement)])) - -(defmethod replace-first [String String] [^String s pattern replacement] - (.replaceFirst (re-matcher (Pattern/quote pattern) s) replacement)) - -(defmethod replace-first [Pattern String] [^String s re replacement] - (.replaceFirst (re-matcher re s) replacement)) - -(defmethod replace-first [Pattern clojure.lang.IFn] [^String s ^Pattern re f] - (let [m (re-matcher re s)] - (let [buffer (StringBuffer.)] - (if (.find m) - (let [rep (f (re-groups m))] - (.appendReplacement m buffer rep) - (.appendTail m buffer) - (str buffer)))))) - -(defn partition - "Splits the string into a lazy sequence of substrings, alternating - between substrings that match the patthern and the substrings - between the matches. The sequence always starts with the substring - before the first match, or an empty string if the beginning of the - string matches. - - For example: (partition \"abc123def\" #\"[a-z]+\") - returns: (\"\" \"abc\" \"123\" \"def\")" - [^String s ^Pattern re] - (let [m (re-matcher re s)] - ((fn step [prevend] - (lazy-seq - (if (.find m) - (cons (.subSequence s prevend (.start m)) - (cons (re-groups m) - (step (+ (.start m) (count (.group m)))))) - (when (< prevend (.length s)) - (list (.subSequence s prevend (.length s))))))) - 0))) - -(defn ^String join - "Returns a string of all elements in coll, separated by - separator. Like Perl's join." - [^String separator coll] - (apply str (interpose separator coll))) - -(defn ^String chop - "Removes the last character of string, does nothing on a zero-length - string." - [^String s] - (let [size (count s)] - (if (zero? size) - s - (subs s 0 (dec (count s)))))) - -(defn ^String chomp - "Removes all trailing newline \\n or return \\r characters from - string. Note: String.trim() is similar and faster." - [^String s] - (replace s #"[\r\n]+$" "")) - -(defn title-case [^String s] - (throw (Exception. "title-case not implemeted yet"))) - -(defn ^String swap-case - "Changes upper case characters to lower case and vice-versa. - Handles Unicode supplementary characters correctly. Uses the - locale-sensitive String.toUpperCase() and String.toLowerCase() - methods." - [^String s] - (let [buffer (StringBuilder. (.length s)) - ;; array to make a String from one code point - ^"[I" array (make-array Integer/TYPE 1)] - (docodepoints [c s] - (aset-int array 0 c) - (if (Character/isLowerCase c) - ;; Character.toUpperCase is not locale-sensitive, but - ;; String.toUpperCase is; so we use a String. - (.append buffer (.toUpperCase (String. array 0 1))) - (.append buffer (.toLowerCase (String. array 0 1))))) - (.toString buffer))) - -(defn ^String capitalize - "Converts first character of the string to upper-case, all other - characters to lower-case." - [^String s] - (if (< (count s) 2) - (.toUpperCase s) - (str (.toUpperCase ^String (subs s 0 1)) - (.toLowerCase ^String (subs s 1))))) - -(defn ^String ltrim - "Removes whitespace from the left side of string." - [^String s] - (replace s #"^\s+" "")) - -(defn ^String rtrim - "Removes whitespace from the right side of string." - [^String s] - (replace s #"\s+$" "")) - -(defn split-lines - "Splits s on \\n or \\r\\n." - [^String s] - (seq (.split #"\r?\n" s))) - -;; borrowed from compojure.str-utils, by James Reeves, EPL 1.0 -(defn ^String map-str - "Apply f to each element of coll, concatenate all results into a - String." - [f coll] - (apply str (map f coll))) - -;; borrowed from compojure.str-utils, by James Reeves, EPL 1.0 -(defn grep - "Filters elements of coll by a regular expression. The String - representation (with str) of each element is tested with re-find." - [re coll] - (filter (fn [x] (re-find re (str x))) coll)) - -(defn partial - "Like clojure.core/partial for functions that take their primary - argument first. - - Takes a function f and its arguments, NOT INCLUDING the first - argument. Returns a new function whose first argument will be the - first argument to f. - - Example: (str-utils2/partial str-utils2/take 2) - ;;=> (fn [s] (str-utils2/take s 2))" - [f & args] - (fn [s & more] (apply f s (concat args more)))) - - -;;; WRAPPERS - -;; The following functions are simple wrappers around java.lang.String -;; functions. They are included here for completeness, and for use -;; when mapping over a collection of strings. - -(defn ^String upper-case - "Converts string to all upper-case." - [^String s] - (.toUpperCase s)) - -(defn ^String lower-case - "Converts string to all lower-case." - [^String s] - (.toLowerCase s)) - -(defn split - "Splits string on a regular expression. Optional argument limit is - the maximum number of splits." - ([^String s ^Pattern re] (seq (.split re s))) - ([^String s ^Pattern re limit] (seq (.split re s limit)))) - -(defn ^String trim - "Removes whitespace from both ends of string." - [^String s] - (.trim s)) - -(defn ^String contains? - "True if s contains the substring." - [^String s substring] - (.contains s substring)) - -(defn ^String get - "Gets the i'th character in string." - [^String s i] - (.charAt s i)) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/stream_utils.clj --- a/src/clojure/contrib/stream_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,276 +0,0 @@ -;; Stream utilities - -;; by Konrad Hinsen -;; last updated May 3, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "Functions for setting up computational pipelines via data streams. - - NOTE: This library is experimental. It may change significantly - with future release. - - This library defines: - - an abstract stream type, whose interface consists of the - multimethod stream-next - - a macro for implementing streams - - implementations of stream for - 1) Clojure sequences, and vectors - 2) nil, representing an empty stream - - tools for writing stream transformers, including the - monad stream-m - - various utility functions for working with streams - - Streams are building blocks in the construction of computational - pipelines. A stream is represented by its current state plus - a function that takes a stream state and obtains the next item - in the stream as well as the new stream state. The state is - implemented as a Java class or a Clojure type (as defined by the - function clojure.core/type), and the function is provided as an - implementation of the multimethod stream-next for this class or type. - - While setting up pipelines using this mechanism is somewhat more - cumbersome than using Clojure's lazy seq mechanisms, there are a - few advantages: - - The state of a stream can be stored in any Clojure data structure, - and the stream can be re-generated from it any number of times. - Any number of states can be stored this way. - - The elements of the stream are never cached, so keeping a reference - to a stream state does not incur an uncontrollable memory penalty. - - Note that the stream mechanism is thread-safe as long as the - concrete stream implementations do not use any mutable state. - - Stream transformers take any number of input streams and produce one - output stream. They are typically written using the stream-m - monad. In the definition of a stream transformer, (pick s) returns - the next value of stream argument s, whereas pick-all returns the - next value of all stream arguments in the form of a vector."} - clojure.contrib.stream-utils - (:refer-clojure :exclude (deftype)) - (:use [clojure.contrib.types :only (deftype deftype-)]) - (:use [clojure.contrib.monads :only (defmonad with-monad)]) - (:use [clojure.contrib.def :only (defvar defvar-)]) - (:require [clojure.contrib.seq]) - (:require [clojure.contrib.generic.collection])) - - -; -; Stream type and interface -; -(defvar stream-type ::stream - "The root type for the stream hierarchy. For each stream type, - add a derivation from this type.") - -(defmacro defstream - "Define object of the given type as a stream whose implementation - of stream-next is defined by args and body. This macro adds - a type-specific method for stream-next and derives type - from stream-type." - [type-tag args & body] - `(do - (derive ~type-tag stream-type) - (defmethod stream-next ~type-tag ~args ~@body))) - -(defvar- stream-skip ::skip - "The skip-this-item value.") - -(defn- stream-skip? - "Returns true if x is the stream-skip." - [x] - (identical? x stream-skip)) - -(defmulti stream-next - "Returns a vector [next-value new-state] where next-value is the next - item in the data stream defined by stream-state and new-state - is the new state of the stream. At the end of the stream, - next-value and new-state are nil." - {:arglists '([stream-state])} - type) - -(defmethod stream-next nil - [s] - [nil nil]) - -(defmethod stream-next clojure.lang.ISeq - [s] - (if (seq s) - [(first s) (rest s)] - [nil nil])) - -(defmethod stream-next clojure.lang.IPersistentVector - [v] - (stream-next (seq v))) - -(defn stream-seq - "Return a lazy seq on the stream. Also accessible via - clojure.contrib.seq/seq-on and - clojure.contrib.generic.collection/seq for streams." - [s] - (lazy-seq - (let [[v ns] (stream-next s)] - (if (nil? ns) - nil - (cons v (stream-seq ns)))))) - -(defmethod clojure.contrib.seq/seq-on stream-type - [s] - (stream-seq s)) - -(defmethod clojure.contrib.generic.collection/seq stream-type - [s] - (stream-seq s)) - -; -; Stream transformers -; -(defmonad stream-m - "Monad describing stream computations. The monadic values can be - of any type handled by stream-next." - [m-result (fn m-result-stream [v] - (fn [s] [v s])) - m-bind (fn m-bind-stream [mv f] - (fn [s] - (let [[v ss :as r] (mv s)] - (if (or (nil? ss) (stream-skip? v)) - r - ((f v) ss))))) - m-zero (fn [s] [stream-skip s]) - ]) - -(defn pick - "Return the next value of stream argument n inside a stream - transformer. When used inside of defst, the name of the stream - argument can be used instead of its index n." - [n] - (fn [streams] - (let [[v ns] (stream-next (streams n))] - (if (nil? ns) - [nil nil] - [v (assoc streams n ns)])))) - -(defn pick-all - "Return a vector containing the next value of each stream argument - inside a stream transformer." - [streams] - (let [next (map stream-next streams) - values (map first next) - streams (vec (map second next))] - (if (some nil? streams) - [nil nil] - [values streams]))) - -(deftype ::stream-transformer st-as-stream - (fn [st streams] [st streams]) - seq) - -(defstream ::stream-transformer - [[st streams]] - (loop [s streams] - (let [[v ns] (st s)] - (cond (nil? ns) [nil nil] - (stream-skip? v) (recur ns) - :else [v (st-as-stream st ns)])))) - -(defmacro defst - "Define the stream transformer name by body. - The non-stream arguments args and the stream arguments streams - are given separately, with args being possibly empty." - [name args streams & body] - (if (= (first streams) '&) - `(defn ~name ~(vec (concat args streams)) - (let [~'st (with-monad stream-m ~@body)] - (st-as-stream ~'st ~(second streams)))) - `(defn ~name ~(vec (concat args streams)) - (let [~'st (with-monad stream-m - (let [~streams (range ~(count streams))] - ~@body))] - (st-as-stream ~'st ~streams))))) - -; -; Stream utilities -; -(defn stream-drop - "Return a stream containing all but the first n elements of stream." - [n stream] - (if (zero? n) - stream - (let [[_ s] (stream-next stream)] - (recur (dec n) s)))) - -; Map a function on a stream -(deftype- ::stream-map stream-map-state) - -(defstream ::stream-map - [[f stream]] - (let [[v ns] (stream-next stream)] - (if (nil? ns) - [nil nil] - [(f v) (stream-map-state [f ns])]))) - -(defmulti stream-map - "Return a new stream by mapping the function f on the given stream." - {:arglists '([f stream])} - (fn [f stream] (type stream))) - -(defmethod stream-map :default - [f stream] - (stream-map-state [f stream])) - -(defmethod stream-map ::stream-map - [f [g stream]] - (stream-map-state [(comp f g) stream])) - -; Filter stream elements -(deftype- ::stream-filter stream-filter-state) - -(defstream ::stream-filter - [[p stream]] - (loop [stream stream] - (let [[v ns] (stream-next stream)] - (cond (nil? ns) [nil nil] - (p v) [v (stream-filter-state [p ns])] - :else (recur ns))))) - -(defmulti stream-filter - "Return a new stream that contrains the elements of stream - that satisfy the predicate p." - {:arglists '([p stream])} - (fn [p stream] (type stream))) - -(defmethod stream-filter :default - [p stream] - (stream-filter-state [p stream])) - -(defmethod stream-filter ::stream-filter - [p [q stream]] - (stream-filter-state [(fn [v] (and (q v) (p v))) stream])) - -; Flatten a stream of sequences -(deftype- ::stream-flatten stream-flatten-state) - -(defstream ::stream-flatten - [[buffer stream]] - (loop [buffer buffer - stream stream] - (if (nil? buffer) - (let [[v new-stream] (stream-next stream)] - (cond (nil? new-stream) [nil nil] - (empty? v) (recur nil new-stream) - :else (recur v new-stream))) - [(first buffer) (stream-flatten-state [(next buffer) stream])]))) - -(defn stream-flatten - "Converts a stream of sequences into a stream of the elements of the - sequences. Flattening is not recursive, only one level of nesting - will be removed." - [s] - (stream-flatten-state [nil s])) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/string.clj --- a/src/clojure/contrib/string.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,382 +0,0 @@ -;;; string.clj -- functional string utilities for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; January 26, 2010 - -;; Copyright (c) Stuart Sierra, 2010. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -;; DEPRECATED in 1.2: Many functions have moved to clojure.string. - -(ns ^{:author "Stuart Sierra" - :doc "This is a library of string manipulation functions. It - is intented as a replacement for clojure.contrib.string. - - You cannot (use 'clojure.contrib.string) because it defines - functions with the same names as functions in clojure.core. - Instead, do (require '[clojure.contrib.string :as s]) - or something similar. - - Goals: - 1. Be functional - 2. Most significant argument LAST, to work with ->> - 3. At least O(n) performance for Strings of length n - - Some ideas are borrowed from - http://github.com/francoisdevlin/devlinsf-clojure-utils/"} - clojure.contrib.string - (:refer-clojure :exclude (take replace drop butlast partition - contains? get repeat reverse partial)) - (:import (java.util.regex Pattern))) - - -(defmacro dochars - "bindings => [name string] - - Repeatedly executes body, with name bound to each character in - string. Does NOT handle Unicode supplementary characters (above - U+FFFF)." - [bindings & body] - (assert (vector bindings)) - (assert (= 2 (count bindings))) - ;; This seems to be the fastest way to iterate over characters. - `(let [^String s# ~(second bindings)] - (dotimes [i# (.length s#)] - (let [~(first bindings) (.charAt s# i#)] - ~@body)))) - - -(defmacro docodepoints - "bindings => [name string] - - Repeatedly executes body, with name bound to the integer code point - of each Unicode character in the string. Handles Unicode - supplementary characters (above U+FFFF) correctly." - [bindings & body] - (assert (vector bindings)) - (assert (= 2 (count bindings))) - (let [character (first bindings) - string (second bindings)] - `(let [^String s# ~string - len# (.length s#)] - (loop [i# 0] - (when (< i# len#) - (let [~character (.charAt s# i#)] - (if (Character/isHighSurrogate ~character) - (let [~character (.codePointAt s# i#)] - ~@body - (recur (+ 2 i#))) - (let [~character (int ~character)] - ~@body - (recur (inc i#)))))))))) - -(defn codepoints - "Returns a sequence of integer Unicode code points in s. Handles - Unicode supplementary characters (above U+FFFF) correctly." - [^String s] - (let [len (.length s) - f (fn thisfn [^String s i] - (when (< i len) - (let [c (.charAt s i)] - (if (Character/isHighSurrogate c) - (cons (.codePointAt s i) (thisfn s (+ 2 i))) - (cons (int c) (thisfn s (inc i)))))))] - (lazy-seq (f s 0)))) - -(defn ^String escape - "Returns a new String by applying cmap (a function or a map) to each - character in s. If cmap returns nil, the original character is - added to the output unchanged." - {:deprecated "1.2"} - [cmap ^String s] - (let [buffer (StringBuilder. (.length s))] - (dochars [c s] - (if-let [r (cmap c)] - (.append buffer r) - (.append buffer c))) - (.toString buffer))) - -(defn blank? - "True if s is nil, empty, or contains only whitespace." - {:deprecated "1.2"} - [^String s] - (every? (fn [^Character c] (Character/isWhitespace c)) s)) - -(defn ^String take - "Take first n characters from s, up to the length of s." - [n ^String s] - (if (< (count s) n) - s - (.substring s 0 n))) - -(defn ^String drop - "Drops first n characters from s. Returns an empty string if n is - greater than the length of s." - [n ^String s] - (if (< (count s) n) - "" - (.substring s n))) - -(defn ^String butlast - "Returns s without the last n characters. Returns an empty string - if n is greater than the length of s." - [n ^String s] - (if (< (count s) n) - "" - (.substring s 0 (- (count s) n)))) - -(defn ^String tail - "Returns the last n characters of s." - [n ^String s] - (if (< (count s) n) - s - (.substring s (- (count s) n)))) - -(defn ^String repeat - "Returns a new String containing s repeated n times." - [n ^String s] - (apply str (clojure.core/repeat n s))) - -(defn ^String reverse - "Returns s with its characters reversed." - {:deprecated "1.2"} - [^String s] - (.toString (.reverse (StringBuilder. s)))) - -(defn replace-str - "Replaces all instances of substring a with b in s." - {:deprecated "1.2"} - [^String a ^String b ^String s] - (.replace s a b)) - -(defn replace-char - "Replaces all instances of character a with character b in s." - {:deprecated "1.2"} - [^Character a ^Character b ^String s] - (.replace s a b)) - -(defn replace-re - "Replaces all matches of re with replacement in s." - {:deprecated "1.2"} - [re replacement ^String s] - (.replaceAll (re-matcher re s) replacement)) - -(defn replace-by - "Replaces all matches of re in s with the result of - (f (re-groups the-match))." - {:deprecated "1.2"} - [re f ^String s] - (let [m (re-matcher re s)] - (let [buffer (StringBuffer. (.length s))] - (loop [] - (if (.find m) - (do (.appendReplacement m buffer (f (re-groups m))) - (recur)) - (do (.appendTail m buffer) - (.toString buffer))))))) - -(defn replace-first-str - "Replace first occurance of substring a with b in s." - {:deprecated "1.2"} - [^String a ^String b ^String s] - (.replaceFirst (re-matcher (Pattern/quote a) s) b)) - -(defn replace-first-re - "Replace first match of re in s." - {:deprecated "1.2"} - [^Pattern re ^String replacement ^String s] - (.replaceFirst (re-matcher re s) replacement)) - -(defn replace-first-by - "Replace first match of re in s with the result of - (f (re-groups the-match))." - {:deprecated "1.2"} - [^Pattern re f ^String s] - (let [m (re-matcher re s)] - (let [buffer (StringBuffer.)] - (if (.find m) - (let [rep (f (re-groups m))] - (.appendReplacement m buffer rep) - (.appendTail m buffer) - (str buffer)))))) - -(defn partition - "Splits the string into a lazy sequence of substrings, alternating - between substrings that match the patthern and the substrings - between the matches. The sequence always starts with the substring - before the first match, or an empty string if the beginning of the - string matches. - - For example: (partition #\"[a-z]+\" \"abc123def\") - returns: (\"\" \"abc\" \"123\" \"def\")" - [^Pattern re ^String s] - (let [m (re-matcher re s)] - ((fn step [prevend] - (lazy-seq - (if (.find m) - (cons (.subSequence s prevend (.start m)) - (cons (re-groups m) - (step (+ (.start m) (count (.group m)))))) - (when (< prevend (.length s)) - (list (.subSequence s prevend (.length s))))))) - 0))) - -(defn ^String join - "Returns a string of all elements in coll, separated by - separator. Like Perl's join." - {:deprecated "1.2"} - [^String separator coll] - (apply str (interpose separator coll))) - -(defn ^String chop - "Removes the last character of string, does nothing on a zero-length - string." - [^String s] - (let [size (count s)] - (if (zero? size) - s - (subs s 0 (dec (count s)))))) - -(defn ^String chomp - "Removes all trailing newline \\n or return \\r characters from - string. Note: String.trim() is similar and faster. - Deprecated in 1.2. Use clojure.string/trim-newline" - {:deprecated "1.2"} - [^String s] - (replace-re #"[\r\n]+$" "" s)) - -(defn ^String swap-case - "Changes upper case characters to lower case and vice-versa. - Handles Unicode supplementary characters correctly. Uses the - locale-sensitive String.toUpperCase() and String.toLowerCase() - methods." - [^String s] - (let [buffer (StringBuilder. (.length s)) - ;; array to make a String from one code point - ^"[I" array (make-array Integer/TYPE 1)] - (docodepoints [c s] - (aset-int array 0 c) - (if (Character/isLowerCase c) - ;; Character.toUpperCase is not locale-sensitive, but - ;; String.toUpperCase is; so we use a String. - (.append buffer (.toUpperCase (String. array 0 1))) - (.append buffer (.toLowerCase (String. array 0 1))))) - (.toString buffer))) - -(defn ^String capitalize - "Converts first character of the string to upper-case, all other - characters to lower-case." - {:deprecated "1.2"} - [^String s] - (if (< (count s) 2) - (.toUpperCase s) - (str (.toUpperCase ^String (subs s 0 1)) - (.toLowerCase ^String (subs s 1))))) - -(defn ^String ltrim - "Removes whitespace from the left side of string. - Deprecated in 1.2. Use clojure.string/triml." - {:deprecated "1.2"} - [^String s] - (replace-re #"^\s+" "" s)) - -(defn ^String rtrim - "Removes whitespace from the right side of string. - Deprecated in 1.2. Use clojure.string/trimr." - {:deprecated "1.2"} - [^String s] - (replace-re #"\s+$" "" s)) - -(defn split-lines - "Splits s on \\n or \\r\\n." - {:deprecated "1.2"} - [^String s] - (seq (.split #"\r?\n" s))) - -;; borrowed from compojure.string, by James Reeves, EPL 1.0 -(defn ^String map-str - "Apply f to each element of coll, concatenate all results into a - String." - [f coll] - (apply str (map f coll))) - -;; borrowed from compojure.string, by James Reeves, EPL 1.0 -(defn grep - "Filters elements of coll by a regular expression. The String - representation (with str) of each element is tested with re-find." - [re coll] - (filter (fn [x] (re-find re (str x))) coll)) - -(defn as-str - "Like clojure.core/str, but if an argument is a keyword or symbol, - its name will be used instead of its literal representation. - - Example: - (str :foo :bar) ;;=> \":foo:bar\" - (as-str :foo :bar) ;;=> \"foobar\" - - Note that this does not apply to keywords or symbols nested within - data structures; they will be rendered as with str. - - Example: - (str {:foo :bar}) ;;=> \"{:foo :bar}\" - (as-str {:foo :bar}) ;;=> \"{:foo :bar}\" " - ([] "") - ([x] (if (instance? clojure.lang.Named x) - (name x) - (str x))) - ([x & ys] - ((fn [^StringBuilder sb more] - (if more - (recur (. sb (append (as-str (first more)))) (next more)) - (str sb))) - (new StringBuilder ^String (as-str x)) ys))) - - -;;; WRAPPERS - -;; The following functions are simple wrappers around java.lang.String -;; functions. They are included here for completeness, and for use -;; when mapping over a collection of strings. - -(defn ^String upper-case - "Converts string to all upper-case." - {:deprecated "1.2"} - [^String s] - (.toUpperCase s)) - -(defn ^String lower-case - "Converts string to all lower-case." - {:deprecated "1.2"} - [^String s] - (.toLowerCase s)) - -(defn split - "Splits string on a regular expression. Optional argument limit is - the maximum number of splits." - {:deprecated "1.2"} - ([^Pattern re ^String s] (seq (.split re s))) - ([^Pattern re limit ^String s] (seq (.split re s limit)))) - -(defn ^String trim - "Removes whitespace from both ends of string." - {:deprecated "1.2"} - [^String s] - (.trim s)) - -(defn ^String substring? - "True if s contains the substring." - [substring ^String s] - (.contains s substring)) - -(defn ^String get - "Gets the i'th character in string." - {:deprecated "1.2"} - [^String s i] - (.charAt s i)) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/strint.clj --- a/src/clojure/contrib/strint.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,72 +0,0 @@ -;;; strint.clj -- String interpolation for Clojure -;; originally proposed/published at http://muckandbrass.com/web/x/AgBP - -;; by Chas Emerick -;; December 4, 2009 - -;; Copyright (c) Chas Emerick, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Chas Emerick", - :doc "String interpolation for Clojure."} - clojure.contrib.strint) - -(defn- silent-read - "Attempts to clojure.core/read a single form from the provided String, returning - a vector containing the read form and a String containing the unread remainder - of the provided String. Returns nil if no valid form can be read from the - head of the String." - [s] - (try - (let [r (-> s java.io.StringReader. java.io.PushbackReader.)] - [(read r) (slurp r)]) - (catch Exception e))) ; this indicates an invalid form -- the head of s is just string data - -(defn- interpolate - "Yields a seq of Strings and read forms." - ([s atom?] - (lazy-seq - (if-let [[form rest] (silent-read (subs s (if atom? 2 1)))] - (cons form (interpolate (if atom? (subs rest 1) rest))) - (cons (subs s 0 2) (interpolate (subs s 2)))))) - ([^String s] - (if-let [start (->> ["~{" "~("] - (map #(.indexOf s %)) - (remove #(== -1 %)) - sort - first)] - (lazy-seq (cons - (subs s 0 start) - (interpolate (subs s start) (= \{ (.charAt s (inc start)))))) - [s]))) - -(defmacro << - "Takes a single string argument and emits a str invocation that concatenates - the string data and evaluated expressions contained within that argument. - Evaluation is controlled using ~{} and ~() forms. The former is used for - simple value replacement using clojure.core/str; the latter can be used to - embed the results of arbitrary function invocation into the produced string. - - Examples: - user=> (def v 30.5) - #'user/v - user=> (<< \"This trial required ~{v}ml of solution.\") - \"This trial required 30.5ml of solution.\" - user=> (<< \"There are ~(int v) days in November.\") - \"There are 30 days in November.\" - user=> (def m {:a [1 2 3]}) - #'user/m - user=> (<< \"The total for your order is $~(->> m :a (apply +)).\") - \"The total for your order is $6.\" - - Note that quotes surrounding string literals within ~() forms must be - escaped." - [string] - `(str ~@(interpolate string))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/swing_utils.clj --- a/src/clojure/contrib/swing_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,152 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; clojure.contrib.swing-utils -;; -;; Useful functions for interfacing Clojure to Swing -;; -;; scgilardi (gmail) -;; Created 31 May 2009 - -(ns clojure.contrib.swing-utils - (:import (java.awt.event ActionListener KeyAdapter) - (javax.swing AbstractAction Action - JMenu JMenuBar JMenuItem - SwingUtilities)) - (:use [clojure.contrib.def :only (defvar)])) - -(defn add-action-listener - "Adds an ActionLister to component. When the action fires, f will be - invoked with the event as its first argument followed by args. - Returns the listener." - [component f & args] - (let [listener (proxy [ActionListener] [] - (actionPerformed [event] (apply f event args)))] - (.addActionListener component listener) - listener)) - -(defn add-key-typed-listener - "Adds a KeyListener to component that only responds to KeyTyped events. - When a key is typed, f is invoked with the KeyEvent as its first argument - followed by args. Returns the listener." - [component f & args] - (let [listener (proxy [KeyAdapter] [] - (keyTyped [event] (apply f event args)))] - (.addKeyListener component listener) - listener)) - -;; ---------------------------------------------------------------------- -;; Meikel Brandmeyer - -(defn do-swing* - "Runs thunk in the Swing event thread according to schedule: - - :later => schedule the execution and return immediately - - :now => wait until the execution completes." - [schedule thunk] - (cond - (= schedule :later) (SwingUtilities/invokeLater thunk) - (= schedule :now) (if (SwingUtilities/isEventDispatchThread) - (thunk) - (SwingUtilities/invokeAndWait thunk))) - nil) - -(defmacro do-swing - "Executes body in the Swing event thread asynchronously. Returns - immediately after scheduling the execution." - [& body] - `(do-swing* :later (fn [] ~@body))) - -(defmacro do-swing-and-wait - "Executes body in the Swing event thread synchronously. Returns - after the execution is complete." - [& body] - `(do-swing* :now (fn [] ~@body))) - -(defvar action-translation-table - (atom {:name Action/NAME - :accelerator Action/ACCELERATOR_KEY - :command-key Action/ACTION_COMMAND_KEY - :long-desc Action/LONG_DESCRIPTION - :short-desc Action/SHORT_DESCRIPTION - :mnemonic Action/MNEMONIC_KEY - :icon Action/SMALL_ICON}) - "Translation table for the make-action constructor.") - -(defn make-action - "Create an Action proxy from the given action spec. The standard keys - recognised are: :name, :accelerator, :command-key, :long-desc, - :short-desc, :mnemonic and :icon - corresponding to the similar named - Action properties. The :handler value is used in the actionPerformed - method of the proxy to pass on the event." - [spec] - (let [t-table @action-translation-table - handler (:handler spec) - spec (dissoc spec :handler) - spec (map (fn [[k v]] [(t-table k) v]) spec) - action (proxy [AbstractAction] [] - (actionPerformed [evt] (handler evt)))] - (doseq [[k v] spec] - (.putValue action k v)) - action)) - -(defvar menu-constructor-dispatch - (atom #{:action :handler :items}) - "An atom containing the dispatch set for the add-menu-item method.") - -(defmulti add-menu-item - "Adds a menu item to the parent according to the item description. - The item description is a map of the following structure. - - Either: - - one single :action specifying a javax.swing.Action to be associated - with the item. - - a specification suitable for make-action - - a set of :name, :mnemonic and :items keys, specifying a submenu with - the given sequence of item entries. - - an empty map specifying a separator." - {:arglists '([parent item])} - (fn add-menu-item-dispatch [_ item] - (some @menu-constructor-dispatch (keys item)))) - -(defmethod add-menu-item :action - add-menu-item-action - [parent {:keys [action]}] - (let [item (JMenuItem. action)] - (.add parent item))) - -(defmethod add-menu-item :handler - add-menu-item-handler - [parent spec] - (add-menu-item parent {:action (make-action spec)})) - -(defmethod add-menu-item :items - add-menu-item-submenu - [parent {:keys [items mnemonic name]}] - (let [menu (JMenu. name)] - (when mnemonic - (.setMnemonic menu mnemonic)) - (doseq [item items] - (add-menu-item menu item)) - (.add parent menu))) - -(defmethod add-menu-item nil ; nil meaning separator - add-menu-item-separator - [parent _] - (.addSeparator parent)) - -(defn make-menubar - "Create a menubar containing the given sequence of menu items. The menu - items are described by a map as is detailed in the docstring of the - add-menu-item function." - [menubar-items] - (let [menubar (JMenuBar.)] - (doseq [item menubar-items] - (add-menu-item menubar item)) - menubar)) - -;; ---------------------------------------------------------------------- diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/accumulators/examples.clj --- a/src/clojure/contrib/test_contrib/accumulators/examples.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Accumulator application examples -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for using accumulators"} - clojure.contrib.accumulators.examples - (:use [clojure.contrib.accumulators - :only (combine add add-items - empty-vector empty-list empty-queue empty-set empty-map - empty-counter empty-counter-with-total - empty-sum empty-product empty-maximum empty-minimum - empty-min-max empty-mean-variance empty-string empty-tuple)])) - -; Vector accumulator: combine is concat, add is conj -(combine [:a :b] [:c :d] [:x :y]) -(add [:a :b] :c) -(add-items empty-vector [:a :b :a]) - -; List accumulator: combine is concat, add is conj -(combine '(:a :b) '(:c :d) '(:x :y)) -(add '(:a :b) :c) -(add-items empty-list [:a :b :a]) - -; Queue accumulator -(let [q1 (add-items empty-queue [:a :b :a]) - q2 (add-items empty-queue [:x :y])] - (combine q1 q2)) - -; Set accumulator: combine is union, add is conj -(combine #{:a :b} #{:c :d} #{:a :d}) -(add #{:a :b} :c) -(add-items empty-set [:a :b :a]) - -; Map accumulator: combine is merge, add is conj -(combine {:a 1} {:b 2 :c 3} {}) -(add {:a 1} [:b 2]) -(add-items empty-map [[:a 1] [:b 2] [:a 0]]) - -; Counter accumulator -(let [c1 (add-items empty-counter [:a :b :a]) - c2 (add-items empty-counter [:x :y])] - (combine c1 c2)) - -; Counter-with-total accumulator -(let [c1 (add-items empty-counter-with-total [:a :b :a]) - c2 (add-items empty-counter-with-total [:x :y])] - (combine c1 c2)) - -; Sum accumulator: combine is addition -(let [s1 (add-items empty-sum [1 2 3]) - s2 (add-items empty-sum [-1 -2 -3])] - (combine s1 s2)) - -; Product accumulator: combine is multiplication -(let [p1 (add-items empty-product [2 3]) - p2 (add-items empty-product [(/ 1 2)])] - (combine p1 p2)) - -; Maximum accumulator: combine is max -(let [m1 (add-items empty-maximum [2 3]) - m2 (add-items empty-maximum [(/ 1 2)])] - (combine m1 m2)) - -; Minimum accumulator: combine is min -(let [m1 (add-items empty-minimum [2 3]) - m2 (add-items empty-minimum [(/ 1 2)])] - (combine m1 m2)) - -; Min-max accumulator: combination of minimum and maximum -(let [m1 (add-items empty-min-max [2 3]) - m2 (add-items empty-min-max [(/ 1 2)])] - (combine m1 m2)) - -; Mean-variance accumulator: sample mean and sample variance -(let [m1 (add-items empty-mean-variance [2 4]) - m2 (add-items empty-mean-variance [6])] - (combine m1 m2)) - -; String accumulator: combine is concatenation -(combine "a" "b" "c" "def") -(add "a" (char 44)) -(add-items empty-string [(char 55) (char 56) (char 57)]) - -; Accumulator tuples permit to update several accumulators in parallel -(let [pair (empty-tuple [empty-vector empty-string])] - (add-items pair [[1 "a"] [2 "b"]])) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/condition/example.clj --- a/src/clojure/contrib/test_contrib/condition/example.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; clojure.contrib.condition.example.clj -;; -;; scgilardi (gmail) -;; Created 09 June 2009 - -(ns clojure.contrib.condition.example - (:use (clojure.contrib - [condition - :only (handler-case print-stack-trace raise *condition*)]))) - -(defn func [x y] - "Raises an exception if x is negative" - (when (neg? x) - (raise :type :illegal-argument :arg 'x :value x)) - (+ x y)) - -(defn main - [] - - ;; simple handler - - (handler-case :type - (println (func 3 4)) - (println (func -5 10)) - (handle :illegal-argument - (print-stack-trace *condition*)) - (println 3)) - - ;; multiple handlers - - (handler-case :type - (println (func 4 1)) - (println (func -3 22)) - (handle :overflow - (print-stack-trace *condition*)) - (handle :illegal-argument - (print-stack-trace *condition*))) - - ;; nested handlers - - (handler-case :type - (handler-case :type - nil - nil - (println 1) - (println 2) - (println 3) - (println (func 8 2)) - (println (func -6 17)) - ;; no handler for :illegal-argument - (handle :overflow - (println "nested") - (print-stack-trace *condition*))) - (println (func 3 4)) - (println (func -5 10)) - (handle :illegal-argument - (println "outer") - (print-stack-trace *condition*)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/datalog/example.clj --- a/src/clojure/contrib/test_contrib/datalog/example.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,116 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; example.clj -;; -;; A Clojure implementation of Datalog - Example -;; -;; straszheimjeffrey (gmail) -;; Created 2 March 2009 - - -(ns clojure.contrib.datalog.example - (:use [clojure.contrib.datalog :only (build-work-plan run-work-plan)] - [clojure.contrib.datalog.rules :only (<- ?- rules-set)] - [clojure.contrib.datalog.database :only (make-database add-tuples)] - [clojure.contrib.datalog.util :only (*trace-datalog*)])) - - - - -(def db-base - (make-database - (relation :employee [:id :name :position]) - (index :employee :name) - - (relation :boss [:employee-id :boss-id]) - (index :boss :employee-id) - - (relation :can-do-job [:position :job]) - (index :can-do-job :position) - - (relation :job-replacement [:job :can-be-done-by]) - ;(index :job-replacement :can-be-done-by) - - (relation :job-exceptions [:id :job]))) - -(def db - (add-tuples db-base - [:employee :id 1 :name "Bob" :position :boss] - [:employee :id 2 :name "Mary" :position :chief-accountant] - [:employee :id 3 :name "John" :position :accountant] - [:employee :id 4 :name "Sameer" :position :chief-programmer] - [:employee :id 5 :name "Lilian" :position :programmer] - [:employee :id 6 :name "Li" :position :technician] - [:employee :id 7 :name "Fred" :position :sales] - [:employee :id 8 :name "Brenda" :position :sales] - [:employee :id 9 :name "Miki" :position :project-management] - [:employee :id 10 :name "Albert" :position :technician] - - [:boss :employee-id 2 :boss-id 1] - [:boss :employee-id 3 :boss-id 2] - [:boss :employee-id 4 :boss-id 1] - [:boss :employee-id 5 :boss-id 4] - [:boss :employee-id 6 :boss-id 4] - [:boss :employee-id 7 :boss-id 1] - [:boss :employee-id 8 :boss-id 7] - [:boss :employee-id 9 :boss-id 1] - [:boss :employee-id 10 :boss-id 6] - - [:can-do-job :position :boss :job :management] - [:can-do-job :position :accountant :job :accounting] - [:can-do-job :position :chief-accountant :job :accounting] - [:can-do-job :position :programmer :job :programming] - [:can-do-job :position :chief-programmer :job :programming] - [:can-do-job :position :technician :job :server-support] - [:can-do-job :position :sales :job :sales] - [:can-do-job :position :project-management :job :project-management] - - [:job-replacement :job :pc-support :can-be-done-by :server-support] - [:job-replacement :job :pc-support :can-be-done-by :programming] - [:job-replacement :job :payroll :can-be-done-by :accounting] - - [:job-exceptions :id 4 :job :pc-support])) - -(def rules - (rules-set - (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id) - (:employee :id ?e-id :name ?x) - (:employee :id ?b-id :name ?y)) - (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z) - (:works-for :employee ?z :boss ?y)) - (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos) - (:can-do-job :position ?pos :job ?y)) - (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z) - (:employee-job* :employee ?x :job ?z)) - (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y) - (:employee :name ?x :position ?z) - (if = ?z :boss)) - (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y) - (:employee :id ?id :name ?x) - (not! :job-exceptions :id ?id :job ?y)) - (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y) - (not! :employee-job :employee ?y :job :pc-support)))) - - - -(def wp-1 (build-work-plan rules (?- :works-for :employee '??name :boss ?x))) -(run-work-plan wp-1 db {'??name "Albert"}) - -(def wp-2 (build-work-plan rules (?- :employee-job :employee '??name :job ?x))) -(binding [*trace-datalog* true] - (run-work-plan wp-2 db {'??name "Li"})) - -(def wp-3 (build-work-plan rules (?- :bj :name '??name :boss ?x))) -(run-work-plan wp-3 db {'??name "Albert"}) - -(def wp-4 (build-work-plan rules (?- :works-for :employee ?x :boss ?y))) -(run-work-plan wp-4 db {}) - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/datalog/tests/test.clj --- a/src/clojure/contrib/test_contrib/datalog/tests/test.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; test.clj -;; -;; A Clojure implementation of Datalog -- Tests -;; -;; straszheimjeffrey (gmail) -;; Created 11 Feburary 2009 - -(ns clojure.contrib.datalog.tests.test - (:use [clojure.test :only (run-tests)]) - (:gen-class)) - -(def test-names [:test-util - :test-database - :test-literals - :test-rules - :test-magic - :test-softstrat]) - -(def test-namespaces - (map #(symbol (str "clojure.contrib.datalog.tests." (name %))) - test-names)) - -(defn run - "Runs all defined tests" - [] - (println "Loading tests...") - (apply require :reload-all test-namespaces) - (apply run-tests test-namespaces)) - -(defn -main - "Run all defined tests from the command line" - [& args] - (run) - (System/exit 0)) - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/datalog/tests/test_database.clj --- a/src/clojure/contrib/test_contrib/datalog/tests/test_database.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,153 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; test-database.clj -;; -;; A Clojure implementation of Datalog -- Database -;; -;; straszheimjeffrey (gmail) -;; Created 12 Feburary 2009 - - -(ns clojure.contrib.datalog.tests.test-database - (:use clojure.test - clojure.contrib.datalog.database)) - - -(def test-db - (make-database - (relation :fred [:mary :sue]) - (index :fred :mary) - (relation :sally [:jen :becky :joan]) - (index :sally :jen) - (index :sally :becky))) - -(deftest test-make-database - (is (= test-db - (datalog-database - {:sally (datalog-relation - #{:jen :joan :becky} - #{} - {:becky {} - :jen {}}) - :fred (datalog-relation - #{:sue :mary} - #{} - {:mary {}})})))) - - -(deftest test-ensure-relation - (is (contains? (ensure-relation test-db :bob [:sam :george] [:sam]) :bob)) - (is (contains? (ensure-relation test-db :fred [:mary :sue] [:mary]) :fred)) - (is (thrown? AssertionError (ensure-relation test-db :fred [:bob :joe] [])))) - -(deftest test-add-tuple - (let [new-db (add-tuple test-db :fred {:mary 1 :sue 2})] - (is (= (select new-db :fred {:mary 1}) [{:mary 1 :sue 2}]))) - (is (thrown? AssertionError (add-tuple test-db :fred {:mary 1})))) - -(def test-db-1 - (add-tuples test-db - [:fred :mary 1 :sue 2] - [:fred :mary 2 :sue 3] - [:sally :jen 1 :becky 2 :joan 0] - [:sally :jen 1 :becky 4 :joan 3] - [:sally :jen 1 :becky 3 :joan 0] - [:sally :jen 1 :becky 2 :joan 3] - [:fred :mary 1 :sue 1] - [:fred :mary 3 :sue 1])) - -(deftest test-add-tuples - (is (= test-db-1 - (datalog-database - {:sally (datalog-relation - #{:jen :joan :becky} - #{{:jen 1, :joan 0, :becky 3} - {:jen 1, :joan 0, :becky 2} - {:jen 1, :joan 3, :becky 2} - {:jen 1, :joan 3, :becky 4}} - {:becky {3 - #{{:jen 1, :joan 0, :becky 3}} - 4 - #{{:jen 1, :joan 3, :becky 4}} - 2 - #{{:jen 1, :joan 0, :becky 2} - {:jen 1, :joan 3, :becky 2}}} - :jen {1 - #{{:jen 1, :joan 0, :becky 3} - {:jen 1, :joan 0, :becky 2} - {:jen 1, :joan 3, :becky 2} - {:jen 1, :joan 3, :becky 4}}}}) - :fred (datalog-relation - #{:sue :mary} - #{{:sue 2, :mary 1} - {:sue 1, :mary 1} - {:sue 3, :mary 2} - {:sue 1, :mary 3}} - {:mary {3 - #{{:sue 1, :mary 3}} - 2 - #{{:sue 3, :mary 2}} - 1 - #{{:sue 2, :mary 1} - {:sue 1, :mary 1}}}})})))) - -(deftest test-remove-tuples - (let [db (reduce #(apply remove-tuple %1 (first %2) (next %2)) - test-db-1 - [[:fred {:mary 1 :sue 1}] - [:fred {:mary 3 :sue 1}] - [:sally {:jen 1 :becky 2 :joan 0}] - [:sally {:jen 1 :becky 4 :joan 3}]])] - (is (= db - (datalog-database - {:sally (datalog-relation - #{:jen :joan :becky} - #{{:jen 1, :joan 0, :becky 3} - {:jen 1, :joan 3, :becky 2}} - {:becky - {3 - #{{:jen 1, :joan 0, :becky 3}} - 2 - #{{:jen 1, :joan 3, :becky 2}}} - :jen - {1 - #{{:jen 1, :joan 0, :becky 3} - {:jen 1, :joan 3, :becky 2}}}}) - :fred (datalog-relation - #{:sue :mary} - #{{:sue 2, :mary 1} - {:sue 3, :mary 2}} - {:mary - {2 - #{{:sue 3, :mary 2}} - 1 - #{{:sue 2, :mary 1}}}})}))))) - - - -(deftest test-select - (is (= (set (select test-db-1 :sally {:jen 1 :becky 2})) - #{{:jen 1 :joan 0 :becky 2} {:jen 1 :joan 3 :becky 2}})) - (is (= (set (select test-db-1 :fred {:sue 1}))) - #{{:mary 3 :sue 1} {:mary 1 :sue 1}}) - (is (empty? (select test-db-1 :sally {:joan 5 :jen 1})))) - -(deftest test-any-match? - (is (any-match? test-db-1 :fred {:mary 3})) - (is (any-match? test-db-1 :sally {:jen 1 :becky 2 :joan 3})) - (is (not (any-match? test-db-1 :sally {:jen 5}))) - (is (not (any-match? test-db-1 :fred {:mary 1 :sue 5})))) - - -(comment - (run-tests) -) - -;; End of file - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/datalog/tests/test_literals.clj --- a/src/clojure/contrib/test_contrib/datalog/tests/test_literals.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,187 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; test-literals.clj -;; -;; A Clojure implementation of Datalog -- Literals tests -;; -;; straszheimjeffrey (gmail) -;; Created 25 Feburary 2009 - - -(ns clojure.contrib.datalog.tests.test-literals - (:use clojure.test) - (:use clojure.contrib.datalog.literals - clojure.contrib.datalog.database)) - - -(def pl (eval (build-literal '(:fred :x ?x :y ?y :z 3)))) -(def nl (eval (build-literal '(not! :fred :x ?x :y ?y :z 3)))) -(def cl (eval (build-literal '(if > ?x 3)))) - -(def bl (eval (build-literal '(:fred)))) - -(def bns {:x '?x :y '?y :z 3}) - -(deftest test-build-literal - (is (= (:predicate pl) :fred)) - (is (= (:term-bindings pl) bns)) - (is (= (:predicate nl) :fred)) - (is (= (:term-bindings nl) bns)) - (is (= (:symbol cl) '>)) - (is (= (:terms cl) '(?x 3))) - (is ((:fun cl) [4 3])) - (is (not ((:fun cl) [2 4]))) - (is (= (:predicate bl) :fred))) - -(deftest test-literal-predicate - (is (= (literal-predicate pl) :fred)) - (is (= (literal-predicate nl) :fred)) - (is (nil? (literal-predicate cl))) - (is (= (literal-predicate bl) :fred))) - -(deftest test-literal-columns - (is (= (literal-columns pl) #{:x :y :z})) - (is (= (literal-columns nl) #{:x :y :z})) - (is (nil? (literal-columns cl))) - (is (empty? (literal-columns bl)))) - -(deftest test-literal-vars - (is (= (literal-vars pl) #{'?x '?y})) - (is (= (literal-vars nl) #{'?x '?y})) - (is (= (literal-vars cl) #{'?x})) - (is (empty? (literal-vars bl)))) - -(deftest test-positive-vars - (is (= (positive-vars pl) (literal-vars pl))) - (is (nil? (positive-vars nl))) - (is (nil? (positive-vars cl))) - (is (empty? (positive-vars bl)))) - -(deftest test-negative-vars - (is (nil? (negative-vars pl))) - (is (= (negative-vars nl) (literal-vars nl))) - (is (= (negative-vars cl) (literal-vars cl))) - (is (empty? (negative-vars bl)))) - -(deftest test-negated? - (is (not (negated? pl))) - (is (negated? nl)) - (is (not (negated? cl)))) - -(deftest test-vs-from-cs - (is (= (get-vs-from-cs pl #{:x}) #{'?x})) - (is (empty? (get-vs-from-cs pl #{:z}))) - (is (= (get-vs-from-cs pl #{:x :r}) #{'?x})) - (is (empty? (get-vs-from-cs pl #{})))) - -(deftest test-cs-from-vs - (is (= (get-cs-from-vs pl #{'?x}) #{:x})) - (is (= (get-cs-from-vs pl #{'?x '?r}) #{:x})) - (is (empty? (get-cs-from-vs pl #{})))) - -(deftest test-literal-appropriate? - (is (not (literal-appropriate? #{} pl))) - (is (literal-appropriate? #{'?x} pl)) - (is (not (literal-appropriate? #{'?x} nl))) - (is (literal-appropriate? #{'?x '?y} nl)) - (is (not (literal-appropriate? #{'?z} cl))) - (is (literal-appropriate? #{'?x} cl))) - -(deftest test-adorned-literal - (is (= (literal-predicate (adorned-literal pl #{:x})) - {:pred :fred :bound #{:x}})) - (is (= (literal-predicate (adorned-literal nl #{:x :y :q})) - {:pred :fred :bound #{:x :y}})) - (is (= (:term-bindings (adorned-literal nl #{:x})) - {:x '?x :y '?y :z 3})) - (is (= (adorned-literal cl #{}) - cl))) - -(deftest test-get-adorned-bindings - (is (= (get-adorned-bindings (literal-predicate (adorned-literal pl #{:x}))) - #{:x})) - (is (= (get-adorned-bindings (literal-predicate pl)) - nil))) - -(deftest test-get-base-predicate - (is (= (get-base-predicate (literal-predicate (adorned-literal pl #{:x}))) - :fred)) - (is (= (get-base-predicate (literal-predicate pl)) - :fred))) - -(deftest test-magic-literal - (is (= (magic-literal pl) - {:predicate {:pred :fred :magic true}, :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal})) - (is (= (magic-literal (adorned-literal pl #{:x})) - {:predicate {:pred :fred :magic true :bound #{:x}}, - :term-bindings {:x '?x}, - :literal-type :clojure.contrib.datalog.literals/literal}))) - -(comment - (use 'clojure.contrib.stacktrace) (e) - (use :reload 'clojure.contrib.datalog.literals) -) - - -(def db1 (make-database - (relation :fred [:x :y]) - (index :fred :x) - (relation :sally [:x]))) - -(def db2 (add-tuples db1 - [:fred :x 1 :y :mary] - [:fred :x 1 :y :becky] - [:fred :x 3 :y :sally] - [:fred :x 4 :y :joe] - [:sally :x 1] - [:sally :x 2])) - -(def lit1 (eval (build-literal '(:fred :x ?x :y ?y)))) -(def lit2 (eval (build-literal '(not! :fred :x ?x)))) -(def lit3 (eval (build-literal '(if > ?x ?y)))) -(def lit4 (adorned-literal (eval (build-literal '(:joan :x ?x :y ?y))) #{:x})) - -(deftest test-join-literal - (is (= (set (join-literal db2 lit1 [{'?x 1} {'?x 2} {'?x 3}])) - #{{'?x 1, '?y :mary} {'?x 1, '?y :becky} {'?x 3, '?y :sally}})) - (is (= (join-literal db2 lit2 [{'?x 1} {'?x 2} {'?x 3}]) - [{'?x 2}])) - (is (= (join-literal db2 lit3 [{'?x 1 '?y 2} {'?x 3 '?y 1}]) - [{'?x 3 '?y 1}]))) - -(deftest test-project-literal - (is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) {:pred :joan :bound #{:x}}) - (datalog-relation - ;; Schema - #{:y :x} - - ;; Data - #{ - {:x 1, :y 3} - {:x 4, :y 2} - } - - ;; Indexes - { - :x - { - 4 - #{{:x 4, :y 2}} - 1 - #{{:x 1, :y 3}} - } - })))) - - - -(comment - (run-tests) -) - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/datalog/tests/test_magic.clj --- a/src/clojure/contrib/test_contrib/datalog/tests/test_magic.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,72 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; test-magic.clj -;; -;; A Clojure implementation of Datalog -- Magic Tests -;; -;; straszheimjeffrey (gmail) -;; Created 18 Feburary 2009 - -(ns clojure.contrib.datalog.tests.test-magic - (:use clojure.test) - (:use clojure.contrib.datalog.magic - clojure.contrib.datalog.rules)) - - - -(def rs (rules-set - (<- (:p :x ?x :y ?y) (:e :x ?x :y ?y)) - (<- (:p :x ?x :y ?y) (:e :x ?x :y ?z) (:p :x ?z :y ?y)) - (<- (:e :x ?x :y ?y) (:b :x ?x :y ?y)) - (<- (:e :x ?y :y ?y) (:c :x ?x :y ?y)))) - -(def q (adorn-query (?- :p :x 1 :y ?y))) - -(def ars (adorn-rules-set rs q)) - -(deftest test-adorn-rules-set - (is (= ars - (rules-set - (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?y :x ?x)) - (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?z :x ?x) - ({:pred :p :bound #{:x}} :y ?y :x ?z)) - (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) (:c :y ?y :x ?x)) - (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) (:b :y ?y :x ?x)))))) - - -(def m (magic-transform ars)) - -(deftest test-magic-transform - (is (= m - (rules-set - (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) ({:pred :e :magic true :bound #{:x}} :x ?y) (:c :y ?y :x ?x)) - - (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) ({:pred :e :magic true :bound #{:x}} :x ?x) (:b :y ?y :x ?x)) - - (<- ({:pred :p :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x) - ({:pred :e :bound #{:x}} :y ?z :x ?x)) - - (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) - ({:pred :e :bound #{:x}} :y ?z :x ?x) - ({:pred :p :bound #{:x}} :y ?y :x ?z)) - - (<- ({:pred :e :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)) - - (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) - ({:pred :e :bound #{:x}} :y ?y :x ?x)))))) - - - - -(comment - (run-tests) -) - -;; End of file - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/datalog/tests/test_rules.clj --- a/src/clojure/contrib/test_contrib/datalog/tests/test_rules.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,130 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; test-rules.clj -;; -;; A Clojure implementation of Datalog -- Rule Tests -;; -;; straszheimjeffrey (gmail) -;; Created 12 Feburary 2009 - - -(ns clojure.contrib.datalog.tests.test-rules - (:use clojure.test - clojure.contrib.datalog.rules - clojure.contrib.datalog.literals - clojure.contrib.datalog.database)) - - -(def tr-1 (<- (:fred :x ?x :y ?y) (:mary :x ?x :z ?z) (:sally :z ?z :y ?y))) -(def tr-2 (<- (:fred) (not! :mary :x 3))) -(def tr-3 (<- (:fred :x ?x :y ?y) (if > ?x ?y) (:mary :x ?x) (:sally :y ?y))) - - - -(deftest test-rule-safety - (is (thrown-with-msg? Exception #".*Head vars.*not bound.*" - (<- (:fred :x ?x) (:sally :y ?y)))) - (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*" - (<- (:fred :x ?x) (:becky :x ?x) (not! :sally :y ?y)))) - (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*" - (<- (:fred :x ?x) (:becky :x ?x) (if > ?x ?y))))) - - -(deftest test-sip - (is (= (compute-sip #{:x} #{:mary :sally} tr-1) - (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y) - ({:pred :mary :bound #{:x}} :z ?z :x ?x) - ({:pred :sally :bound #{:z}} :y ?y :z ?z)))) - - (is (= (compute-sip #{} #{:mary :sally} tr-1) - (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z)))) - - (is (= (compute-sip #{} #{:mary} tr-2) - (<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3)))) - - (is (= (compute-sip #{} #{} tr-2) - tr-2)) - - (is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3)) - (display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y) - ({:pred :mary :bound #{:x}} :x ?x) - (:sally :y ?y) - (if > ?x ?y)))))) - ; Display rule is used because = does not work on - ; (if > ?x ?y) because it contains a closure - - -(def rs - (rules-set - (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y)) - (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y)) - (<- (:edge :a ?x :b ?y) (:route :a ?x :b ?y) (if not= ?x ?y)))) - -(deftest test-rules-set - (is (= (count rs) 3)) - (is (contains? rs (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))))) - -(deftest test-predicate-map - (let [pm (predicate-map rs)] - (is (= (pm :path) - #{(<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y)) - (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))})) - (is (= (-> :edge pm count) 1)))) - - -(def db1 (make-database - (relation :fred [:x :y]) - (index :fred :x) - (relation :sally [:x]) - (relation :ben [:y]))) - -(def db2 (add-tuples db1 - [:fred :x 1 :y :mary] - [:fred :x 1 :y :becky] - [:fred :x 3 :y :sally] - [:fred :x 4 :y :joe] - [:fred :x 4 :y :bob] - [:sally :x 1] - [:sally :x 2] - [:sally :x 3] - [:sally :x 4] - [:ben :y :bob])) - - -(deftest test-apply-rule - (is (= (apply-rule db2 empty-database (<- (:becky :y ?y) (:sally :x ?x) - (:fred :x ?x :y ?y) - (not! :ben :y ?y) - (if not= ?x 3))) - (datalog-database - { - :becky - (datalog-relation - ;; Schema - #{:y} - ;; Data - #{ - {:y :joe} - {:y :mary} - {:y :becky} - } - ;; Indexes - { - }) - })))) - - - - -(comment - (run-tests) -) - -;; End of file - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/datalog/tests/test_softstrat.clj --- a/src/clojure/contrib/test_contrib/datalog/tests/test_softstrat.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,233 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; test-softstrat.clj -;; -;; A Clojure implementation of Datalog -- Soft Stratification Tests -;; -;; straszheimjeffrey (gmail) -;; Created 28 Feburary 2009 - -(ns clojure.contrib.datalog.tests.test-softstrat - (:use clojure.test) - (:use clojure.contrib.datalog.softstrat - clojure.contrib.datalog.magic - clojure.contrib.datalog.rules - clojure.contrib.datalog.database) - (:use [clojure.contrib.set :only (subset?)])) - - - -(def rs1 (rules-set - (<- (:p :x ?x) (:b :x ?x :y ?y :z ?z) (not! :q :x ?x) (not! :q :x ?y) (not! :q :x ?z)) - (<- (:q :x ?x) (:d :x ?x)))) - -(def q1 (?- :p :x 1)) - -(def ws (build-soft-strat-work-plan rs1 q1)) - -(deftest test-soft-stratification - (let [soft (:stratification ws) - q (:query ws)] - (is (= q (?- {:pred :p :bound #{:x}} :x 1))) - (is (= (count soft) 4)) - (is (subset? (rules-set - (<- ({:pred :q :bound #{:x}} :x ?x) ({:pred :q :magic true :bound #{:x}} :x ?x) - (:d :x ?x)) - - (<- ({:pred :q :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) - (:b :z ?z :y ?y :x ?x))) - (nth soft 0))) - (is (= (nth soft 1) - (rules-set - (<- ({:pred :q :magic true :bound #{:x}} :x ?y) ({:pred :p :magic true :bound #{:x}} :x ?x) - (:b :z ?z :y ?y :x ?x) - (not! {:pred :q :bound #{:x}} :x ?x))))) - (is (= (nth soft 2) - (rules-set - (<- ({:pred :q :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x) - (:b :z ?z :y ?y :x ?x) - (not! {:pred :q :bound #{:x}} :x ?x) - (not! {:pred :q :bound #{:x}} :x ?y))))) - (is (= (nth soft 3) - (rules-set - (<- ({:pred :p :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) - (:b :z ?z :y ?y :x ?x) - (not! {:pred :q :bound #{:x}} :x ?x) - (not! {:pred :q :bound #{:x}} :x ?y) - (not! {:pred :q :bound #{:x}} :x ?z))))))) - - -(def tdb-1 - (make-database - (relation :b [:x :y :z]) - (relation :d [:x]))) - -(def tdb-2 - (add-tuples tdb-1 - [:b :x 1 :y 2 :z 3])) - -(deftest test-tdb-2 - (is (= (evaluate-soft-work-set ws tdb-2 {}) - [{:x 1}]))) - - - -(def tdb-3 - (add-tuples tdb-2 - [:d :x 2] - [:d :x 3])) - -(deftest test-tdb-3 - (is (empty? (evaluate-soft-work-set ws tdb-3 {})))) - - - -;;;;;;;;;;; - - - -(def db-base - (make-database - (relation :employee [:id :name :position]) - (index :employee :name) - - (relation :boss [:employee-id :boss-id]) - (index :boss :employee-id) - - (relation :can-do-job [:position :job]) - (index :can-do-job :position) - - (relation :job-replacement [:job :can-be-done-by]) - - (relation :job-exceptions [:id :job]))) - -(def db - (add-tuples db-base - [:employee :id 1 :name "Bob" :position :boss] - [:employee :id 2 :name "Mary" :position :chief-accountant] - [:employee :id 3 :name "John" :position :accountant] - [:employee :id 4 :name "Sameer" :position :chief-programmer] - [:employee :id 5 :name "Lilian" :position :programmer] - [:employee :id 6 :name "Li" :position :technician] - [:employee :id 7 :name "Fred" :position :sales] - [:employee :id 8 :name "Brenda" :position :sales] - [:employee :id 9 :name "Miki" :position :project-management] - [:employee :id 10 :name "Albert" :position :technician] - - [:boss :employee-id 2 :boss-id 1] - [:boss :employee-id 3 :boss-id 2] - [:boss :employee-id 4 :boss-id 1] - [:boss :employee-id 5 :boss-id 4] - [:boss :employee-id 6 :boss-id 4] - [:boss :employee-id 7 :boss-id 1] - [:boss :employee-id 8 :boss-id 7] - [:boss :employee-id 9 :boss-id 1] - [:boss :employee-id 10 :boss-id 6] - - [:can-do-job :position :boss :job :management] - [:can-do-job :position :accountant :job :accounting] - [:can-do-job :position :chief-accountant :job :accounting] - [:can-do-job :position :programmer :job :programming] - [:can-do-job :position :chief-programmer :job :programming] - [:can-do-job :position :technician :job :server-support] - [:can-do-job :position :sales :job :sales] - [:can-do-job :position :project-management :job :project-management] - - [:job-replacement :job :pc-support :can-be-done-by :server-support] - [:job-replacement :job :pc-support :can-be-done-by :programming] - [:job-replacement :job :payroll :can-be-done-by :accounting] - - [:job-exceptions :id 4 :job :pc-support])) - -(def rules - (rules-set - (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id) - (:employee :id ?e-id :name ?x) - (:employee :id ?b-id :name ?y)) - (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z) - (:works-for :employee ?z :boss ?y)) - (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos) - (:can-do-job :position ?pos :job ?y)) - (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z) - (:employee-job* :employee ?x :job ?z)) - (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y) - (:employee :name ?x :position ?z) - (if = ?z :boss)) - (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y) - (:employee :id ?id :name ?x) - (not! :job-exceptions :id ?id :job ?y)) - (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y) - (not! :employee-job :employee ?y :job :pc-support)))) - - -(def ws-1 (build-soft-strat-work-plan rules (?- :works-for :employee '??name :boss ?x))) -(defn evaluate-1 [name] (set (evaluate-soft-work-set ws-1 db {'??name name}))) - -(deftest test-ws-1 - (is (= (evaluate-1 "Albert") - #{{:employee "Albert", :boss "Li"} - {:employee "Albert", :boss "Sameer"} - {:employee "Albert", :boss "Bob"}})) - (is (empty? (evaluate-1 "Bob"))) - (is (= (evaluate-1 "John") - #{{:employee "John", :boss "Bob"} - {:employee "John", :boss "Mary"}}))) - - -(def ws-2 (build-soft-strat-work-plan rules (?- :employee-job :employee '??name :job ?x))) -(defn evaluate-2 [name] (set (evaluate-soft-work-set ws-2 db {'??name name}))) - -(deftest test-ws-2 - (is (= (evaluate-2 "Albert") - #{{:employee "Albert", :job :pc-support} - {:employee "Albert", :job :server-support}})) - (is (= (evaluate-2 "Sameer") - #{{:employee "Sameer", :job :programming}})) - (is (= (evaluate-2 "Bob") - #{{:employee "Bob", :job :accounting} - {:employee "Bob", :job :management} - {:employee "Bob", :job :payroll} - {:employee "Bob", :job :pc-support} - {:employee "Bob", :job :project-management} - {:employee "Bob", :job :programming} - {:employee "Bob", :job :server-support} - {:employee "Bob", :job :sales}}))) - -(def ws-3 (build-soft-strat-work-plan rules (?- :bj :name '??name :boss ?x))) -(defn evaluate-3 [name] (set (evaluate-soft-work-set ws-3 db {'??name name}))) - -(deftest test-ws-3 - (is (= (evaluate-3 "Albert") - #{{:name "Albert", :boss "Sameer"}}))) - -(def ws-4 (build-soft-strat-work-plan rules (?- :works-for :name ?x :boss ?x))) - -(deftest test-ws-4 - (is (= (set (evaluate-soft-work-set ws-4 db {})) - #{{:employee "Miki", :boss "Bob"} - {:employee "Albert", :boss "Li"} - {:employee "Lilian", :boss "Sameer"} - {:employee "Li", :boss "Bob"} - {:employee "Lilian", :boss "Bob"} - {:employee "Brenda", :boss "Fred"} - {:employee "Fred", :boss "Bob"} - {:employee "John", :boss "Bob"} - {:employee "John", :boss "Mary"} - {:employee "Albert", :boss "Sameer"} - {:employee "Sameer", :boss "Bob"} - {:employee "Albert", :boss "Bob"} - {:employee "Brenda", :boss "Bob"} - {:employee "Mary", :boss "Bob"} - {:employee "Li", :boss "Sameer"}}))) - -(comment - (run-tests) -) - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/datalog/tests/test_util.clj --- a/src/clojure/contrib/test_contrib/datalog/tests/test_util.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,69 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; test-util.clj -;; -;; A Clojure implementation of Datalog -- Utilities Tests -;; -;; straszheimjeffrey (gmail) -;; Created 11 Feburary 2009 - -(ns clojure.contrib.datalog.tests.test-util - (:use clojure.test - clojure.contrib.datalog.util) - (:use [clojure.contrib.except :only (throwf)])) - -(deftest test-is-var? - (is (is-var? '?x)) - (is (is-var? '?)) - (is (not (is-var? '??x))) - (is (not (is-var? '??))) - (is (not (is-var? 'x))) - (is (not (is-var? "fred"))) - (is (not (is-var? :q)))) - -(deftest test-map-values - (let [map {:fred 1 :sally 2}] - (is (= (map-values #(* 2 %) map) {:fred 2 :sally 4})) - (is (= (map-values identity {}) {})))) - -(deftest test-keys-to-vals - (let [map {:fred 1 :sally 2 :joey 3}] - (is (= (set (keys-to-vals map [:fred :sally])) #{1 2})) - (is (= (set (keys-to-vals map [:fred :sally :becky])) #{1 2})) - (is (empty? (keys-to-vals map []))) - (is (empty? (keys-to-vals {} [:fred]))))) - -(deftest test-reverse-map - (let [map {:fred 1 :sally 2 :joey 3} - map-1 (assoc map :mary 3)] - (is (= (reverse-map map) {1 :fred 2 :sally 3 :joey})) - (is (or (= (reverse-map map-1) {1 :fred 2 :sally 3 :joey}) - (= (reverse-map map-1) {1 :fred 2 :sally 3 :mary}))))) - -(def some-maps - [ - { :a 1 :b 2 } - { :c 3 :b 3 } - { :d 4 :a 1 } - { :g 4 :b 4 } - { :a 2 :b 1 } - { :e 1 :f 1 } - ]) - -(def reduced (preduce + some-maps)) -(def merged (apply merge-with + some-maps)) - -(deftest test-preduce - (is (= reduced merged))) - -(comment - (run-tests) -) - -; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/miglayout/example.clj --- a/src/clojure/contrib/test_contrib/miglayout/example.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,60 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; clojure.contrib.miglayout.example -;; -;; A temperature converter using miglayout. Demonstrates accessing -;; components by their id constraint. -;; -;; scgilardi (gmail) -;; Created 31 May 2009 - -(ns clojure.contrib.miglayout.example - (:import (javax.swing JButton JFrame JLabel JPanel JTextField - SwingUtilities)) - (:use (clojure.contrib - [miglayout :only (miglayout components)] - [swing-utils :only (add-key-typed-listener)]))) - -(defn fahrenheit - "Converts a Celsius temperature to Fahrenheit. Input and output are - strings. Returns \"input?\" if the input can't be parsed as a Double." - [celsius] - (try - (format "%.2f" (+ 32 (* 1.8 (Double/parseDouble celsius)))) - (catch NumberFormatException _ "input?"))) - -(defn- handle-key - "Clears output on most keys, shows conversion on \"Enter\"" - [event out] - (.setText out - (if (= (.getKeyChar event) \newline) - (fahrenheit (-> event .getComponent .getText)) - ""))) - -(defn converter-ui - "Lays out and shows a Temperature Converter UI" - [] - (let [panel - (miglayout (JPanel.) - (JTextField. 6) {:id :input} - (JLabel. "\u00b0Celsius") :wrap - (JLabel.) {:id :output} - (JLabel. "\u00b0Fahrenheit")) - {:keys [input output]} (components panel)] - (add-key-typed-listener input handle-key output) - (doto (JFrame. "Temperature Converter") - (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE) - (.add panel) - (.pack) - (.setVisible true)))) - -(defn main - "Invokes converter-ui in the AWT Event thread" - [] - (SwingUtilities/invokeLater converter-ui)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/mock/test_adapter.clj --- a/src/clojure/contrib/test_contrib/mock/test_adapter.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -(ns clojure.contrib.test-contrib.mock-test.test-adapter-test - (:use clojure.contrib.mock.test-adapter - [clojure.contrib.test-contrib.mock-test :only (assert-called)] - clojure.test)) - -(deftest test-report-problem-called - (def #^{:private true :dynamic true} fn1 (fn [x] "dummy code")) - (def #^{:private true :dynamic true} fn2 (fn [x y] "dummy code2")) - (let [under-test (fn [x] (fn1 x))] - (assert-called clojure.contrib.mock.test-adapter/report-problem - true (expect [fn1 (times 5)] (under-test "hi"))))) - -(deftest test-is-report-called - (assert-called clojure.test/report true - (clojure.contrib.mock.test-adapter/report-problem - 'fn-name 5 6 "fake problem"))) - - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/monads/examples.clj --- a/src/clojure/contrib/test_contrib/monads/examples.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,425 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Monad application examples -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for using monads"} - clojure.contrib.monads.examples - (:use [clojure.contrib.monads - :only (domonad with-monad m-lift m-seq m-reduce m-when - sequence-m - maybe-m - state-m fetch-state set-state - writer-m write - cont-m run-cont call-cc - maybe-t)]) - (:require (clojure.contrib [accumulators :as accu]))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Sequence manipulations with the sequence monad -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; Note: in the Haskell world, this monad is called the list monad. -; The Clojure equivalent to Haskell's lists are (possibly lazy) -; sequences. This is why I call this monad "sequence". All sequences -; created by sequence monad operations are lazy. - -; Monad comprehensions in the sequence monad work exactly the same -; as Clojure's 'for' construct, except that :while clauses are not -; available. -(domonad sequence-m - [x (range 5) - y (range 3)] - (+ x y)) - -; Inside a with-monad block, domonad is used without the monad name. -(with-monad sequence-m - (domonad - [x (range 5) - y (range 3)] - (+ x y))) - -; Conditions are written with :when, as in Clojure's for form: -(domonad sequence-m - [x (range 5) - y (range (+ 1 x)) - :when (= (+ x y) 2)] - (list x y)) - -; :let is also supported like in for: -(domonad sequence-m - [x (range 5) - y (range (+ 1 x)) - :let [sum (+ x y) - diff (- x y)] - :when (= sum 2)] - (list diff)) - -; An example of a sequence function defined in terms of a lift operation. -(with-monad sequence-m - (defn pairs [xs] - ((m-lift 2 #(list %1 %2)) xs xs))) - -(pairs (range 5)) - -; Another way to define pairs is through the m-seq operation. It takes -; a sequence of monadic values and returns a monadic value containing -; the sequence of the underlying values, obtained from chaining together -; from left to right the monadic values in the sequence. -(with-monad sequence-m - (defn pairs [xs] - (m-seq (list xs xs)))) - -(pairs (range 5)) - -; This definition suggests a generalization: -(with-monad sequence-m - (defn ntuples [n xs] - (m-seq (replicate n xs)))) - -(ntuples 2 (range 5)) -(ntuples 3 (range 5)) - -; Lift operations can also be used inside a monad comprehension: -(domonad sequence-m - [x ((m-lift 1 (partial * 2)) (range 5)) - y (range 2)] - [x y]) - -; The m-plus operation does concatenation in the sequence monad. -(domonad sequence-m - [x ((m-lift 2 +) (range 5) (range 3)) - y (m-plus (range 2) '(10 11))] - [x y]) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Handling failures with the maybe monad -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; Maybe monad versions of basic arithmetic -(with-monad maybe-m - (def m+ (m-lift 2 +)) - (def m- (m-lift 2 -)) - (def m* (m-lift 2 *))) - -; Division is special for two reasons: we can't call it m/ because that's -; not a legal Clojure symbol, and we want it to fail if a division by zero -; is attempted. It is best defined by a monad comprehension with a -; :when clause: -(defn safe-div [x y] - (domonad maybe-m - [a x - b y - :when (not (zero? b))] - (/ a b))) - -; Now do some non-trivial computation with division -; It fails for (1) x = 0, (2) y = 0 or (3) y = -x. -(with-monad maybe-m - (defn some-function [x y] - (let [one (m-result 1)] - (safe-div one (m+ (safe-div one (m-result x)) - (safe-div one (m-result y))))))) - -; An example that doesn't fail: -(some-function 2 3) -; And two that do fail, at different places: -(some-function 2 0) -(some-function 2 -2) - -; In the maybe monad, m-plus selects the first monadic value that -; holds a valid value. -(with-monad maybe-m - (m-plus (some-function 2 0) (some-function 2 -2) (some-function 2 3))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Random numbers with the state monad -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; A state monad item represents a computation that changes a state and -; returns a value. Its structure is a function that takes a state argument -; and returns a two-item list containing the value and the updated state. -; It is important to realize that everything you put into a state monad -; expression is a state monad item (thus a function), and everything you -; get out as well. A state monad does not perform a calculation, it -; constructs a function that does the computation when called. - -; First, we define a simple random number generator with explicit state. -; rng is a function of its state (an integer) that returns the -; pseudo-random value derived from this state and the updated state -; for the next iteration. This is exactly the structure of a state -; monad item. -(defn rng [seed] - (let [m 259200 - value (/ (float seed) (float m)) - next (rem (+ 54773 (* 7141 seed)) m)] - [value next])) - -; We define a convenience function that creates an infinite lazy seq -; of values obtained from iteratively applying a state monad value. -(defn value-seq [f seed] - (lazy-seq - (let [[value next] (f seed)] - (cons value (value-seq f next))))) - -; Next, we define basic statistics functions to check our random numbers -(defn sum [xs] (apply + xs)) -(defn mean [xs] (/ (sum xs) (count xs))) -(defn variance [xs] - (let [m (mean xs) - sq #(* % %)] - (mean (for [x xs] (sq (- x m)))))) - -; rng implements a uniform distribution in the interval [0., 1.), so -; ideally, the mean would be 1/2 (0.5) and the variance 1/12 (0.8333). -(mean (take 1000 (value-seq rng 1))) -(variance (take 1000 (value-seq rng 1))) - -; We make use of the state monad to implement a simple (but often sufficient) -; approximation to a Gaussian distribution: the sum of 12 random numbers -; from rng's distribution, shifted by -6, has a distribution that is -; approximately Gaussian with 0 mean and variance 1, by virtue of the central -; limit theorem. -; In the first version, we call rng 12 times explicitly and calculate the -; shifted sum in a monad comprehension: -(def gaussian1 - (domonad state-m - [x1 rng - x2 rng - x3 rng - x4 rng - x5 rng - x6 rng - x7 rng - x8 rng - x9 rng - x10 rng - x11 rng - x12 rng] - (- (+ x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12) 6.))) - -; Let's test it: -(mean (take 1000 (value-seq gaussian1 1))) -(variance (take 1000 (value-seq gaussian1 1))) - -; Of course, we'd rather have a loop construct for creating the 12 -; random numbers. This would be easy if we could define a summation -; operation on random-number generators, which would then be used in -; combination with reduce. The lift operation gives us exactly that. -; More precisely, we need (m-lift 2 +), because we want both arguments -; of + to be lifted to the state monad: -(def gaussian2 - (domonad state-m - [sum12 (reduce (m-lift 2 +) (replicate 12 rng))] - (- sum12 6.))) - -; Such a reduction is often quite useful, so there's m-reduce predefined -; to simplify it: -(def gaussian2 - (domonad state-m - [sum12 (m-reduce + (replicate 12 rng))] - (- sum12 6.))) - -; The statistics should be strictly the same as above, as long as -; we use the same seed: -(mean (take 1000 (value-seq gaussian2 1))) -(variance (take 1000 (value-seq gaussian2 1))) - -; We can also do the subtraction of 6 in a lifted function, and get rid -; of the monad comprehension altogether: -(with-monad state-m - (def gaussian3 - ((m-lift 1 #(- % 6.)) - (m-reduce + (replicate 12 rng))))) - -; Again, the statistics are the same: -(mean (take 1000 (value-seq gaussian3 1))) -(variance (take 1000 (value-seq gaussian3 1))) - -; For a random point in two dimensions, we'd like a random number generator -; that yields a list of two random numbers. The m-seq operation can easily -; provide it: -(with-monad state-m - (def rng2 (m-seq (list rng rng)))) - -; Let's test it: -(rng2 1) - -; fetch-state and get-state can be used to save the seed of the random -; number generator and go back to that saved seed later on: -(def identical-random-seqs - (domonad state-m - [seed (fetch-state) - x1 rng - x2 rng - _ (set-state seed) - y1 rng - y2 rng] - (list [x1 x2] [y1 y2]))) - -(identical-random-seqs 1) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Logging with the writer monad -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; A basic logging example -(domonad (writer-m accu/empty-string) - [x (m-result 1) - _ (write "first step\n") - y (m-result 2) - _ (write "second step\n")] - (+ x y)) - -; For a more elaborate application, let's trace the recursive calls of -; a naive implementation of a Fibonacci function. The starting point is: -(defn fib [n] - (if (< n 2) - n - (let [n1 (dec n) - n2 (dec n1)] - (+ (fib n1) (fib n2))))) - -; First we rewrite it to make every computational step explicit -; in a let expression: -(defn fib [n] - (if (< n 2) - n - (let [n1 (dec n) - n2 (dec n1) - f1 (fib n1) - f2 (fib n2)] - (+ f1 f2)))) - -; Next, we replace the let by a domonad in a writer monad that uses a -; vector accumulator. We can then place calls to write in between the -; steps, and obtain as a result both the return value of the function -; and the accumulated trace values. -(with-monad (writer-m accu/empty-vector) - - (defn fib-trace [n] - (if (< n 2) - (m-result n) - (domonad - [n1 (m-result (dec n)) - n2 (m-result (dec n1)) - f1 (fib-trace n1) - _ (write [n1 f1]) - f2 (fib-trace n2) - _ (write [n2 f2]) - ] - (+ f1 f2)))) - -) - -(fib-trace 5) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Sequences with undefined value: the maybe-t monad transformer -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; A monad transformer is a function that takes a monad argument and -; returns a monad as its result. The resulting monad adds some -; specific behaviour aspect to the input monad. - -; The simplest monad transformer is maybe-t. It adds the functionality -; of the maybe monad (handling failures or undefined values) to any other -; monad. We illustrate this by applying maybe-t to the sequence monad. -; The result is an enhanced sequence monad in which undefined values -; (represented by nil) are not subjected to any transformation, but -; lead immediately to a nil result in the output. - -; First we define the combined monad: -(def seq-maybe-m (maybe-t sequence-m)) - -; As a first illustration, we create a range of integers and replace -; all even values by nil, using a simple when expression. We use this -; sequence in a monad comprehension that yields (inc x). The result -; is a sequence in which inc has been applied to all non-nil values, -; whereas the nil values appear unmodified in the output: -(domonad seq-maybe-m - [x (for [n (range 10)] (when (odd? n) n))] - (inc x)) - -; Next we repeat the definition of the function pairs (see above), but -; using the seq-maybe monad: -(with-monad seq-maybe-m - (defn pairs-maybe [xs] - (m-seq (list xs xs)))) - -; Applying this to a sequence containing nils yields the pairs of all -; non-nil values interspersed with nils that result from any combination -; in which one or both of the values is nil: -(pairs-maybe (for [n (range 5)] (when (odd? n) n))) - -; It is important to realize that undefined values (nil) are not eliminated -; from the iterations. They are simply not passed on to any operations. -; The outcome of any function applied to arguments of which at least one -; is nil is supposed to be nil as well, and the function is never called. - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Continuation-passing style in the cont monad -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; A simple computation performed in continuation-passing style. -; (m-result 1) returns a function that, when called with a single -; argument f, calls (f 1). The result of the domonad-computation is -; a function that behaves in the same way, passing 3 to its function -; argument. run-cont executes a continuation by calling it on identity. -(run-cont - (domonad cont-m - [x (m-result 1) - y (m-result 2)] - (+ x y))) - -; Let's capture a continuation using call-cc. We store it in a global -; variable so that we can do with it whatever we want. The computation -; is the same one as in the first example, but it has the side effect -; of storing the continuation at (m-result 2). -(def continuation nil) - -(run-cont - (domonad cont-m - [x (m-result 1) - y (call-cc (fn [c] (def continuation c) (c 2)))] - (+ x y))) - -; Now we can call the continuation with whatever argument we want. The -; supplied argument takes the place of 2 in the above computation: -(run-cont (continuation 5)) -(run-cont (continuation 42)) -(run-cont (continuation -1)) - -; Next, a function that illustrates how a captured continuation can be -; used as an "emergency exit" out of a computation: -(defn sqrt-as-str [x] - (call-cc - (fn [k] - (domonad cont-m - [_ (m-when (< x 0) (k (str "negative argument " x)))] - (str (. Math sqrt x)))))) - -(run-cont (sqrt-as-str 2)) -(run-cont (sqrt-as-str -2)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/pprint/examples/hexdump.clj --- a/src/clojure/contrib/test_contrib/pprint/examples/hexdump.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,63 +0,0 @@ -;;; hexdump.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This example is a classic hexdump program written using cl-format. - -;; For some local color, it was written in Dulles Airport while waiting for a flight -;; home to San Francisco. - -(ns clojure.contrib.pprint.examples.hexdump - (:use clojure.contrib.pprint - clojure.contrib.pprint.utilities) - (:gen-class (:main true))) - -(def *buffer-length* 1024) - -(defn zip-array [base-offset arr] - (let [grouped (partition 16 arr)] - (first (map-passing-context - (fn [line offset] - [[offset - (map #(if (neg? %) (+ % 256) %) line) - (- 16 (count line)) - (map #(if (<= 32 % 126) (char %) \.) line)] - (+ 16 offset)]) - base-offset grouped)))) - - -(defn hexdump - ([in-stream] (hexdump in-stream true 0)) - ([in-stream out-stream] (hexdump [in-stream out-stream 0])) - ([in-stream out-stream offset] - (let [buf (make-array Byte/TYPE *buffer-length*)] - (loop [offset offset - count (.read in-stream buf)] - (if (neg? count) - nil - (let [bytes (take count buf) - zipped (zip-array offset bytes)] - (cl-format out-stream - "~:{~8,'0X: ~2{~8@{~#[ ~:;~2,'0X ~]~} ~}~v@{ ~}~2{~8@{~A~} ~}~%~}" - zipped) - (recur (+ offset *buffer-length*) (.read in-stream buf)))))))) - -(defn hexdump-file - ([file-name] (hexdump-file file-name true)) - ([file-name stream] - (with-open [s (java.io.FileInputStream. file-name)] - (hexdump s)))) - -;; I don't quite understand how to invoke main funcs w/o AOT yet -(defn -main [& args] - (hexdump-file (first args))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/pprint/examples/json.clj --- a/src/clojure/contrib/test_contrib/pprint/examples/json.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,142 +0,0 @@ -;;; json.clj: A pretty printing version of the JavaScript Object Notation (JSON) generator - -;; by Tom Faulhaber, based on the version by Stuart Sierra (clojure.contrib.json.write) -;; May 9, 2009 - -;; Copyright (c) Tom Faulhaber/Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(ns - #^{:author "Tom Faulhaber (based on the version by Stuart Sierra)", - :doc "Pretty printing JavaScript Object Notation (JSON) generator. - -This is an example of using a pretty printer dispatch function to generate JSON output", - :see-also [["http://json.org/", "JSON Home Page"]]} - clojure.contrib.pprint.examples.json - (:use [clojure.test :only (deftest- is)] - [clojure.contrib.string :only (as-str)] - [clojure.contrib.pprint :only (write formatter-out)])) - - - -(defmulti dispatch-json - "The dispatch function for printing objects as JSON" - {:arglists '[[x]]} - (fn [x] (cond - (nil? x) nil ;; prevent NullPointerException on next line - (.isArray (class x)) ::array - :else (type x)))) - -;; Primitive types can be printed with Clojure's pr function. -(derive java.lang.Boolean ::pr) -(derive java.lang.Byte ::pr) -(derive java.lang.Short ::pr) -(derive java.lang.Integer ::pr) -(derive java.lang.Long ::pr) -(derive java.lang.Float ::pr) -(derive java.lang.Double ::pr) - -;; Collection types can be printed as JSON objects or arrays. -(derive java.util.Map ::object) -(derive java.util.Collection ::array) - -;; Symbols and keywords are converted to strings. -(derive clojure.lang.Symbol ::symbol) -(derive clojure.lang.Keyword ::symbol) - - -(defmethod dispatch-json ::pr [x] (pr x)) - -(defmethod dispatch-json nil [x] (print "null")) - -(defmethod dispatch-json ::symbol [x] (pr (name x))) - -(defmethod dispatch-json ::array [s] - ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s)) - -(defmethod dispatch-json ::object [m] - ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") - (for [[k v] m] [(as-str k) v]))) - -(defmethod dispatch-json java.lang.CharSequence [s] - (print \") - (dotimes [i (count s)] - (let [cp (Character/codePointAt s i)] - (cond - ;; Handle printable JSON escapes before ASCII - (= cp 34) (print "\\\"") - (= cp 92) (print "\\\\") - ;; Print simple ASCII characters - (< 31 cp 127) (print (.charAt s i)) - ;; Handle non-printable JSON escapes - (= cp 8) (print "\\b") - (= cp 12) (print "\\f") - (= cp 10) (print "\\n") - (= cp 13) (print "\\r") - (= cp 9) (print "\\t") - ;; Any other character is printed as Hexadecimal escape - :else (printf "\\u%04x" cp)))) - (print \")) - -(defn print-json - "Prints x as JSON. Nil becomes JSON null. Keywords become - strings, without the leading colon. Maps become JSON objects, all - other collection types become JSON arrays. Java arrays become JSON - arrays. Unicode characters in strings are escaped as \\uXXXX. - Numbers print as with pr." - [x] - (write x :dispatch dispatch-json)) - -(defn json-str - "Converts x to a JSON-formatted string." - [x] - (with-out-str (print-json x))) - - - -;;; TESTS - -;; Run these tests with -;; (clojure.test/run-tests 'clojure.contrib.print-json) - -;; Bind clojure.test/*load-tests* to false to omit these -;; tests from production code. - -(deftest- can-print-json-strings - (is (= "\"Hello, World!\"" (json-str "Hello, World!"))) - (is (= "\"\\\"Embedded\\\" Quotes\"" (json-str "\"Embedded\" Quotes")))) - -(deftest- can-print-unicode - (is (= "\"\\u1234\\u4567\"" (json-str "\u1234\u4567")))) - -(deftest- can-print-json-null - (is (= "null" (json-str nil)))) - -(deftest- can-print-json-arrays - (is (= "[1, 2, 3]" (json-str [1 2 3]))) - (is (= "[1, 2, 3]" (json-str (list 1 2 3)))) - (is (= "[1, 2, 3]" (json-str (sorted-set 1 2 3)))) - (is (= "[1, 2, 3]" (json-str (seq [1 2 3]))))) - -(deftest- can-print-java-arrays - (is (= "[1, 2, 3]" (json-str (into-array [1 2 3]))))) - -(deftest- can-print-empty-arrays - (is (= "[]" (json-str []))) - (is (= "[]" (json-str (list)))) - (is (= "[]" (json-str #{})))) - -(deftest- can-print-json-objects - (is (= "{\"a\":1, \"b\":2}" (json-str (sorted-map :a 1 :b 2))))) - -(deftest- object-keys-must-be-strings - (is (= "{\"1\":1, \"2\":2}" (json-str (sorted-map 1 1 2 2))))) - -(deftest- can-print-empty-objects - (is (= "{}" (json-str {})))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/pprint/examples/multiply.clj --- a/src/clojure/contrib/test_contrib/pprint/examples/multiply.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,23 +0,0 @@ -;;; multiply.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This example prints a multiplication table using cl-format. - -(ns clojure.contrib.pprint.examples.multiply - (:use clojure.contrib.pprint)) - -(defn multiplication-table [limit] - (let [nums (range 1 (inc limit))] - (cl-format true "~{~{~4d~}~%~}" - (map #(map % nums) - (map #(partial * %) nums))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/pprint/examples/props.clj --- a/src/clojure/contrib/test_contrib/pprint/examples/props.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,25 +0,0 @@ -;;; props.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This example displays a nicely formatted table of the java properties using -;; cl-format - -(ns clojure.contrib.pprint.examples.props - (:use clojure.contrib.pprint)) - -(defn show-props [stream] - (let [p (mapcat - #(vector (key %) (val %)) - (sort-by key (System/getProperties)))] - (cl-format true "~30A~A~%~{~20,,,'-A~10A~}~%~{~30A~S~%~}" - "Property" "Value" ["" "" "" ""] p))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/pprint/examples/show_doc.clj --- a/src/clojure/contrib/test_contrib/pprint/examples/show_doc.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,50 +0,0 @@ -;;; show_doc.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This example uses cl-format as part of a routine to display all the doc -;; strings and function arguments from one or more namespaces. - -(ns clojure.contrib.pprint.examples.show-doc - (:use clojure.contrib.pprint)) - -(defn ns-list - ([] (ns-list nil)) - ([pattern] - (filter - (if pattern - (comp (partial re-find pattern) name ns-name) - (constantly true)) - (sort-by ns-name (all-ns))))) - -(defn show-doc - ([] (show-doc nil)) - ([pattern] - (cl-format - true - "~:{~A: ===============================================~ - ~%~{~{~a: ~{~a~^, ~}~%~a~%~}~^~%~}~2%~}" - (map - #(vector (ns-name %) - (map - (fn [f] - (let [f-meta (meta (find-var (symbol (str (ns-name %)) (str f))))] - [f (:arglists f-meta) (:doc f-meta)])) - (filter - (fn [a] (instance? clojure.lang.IFn a)) - (sort (map key (ns-publics %)))))) - (ns-list pattern))))) - -(defn create-api-file [pattern out-file] - (with-open [f (java.io.FileWriter. out-file)] - (binding [*out* f] - (show-doc pattern)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/pprint/examples/xml.clj --- a/src/clojure/contrib/test_contrib/pprint/examples/xml.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,121 +0,0 @@ -;;; xml.clj -- a pretty print dispatch version of prxml.clj -- a compact syntax for generating XML - -;; by Tom Faulhaber, based on the original by Stuart Sierra, http://stuartsierra.com/ -;; May 13, 2009 - -;; Copyright (c) 2009 Tom Faulhaber/Stuart Sierra. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; See function "prxml" at the bottom of this file for documentation. - - -(ns - #^{:author "Tom Faulhaber, based on the original by Stuart Sierra", - :doc "A version of prxml that uses a pretty print dispatch function."} - clojure.contrib.pprint.examples.xml - (:use [clojure.contrib.string :only (as-str escape)] - [clojure.contrib.pprint :only (formatter-out write)] - [clojure.contrib.pprint.utilities :only (prlabel)])) - -(def - #^{:doc "If true, empty tags will have a space before the closing />"} - *html-compatible* false) - -(def - #^{:doc "The number of spaces to indent sub-tags."} - *prxml-indent* 2) - -(defmulti #^{:private true} print-xml-tag (fn [tag attrs content] tag)) - -(defmethod print-xml-tag :raw! [tag attrs contents] - (doseq [c contents] (print c))) - -(defmethod print-xml-tag :comment! [tag attrs contents] - (print "")) - -(defmethod print-xml-tag :decl! [tag attrs contents] - (let [attrs (merge {:version "1.0" :encoding "UTF-8"} - attrs)] - ;; Must enforce ordering of pseudo-attributes: - ((formatter-out "") - (:version attrs) (:encoding attrs) (:standalone attrs)))) - -(defmethod print-xml-tag :cdata! [tag attrs contents] - ((formatter-out "<[!CDATA[~{~a~}]]>") contents)) - -(defmethod print-xml-tag :doctype! [tag attrs contents] - ((formatter-out "<[!DOCTYPE [~{~a~}]]>") contents)) - -(defmethod print-xml-tag :default [tag attrs contents] - (let [tag-name (as-str tag) - xlated-attrs (map #(vector (as-str (key %)) (as-str (val %))) attrs)] - (if (seq contents) - ((formatter-out "~<~<<~a~1:i~{ ~:_~{~a=\"~a\"~}~}>~:>~vi~{~_~w~}~0i~_~:>") - [[tag-name xlated-attrs] *prxml-indent* contents tag-name]) - ((formatter-out "~<<~a~1:i~{~:_ ~{~a=\"~a\"~}~}/>~:>") [tag-name xlated-attrs])))) - - -(defmulti xml-dispatch class) - -(defmethod xml-dispatch clojure.lang.IPersistentVector [x] - (let [[tag & contents] x - [attrs content] (if (map? (first contents)) - [(first contents) (rest contents)] - [{} contents])] - (print-xml-tag tag attrs content))) - -(defmethod xml-dispatch clojure.lang.ISeq [x] - ;; Recurse into sequences, so we can use (map ...) inside prxml. - (doseq [c x] (xml-dispatch c))) - -(defmethod xml-dispatch clojure.lang.Keyword [x] - (print-xml-tag x {} nil)) - - -(defmethod xml-dispatch String [x] - (print (escape {\< "<" - \> ">" - \& "&" - \' "'" - \" """} x))) - -(defmethod xml-dispatch nil [x]) - -(defmethod xml-dispatch :default [x] - (print x)) - - -(defn prxml - "Print XML to *out*. Vectors become XML tags: the first item is the - tag name; optional second item is a map of attributes. - - Sequences are processed recursively, so you can use map and other - sequence functions inside prxml. - - (prxml [:p {:class \"greet\"} [:i \"Ladies & gentlemen\"]]) - ; =>

Ladies & gentlemen

- - PSEUDO-TAGS: some keywords have special meaning: - - :raw! do not XML-escape contents - :comment! create an XML comment - :decl! create an XML declaration, with attributes - :cdata! create a CDATA section - :doctype! create a DOCTYPE! - - (prxml [:p [:raw! \"here & gone\"]]) - ; =>

here & gone

- - (prxml [:decl! {:version \"1.1\"}]) - ; => " - [& args] - (doseq [arg args] (write arg :dispatch xml-dispatch)) - (when (pos? (count args)) (newline))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/pprint/test_cl_format.clj --- a/src/clojure/contrib/test_contrib/pprint/test_cl_format.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,691 +0,0 @@ -;;; cl_format.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This test set tests the basic cl-format functionality - -(ns clojure.contrib.pprint.test-cl-format - (:refer-clojure :exclude [format]) - (:use [clojure.test :only (deftest are run-tests)] - clojure.contrib.pprint.test-helper - clojure.contrib.pprint)) - -(def format cl-format) - -;; TODO tests for ~A, ~D, etc. -;; TODO add tests for ~F, etc.: 0.0, 9.9999 with rounding, 9.9999E99 with rounding - -(simple-tests d-tests - (cl-format nil "~D" 0) "0" - (cl-format nil "~D" 2e6) "2000000" - (cl-format nil "~D" 2000000) "2000000" - (cl-format nil "~:D" 2000000) "2,000,000" - (cl-format nil "~D" 1/2) "1/2" - (cl-format nil "~D" 'fred) "fred" -) - -(simple-tests base-tests - (cl-format nil "~{~2r~^ ~}~%" (range 10)) - "0 1 10 11 100 101 110 111 1000 1001\n" - (with-out-str - (dotimes [i 35] - (binding [*print-base* (+ i 2)] ;print the decimal number 40 - (write 40) ;in each base from 2 to 36 - (if (zero? (mod i 10)) (prn) (cl-format true " "))))) - "101000 -1111 220 130 104 55 50 44 40 37 34 -31 2c 2a 28 26 24 22 20 1j 1i -1h 1g 1f 1e 1d 1c 1b 1a 19 18 -17 16 15 14 " - (with-out-str - (doseq [pb [2 3 8 10 16]] - (binding [*print-radix* true ;print the integer 10 and - *print-base* pb] ;the ratio 1/10 in bases 2, - (cl-format true "~&~S ~S~%" 10 1/10)))) ;3, 8, 10, 16 - "#b1010 #b1/1010 -#3r101 #3r1/101 -#o12 #o1/12 -10. #10r1/10 -#xa #x1/a -") - - - -(simple-tests cardinal-tests - (cl-format nil "~R" 0) "zero" - (cl-format nil "~R" 4) "four" - (cl-format nil "~R" 15) "fifteen" - (cl-format nil "~R" -15) "minus fifteen" - (cl-format nil "~R" 25) "twenty-five" - (cl-format nil "~R" 20) "twenty" - (cl-format nil "~R" 200) "two hundred" - (cl-format nil "~R" 203) "two hundred three" - - (cl-format nil "~R" 44879032) - "forty-four million, eight hundred seventy-nine thousand, thirty-two" - - (cl-format nil "~R" -44879032) - "minus forty-four million, eight hundred seventy-nine thousand, thirty-two" - - (cl-format nil "~R = ~:*~:D" 44000032) - "forty-four million, thirty-two = 44,000,032" - - (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) - "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-four = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" - - (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475 = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" - - (cl-format nil "~R = ~:*~:D" 2e6) - "two million = 2,000,000" - - (cl-format nil "~R = ~:*~:D" 200000200000) - "two hundred billion, two hundred thousand = 200,000,200,000") - -(simple-tests ordinal-tests - (cl-format nil "~:R" 0) "zeroth" - (cl-format nil "~:R" 4) "fourth" - (cl-format nil "~:R" 15) "fifteenth" - (cl-format nil "~:R" -15) "minus fifteenth" - (cl-format nil "~:R" 25) "twenty-fifth" - (cl-format nil "~:R" 20) "twentieth" - (cl-format nil "~:R" 200) "two hundredth" - (cl-format nil "~:R" 203) "two hundred third" - - (cl-format nil "~:R" 44879032) - "forty-four million, eight hundred seventy-nine thousand, thirty-second" - - (cl-format nil "~:R" -44879032) - "minus forty-four million, eight hundred seventy-nine thousand, thirty-second" - - (cl-format nil "~:R = ~:*~:D" 44000032) - "forty-four million, thirty-second = 44,000,032" - - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) - "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-fourth = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475th = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593471) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471st = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471" - (cl-format nil "~:R = ~:*~:D" 2e6) - "two millionth = 2,000,000") - -(simple-tests ordinal1-tests - (cl-format nil "~:R" 1) "first" - (cl-format nil "~:R" 11) "eleventh" - (cl-format nil "~:R" 21) "twenty-first" - (cl-format nil "~:R" 20) "twentieth" - (cl-format nil "~:R" 220) "two hundred twentieth" - (cl-format nil "~:R" 200) "two hundredth" - (cl-format nil "~:R" 999) "nine hundred ninety-ninth" - ) - -(simple-tests roman-tests - (cl-format nil "~@R" 3) "III" - (cl-format nil "~@R" 4) "IV" - (cl-format nil "~@R" 9) "IX" - (cl-format nil "~@R" 29) "XXIX" - (cl-format nil "~@R" 429) "CDXXIX" - (cl-format nil "~@:R" 429) "CCCCXXVIIII" - (cl-format nil "~@:R" 3429) "MMMCCCCXXVIIII" - (cl-format nil "~@R" 3429) "MMMCDXXIX" - (cl-format nil "~@R" 3479) "MMMCDLXXIX" - (cl-format nil "~@R" 3409) "MMMCDIX" - (cl-format nil "~@R" 300) "CCC" - (cl-format nil "~@R ~D" 300 20) "CCC 20" - (cl-format nil "~@R" 5000) "5,000" - (cl-format nil "~@R ~D" 5000 20) "5,000 20" - (cl-format nil "~@R" "the quick") "the quick") - -(simple-tests c-tests - (cl-format nil "~{~c~^, ~}~%" "hello") "h, e, l, l, o\n" - (cl-format nil "~{~:c~^, ~}~%" "hello") "h, e, l, l, o\n" - (cl-format nil "~@C~%" \m) "\\m\n" - (cl-format nil "~@C~%" (char 222)) "\\Þ\n" - (cl-format nil "~@C~%" (char 8)) "\\backspace\n" - (cl-format nil "~@C~%" (char 3)) "\\\n") - -(simple-tests e-tests - (cl-format nil "*~E*" 0.0) "*0.0E+0*" - (cl-format nil "*~6E*" 0.0) "*0.0E+0*" - (cl-format nil "*~6,0E*" 0.0) "* 0.E+0*" - (cl-format nil "*~7,2E*" 0.0) "*0.00E+0*" - (cl-format nil "*~5E*" 0.0) "*0.E+0*" - (cl-format nil "*~10,2,2,,'?E*" 2.8E120) "*??????????*" - (cl-format nil "*~10,2E*" 9.99999) "* 1.00E+1*" - (cl-format nil "*~10,2E*" 9.99999E99) "* 1.00E+100*" - (cl-format nil "*~10,2,2E*" 9.99999E99) "* 1.00E+100*" - (cl-format nil "*~10,2,2,,'?E*" 9.99999E99) "*??????????*" - ) - -(simple-tests $-tests - (cl-format nil "~$" 22.3) "22.30" - (cl-format nil "~$" 22.375) "22.38" - (cl-format nil "~3,5$" 22.375) "00022.375" - (cl-format nil "~3,5,8$" 22.375) "00022.375" - (cl-format nil "~3,5,10$" 22.375) " 00022.375" - (cl-format nil "~3,5,14@$" 22.375) " +00022.375" - (cl-format nil "~3,5,14@$" 22.375) " +00022.375" - (cl-format nil "~3,5,14@:$" 22.375) "+ 00022.375" - (cl-format nil "~3,,14@:$" 0.375) "+ 0.375" - (cl-format nil "~1,1$" -12.0) "-12.0" - (cl-format nil "~1,1$" 12.0) "12.0" - (cl-format nil "~1,1$" 12.0) "12.0" - (cl-format nil "~1,1@$" 12.0) "+12.0" - (cl-format nil "~1,1,8,' @:$" 12.0) "+ 12.0" - (cl-format nil "~1,1,8,' @$" 12.0) " +12.0" - (cl-format nil "~1,1,8,' :$" 12.0) " 12.0" - (cl-format nil "~1,1,8,' $" 12.0) " 12.0" - (cl-format nil "~1,1,8,' @:$" -12.0) "- 12.0" - (cl-format nil "~1,1,8,' @$" -12.0) " -12.0" - (cl-format nil "~1,1,8,' :$" -12.0) "- 12.0" - (cl-format nil "~1,1,8,' $" -12.0) " -12.0" - (cl-format nil "~1,1$" 0.001) "0.0" - (cl-format nil "~2,1$" 0.001) "0.00" - (cl-format nil "~1,1,6$" 0.001) " 0.0" - (cl-format nil "~1,1,6$" 0.0015) " 0.0" - (cl-format nil "~2,1,6$" 0.005) " 0.01" - (cl-format nil "~2,1,6$" 0.01) " 0.01" - (cl-format nil "~$" 0.099) "0.10" - (cl-format nil "~1$" 0.099) "0.1" - (cl-format nil "~1$" 0.1) "0.1" - (cl-format nil "~1$" 0.99) "1.0" - (cl-format nil "~1$" -0.99) "-1.0") - -(simple-tests f-tests - (cl-format nil "~,1f" -12.0) "-12.0" - (cl-format nil "~,0f" 9.4) "9." - (cl-format nil "~,0f" 9.5) "10." - (cl-format nil "~,0f" -0.99) "-1." - (cl-format nil "~,1f" -0.99) "-1.0" - (cl-format nil "~,2f" -0.99) "-0.99" - (cl-format nil "~,3f" -0.99) "-0.990" - (cl-format nil "~,0f" 0.99) "1." - (cl-format nil "~,1f" 0.99) "1.0" - (cl-format nil "~,2f" 0.99) "0.99" - (cl-format nil "~,3f" 0.99) "0.990" - (cl-format nil "~f" -1) "-1.0" - (cl-format nil "~2f" -1) "-1." - (cl-format nil "~3f" -1) "-1." - (cl-format nil "~4f" -1) "-1.0" - (cl-format nil "~8f" -1) " -1.0" - (cl-format nil "~1,1f" 0.1) ".1") - -(simple-tests ampersand-tests - (cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5) - "The quick brown elephant jumped over 5 lazy dogs" - (cl-format nil "The quick brown ~&~a jumped over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped over 5 lazy dogs" - (cl-format nil "The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~3&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "\n\nThe quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~@{~&The quick brown ~a jumped over ~d lazy dogs~}" 'elephant 5 'fox 10) - "The quick brown elephant jumped over 5 lazy dogs\nThe quick brown fox jumped over 10 lazy dogs" - (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 1) "I d\no have one\n") - -(simple-tests t-tests - (cl-format nil "~@{~&~A~8,4T~:*~A~}" - 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" - (cl-format nil "~@{~&~A~,4T~:*~A~}" - 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" - (cl-format nil "~@{~&~A~2,6@T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" -) - -(simple-tests paren-tests - (cl-format nil "~(PLEASE SPEAK QUIETLY IN HERE~)") "please speak quietly in here" - (cl-format nil "~@(PLEASE SPEAK QUIETLY IN HERE~)") "Please speak quietly in here" - (cl-format nil "~@:(but this Is imporTant~)") "BUT THIS IS IMPORTANT" - (cl-format nil "~:(the greAt gatsby~)!") "The Great Gatsby!" - ;; Test cases from CLtL 18.3 - string-upcase, et al. - (cl-format nil "~@:(~A~)" "Dr. Livingstone, I presume?") "DR. LIVINGSTONE, I PRESUME?" - (cl-format nil "~(~A~)" "Dr. Livingstone, I presume?") "dr. livingstone, i presume?" - (cl-format nil "~:(~A~)" " hello ") " Hello " - (cl-format nil "~:(~A~)" "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") - "Occluded Casements Forestall Inadvertent Defenestration" - (cl-format nil "~:(~A~)" 'kludgy-hash-search) "Kludgy-Hash-Search" - (cl-format nil "~:(~A~)" "DON'T!") "Don'T!" ;not "Don't!" - (cl-format nil "~:(~A~)" "pipe 13a, foo16c") "Pipe 13a, Foo16c" -) - -(simple-tests square-bracket-tests - ;; Tests for format without modifiers - (cl-format nil "I ~[don't ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~]have one~%" 1) "I have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 1) "I do have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 2) "I have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 1) "I do have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 2) "I do have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 700) "I do have one\n" - - ;; Tests for format with a colon - (cl-format nil "I ~:[don't ~;do ~]have one~%" true) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" 700) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" '(a b)) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" nil) "I don't have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" false) "I don't have one\n" - - ;; Tests for format with an at sign - (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 nil) "We had 15 wins.\n" - (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 17) - "We had 15 wins (out of 17 tries).\n" - - ;; Format tests with directives - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 0, 7) - "Max 15: Blue team 7.\n" - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 1, 12) - "Max 15: Red team 12.\n" - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" - 15, -1, "(system failure)") - "Max 15: No team (system failure).\n" - - ;; Nested format tests - (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" - 15, 0, 7, true) - "Max 15: Blue team 7 (complete success).\n" - (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" - 15, 0, 7, false) - "Max 15: Blue team 7.\n" - - ;; Test the selector as part of the argument - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~].") - "The answer is nothing." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 4) - "The answer is 4." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 7 22) - "The answer is 7 out of 22." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 1 2 3 4) - "The answer is something crazy." -) - -(simple-tests curly-brace-plain-tests - ;; Iteration from sublist - (cl-format nil "Coordinates are~{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) - "Coordinates are\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) - "Coordinates are none\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3 1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~{~:}~%" "" []) - "Coordinates are\n" - - (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3 1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) - "Coordinates are none\n" -) - - -(simple-tests curly-brace-colon-tests - ;; Iteration from list of sublists - (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) - "Coordinates are\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) - "Coordinates are none\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [[2 3] [1]]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~:{~:}~%" "" []) - "Coordinates are\n" - - (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [[2 3] [1]]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) - "Coordinates are none\n" -) - -(simple-tests curly-brace-at-tests - ;; Iteration from main list - (cl-format nil "Coordinates are~@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") - "Coordinates are none\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" 2 3 1) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@{~:}~%" "") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" 2 3 1) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") - "Coordinates are none\n" -) - -(simple-tests curly-brace-colon-at-tests - ;; Iteration from sublists on the main arg list - (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1] ) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") - "Coordinates are none\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3] [1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@:{~:}~%" "") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3] [1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") - "Coordinates are none\n" -) - -;; TODO tests for ~^ in ~[ constructs and other brackets -;; TODO test ~:^ generates an error when used improperly -;; TODO test ~:^ works in ~@:{...~} -(let [aseq '(a quick brown fox jumped over the lazy dog) - lseq (mapcat identity (for [x aseq] [x (.length (name x))]))] - (simple-tests up-tests - (cl-format nil "~{~a~^, ~}" aseq) "a, quick, brown, fox, jumped, over, the, lazy, dog" - (cl-format nil "~{~a~0^, ~}" aseq) "a" - (cl-format nil "~{~a~#,3^, ~}" aseq) "a, quick, brown, fox, jumped, over" - (cl-format nil "~{~a~v,3^, ~}" lseq) "a, quick, brown, fox" - (cl-format nil "~{~a~3,v,4^, ~}" lseq) "a, quick, brown, fox" -)) - -(simple-tests angle-bracket-tests - (cl-format nil "~") "foobarbaz" - (cl-format nil "~20") "foo bar baz" - (cl-format nil "~,,2") "foo bar baz" - (cl-format nil "~20<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~20:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz" - (cl-format nil "~20@<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz " - (cl-format nil "~20@:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz " - (cl-format nil "~10,,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~10,10,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~10,10<~A~;~A~;~A~>" "foo" "bar" "baz") "foo barbaz" - (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar") "foo bar" - (cl-format nil "~20@<~A~;~^~A~;~^~A~>" "foo") "foo " - (cl-format nil "~20:<~A~;~^~A~;~^~A~>" "foo") " foo" -) - -(simple-tests angle-bracket-max-column-tests - (cl-format nil "~%;; ~{~<~%;; ~1,50:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance" "\\s"))) - "\n;; This function computes the circular\n;; thermodynamic coefficient of the thrombulator\n;; angle for use in determining the reaction\n;; distance.\n" -(cl-format true "~%;; ~{~<~%;; ~:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance." "\\s")))) - -(defn list-to-table [aseq column-width] - (let [stream (get-pretty-writer (java.io.StringWriter.))] - (binding [*out* stream] - (doseq [row aseq] - (doseq [col row] - (cl-format true "~4D~7,vT" col column-width)) - (prn))) - (.flush stream) - (.toString (:base @@(:base @@stream))))) - -(simple-tests column-writer-test - (list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8) - " 1 1 1 \n 2 4 8 \n 3 9 27 \n 4 16 64 \n 5 25 125 \n 6 36 216 \n 7 49 343 \n 8 64 512 \n 9 81 729 \n 10 100 1000 \n 11 121 1331 \n 12 144 1728 \n 13 169 2197 \n 14 196 2744 \n 15 225 3375 \n 16 256 4096 \n 17 289 4913 \n 18 324 5832 \n 19 361 6859 \n 20 400 8000 \n") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The following tests are the various examples from the format -;; documentation in Common Lisp, the Language, 2nd edition, Chapter 22.3 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn expt [base pow] (reduce * (repeat pow base))) - -(let [x 5, y "elephant", n 3] - (simple-tests cltl-intro-tests - (format nil "foo") "foo" - (format nil "The answer is ~D." x) "The answer is 5." - (format nil "The answer is ~3D." x) "The answer is 5." - (format nil "The answer is ~3,'0D." x) "The answer is 005." - (format nil "The answer is ~:D." (expt 47 x)) "The answer is 229,345,007." - (format nil "Look at the ~A!" y) "Look at the elephant!" - (format nil "Type ~:C to ~A." (char 4) "delete all your files") - "Type Control-D to delete all your files." - (format nil "~D item~:P found." n) "3 items found." - (format nil "~R dog~:[s are~; is~] here." n (= n 1)) "three dogs are here." - (format nil "~R dog~:*~[s are~; is~:;s are~] here." n) "three dogs are here." - (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) "Here are three puppies.")) - -(simple-tests cltl-B-tests - ;; CLtL didn't have the colons here, but the spec requires them - (format nil "~,,' ,4:B" 0xFACE) "1111 1010 1100 1110" - (format nil "~,,' ,4:B" 0x1CE) "1 1100 1110" - (format nil "~19,,' ,4:B" 0xFACE) "1111 1010 1100 1110" - ;; This one was a nice idea, but nothing in the spec supports it working this way - ;; (and SBCL doesn't work this way either) - ;(format nil "~19,,' ,4:B" 0x1CE) "0000 0001 1100 1110") - ) - -(simple-tests cltl-P-tests - (format nil "~D tr~:@P/~D win~:P" 7 1) "7 tries/1 win" - (format nil "~D tr~:@P/~D win~:P" 1 0) "1 try/0 wins" - (format nil "~D tr~:@P/~D win~:P" 1 3) "1 try/3 wins") - -(defn foo [x] - (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" - x x x x x x)) - -(simple-tests cltl-F-tests - (foo 3.14159) " 3.14| 31.42| 3.14|3.1416|3.14|3.14159" - (foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" - (foo 100.0) "100.00|******|100.00| 100.0|100.00|100.0" - (foo 1234.0) "1234.00|******|??????|1234.0|1234.00|1234.0" - (foo 0.006) " 0.01| 0.06| 0.01| 0.006|0.01|0.006") - -(defn foo-e [x] - (format nil - "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E" - x x x x)) - -;; Clojure doesn't support float/double differences in representation -(simple-tests cltl-E-tests - (foo-e 0.0314159) " 3.14E-2| 31.42$-03|+.003E+01| 3.14E-2" ; Added this one - (foo-e 3.14159) " 3.14E+0| 31.42$-01|+.003E+03| 3.14E+0" - (foo-e -3.14159) " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0" - (foo-e 1100.0) " 1.10E+3| 11.00$+02|+.001E+06| 1.10E+3" -; In Clojure, this is identical to the above -; (foo-e 1100.0L0) " 1.10L+3| 11.00$+02|+.001L+06| 1.10L+3" - (foo-e 1.1E13) "*********| 11.00$+12|+.001E+16| 1.10E+13" - (foo-e 1.1E120) "*********|??????????|%%%%%%%%%|1.10E+120" -; Clojure doesn't support real numbers this large -; (foo-e 1.1L1200) "*********|??????????|%%%%%%%%%|1.10L+1200" -) - -(simple-tests cltl-E-scale-tests - (map - (fn [k] (format nil "Scale factor ~2D~:*: |~13,6,2,VE|" - (- k 5) 3.14159)) ;Prints 13 lines - (range 13)) - '("Scale factor -5: | 0.000003E+06|" - "Scale factor -4: | 0.000031E+05|" - "Scale factor -3: | 0.000314E+04|" - "Scale factor -2: | 0.003142E+03|" - "Scale factor -1: | 0.031416E+02|" - "Scale factor 0: | 0.314159E+01|" - "Scale factor 1: | 3.141590E+00|" - "Scale factor 2: | 31.41590E-01|" - "Scale factor 3: | 314.1590E-02|" - "Scale factor 4: | 3141.590E-03|" - "Scale factor 5: | 31415.90E-04|" - "Scale factor 6: | 314159.0E-05|" - "Scale factor 7: | 3141590.E-06|")) - -(defn foo-g [x] - (format nil - "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G" - x x x x)) - -;; Clojure doesn't support float/double differences in representation -(simple-tests cltl-G-tests - (foo-g 0.0314159) " 3.14E-2|314.2$-04|0.314E-01| 3.14E-2" - (foo-g 0.314159) " 0.31 |0.314 |0.314 | 0.31 " - (foo-g 3.14159) " 3.1 | 3.14 | 3.14 | 3.1 " - (foo-g 31.4159) " 31. | 31.4 | 31.4 | 31. " - (foo-g 314.159) " 3.14E+2| 314. | 314. | 3.14E+2" - (foo-g 3141.59) " 3.14E+3|314.2$+01|0.314E+04| 3.14E+3" -; In Clojure, this is identical to the above -; (foo-g 3141.59L0) " 3.14L+3|314.2$+01|0.314L+04| 3.14L+3" - (foo-g 3.14E12) "*********|314.0$+10|0.314E+13| 3.14E+12" - (foo-g 3.14E120) "*********|?????????|%%%%%%%%%|3.14E+120" -; Clojure doesn't support real numbers this large -; (foo-g 3.14L1200) "*********|?????????|%%%%%%%%%|3.14L+1200" -) - -(defn type-clash-error [fun nargs argnum right-type wrong-type] - (format nil ;; CLtL has this format string slightly wrong - "~&Function ~S requires its ~:[~:R ~;~*~]~ - argument to be of type ~S,~%but it was called ~ - with an argument of type ~S.~%" - fun (= nargs 1) argnum right-type wrong-type)) - -(simple-tests cltl-Newline-tests - (type-clash-error 'aref nil 2 'integer 'vector) -"Function aref requires its second argument to be of type integer, -but it was called with an argument of type vector.\n" - (type-clash-error 'car 1 1 'list 'short-float) -"Function car requires its argument to be of type list, -but it was called with an argument of type short-float.\n") - -(simple-tests cltl-?-tests - (format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) " 7" - (format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) " 7" - (format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) " 7" - (format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) " 14") - -(defn f [n] (format nil "~@(~R~) error~:P detected." n)) - -(simple-tests cltl-paren-tests - (format nil "~@R ~(~@R~)" 14 14) "XIV xiv" - (f 0) "Zero errors detected." - (f 1) "One error detected." - (f 23) "Twenty-three errors detected.") - -(let [*print-level* nil *print-length* 5] - (simple-tests cltl-bracket-tests - (format nil "~@[ print level = ~D~]~@[ print length = ~D~]" - *print-level* *print-length*) - " print length = 5")) - -(let [foo "Items:~#[ none~; ~S~; ~S and ~S~ - ~:;~@{~#[~; and~] ~ - ~S~^,~}~]."] - (simple-tests cltl-bracket1-tests - (format nil foo) "Items: none." - (format nil foo 'foo) "Items: foo." - (format nil foo 'foo 'bar) "Items: foo and bar." - (format nil foo 'foo 'bar 'baz) "Items: foo, bar, and baz." - (format nil foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux.")) - -(simple-tests cltl-curly-bracket-tests - (format nil - "The winners are:~{ ~S~}." - '(fred harry jill)) - "The winners are: fred harry jill." - - (format nil "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3)) - "Pairs: ." - - (format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3))) - "Pairs: ." - - (format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3) - "Pairs: ." - - (format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3)) - "Pairs: .") - -(simple-tests cltl-angle-bracket-tests - (format nil "~10") "foo bar" - (format nil "~10:") " foo bar" - (format nil "~10:@") " foo bar " - (format nil "~10") " foobar" - (format nil "~10:") " foobar" - (format nil "~10@") "foobar " - (format nil "~10:@") " foobar ") - -(let [donestr "Done.~^ ~D warning~:P.~^ ~D error~:P." - tellstr "~@{~@(~@[~R~^ ~]~A~)~}."] ;; The CLtL example is a little wrong here - - (simple-tests cltl-up-tests - (format nil donestr) "Done." - (format nil donestr 3) "Done. 3 warnings." - (format nil donestr 1 5) "Done. 1 warning. 5 errors." - (format nil tellstr 23) "Twenty-three." - (format nil tellstr nil "losers") "Losers." - (format nil tellstr 23 "losers") "Twenty-three losers." - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo) - " foo" - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar) - "foo bar" - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz) - "foo bar baz")) - -(simple-tests cltl-up-x3j13-tests - (format nil - "~:{/~S~^ ...~}" - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger/ice .../french ..." - (format nil - "~:{/~S~:^ ...~}" - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger .../ice .../french" - - (format nil - "~:{/~S~#:^ ...~}" ;; This is wrong in CLtL - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger") - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/pprint/test_helper.clj --- a/src/clojure/contrib/test_contrib/pprint/test_helper.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,21 +0,0 @@ -;;; helper.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, April 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; This is just a macro to make my tests a little cleaner - -(ns clojure.contrib.pprint.test-helper - (:use [clojure.test :only (deftest are run-tests)])) - -(defmacro simple-tests [name & test-pairs] - `(deftest ~name (are [x y] (= x y) ~@test-pairs))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/pprint/test_pretty.clj --- a/src/clojure/contrib/test_contrib/pprint/test_pretty.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,127 +0,0 @@ -;;; pretty.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Feb 2009. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.contrib.pprint.test-pretty - (:use [clojure.test :only (deftest are run-tests)] - clojure.contrib.pprint.test-helper - clojure.contrib.pprint)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Unit tests for the pretty printer -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(simple-tests xp-fill-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 38 - *print-miser-width* nil] - (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" - '((x 4) (*print-length* nil) (z 2) (list nil)))) - "(let ((x 4) (*print-length* nil)\n (z 2) (list nil))\n ...)\n" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 22] - (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" - '((x 4) (*print-length* nil) (z 2) (list nil)))) - "(let ((x 4)\n (*print-length*\n nil)\n (z 2)\n (list nil))\n ...)\n") - -(simple-tests xp-miser-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 9] - (cl-format nil "~:" '(first second third))) - "(LIST\n first\n second\n third)" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 8] - (cl-format nil "~:" '(first second third))) - "(LIST first second third)") - -(simple-tests mandatory-fill-test - (cl-format nil - "
~%~~%
~%" - [ "hello" "gooodbye" ]) - "
-Usage: *hello*
-       *gooodbye*
-
-") - -(simple-tests prefix-suffix-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 10] - (cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third))) - "{LIST\n first\n second\n third}") - -(simple-tests pprint-test - (binding [*print-pprint-dispatch* *simple-dispatch*] - (write '(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true "That number is too big") - (cl-format true "The result of ~d x ~d is ~d" x y result)))) - :stream nil)) - "(defn - foo - [x y] - (let - [result (* x y)] - (if - (> result 400) - (cl-format true \"That number is too big\") - (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" - - (with-pprint-dispatch *code-dispatch* - (write '(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true "That number is too big") - (cl-format true "The result of ~d x ~d is ~d" x y result)))) - :stream nil)) - "(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true \"That number is too big\") - (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 15] - (write '(fn (cons (car x) (cdr y))) :stream nil)) - "(fn\n (cons\n (car x)\n (cdr y)))" - - (with-pprint-dispatch *code-dispatch* - (binding [*print-right-margin* 52] - (write - '(add-to-buffer this (make-buffer-blob (str (char c)) nil)) - :stream nil))) - "(add-to-buffer\n this\n (make-buffer-blob (str (char c)) nil))" - ) - - - -(simple-tests pprint-reader-macro-test - (with-pprint-dispatch *code-dispatch* - (write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])") - :stream nil)) - "(map #(first %) [[1 2 3] [4 5 6] [7]])" - - (with-pprint-dispatch *code-dispatch* - (write (read-string "@@(ref (ref 1))") - :stream nil)) - "@@(ref (ref 1))" - - (with-pprint-dispatch *code-dispatch* - (write (read-string "'foo") - :stream nil)) - "'foo" -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/probabilities/examples_finite_distributions.clj --- a/src/clojure/contrib/test_contrib/probabilities/examples_finite_distributions.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,209 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Probability distribution application examples -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for finite probability distribution"} - clojure.contrib.probabilities.examples-finite-distributions - (:use [clojure.contrib.probabilities.finite-distributions - :only (uniform prob cond-prob join-with dist-m choose - normalize certainly cond-dist-m normalize-cond)]) - (:use [clojure.contrib.monads - :only (domonad with-monad m-seq m-chain m-lift)]) - (:require clojure.contrib.accumulators)) - -;; Simple examples using dice - -; A single die is represented by a uniform distribution over the -; six possible outcomes. -(def die (uniform #{1 2 3 4 5 6})) - -; The probability that the result is odd... -(prob odd? die) -; ... or greater than four. -(prob #(> % 4) die) - -; The sum of two dice -(def two-dice (join-with + die die)) -(prob #(> % 6) two-dice) - -; The sum of two dice using a monad comprehension -(assert (= two-dice - (domonad dist-m - [d1 die - d2 die] - (+ d1 d2)))) - -; The two values separately, but as an ordered pair -(domonad dist-m - [d1 die - d2 die] - (if (< d1 d2) (list d1 d2) (list d2 d1))) - -; The conditional probability for two dice yielding X if X is odd: -(cond-prob odd? two-dice) - -; A two-step experiment: throw a die, and then add 1 with probability 1/2 -(domonad dist-m - [d die - x (choose (/ 1 2) d - :else (inc d))] - x) - -; The sum of n dice -(defn dice [n] - (domonad dist-m - [ds (m-seq (replicate n die))] - (apply + ds))) - -(assert (= two-dice (dice 2))) - -(dice 3) - - -;; Construct an empirical distribution from counters - -; Using an ordinary counter: -(def dist1 - (normalize - (clojure.contrib.accumulators/add-items - clojure.contrib.accumulators/empty-counter - (for [_ (range 1000)] (rand-int 5))))) - -; Or, more efficiently, using a counter that already keeps track of its total: -(def dist2 - (normalize - (clojure.contrib.accumulators/add-items - clojure.contrib.accumulators/empty-counter-with-total - (for [_ (range 1000)] (rand-int 5))))) - - -;; The Monty Hall game -;; (see http://en.wikipedia.org/wiki/Monty_Hall_problem for a description) - -; The set of doors. In the classical variant, there are three doors, -; but the code can also work with more than three doors. -(def doors #{:A :B :C}) - -; A simulation of the game, step by step: -(domonad dist-m - [; The prize is hidden behind one of the doors. - prize (uniform doors) - ; The player make his initial choice. - choice (uniform doors) - ; The host opens a door which is neither the prize door nor the - ; one chosen by the player. - opened (uniform (disj doors prize choice)) - ; If the player stays with his initial choice, the game ends and the - ; following line should be commented out. It describes the switch from - ; the initial choice to a door that is neither the opened one nor - ; his original choice. - choice (uniform (disj doors opened choice)) - ] - ; If the chosen door has the prize behind it, the player wins. - (if (= choice prize) :win :loose)) - - -;; Tree growth simulation -;; Adapted from the code in: -;; Martin Erwig and Steve Kollmansberger, -;; "Probabilistic Functional Programming in Haskell", -;; Journal of Functional Programming, Vol. 16, No. 1, 21-34, 2006 -;; http://web.engr.oregonstate.edu/~erwig/papers/abstracts.html#JFP06a - -; A tree is represented by two attributes: its state (alive, hit, fallen), -; and its height (an integer). A new tree starts out alive and with zero height. -(def new-tree {:state :alive, :height 0}) - -; An evolution step in the simulation modifies alive trees only. They can -; either grow by one (90% probability), be hit by lightning and then stop -; growing (4% probability), or fall down (6% probability). -(defn evolve-1 [tree] - (let [{s :state h :height} tree] - (if (= s :alive) - (choose 0.9 (assoc tree :height (inc (:height tree))) - 0.04 (assoc tree :state :hit) - :else {:state :fallen, :height 0}) - (certainly tree)))) - -; Multiple evolution steps can be chained together with m-chain, -; since each step's input is the output of the previous step. -(with-monad dist-m - (defn evolve [n tree] - ((m-chain (replicate n evolve-1)) tree))) - -; Try it for zero, one, or two steps. -(evolve 0 new-tree) -(evolve 1 new-tree) -(evolve 2 new-tree) - -; We can also get a distribution of the height only: -(with-monad dist-m - ((m-lift 1 :height) (evolve 2 new-tree))) - - - -;; Bayesian inference -;; -;; Suppose someone has three dice, one with six faces, one with eight, and -;; one with twelve. This person throws one die and gives us the number, -;; but doesn't tell us which die it was. What are the Bayesian probabilities -;; for each of the three dice, given the observation we have? - -; A function that returns the distribution of a dice with n faces. -(defn die-n [n] (uniform (range 1 (inc n)))) - -; The three dice in the game with their distributions. With this map, we -; can easily calculate the probability for an observation under the -; condition that a particular die was used. -(def dice {:six (die-n 6) - :eight (die-n 8) - :twelve (die-n 12)}) - -; The only prior knowledge is that one of the three dice is used, so we -; have no better than a uniform distribution to start with. -(def prior (uniform (keys dice))) - -; Add a single observation to the information contained in the -; distribution. Adding an observation consists of -; 1) Draw a die from the prior distribution. -; 2) Draw an observation from the distribution of that die. -; 3) Eliminate (replace by nil) the trials that do not match the observation. -; 4) Normalize the distribution for the non-nil values. -(defn add-observation [prior observation] - (normalize-cond - (domonad cond-dist-m - [die prior - number (get dice die) - :when (= number observation) ] - die))) - -; Add one observation. -(add-observation prior 1) - -; Add three consecutive observations. -(-> prior (add-observation 1) - (add-observation 3) - (add-observation 7)) - -; We can also add multiple observations in a single trial, but this -; is slower because more combinations have to be taken into account. -; With Bayesian inference, it is most efficient to eliminate choices -; as early as possible. -(defn add-observations [prior observations] - (with-monad cond-dist-m - (let [n-nums #(m-seq (replicate (count observations) (get dice %)))] - (normalize-cond - (domonad - [die prior - nums (n-nums die) - :when (= nums observations)] - die))))) - -(add-observations prior [1 3 7]) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/probabilities/examples_monte_carlo.clj --- a/src/clojure/contrib/test_contrib/probabilities/examples_monte_carlo.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,73 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Monte-Carlo application examples -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for monte carlo methods"} - clojure.contrib.probabilities.random.examples-monte-carlo - (:require [clojure.contrib.generic.collection :as gc]) - (:use [clojure.contrib.probabilities.random-numbers - :only (lcg rand-stream)]) - (:use [clojure.contrib.probabilities.finite-distributions - :only (uniform)]) - (:use [clojure.contrib.probabilities.monte-carlo - :only (random-stream discrete interval normal lognormal exponential - n-sphere - sample sample-sum sample-mean sample-mean-variance)] - :reload) - (:use [clojure.contrib.monads - :only (domonad state-m)])) - -; Create a linear congruential generator -(def urng (lcg 259200 7141 54773 1)) - -;; Use Clojure's built-in random number generator -;(def urng rand-stream) - -; Sample transformed distributions -(defn sample-distribution - [n rt] - (take n (gc/seq (random-stream rt urng)))) - -; Interval [-2, 2) -(sample-distribution 10 (interval -2 2)) -; Compare with a direct transformation -(= (sample-distribution 10 (interval -2 2)) - (map (fn [x] (- (* 4 x) 2)) (take 10 (gc/seq urng)))) - -; Normal distribution -(sample-distribution 10 (normal 0 1)) - -; Log-Normal distribution -(sample-distribution 10 (lognormal 0 1)) - -; Exponential distribution -(sample-distribution 10 (exponential 1)) - -; n-sphere distribution -(sample-distribution 10 (n-sphere 2 1)) - -; Discrete distribution -(sample-distribution 10 (discrete (uniform (range 1 7)))) - -; Compose distributions in the state monad -(def sum-two-dists - (domonad state-m - [r1 (interval -2 2) - r2 (normal 0 1)] - (+ r1 r2))) - -(sample-distribution 10 sum-two-dists) - -; Distribution transformations -(sample-distribution 5 (sample 2 (interval -2 2))) -(sample-distribution 10 (sample-sum 10 (interval -2 2))) -(sample-distribution 10 (sample-mean 10 (interval -2 2))) -(sample-distribution 10 (sample-mean-variance 10 (interval -2 2))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/stream_utils/examples.clj --- a/src/clojure/contrib/test_contrib/stream_utils/examples.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,117 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Stream application examples -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for data streams"} - clojure.contrib.stream-utils.examples - (:refer-clojure :exclude (deftype)) - (:use [clojure.contrib.stream-utils - :only (defst stream-next - pick pick-all - stream-type defstream - stream-drop stream-map stream-filter stream-flatten)]) - (:use [clojure.contrib.monads :only (domonad)]) - (:use [clojure.contrib.types :only (deftype)]) - (:require [clojure.contrib.generic.collection :as gc])) - -; -; Define a stream of Fibonacci numbers -; -(deftype ::fib-stream last-two-fib) - -(defstream ::fib-stream - [fs] - (let [[n1 n2] fs] - [n1 (last-two-fib [n2 (+ n1 n2)])])) - -(def fib-stream (last-two-fib [0 1])) - -(take 10 (gc/seq fib-stream)) - -; -; A simple random number generator, implemented as a stream -; -(deftype ::random-seed rng-seed vector seq) - -(defstream ::random-seed - [seed] - (let [[seed] seed - m 259200 - value (/ (float seed) (float m)) - next (rem (+ 54773 (* 7141 seed)) m)] - [value (rng-seed next)])) - -(take 10 (gc/seq (rng-seed 1))) - -; -; Various stream utilities -; -(take 10 (gc/seq (stream-drop 10 (rng-seed 1)))) -(gc/seq (stream-map inc (range 5))) -(gc/seq (stream-filter odd? (range 10))) -(gc/seq (stream-flatten (partition 3 (range 9)))) - -; -; Stream transformers -; - -; Transform a stream of numbers into a stream of sums of two -; consecutive numbers. -(defst sum-two [] [xs] - (domonad - [x1 (pick xs) - x2 (pick xs)] - (+ x1 x2))) - -(def s (sum-two '(1 2 3 4 5 6 7 8))) - -(let [[v1 s] (stream-next s)] - (let [[v2 s] (stream-next s)] - (let [[v3 s] (stream-next s)] - (let [[v4 s] (stream-next s)] - (let [[v5 s] (stream-next s)] - [v1 v2 v3 v4 v5]))))) - -(gc/seq s) - -; Map (for a single stream) written as a stream transformer -(defst my-map-1 [f] [xs] - (domonad - [x (pick xs)] - (f x))) - -(gc/seq (my-map-1 inc [1 2 3])) - -; Map for two stream arguments -(defst my-map-2 [f] [xs ys] - (domonad - [x (pick xs) - y (pick ys)] - (f x y))) - -(gc/seq (my-map-2 + '(1 2 3 4) '(10 20 30 40))) - -; Map for any number of stream arguments -(defst my-map [f] [& streams] - (domonad - [vs pick-all] - (apply f vs))) - -(gc/seq (my-map inc [1 2 3])) -(gc/seq (my-map + '(1 2 3 4) '(10 20 30 40))) - -; Filter written as a stream transformer -(defst my-filter [p] [xs] - (domonad - [x (pick xs) :when (p x)] - x)) - -(gc/seq (my-filter odd? [1 2 3])) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_complex_numbers.clj --- a/src/clojure/contrib/test_contrib/test_complex_numbers.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,313 +0,0 @@ -;; Test routines for complex-numbers.clj - -;; by Konrad Hinsen -;; last updated April 2, 2009 - -;; Copyright (c) Konrad Hinsen, 2008. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns clojure.contrib.test-complex-numbers - (:refer-clojure :exclude [+ - * / = < > <= >=]) - (:use [clojure.test - :only (deftest is are run-tests)] - [clojure.contrib.generic.arithmetic - :only (+ - * /)] - [clojure.contrib.generic.comparison - :only (= < > <= >=)] - [clojure.contrib.generic.math-functions - :only (abs approx= conjugate exp sqr sqrt)] - [clojure.contrib.complex-numbers - :only (complex imaginary real imag)])) - -(deftest complex-addition - (is (= (+ (complex 1 2) (complex 1 2)) (complex 2 4))) - (is (= (+ (complex 1 2) (complex -3 -7)) (complex -2 -5))) - (is (= (+ (complex -3 -7) (complex 1 2)) (complex -2 -5))) - (is (= (+ (complex 1 2) 3) (complex 4 2))) - (is (= (+ 3 (complex 1 2)) (complex 4 2))) - (is (= (+ (complex 1 2) -1) (imaginary 2))) - (is (= (+ -1 (complex 1 2)) (imaginary 2))) - (is (= (+ (complex 1 2) (imaginary -2)) 1)) - (is (= (+ (imaginary -2) (complex 1 2)) 1)) - (is (= (+ (complex 1 2) (imaginary 5)) (complex 1 7))) - (is (= (+ (imaginary 5) (complex 1 2)) (complex 1 7))) - (is (= (+ (complex -3 -7) (complex 1 2)) (complex -2 -5))) - (is (= (+ (complex 1 2) (complex -3 -7)) (complex -2 -5))) - (is (= (+ (complex -3 -7) (complex -3 -7)) (complex -6 -14))) - (is (= (+ (complex -3 -7) 3) (imaginary -7))) - (is (= (+ 3 (complex -3 -7)) (imaginary -7))) - (is (= (+ (complex -3 -7) -1) (complex -4 -7))) - (is (= (+ -1 (complex -3 -7)) (complex -4 -7))) - (is (= (+ (complex -3 -7) (imaginary -2)) (complex -3 -9))) - (is (= (+ (imaginary -2) (complex -3 -7)) (complex -3 -9))) - (is (= (+ (complex -3 -7) (imaginary 5)) (complex -3 -2))) - (is (= (+ (imaginary 5) (complex -3 -7)) (complex -3 -2))) - (is (= (+ 3 (complex 1 2)) (complex 4 2))) - (is (= (+ (complex 1 2) 3) (complex 4 2))) - (is (= (+ 3 (complex -3 -7)) (imaginary -7))) - (is (= (+ (complex -3 -7) 3) (imaginary -7))) - (is (= (+ 3 (imaginary -2)) (complex 3 -2))) - (is (= (+ (imaginary -2) 3) (complex 3 -2))) - (is (= (+ 3 (imaginary 5)) (complex 3 5))) - (is (= (+ (imaginary 5) 3) (complex 3 5))) - (is (= (+ -1 (complex 1 2)) (imaginary 2))) - (is (= (+ (complex 1 2) -1) (imaginary 2))) - (is (= (+ -1 (complex -3 -7)) (complex -4 -7))) - (is (= (+ (complex -3 -7) -1) (complex -4 -7))) - (is (= (+ -1 (imaginary -2)) (complex -1 -2))) - (is (= (+ (imaginary -2) -1) (complex -1 -2))) - (is (= (+ -1 (imaginary 5)) (complex -1 5))) - (is (= (+ (imaginary 5) -1) (complex -1 5))) - (is (= (+ (imaginary -2) (complex 1 2)) 1)) - (is (= (+ (complex 1 2) (imaginary -2)) 1)) - (is (= (+ (imaginary -2) (complex -3 -7)) (complex -3 -9))) - (is (= (+ (complex -3 -7) (imaginary -2)) (complex -3 -9))) - (is (= (+ (imaginary -2) 3) (complex 3 -2))) - (is (= (+ 3 (imaginary -2)) (complex 3 -2))) - (is (= (+ (imaginary -2) -1) (complex -1 -2))) - (is (= (+ -1 (imaginary -2)) (complex -1 -2))) - (is (= (+ (imaginary -2) (imaginary -2)) (imaginary -4))) - (is (= (+ (imaginary -2) (imaginary 5)) (imaginary 3))) - (is (= (+ (imaginary 5) (imaginary -2)) (imaginary 3))) - (is (= (+ (imaginary 5) (complex 1 2)) (complex 1 7))) - (is (= (+ (complex 1 2) (imaginary 5)) (complex 1 7))) - (is (= (+ (imaginary 5) (complex -3 -7)) (complex -3 -2))) - (is (= (+ (complex -3 -7) (imaginary 5)) (complex -3 -2))) - (is (= (+ (imaginary 5) 3) (complex 3 5))) - (is (= (+ 3 (imaginary 5)) (complex 3 5))) - (is (= (+ (imaginary 5) -1) (complex -1 5))) - (is (= (+ -1 (imaginary 5)) (complex -1 5))) - (is (= (+ (imaginary 5) (imaginary -2)) (imaginary 3))) - (is (= (+ (imaginary -2) (imaginary 5)) (imaginary 3))) - (is (= (+ (imaginary 5) (imaginary 5)) (imaginary 10)))) - -(deftest complex-subtraction - (is (= (- (complex 1 2) (complex 1 2)) 0)) - (is (= (- (complex 1 2) (complex -3 -7)) (complex 4 9))) - (is (= (- (complex -3 -7) (complex 1 2)) (complex -4 -9))) - (is (= (- (complex 1 2) 3) (complex -2 2))) - (is (= (- 3 (complex 1 2)) (complex 2 -2))) - (is (= (- (complex 1 2) -1) (complex 2 2))) - (is (= (- -1 (complex 1 2)) (complex -2 -2))) - (is (= (- (complex 1 2) (imaginary -2)) (complex 1 4))) - (is (= (- (imaginary -2) (complex 1 2)) (complex -1 -4))) - (is (= (- (complex 1 2) (imaginary 5)) (complex 1 -3))) - (is (= (- (imaginary 5) (complex 1 2)) (complex -1 3))) - (is (= (- (complex -3 -7) (complex 1 2)) (complex -4 -9))) - (is (= (- (complex 1 2) (complex -3 -7)) (complex 4 9))) - (is (= (- (complex -3 -7) (complex -3 -7)) 0)) - (is (= (- (complex -3 -7) 3) (complex -6 -7))) - (is (= (- 3 (complex -3 -7)) (complex 6 7))) - (is (= (- (complex -3 -7) -1) (complex -2 -7))) - (is (= (- -1 (complex -3 -7)) (complex 2 7))) - (is (= (- (complex -3 -7) (imaginary -2)) (complex -3 -5))) - (is (= (- (imaginary -2) (complex -3 -7)) (complex 3 5))) - (is (= (- (complex -3 -7) (imaginary 5)) (complex -3 -12))) - (is (= (- (imaginary 5) (complex -3 -7)) (complex 3 12))) - (is (= (- 3 (complex 1 2)) (complex 2 -2))) - (is (= (- (complex 1 2) 3) (complex -2 2))) - (is (= (- 3 (complex -3 -7)) (complex 6 7))) - (is (= (- (complex -3 -7) 3) (complex -6 -7))) - (is (= (- 3 (imaginary -2)) (complex 3 2))) - (is (= (- (imaginary -2) 3) (complex -3 -2))) - (is (= (- 3 (imaginary 5)) (complex 3 -5))) - (is (= (- (imaginary 5) 3) (complex -3 5))) - (is (= (- -1 (complex 1 2)) (complex -2 -2))) - (is (= (- (complex 1 2) -1) (complex 2 2))) - (is (= (- -1 (complex -3 -7)) (complex 2 7))) - (is (= (- (complex -3 -7) -1) (complex -2 -7))) - (is (= (- -1 (imaginary -2)) (complex -1 2))) - (is (= (- (imaginary -2) -1) (complex 1 -2))) - (is (= (- -1 (imaginary 5)) (complex -1 -5))) - (is (= (- (imaginary 5) -1) (complex 1 5))) - (is (= (- (imaginary -2) (complex 1 2)) (complex -1 -4))) - (is (= (- (complex 1 2) (imaginary -2)) (complex 1 4))) - (is (= (- (imaginary -2) (complex -3 -7)) (complex 3 5))) - (is (= (- (complex -3 -7) (imaginary -2)) (complex -3 -5))) - (is (= (- (imaginary -2) 3) (complex -3 -2))) - (is (= (- 3 (imaginary -2)) (complex 3 2))) - (is (= (- (imaginary -2) -1) (complex 1 -2))) - (is (= (- -1 (imaginary -2)) (complex -1 2))) - (is (= (- (imaginary -2) (imaginary -2)) 0)) - (is (= (- (imaginary -2) (imaginary 5)) (imaginary -7))) - (is (= (- (imaginary 5) (imaginary -2)) (imaginary 7))) - (is (= (- (imaginary 5) (complex 1 2)) (complex -1 3))) - (is (= (- (complex 1 2) (imaginary 5)) (complex 1 -3))) - (is (= (- (imaginary 5) (complex -3 -7)) (complex 3 12))) - (is (= (- (complex -3 -7) (imaginary 5)) (complex -3 -12))) - (is (= (- (imaginary 5) 3) (complex -3 5))) - (is (= (- 3 (imaginary 5)) (complex 3 -5))) - (is (= (- (imaginary 5) -1) (complex 1 5))) - (is (= (- -1 (imaginary 5)) (complex -1 -5))) - (is (= (- (imaginary 5) (imaginary -2)) (imaginary 7))) - (is (= (- (imaginary -2) (imaginary 5)) (imaginary -7))) - (is (= (- (imaginary 5) (imaginary 5)) 0))) - -(deftest complex-multiplication - (is (= (* (complex 1 2) (complex 1 2)) (complex -3 4))) - (is (= (* (complex 1 2) (complex -3 -7)) (complex 11 -13))) - (is (= (* (complex -3 -7) (complex 1 2)) (complex 11 -13))) - (is (= (* (complex 1 2) 3) (complex 3 6))) - (is (= (* 3 (complex 1 2)) (complex 3 6))) - (is (= (* (complex 1 2) -1) (complex -1 -2))) - (is (= (* -1 (complex 1 2)) (complex -1 -2))) - (is (= (* (complex 1 2) (imaginary -2)) (complex 4 -2))) - (is (= (* (imaginary -2) (complex 1 2)) (complex 4 -2))) - (is (= (* (complex 1 2) (imaginary 5)) (complex -10 5))) - (is (= (* (imaginary 5) (complex 1 2)) (complex -10 5))) - (is (= (* (complex -3 -7) (complex 1 2)) (complex 11 -13))) - (is (= (* (complex 1 2) (complex -3 -7)) (complex 11 -13))) - (is (= (* (complex -3 -7) (complex -3 -7)) (complex -40 42))) - (is (= (* (complex -3 -7) 3) (complex -9 -21))) - (is (= (* 3 (complex -3 -7)) (complex -9 -21))) - (is (= (* (complex -3 -7) -1) (complex 3 7))) - (is (= (* -1 (complex -3 -7)) (complex 3 7))) - (is (= (* (complex -3 -7) (imaginary -2)) (complex -14 6))) - (is (= (* (imaginary -2) (complex -3 -7)) (complex -14 6))) - (is (= (* (complex -3 -7) (imaginary 5)) (complex 35 -15))) - (is (= (* (imaginary 5) (complex -3 -7)) (complex 35 -15))) - (is (= (* 3 (complex 1 2)) (complex 3 6))) - (is (= (* (complex 1 2) 3) (complex 3 6))) - (is (= (* 3 (complex -3 -7)) (complex -9 -21))) - (is (= (* (complex -3 -7) 3) (complex -9 -21))) - (is (= (* 3 (imaginary -2)) (imaginary -6))) - (is (= (* (imaginary -2) 3) (imaginary -6))) - (is (= (* 3 (imaginary 5)) (imaginary 15))) - (is (= (* (imaginary 5) 3) (imaginary 15))) - (is (= (* -1 (complex 1 2)) (complex -1 -2))) - (is (= (* (complex 1 2) -1) (complex -1 -2))) - (is (= (* -1 (complex -3 -7)) (complex 3 7))) - (is (= (* (complex -3 -7) -1) (complex 3 7))) - (is (= (* -1 (imaginary -2)) (imaginary 2))) - (is (= (* (imaginary -2) -1) (imaginary 2))) - (is (= (* -1 (imaginary 5)) (imaginary -5))) - (is (= (* (imaginary 5) -1) (imaginary -5))) - (is (= (* (imaginary -2) (complex 1 2)) (complex 4 -2))) - (is (= (* (complex 1 2) (imaginary -2)) (complex 4 -2))) - (is (= (* (imaginary -2) (complex -3 -7)) (complex -14 6))) - (is (= (* (complex -3 -7) (imaginary -2)) (complex -14 6))) - (is (= (* (imaginary -2) 3) (imaginary -6))) - (is (= (* 3 (imaginary -2)) (imaginary -6))) - (is (= (* (imaginary -2) -1) (imaginary 2))) - (is (= (* -1 (imaginary -2)) (imaginary 2))) - (is (= (* (imaginary -2) (imaginary -2)) -4)) - (is (= (* (imaginary -2) (imaginary 5)) 10)) - (is (= (* (imaginary 5) (imaginary -2)) 10)) - (is (= (* (imaginary 5) (complex 1 2)) (complex -10 5))) - (is (= (* (complex 1 2) (imaginary 5)) (complex -10 5))) - (is (= (* (imaginary 5) (complex -3 -7)) (complex 35 -15))) - (is (= (* (complex -3 -7) (imaginary 5)) (complex 35 -15))) - (is (= (* (imaginary 5) 3) (imaginary 15))) - (is (= (* 3 (imaginary 5)) (imaginary 15))) - (is (= (* (imaginary 5) -1) (imaginary -5))) - (is (= (* -1 (imaginary 5)) (imaginary -5))) - (is (= (* (imaginary 5) (imaginary -2)) 10)) - (is (= (* (imaginary -2) (imaginary 5)) 10)) - (is (= (* (imaginary 5) (imaginary 5)) -25))) - -(deftest complex-division - (is (= (/ (complex 1 2) (complex 1 2)) 1)) - (is (= (/ (complex 1 2) (complex -3 -7)) (complex -17/58 1/58))) - (is (= (/ (complex -3 -7) (complex 1 2)) (complex -17/5 -1/5))) - (is (= (/ (complex 1 2) 3) (complex 1/3 2/3))) - (is (= (/ 3 (complex 1 2)) (complex 3/5 -6/5))) - (is (= (/ (complex 1 2) -1) (complex -1 -2))) - (is (= (/ -1 (complex 1 2)) (complex -1/5 2/5))) - (is (= (/ (complex 1 2) (imaginary -2)) (complex -1 1/2))) - (is (= (/ (imaginary -2) (complex 1 2)) (complex -4/5 -2/5))) - (is (= (/ (complex 1 2) (imaginary 5)) (complex 2/5 -1/5))) - (is (= (/ (imaginary 5) (complex 1 2)) (complex 2 1))) - (is (= (/ (complex -3 -7) (complex 1 2)) (complex -17/5 -1/5))) - (is (= (/ (complex 1 2) (complex -3 -7)) (complex -17/58 1/58))) - (is (= (/ (complex -3 -7) (complex -3 -7)) 1)) - (is (= (/ (complex -3 -7) 3) (complex -1 -7/3))) - (is (= (/ 3 (complex -3 -7)) (complex -9/58 21/58))) - (is (= (/ (complex -3 -7) -1) (complex 3 7))) - (is (= (/ -1 (complex -3 -7)) (complex 3/58 -7/58))) - (is (= (/ (complex -3 -7) (imaginary -2)) (complex 7/2 -3/2))) - (is (= (/ (imaginary -2) (complex -3 -7)) (complex 7/29 3/29))) - (is (= (/ (complex -3 -7) (imaginary 5)) (complex -7/5 3/5))) - (is (= (/ (imaginary 5) (complex -3 -7)) (complex -35/58 -15/58))) - (is (= (/ 3 (complex 1 2)) (complex 3/5 -6/5))) - (is (= (/ (complex 1 2) 3) (complex 1/3 2/3))) - (is (= (/ 3 (complex -3 -7)) (complex -9/58 21/58))) - (is (= (/ (complex -3 -7) 3) (complex -1 -7/3))) - #_(is (= (/ 3 (imaginary -2)) (imaginary 1.5))) - (is (= (/ (imaginary -2) 3) (imaginary -2/3))) - (is (= (/ 3 (imaginary 5)) (imaginary -3/5))) - (is (= (/ (imaginary 5) 3) (imaginary 5/3))) - (is (= (/ -1 (complex 1 2)) (complex -1/5 2/5))) - (is (= (/ (complex 1 2) -1) (complex -1 -2))) - (is (= (/ -1 (complex -3 -7)) (complex 3/58 -7/58))) - (is (= (/ (complex -3 -7) -1) (complex 3 7))) - (is (= (/ -1 (imaginary -2)) (imaginary -1/2))) - (is (= (/ (imaginary -2) -1) (imaginary 2))) - (is (= (/ -1 (imaginary 5)) (imaginary 1/5))) - (is (= (/ (imaginary 5) -1) (imaginary -5))) - (is (= (/ (imaginary -2) (complex 1 2)) (complex -4/5 -2/5))) - (is (= (/ (complex 1 2) (imaginary -2)) (complex -1 1/2))) - (is (= (/ (imaginary -2) (complex -3 -7)) (complex 7/29 3/29))) - (is (= (/ (complex -3 -7) (imaginary -2)) (complex 7/2 -3/2))) - (is (= (/ (imaginary -2) 3) (imaginary -2/3))) - (is (= (/ 3 (imaginary -2)) (imaginary 3/2))) - (is (= (/ (imaginary -2) -1) (imaginary 2))) - (is (= (/ -1 (imaginary -2)) (imaginary -1/2))) - (is (= (/ (imaginary -2) (imaginary -2)) 1)) - (is (= (/ (imaginary -2) (imaginary 5)) -2/5)) - (is (= (/ (imaginary 5) (imaginary -2)) -5/2)) - (is (= (/ (imaginary 5) (complex 1 2)) (complex 2 1))) - (is (= (/ (complex 1 2) (imaginary 5)) (complex 2/5 -1/5))) - (is (= (/ (imaginary 5) (complex -3 -7)) (complex -35/58 -15/58))) - (is (= (/ (complex -3 -7) (imaginary 5)) (complex -7/5 3/5))) - (is (= (/ (imaginary 5) 3) (imaginary 5/3))) - (is (= (/ 3 (imaginary 5)) (imaginary -3/5))) - (is (= (/ (imaginary 5) -1) (imaginary -5))) - (is (= (/ -1 (imaginary 5)) (imaginary 1/5))) - (is (= (/ (imaginary 5) (imaginary -2)) -5/2)) - (is (= (/ (imaginary -2) (imaginary 5)) -2/5)) - (is (= (/ (imaginary 5) (imaginary 5)) 1))) - -(deftest complex-conjugate - (is (= (conjugate (complex 1 2)) (complex 1 -2))) - (is (= (conjugate (complex -3 -7)) (complex -3 7))) - (is (= (conjugate (imaginary -2)) (imaginary 2))) - (is (= (conjugate (imaginary 5)) (imaginary -5)))) - -(deftest complex-abs - (doseq [c [(complex 1 2) (complex -2 3) (complex 4 -2) - (complex -3 -7) (imaginary -2) (imaginary 5)]] - (is (approx= (* c (conjugate c)) - (sqr (abs c)) - 1e-14)))) - -(deftest complex-sqrt - (doseq [c [(complex 1 2) (complex -2 3) (complex 4 -2) - (complex -3 -7) (imaginary -2) (imaginary 5)]] - (let [r (sqrt c)] - (is (approx= c (sqr r) 1e-14)) - (is (>= (real r) 0))))) - -(deftest complex-exp - (is (approx= (exp (complex 1 2)) - (complex -1.1312043837568135 2.4717266720048188) - 1e-14)) - (is (approx= (exp (complex 2 3)) - (complex -7.3151100949011028 1.0427436562359045) - 1e-14)) - (is (approx= (exp (complex 4 -2)) - (complex -22.720847417619233 -49.645957334580565) - 1e-14)) - (is (approx= (exp (complex 3 -7)) - (complex 15.142531566086868 -13.195928586605717) - 1e-14)) - (is (approx= (exp (imaginary -2)) - (complex -0.41614683654714241 -0.90929742682568171) - 1e-14)) - (is (approx= (exp (imaginary 5)) - (complex 0.2836621854632263 -0.95892427466313845) - 1e-14))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_core.clj --- a/src/clojure/contrib/test_contrib/test_core.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,42 +0,0 @@ -; Copyright (c) Laurent Petit, March 2009. All rights reserved. - -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this -; distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; test namespace for clojure.contrib.core - -;; note to other contrib members: feel free to add to this lib - -(ns clojure.contrib.test-core - (:use clojure.test) - (:use clojure.contrib.core)) - -(deftest test-classic-versions - (testing "Classic -> throws NPE if passed nil" - (is (thrown? NullPointerException (-> nil .toString))) - (is (thrown? NullPointerException (-> "foo" seq next next next .toString)))) - (testing "Classic .. throws NPE if one of the intermediate threaded values is nil" - (is (thrown? NullPointerException (.. nil toString))) - (is (thrown? NullPointerException (.. [nil] (get 0) toString))))) - -(deftest test-new-versions - (testing "Version -?>> falls out on nil" - (is (nil? (-?>> nil .toString))) - (is (nil? (-?>> [] seq (map inc)))) - (is (= [] (->> [] seq (map inc))))) - (testing "Version -?>> completes for non-nil" - (is (= [3 4] (-?>> [1 2] (map inc) (map inc))))) - (testing "Version -?> falls out on nil" - (is (nil? (-?> nil .toString))) - (is (nil? (-?> "foo" seq next next next .toString)))) - (testing "Version -?> completes for non-nil" - (is (= [\O \O] (-?> "foo" .toUpperCase rest)))) - (testing "Version .?. returns nil if one of the intermediate threaded values is nil" - (is (nil? (.?. nil toString))) - (is (nil? (.?. [nil] (get 0) toString))))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_dataflow.clj --- a/src/clojure/contrib/test_contrib/test_dataflow.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,90 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; test-dataflow -;; -;; A Library to Support a Dataflow Model of State - Tests -;; -;; straszheimjeffrey (gmail) -;; Created 11 March 2009 - - -(ns clojure.contrib.test-dataflow - (:use clojure.test) - (:use clojure.contrib.dataflow)) - -(def df-1 - (build-dataflow - [(cell :source base 0) - (cell :source items ()) - (cell product (* ?base (apply + ?items))) - (cell :validator (when (number? ?-product) - (assert (>= ?product ?-product))))])) - -(deftest test-df-1 - (is (= (get-value df-1 'product) 0)) - (is (do (update-values df-1 {'items [4 5]}) - (= (get-value df-1 'product) 0))) - (is (do (update-values df-1 {'base 2}) - (= (get-value df-1 'product) 18))) - (is (thrown? AssertionError (update-values df-1 {'base 0}))) - (is (= (get-value df-1 'product) 18))) - -(def df-2 - (build-dataflow - [(cell :source strength 10) - (cell :source agility 10) - (cell :source magic 10) - - (cell total-cost (apply + ?*cost)) - - (cell cost (- ?strength 10)) - (cell cost (- ?agility 10)) - (cell cost (- ?magic 10)) - - (cell combat (+ ?strength ?agility ?combat-mod)) - (cell speed (+ ?agility (/ ?strength 10.0) ?speed-mod)) - (cell casting (+ ?agility ?magic ?magic-mod)) - - (cell combat-mod (apply + ?*combat-mods)) - (cell speed-mod (apply + ?*speed-mods)) - (cell magic-mod (apply + ?*magic-mods))])) - -(def magic-skill - [(cell cost 5) - (cell speed-mods 1) - (cell magic-mods 2)]) - -(defn gv [n] (get-value df-2 n)) - -(deftest test-df-2 - (is (and (= (gv 'total-cost) 0) - (= (gv 'strength) 10) - (= (gv 'casting) 20))) - (is (do (update-values df-2 {'magic 12}) - (and (= (gv 'total-cost) 2) - (= (gv 'casting) 22)))) - (is (do (add-cells df-2 magic-skill) - (and (= (gv 'total-cost) 7) - (= (gv 'casting) 24)))) - (is (do (remove-cells df-2 magic-skill) - (and (= (gv 'total-cost) 2) - (= (gv 'casting) 22))))) - - -(comment - (run-tests) - - (use :reload 'clojure.contrib.dataflow) - (use 'clojure.contrib.stacktrace) (e) - (use 'clojure.contrib.trace) - -) - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_def.clj --- a/src/clojure/contrib/test_contrib/test_def.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,27 +0,0 @@ -;; Tests for def.clj - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns clojure.contrib.test-def - (:use clojure.test) - (:require [clojure.contrib.def :as d])) - -(defn sample-fn "sample-fn docstring" []) -(d/defalias aliased-fn sample-fn) -(defmacro sample-macro "sample-macro-docstring" []) -(d/defalias aliased-macro sample-macro) - -(deftest defalias-preserves-metadata - (let [preserved-meta #(-> % (meta) (select-keys [:doc :arglists :ns :file :macro]))] - (are [x y] (= (preserved-meta (var x)) (preserved-meta (var y))) - aliased-fn sample-fn - aliased-macro sample-macro))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_fnmap.clj --- a/src/clojure/contrib/test_contrib/test_fnmap.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -(ns clojure.contrib.test-fnmap - (:use clojure.contrib.fnmap - clojure.test)) - -(deftest acts-like-map - (let [m1 (fnmap get assoc :key1 1 :key2 2)] - (are [k v] (= v (get m1 k)) - :key1 1 - :key2 2 - :nonexistent-key nil) - (are [k v] (= v (k m1)) - :key1 1 - :key2 2 - :nonexistent-key nil) - (let [m2 (assoc m1 :key3 3 :key4 4)] - (are [k v] (= v (get m2 k)) - :key1 1 - :key2 2 - :key3 3 - :key4 4 - :nonexistent-key nil)))) - -(defn assoc-validate [m key value] - (if (integer? value) - (assoc m key value) - (throw (Exception. "Only integers allowed in this map!")))) - -(deftest validators - (let [m (fnmap get assoc-validate)] - (is (= 2 (:key2 (assoc m :key2 2)))) - (is (thrown? Exception (assoc m :key3 3.14))))) - -(defn get-transform [m key] - (when-let [value (m key)] - (- value))) - -(deftest transforms - (let [m (fnmap get-transform assoc)] - (is (= -2 (:key2 (assoc m :key2 2)))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_graph.clj --- a/src/clojure/contrib/test_contrib/test_graph.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,187 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; test-graph -;; -;; Basic Graph Theory Algorithms Tests -;; -;; straszheimjeffrey (gmail) -;; Created 23 June 2009 - -(ns clojure.contrib.test-graph - (use clojure.test - clojure.contrib.graph)) - - -(def empty-graph (struct directed-graph #{} {})) - -(def test-graph-1 - (struct directed-graph - #{:a :b :c :d :e} - {:a #{:b :c} - :b #{:a :c} - :c #{:d :e} - :d #{:a :b} - :e #{:d}})) - -(deftest test-reverse-graph - (is (= (reverse-graph test-graph-1) - (struct directed-graph - #{:a :b :c :d :e} - {:c #{:b :a} - :e #{:c} - :d #{:c :e} - :b #{:d :a} - :a #{:d :b}}))) - (is (= (reverse-graph (reverse-graph test-graph-1)) - test-graph-1)) - (is (= (reverse-graph empty-graph) empty-graph))) - -(deftest test-add-loops - (let [tg1 (add-loops test-graph-1)] - (is (every? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1)))) - (is (= (add-loops empty-graph) empty-graph))) - -(deftest test-remove-loops - (let [tg1 (remove-loops (add-loops test-graph-1))] - (is (not-any? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1)))) - (is (= (remove-loops empty-graph) empty-graph))) - - -(def test-graph-2 - (struct directed-graph - #{:a :b :c :d :e :f :g :h :i :j} - {:a #{:b :c} - :b #{:a :c} - :c #{:d :e} - :d #{:a :b} - :e #{:d} - :f #{:f} - :g #{:a :f} - :h #{} - :i #{:j} - :j #{:i}})) - - -(deftest test-lazy-walk - (is (= (lazy-walk test-graph-2 :h) [:h])) - (is (= (lazy-walk test-graph-2 :j) [:j :i]))) - -(deftest test-transitive-closure - (let [tc-1 (transitive-closure test-graph-1) - tc-2 (transitive-closure test-graph-2) - get (fn [n] (set (get-neighbors tc-2 n)))] - (is (every? #(= #{:a :b :c :d :e} (set %)) - (map (partial get-neighbors tc-1) (:nodes tc-1)))) - (is (= (get :a) #{:a :b :c :d :e})) - (is (= (get :h) #{})) - (is (= (get :j) #{:i :j})) - (is (= (get :g) #{:a :b :c :d :e :f})))) - - -(deftest test-post-ordered-nodes - (is (= (set (post-ordered-nodes test-graph-2)) - #{:a :b :c :d :e :f :g :h :i :j})) - (is (empty? (post-ordered-nodes empty-graph)))) - - -(deftest test-scc - (is (= (set (scc test-graph-2)) - #{#{:h} #{:g} #{:i :j} #{:b :c :a :d :e} #{:f}})) - (is (empty? (scc empty-graph)))) - -(deftest test-component-graph - (let [cg (component-graph test-graph-2) - ecg (component-graph empty-graph)] - (is (= (:nodes cg) (set (scc test-graph-2)))) - (is (= (get-neighbors cg #{:a :b :c :d :e}) - #{#{:a :b :c :d :e}})) - (is (= (get-neighbors cg #{:g}) - #{#{:a :b :c :d :e} #{:f}})) - (is (= (get-neighbors cg #{:i :j}) - #{#{:i :j}})) - (is (= (get-neighbors cg #{:h}) - #{})) - (is (= (apply max (map count (self-recursive-sets cg))) 1)) - (is (= ecg empty-graph)))) - - -(deftest test-recursive-component? - (let [sccs (scc test-graph-2)] - (is (= (set (filter (partial recursive-component? test-graph-2) sccs)) - #{#{:i :j} #{:b :c :a :d :e} #{:f}})))) - - -(deftest test-self-recursive-sets - (is (= (set (self-recursive-sets test-graph-2)) - (set (filter - (partial recursive-component? test-graph-2) - (scc test-graph-2))))) - (is (empty? (self-recursive-sets empty-graph)))) - - -(def test-graph-3 - (struct directed-graph - #{:a :b :c :d :e :f} - {:a #{:b} - :b #{:c} - :c #{:d} - :d #{:e} - :e #{:f} - :f #{}})) - -(def test-graph-4 - (struct directed-graph - #{:a :b :c :d :e :f :g :h} - {:a #{} - :b #{:a} - :c #{:a} - :d #{:a :b} - :e #{:d :c} - :f #{:e} - :g #{:d} - :h #{:f}})) - -(def test-graph-5 - (struct directed-graph - #{:a :b :c :d :e :f :g :h} - {:a #{} - :b #{} - :c #{:b} - :d #{} - :e #{} - :f #{} - :g #{:f} - :h #{}})) - -(deftest test-dependency-list - (is (thrown-with-msg? Exception #".*Fixed point overflow.*" - (dependency-list test-graph-2))) - (is (= (dependency-list test-graph-3) - [#{:f} #{:e} #{:d} #{:c} #{:b} #{:a}])) - (is (= (dependency-list test-graph-4) - [#{:a} #{:b :c} #{:d} #{:g :e} #{:f} #{:h}])) - (is (= (dependency-list test-graph-5) - [#{:f :b :a :d :h :e} #{:g :c}])) - (is (= (dependency-list empty-graph) - [#{}]))) - -(deftest test-stratification-list - (is (thrown-with-msg? Exception #".*Fixed point overflow.*" - (stratification-list test-graph-2 test-graph-2))) - (is (= (stratification-list test-graph-4 test-graph-5) - [#{:a} #{:b :c} #{:d} #{:e} #{:f :g} #{:h}])) - (is (= (stratification-list empty-graph empty-graph) - [#{}]))) - -(comment - (run-tests) -) - - -;; End of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_greatest_least.clj --- a/src/clojure/contrib/test_contrib/test_greatest_least.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,65 +0,0 @@ -(ns clojure.contrib.test-greatest-least - (:use clojure.contrib.greatest-least - [clojure.test :only (is deftest run-tests)])) - -(deftest test-greatest - (is (nil? (greatest)) "greatest with no arguments is nil") - (is (= 1 (greatest 1))) - (is (= 2 (greatest 1 2))) - (is (= 2 (greatest 2 1))) - (is (= "b" (greatest "aa" "b")))) - -(deftest test-greatest-by - (is (nil? (greatest-by identity)) "greatest-by with no arguments is nil") - (is (= "" (greatest-by count ""))) - (is (= "a" (greatest-by count "a" ""))) - (is (= "a" (greatest-by count "" "a"))) - (is (= "aa" (greatest-by count "aa" "b")))) - -(deftest test-least - (is (nil? (least)) "least with no arguments is nil") - (is (= 1 (least 1))) - (is (= 1 (least 1 2))) - (is (= 1 (least 2 1))) - (is (= "aa" (least "aa" "b")))) - -(deftest test-least-by - (is (nil? (least-by identity)) "least-by with no arguments is nil") - (is (= "" (least-by count ""))) - (is (= "" (least-by count "a" ""))) - (is (= "" (least-by count "" "a"))) - (is (= "b" (least-by count "aa" "b")))) - -(deftest test-all-greatest - (is (nil? (all-greatest)) "all-greatest with no arguments is nil") - (is (= (list 1) (all-greatest 1))) - (is (= (list 1 1) (all-greatest 1 1))) - (is (= (list 2) (all-greatest 2 1 1))) - (is (= (list 2) (all-greatest 1 2 1))) - (is (= (list 2) (all-greatest 1 1 2))) - (is (= (list :c) (all-greatest :b :c :a)))) - -(deftest test-all-greatest-by - (is (nil? (all-greatest-by identity)) "all-greatest-by with no arguments is nil") - (is (= (list "a")) (all-greatest-by count "a")) - (is (= (list "a" "a")) (all-greatest-by count "a" "a")) - (is (= (list "aa")) (all-greatest-by count "aa" "b")) - (is (= (list "aa")) (all-greatest-by count "b" "aa" "c")) - (is (= (list "cc" "aa")) (all-greatest-by count "aa" "b" "cc"))) - -(deftest test-all-least - (is (nil? (all-least)) "all-least with no arguments is nil") - (is (= (list 1) (all-least 1))) - (is (= (list 1 1) (all-least 1 1))) - (is (= (list 1 1) (all-least 2 1 1))) - (is (= (list 1 1) (all-least 1 2 1))) - (is (= (list 1 1) (all-least 1 1 2))) - (is (= (list :a) (all-least :b :c :a)))) - -(deftest test-all-least-by - (is (nil? (all-least-by identity)) "all-least-by with no arguments is nil") - (is (= (list "a")) (all-least-by count "a")) - (is (= (list "a" "a")) (all-least-by count "a" "a")) - (is (= (list "b")) (all-least-by count "aa" "b")) - (is (= (list "c" "b")) (all-least-by count "b" "aa" "c")) - (is (= (list "b")) (all-least-by count "aa" "b" "cc"))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_io.clj --- a/src/clojure/contrib/test_contrib/test_io.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,96 +0,0 @@ -(ns clojure.contrib.test-io - (:refer-clojure :exclude (spit)) - (:use clojure.test clojure.contrib.io) - (:import (java.io File FileInputStream BufferedInputStream) - (java.net URL URI))) - -(deftest file-str-backslash - (is (= (java.io.File. - (str "C:" java.io.File/separator - "Documents" java.io.File/separator - "file.txt")) - (file-str "C:\\Documents\\file.txt")))) - -(deftest test-as-file - (testing "strings" - (is (= (File. "foo") (as-file "foo")))) - (testing "Files" - (is (= (File. "bar") (as-file (File. "bar")))))) - -(deftest test-as-url - (are [result expr] (= result expr) - (URL. "http://foo") (as-url (URL. "http://foo")) - (URL. "http://foo") (as-url "http://foo") - (URL. "http://foo") (as-url (URI. "http://foo")) - (URL. "file:/foo") (as-url (File. "/foo")))) - -(deftest test-delete-file - (let [file (File/createTempFile "test" "deletion") - not-file (File. (str (java.util.UUID/randomUUID)))] - (delete-file (.getAbsolutePath file)) - (is (not (.exists file))) - (is (thrown? ArithmeticException (/ 1 0))) - (is (thrown? java.io.IOException (delete-file not-file))) - (is (delete-file not-file :silently)))) - -(deftest test-relative-path-string - (testing "strings" - (is (= "foo" (relative-path-string "foo")))) - (testing "absolute path strings are forbidden" - (is (thrown? IllegalArgumentException (relative-path-string (str File/separator "baz"))))) - (testing "relative File paths" - (is (= "bar" (relative-path-string (File. "bar"))))) - (testing "absolute File paths are forbidden" - (is (thrown? IllegalArgumentException (relative-path-string (File. (str File/separator "quux"))))))) - -(defn stream-should-have [stream expected-bytes msg] - (let [actual-bytes (byte-array (alength expected-bytes))] - (.read stream actual-bytes) - (is (= -1 (.read stream)) (str msg " : should be end of stream")) - (is (= (seq expected-bytes) (seq actual-bytes)) (str msg " : byte arrays should match")))) - -(deftest test-input-stream - (let [file (File/createTempFile "test-input-stream" "txt") - bytes (.getBytes "foobar")] - (spit file "foobar") - (doseq [[expr msg] - [[file File] - [(FileInputStream. file) FileInputStream] - [(BufferedInputStream. (FileInputStream. file)) BufferedInputStream] - [(.. file toURI) URI] - [(.. file toURI toURL) URL] - [(.. file toURI toURL toString) "URL as String"] - [(.. file toString) "File as String"]]] - (with-open [s (input-stream expr)] - (stream-should-have s bytes msg))))) - -(deftest test-streams-buffering - (let [data (.getBytes "")] - (is (instance? java.io.BufferedReader (reader data))) - (is (instance? java.io.BufferedWriter (writer (java.io.ByteArrayOutputStream.)))) - (is (instance? java.io.BufferedInputStream (input-stream data))) - (is (instance? java.io.BufferedOutputStream (output-stream (java.io.ByteArrayOutputStream.)))))) - -(deftest test-streams-defaults - (let [f (File/createTempFile "clojure.contrib" "test-reader-writer") - content "test\u2099ing"] - (try - (is (thrown? Exception (reader (Object.)))) - (is (thrown? Exception (writer (Object.)))) - - (are [write-to read-from] (= content (do - (spit write-to content) - (slurp* (or read-from write-to)))) - f nil - (.getAbsolutePath f) nil - (.toURL f) nil - (.toURI f) nil - (java.io.FileOutputStream. f) f - (java.io.OutputStreamWriter. (java.io.FileOutputStream. f) "UTF-8") f - f (java.io.FileInputStream. f) - f (java.io.InputStreamReader. (java.io.FileInputStream. f) "UTF-8")) - - (is (= content (slurp* (.getBytes content "UTF-8")))) - (is (= content (slurp* (.toCharArray content)))) - (finally - (.delete f))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_jmx.clj --- a/src/clojure/contrib/test_contrib/test_jmx.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,178 +0,0 @@ -;; Tests for JMX support for Clojure (see also clojure/contrib/jmx.clj) - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns clojure.contrib.test-jmx - (:import javax.management.openmbean.CompositeDataSupport - [javax.management MBeanAttributeInfo AttributeList] - [java.util.logging LogManager Logger] - clojure.contrib.jmx.Bean) - (:use clojure.test) - (:require [clojure.contrib [jmx :as jmx]])) - - -(defn =set [a b] - (= (set a) (set b))) - -(defn seq-contains-all? - "Does container contain every item in containee? - Not fast. Testing use only" - [container containee] - (let [container (set container)] - (every? #(contains? container %) containee))) - -(deftest finding-mbeans - (testing "as-object-name" - (are [cname object-name] - (= cname (.getCanonicalName object-name)) - "java.lang:type=Memory" (jmx/as-object-name "java.lang:type=Memory"))) - (testing "mbean-names" - (are [cnames object-name] - (= cnames (map #(.getCanonicalName %) object-name)) - ["java.lang:type=Memory"] (jmx/mbean-names "java.lang:type=Memory")))) - -; These actual beans may differ on different JVM platforms. -; Tested April 2010 to work on Sun and IBM JDKs. -(deftest testing-actual-beans - (testing "reflecting on capabilities" - (are [attr-list mbean-name] - (seq-contains-all? (jmx/attribute-names mbean-name) attr-list) - [:Verbose :ObjectPendingFinalizationCount :HeapMemoryUsage :NonHeapMemoryUsage] "java.lang:type=Memory") - (are [op-list mbean-name] - (seq-contains-all? (jmx/operation-names mbean-name) op-list) - [:gc] "java.lang:type=Memory")) - (testing "mbean-from-oname" - (are [key-names oname] - (seq-contains-all? (keys (jmx/mbean oname)) key-names) - [:Verbose :ObjectPendingFinalizationCount :HeapMemoryUsage :NonHeapMemoryUsage] "java.lang:type=Memory"))) - -(deftest raw-reading-attributes - (let [mem "java.lang:type=Memory" - log "java.util.logging:type=Logging"] - (testing "simple scalar attributes" - (are [a b] (= a b) - false (jmx/raw-read mem :Verbose)) - (are [type attr] (instance? type attr) - Number (jmx/raw-read mem :ObjectPendingFinalizationCount))))) - -(deftest reading-attributes - (testing "simple scalar attributes" - (are [type attr] (instance? type attr) - Number (jmx/read "java.lang:type=Memory" :ObjectPendingFinalizationCount))) - (testing "composite attributes" - (are [ks attr] (=set ks (keys attr)) - [:used :max :init :committed] (jmx/read "java.lang:type=Memory" :HeapMemoryUsage))) - (testing "tabular attributes" - (is (map? (jmx/read "java.lang:type=Runtime" :SystemProperties))))) - -(deftest writing-attributes - (let [mem "java.lang:type=Memory"] - (jmx/write! mem :Verbose true) - (is (true? (jmx/raw-read mem :Verbose))) - (jmx/write! mem :Verbose false))) - -(deftest test-invoke-operations - (testing "without arguments" - (jmx/invoke "java.lang:type=Memory" :gc)) - (testing "with arguments" - (.addLogger (LogManager/getLogManager) (Logger/getLogger "clojure.contrib.test_contrib.test_jmx")) - (jmx/invoke "java.util.logging:type=Logging" :setLoggerLevel "clojure.contrib.test_contrib.test_jmx" "WARNING"))) - -(deftest test-jmx->clj - (testing "it works recursively on maps" - (let [some-map {:foo (jmx/raw-read "java.lang:type=Memory" :HeapMemoryUsage)}] - (is (map? (:foo (jmx/jmx->clj some-map)))))) - (testing "it leaves everything else untouched" - (is (= "foo" (jmx/jmx->clj "foo"))))) - - -(deftest test-composite-data->map - (let [data (jmx/raw-read "java.lang:type=Memory" :HeapMemoryUsage) - prox (jmx/composite-data->map data)] - (testing "returns a map with keyword keys" - (is (= (set [:committed :init :max :used]) (set (keys prox))))))) - -(deftest test-tabular-data->map - (let [raw-props (jmx/raw-read "java.lang:type=Runtime" :SystemProperties) - props (jmx/tabular-data->map raw-props)] - (are [k] (contains? props k) - :java.class.path - :path.separator))) - -(deftest test-creating-attribute-infos - (let [infos (jmx/map->attribute-infos [[:a 1] [:b 2]]) - info (first infos)] - (testing "generates the right class" - (is (= (class (into-array MBeanAttributeInfo [])) (class infos)))) - (testing "generates the right instance data" - (are [result expr] (= result expr) - "a" (.getName info) - "a" (.getDescription info))))) - -(deftest various-beans-are-readable - (testing "that all java.lang beans can be read without error" - (doseq [mb (jmx/mbean-names "*:*")] - (is (map? (jmx/mbean mb)) mb)))) - -(deftest test-jmx-url - (testing "creates default url" - (is (= "service:jmx:rmi:///jndi/rmi://localhost:3000/jmxrmi" - (jmx/jmx-url)))) - (testing "creates custom url" - (is (= "service:jmx:rmi:///jndi/rmi://example.com:4000/jmxrmi" - (jmx/jmx-url {:host "example.com" :port 4000})))) - (testing "creates custom jndi path" - (is (= "service:jmx:rmi:///jndi/rmi://example.com:4000/jmxconnector" - (jmx/jmx-url {:host "example.com" :port 4000 :jndi-path "jmxconnector"}))))) - -;; ---------------------------------------------------------------------- -;; tests for clojure.contrib.jmx.Bean. - -(deftest dynamic-mbean-from-compiled-class - (let [mbean-name "clojure.contrib.test_contrib.test_jmx:name=Foo"] - (jmx/register-mbean - (Bean. - (ref {:string-attribute "a-string"})) - mbean-name) - (are [result expr] (= result expr) - "a-string" (jmx/read mbean-name :string-attribute) - {:string-attribute "a-string"} (jmx/mbean mbean-name) - ))) - -(deftest test-getAttribute - (doseq [reftype [ref atom agent]] - (let [state (reftype {:a 1 :b 2}) - bean (Bean. state)] - (testing (str "accessing values from a " (class state)) - (are [result expr] (= result expr) - 1 (.getAttribute bean "a")))))) - -(deftest test-bean-info - (let [state (ref {:a 1 :b 2}) - bean (Bean. state) - info (.getMBeanInfo bean)] - (testing "accessing info" - (are [result expr] (= result expr) - "clojure.contrib.jmx.Bean" (.getClassName info))))) - -(deftest test-getAttributes - (let [bean (Bean. (ref {:r 5 :d 4})) - atts (.getAttributes bean (into-array ["r" "d"]))] - (are [x y] (= x y) - AttributeList (class atts) - [5 4] (seq atts)))) - -(deftest test-guess-attribute-typename - (are [x y] (= x (jmx/guess-attribute-typename y)) -; "long" 10 - "boolean" false - "java.lang.String" "foo" - "long" (Long/valueOf (long 10)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_json.clj --- a/src/clojure/contrib/test_contrib/test_json.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,186 +0,0 @@ -(ns clojure.contrib.test-json - (:use clojure.test clojure.contrib.json)) - -(deftest can-read-from-pushback-reader - (let [s (java.io.PushbackReader. (java.io.StringReader. "42"))] - (is (= 42 (read-json s))))) - -(deftest can-read-from-reader - (let [s (java.io.StringReader. "42")] - (is (= 42 (read-json s))))) - -(deftest can-read-numbers - (is (= 42 (read-json "42"))) - (is (= -3 (read-json "-3"))) - (is (= 3.14159 (read-json "3.14159"))) - (is (= 6.022e23 (read-json "6.022e23")))) - -(deftest can-read-null - (is (= nil (read-json "null")))) - -(deftest can-read-strings - (is (= "Hello, World!" (read-json "\"Hello, World!\"")))) - -(deftest handles-escaped-slashes-in-strings - (is (= "/foo/bar" (read-json "\"\\/foo\\/bar\"")))) - -(deftest handles-unicode-escapes - (is (= " \u0beb " (read-json "\" \\u0bEb \"")))) - -(deftest handles-escaped-whitespace - (is (= "foo\nbar" (read-json "\"foo\\nbar\""))) - (is (= "foo\rbar" (read-json "\"foo\\rbar\""))) - (is (= "foo\tbar" (read-json "\"foo\\tbar\"")))) - -(deftest can-read-booleans - (is (= true (read-json "true"))) - (is (= false (read-json "false")))) - -(deftest can-ignore-whitespace - (is (= nil (read-json "\r\n null")))) - -(deftest can-read-arrays - (is (= [1 2 3] (read-json "[1,2,3]"))) - (is (= ["Ole" "Lena"] (read-json "[\"Ole\", \r\n \"Lena\"]")))) - -(deftest can-read-objects - (is (= {:a 1, :b 2} (read-json "{\"a\": 1, \"b\": 2}")))) - -(deftest can-read-nested-structures - (is (= {:a [1 2 {:b [3 "four"]} 5.5]} - (read-json "{\"a\":[1,2,{\"b\":[3,\"four\"]},5.5]}")))) - -(deftest disallows-non-string-keys - (is (thrown? Exception (read-json "{26:\"z\"")))) - -(deftest disallows-barewords - (is (thrown? Exception (read-json " foo ")))) - -(deftest disallows-unclosed-arrays - (is (thrown? Exception (read-json "[1, 2, ")))) - -(deftest disallows-unclosed-objects - (is (thrown? Exception (read-json "{\"a\":1, ")))) - -(deftest can-get-string-keys - (is (= {"a" [1 2 {"b" [3 "four"]} 5.5]} - (read-json "{\"a\":[1,2,{\"b\":[3,\"four\"]},5.5]}" false true nil)))) - -(declare *pass1-string*) - -(deftest pass1-test - (let [input (read-json *pass1-string* false true nil)] - (is (= "JSON Test Pattern pass1" (first input))) - (is (= "array with 1 element" (get-in input [1 "object with 1 member" 0]))) - (is (= 1234567890 (get-in input [8 "integer"]))) - (is (= "rosebud" (last input))))) - -; from http://www.json.org/JSON_checker/test/pass1.json -(def *pass1-string* - "[ - \"JSON Test Pattern pass1\", - {\"object with 1 member\":[\"array with 1 element\"]}, - {}, - [], - -42, - true, - false, - null, - { - \"integer\": 1234567890, - \"real\": -9876.543210, - \"e\": 0.123456789e-12, - \"E\": 1.234567890E+34, - \"\": 23456789012E66, - \"zero\": 0, - \"one\": 1, - \"space\": \" \", - \"quote\": \"\\\"\", - \"backslash\": \"\\\\\", - \"controls\": \"\\b\\f\\n\\r\\t\", - \"slash\": \"/ & \\/\", - \"alpha\": \"abcdefghijklmnopqrstuvwyz\", - \"ALPHA\": \"ABCDEFGHIJKLMNOPQRSTUVWYZ\", - \"digit\": \"0123456789\", - \"0123456789\": \"digit\", - \"special\": \"`1~!@#$%^&*()_+-={':[,]}|;.?\", - \"hex\": \"\\u0123\\u4567\\u89AB\\uCDEF\\uabcd\\uef4A\", - \"true\": true, - \"false\": false, - \"null\": null, - \"array\":[ ], - \"object\":{ }, - \"address\": \"50 St. James Street\", - \"url\": \"http://www.JSON.org/\", - \"comment\": \"// /* */\": \" \", - \" s p a c e d \" :[1,2 , 3 - -, - -4 , 5 , 6 ,7 ],\"compact\":[1,2,3,4,5,6,7], - \"jsontext\": \"{\\\"object with 1 member\\\":[\\\"array with 1 element\\\"]}\", - \"quotes\": \"" \\u0022 %22 0x22 034 "\", - \"\\/\\\\\\\"\\uCAFE\\uBABE\\uAB98\\uFCDE\\ubcda\\uef4A\\b\\f\\n\\r\\t`1~!@#$%^&*()_+-=[]{}|;:',./<>?\" -: \"A key can be any string\" - }, - 0.5 ,98.6 -, -99.44 -, - -1066, -1e1, -0.1e1, -1e-1, -1e00,2e+00,2e-00 -,\"rosebud\"]") - - -(deftest can-print-json-strings - (is (= "\"Hello, World!\"" (json-str "Hello, World!"))) - (is (= "\"\\\"Embedded\\\" Quotes\"" (json-str "\"Embedded\" Quotes")))) - -(deftest can-print-unicode - (is (= "\"\\u1234\\u4567\"" (json-str "\u1234\u4567")))) - -(deftest can-print-json-null - (is (= "null" (json-str nil)))) - -(deftest can-print-json-arrays - (is (= "[1,2,3]" (json-str [1 2 3]))) - (is (= "[1,2,3]" (json-str (list 1 2 3)))) - (is (= "[1,2,3]" (json-str (sorted-set 1 2 3)))) - (is (= "[1,2,3]" (json-str (seq [1 2 3]))))) - -(deftest can-print-java-arrays - (is (= "[1,2,3]" (json-str (into-array [1 2 3]))))) - -(deftest can-print-empty-arrays - (is (= "[]" (json-str []))) - (is (= "[]" (json-str (list)))) - (is (= "[]" (json-str #{})))) - -(deftest can-print-json-objects - (is (= "{\"a\":1,\"b\":2}" (json-str (sorted-map :a 1 :b 2))))) - -(deftest object-keys-must-be-strings - (is (= "{\"1\":1,\"2\":2") (json-str (sorted-map 1 1 2 2)))) - -(deftest can-print-empty-objects - (is (= "{}" (json-str {})))) - -(deftest accept-sequence-of-nils - (is (= "[null,null,null]" (json-str [nil nil nil])))) - -(deftest error-on-nil-keys - (is (thrown? Exception (json-str {nil 1})))) - -(deftest characters-in-symbols-are-escaped - (is (= "\"foo\\u1b1b\"" (json-str (symbol "foo\u1b1b"))))) - -;;; Pretty-printer - -(deftest pretty-printing - (let [x (read-json *pass1-string* false)] - (is (= x (read-json (with-out-str (pprint-json x)) false))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_lazy_seqs.clj --- a/src/clojure/contrib/test_contrib/test_lazy_seqs.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,21 +0,0 @@ -(ns clojure.contrib.test-lazy-seqs - (:use clojure.test - clojure.contrib.lazy-seqs)) - -(deftest test-fibs - (is (= [0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 - 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 - 3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 - 165580141 267914296 433494437 701408733 1134903170 1836311903 2971215073 - 4807526976 7778742049] - (take 50 (fibs))))) - -(deftest test-powers-of-2 - (is (= [1 2 4 8 16 32 64 128 256 512] - (take 10 (powers-of-2))))) - -(deftest test-primes - (is (= [2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 - 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 - 199 211 223 227 229] - (take 50 primes)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_load_all.clj --- a/src/clojure/contrib/test_contrib/test_load_all.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,53 +0,0 @@ -;;; test_load_all.clj - loads all contrib libraries for testing purposes - -;; by Stuart Halloway, http://blog.thinkrelevance.com - -;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -;; This is only intended to check that the libraries will load without -;; errors, not that they work correctly. - -;; The code includes several design choices I don't love, but find -;; tolerable in a test-only lib: -;; -;; * namespaces that blow up to document deprecation -;; * using directory paths to find contrib -;; * using a macro to reflectively write tests -;; -;; I *am* happy that code that won't even load now breaks the build. - -(ns clojure.contrib.test-load-all - (:use clojure.test clojure.contrib.find-namespaces)) - -(def deprecated-contrib-namespaces - '[clojure.contrib.javadoc]) - -(defn loadable-contrib-namespaces - "Contrib namespaces that can be loaded (everything except - deprecated nses that throw on load.)" - [] - (apply disj - (into #{} (find-namespaces-in-dir (java.io.File. "src/main"))) - deprecated-contrib-namespaces)) - -(defn emit-test-load - [] - `(do - ~@(map - (fn [ns] - `(deftest ~(symbol (str "test-loading-" (.replace (str ns) "." "-"))) - (require :reload '~ns))) - (loadable-contrib-namespaces)))) - -(defmacro test-load - [] - (emit-test-load)) - -(test-load) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_macro_utils.clj --- a/src/clojure/contrib/test_contrib/test_macro_utils.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,67 +0,0 @@ -;; Test routines for macro_utils.clj - -;; by Konrad Hinsen -;; last updated May 6, 2009 - -;; Copyright (c) Konrad Hinsen, 2008. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns clojure.contrib.test-macro-utils - (:use [clojure.test :only (deftest is are run-tests use-fixtures)] - [clojure.contrib.macro-utils - :only (macrolet symbol-macrolet defsymbolmacro with-symbol-macros - mexpand-1 mexpand mexpand-all)] - [clojure.contrib.monads - :only (with-monad domonad)])) - -(use-fixtures :each - (fn [f] (binding [*ns* (the-ns 'clojure.contrib.test-macro-utils)] - (f)))) - -(deftest macrolet-test - (is (= (macroexpand-1 - '(macrolet [(foo [form] `(~form ~form))] (foo x))) - '(do (x x))))) - -(deftest symbol-macrolet-test - (is (= (macroexpand-1 - '(symbol-macrolet [x xx y yy] - (exp [a y] (x y)))) - '(do (exp [a yy] (xx yy))))) - (is (= (macroexpand-1 - '(symbol-macrolet [def foo] - (def def def))) - '(do (def def foo)))) - (is (= (macroexpand-1 - '(symbol-macrolet [x foo z bar] - (let [a x b y x b] [a b x z]))) - '(do (let* [a foo b y x b] [a b x bar])))) - (is (= (macroexpand-1 - '(symbol-macrolet [x foo z bar] - (fn ([x y] [x y z]) ([x y z] [x y z])))) - '(do (fn* ([x y] [x y bar]) ([x y z] [x y z]))))) - (is (= (macroexpand-1 - '(symbol-macrolet [x foo z bar] - (fn f ([x y] [x y z]) ([x y z] [x y z])))) - '(do (fn* f ([x y] [x y bar]) ([x y z] [x y z]))))) - (is (= (nth (second (macroexpand-1 - '(symbol-macrolet [x xx y yy z zz] - (domonad m [a x b y x z] [a b x z])))) 2) - '(do (m-bind xx (fn* ([a] - (m-bind yy (fn* ([b] - (m-bind zz (fn* ([x] - (m-result [a b x zz])))))))))))))) - -(deftest symbol-test - (defsymbolmacro sum-2-3 (plus 2 3)) - (is (= (macroexpand '(with-symbol-macros (+ 1 sum-2-3))) - '(do (+ 1 (plus 2 3))))) - (is (= (macroexpand '(macrolet [(plus [a b] `(+ ~a ~b))] (+ 1 sum-2-3))) - '(do (+ 1 (clojure.core/+ 2 3))))) - (ns-unmap *ns* 'sum-2-3)) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_math.clj --- a/src/clojure/contrib/test_contrib/test_math.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,118 +0,0 @@ -(ns clojure.contrib.test-math - (:use clojure.test - clojure.contrib.math)) - -(deftest test-expt - (are [x y] (= x y) - (expt 2 3) 8 - (expt (expt 2 16) 2) (expt 2 32) - (expt 4/3 2) 16/9 - (expt 2 -10) 1/1024 - (expt 0.5M 2) 0.25M - (expt 5 4.2) (Math/pow 5 4.2) - (expt 5.3 4) (Math/pow 5.3 4))) - -(deftest test-abs - (are [x y] (= x y) - (abs -2) 2 - (abs 0) 0 - (abs 5) 5 - (abs 123456789123456789) 123456789123456789 - (abs -123456789123456789) 123456789123456789 - (abs 5/3) 5/3 - (abs -4/3) 4/3 - (abs 4.3M) 4.3M - (abs -4.3M) 4.3M - (abs 2.8) 2.8 - (abs -2.8) 2.8)) - -(deftest test-gcd - (are [x y] (= x y) - (gcd 4 3) 1 - (gcd 24 12) 12 - (gcd 24 27) 3 - (gcd 1 0) 1 - (gcd 0 1) 1 - (gcd 0 0) 0) - (is (thrown? IllegalArgumentException (gcd nil 0))) - (is (thrown? IllegalArgumentException (gcd 0 nil))) - (is (thrown? IllegalArgumentException (gcd 7.0 0)))) - -(deftest test-lcm - (are [x y] (= x y) - (lcm 2 3) 6 - (lcm 3 2) 6 - (lcm -2 3) 6 - (lcm 2 -3) 6 - (lcm -2 -3) 6 - (lcm 4 10) 20 - (lcm 1 0) 0 - (lcm 0 1) 0 - (lcm 0 0)) - (is (thrown? IllegalArgumentException (lcm nil 0))) - (is (thrown? IllegalArgumentException (lcm 0 nil))) - (is (thrown? IllegalArgumentException (lcm 7.0 0)))) - -(deftest test-floor - (are [x y] (== x y) - (floor 6) 6 - (floor -6) -6 - (floor 123456789123456789) 123456789123456789 - (floor -123456789123456789) -123456789123456789 - (floor 4/3) 1 - (floor -4/3) -2 - (floor 4.3M) 4 - (floor -4.3M) -5 - (floor 4.3) 4.0 - (floor -4.3) -5.0)) - -(deftest test-ceil - (are [x y] (== x y) - (ceil 6) 6 - (ceil -6) -6 - (ceil 123456789123456789) 123456789123456789 - (ceil -123456789123456789) -123456789123456789 - (ceil 4/3) 2 - (ceil -4/3) -1 - (ceil 4.3M) 5 - (ceil -4.3M) -4 - (ceil 4.3) 5.0 - (ceil -4.3) -4.0)) - -(deftest test-round - (are [x y] (== x y) - (round 6) 6 - (round -6) -6 - (round 123456789123456789) 123456789123456789 - (round -123456789123456789) -123456789123456789 - (round 4/3) 1 - (round 5/3) 2 - (round 5/2) 3 - (round -4/3) -1 - (round -5/3) -2 - (round -5/2) -2 - (round 4.3M) 4 - (round 4.7M) 5 - (round -4.3M) -4 - (round -4.7M) -5 - (round 4.5M) 5 - (round -4.5M) -4 - (round 4.3) 4 - (round 4.7) 5 - (round -4.3) -4 - (round -4.7) -5 - (round 4.5) 5 - (round -4.5) -4)) - -(deftest test-sqrt - (are [x y] (= x y) - (sqrt 9) 3 - (sqrt 16/9) 4/3 - (sqrt 0.25M) 0.5M - (sqrt 2) (Math/sqrt 2))) - -(deftest test-exact-integer-sqrt - (are [x y] (= x y) - (exact-integer-sqrt 15) [3 6] - (exact-integer-sqrt (inc (expt 2 32))) [(expt 2 16) 1] - (exact-integer-sqrt 1000000000000) [1000000 0])) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_miglayout.clj --- a/src/clojure/contrib/test_contrib/test_miglayout.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,145 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; clojure.contrib.miglayout.test -;; -;; Test/example for clojure.contrib.miglayout -;; -;; scgilardi (gmail) -;; Created 5 October 2008 - -(ns clojure.contrib.test-miglayout - (:import (javax.swing JButton JFrame JLabel JList JPanel - JScrollPane JTabbedPane JTextField JSeparator)) - (:use clojure.contrib.miglayout)) - -(def tests) - -(defn run-test - [index] - (let [panel ((tests index) (JPanel.))] - (println index (components panel)) - (doto (JFrame. (format "MigLayout Test %d" index)) - (.add panel) - (.pack) - (.setVisible true)))) - -(defn label - "Returns a swing label" - [text] - (JLabel. text)) - -(defn text-field - "Returns a swing text field" - ([] (text-field 10)) - ([width] - (JTextField. width))) - -(defn sep - "Returns a swing separator" - [] - (JSeparator.)) - -(def tests [ - - (fn test0 - [panel] - (miglayout panel - (label "Hello") - (label "World") {:gap :unrelated} - (text-field) :wrap - (label "Bonus!") - (JButton. "Bang it") {:wmin :button :grow :x :span 2} :center)) - - ;; test1 and test2 are based on code from - ;; http://www.devx.com/java/Article/38017/1954 - - ;; constraints as strings exclusively - (fn test1 - [panel] - (miglayout panel - :column "[right]" - (label "General") "split, span" - (sep) "growx, wrap" - (label "Company") "gap 10" - (text-field "") "span, growx" - (label "Contact") "gap 10" - (text-field "") "span, growx, wrap" - (label "Propeller") "split, span, gaptop 10" - (sep) "growx, wrap, gaptop 10" - (label "PTI/kW") "gapx 10, gapy 15" - (text-field) - (label "Power/kW") "gap 10" - (text-field) "wrap" - (label "R/mm") "gap 10" - (text-field) - (label "D/mm") "gap 10" - (text-field))) - - ;; the same constraints as strings, keywords, vectors, and maps - (fn test2 - [panel] - (miglayout panel - :column "[right]" - (label "General") "split, span" - (sep) :growx :wrap - (label "Company") [:gap 10] - (text-field "") :span :growx - (label "Contact") [:gap 10] - (text-field "") :span :growx :wrap - (label "Propeller") :split :span [:gaptop 10] - (sep) :growx :wrap [:gaptop 10] - (label "PTI/kW") {:gapx 10 :gapy 15} - (text-field) - (label "Power/kW") [:gap 10] - (text-field) :wrap - (label "R/mm") [:gap 10] - (text-field) - (label "D/mm") [:gap 10] - (text-field))) - - ;; the same constraints using symbols to name groups of constraints - (fn test3 - [panel] - (let [g [:gap 10] - gt [:gaptop 10] - gxs #{:growx :span} - gxw #{:growx :wrap} - gxy {:gapx 10 :gapy 15} - right "[right]" - ss #{:split :span} - w :wrap] - (miglayout panel - :column right - (label "General") ss - (sep) gxw - (label "Company") g - (text-field "") gxs - (label "Contact") g - (text-field "") gxs - (label "Propeller") ss gt - (sep) gxw g - (label "PTI/kW") gxy - (text-field) - (label "Power/kW") g - (text-field) w - (label "R/mm") g - (text-field) - (label "D/mm") g - (text-field)))) - - (fn test4 - [panel] - (miglayout panel - (label "First Name") - (text-field) {:id :firstname} - (label "Surname") [:gap :unrelated] - (text-field) {:id :surname} :wrap - (label "Address") - (text-field) {:id :address} :span :grow)) -]) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_mock.clj --- a/src/clojure/contrib/test_contrib/test_mock.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,131 +0,0 @@ -(ns clojure.contrib.test-mock - (:use clojure.test) - (:require [clojure.contrib.mock :as mock])) - -; Used as dummy dependency functions -(defn fn1 {:dynamic true} [x] :ignore) -(defn fn2 {:dynamic true} [x y] :ignore) -(defn fn3 {:dynamic true} ([x] :ignore) - ([x y z] :ignore)) -(defn fn4 {:dynamic true} [x y & r] :ignore) - -;functions created using fn directly lack the argslist meta data -(def #^{:dynamic true} deffed-differently (fn [x] :ignore)) - -(defmacro assert-called [fn-name called? & body] - `(let [called-status?# (atom false)] - (binding [~fn-name (fn [& args#] (reset! called-status?# true))] ~@body) - (is (= ~called? @called-status?#)))) - -(deftest test-convenience - (testing "once" - (is (false? (mock/once 0))) - (is (false? (mock/once 123))) - (is (true? (mock/once 1)))) - - (testing "never" - (is (false? (mock/never 4))) - (is (true? (mock/never 0)))) - - (testing "more-than" - (is (false? ((mock/more-than 5) 3))) - (is (true? ((mock/more-than 5) 9)))) - - (testing "less-than" - (is (true? ((mock/less-than 5) 3))) - (is (false? ((mock/less-than 5) 9)))) - - (testing "between" - (is (true? ((mock/between 5 8) 6))) - (is (false? ((mock/between 5 8) 5))))) - - -(deftest test-returns - (is (= {:returns 5} (mock/returns 5))) - (is (= {:other-key "test" :returns nil} (mock/returns nil {:other-key "test"})))) - - -(deftest test-has-args - (let [ex (:has-args (mock/has-args [1]))] - (is (fn? ex)) - (is (ex 'fn1 1)) - (is (ex 'fn1 1 5 6)) - (assert-called mock/unexpected-args true (ex 'fn1 5))) - (is (contains? (mock/has-args [] {:pre-existing-key "test"}) :pre-existing-key)) - (is (true? (((mock/has-args [5]) :has-args)'fn1 5)))) - - -(deftest test-has-matching-signature - (assert-called mock/no-matching-function-signature true - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn2 [1])) - (assert-called mock/no-matching-function-signature true - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn3 [1 3])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn3 [1 3 5])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1 3 5 7 9])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1 3])) - (assert-called mock/no-matching-function-signature true - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-mock/deffed-differently [1]))) - - -(deftest test-times - (is (fn? ((mock/times #(= 1 %)) :times))) - (is (contains? (mock/times #(= 1 %) {:existing-key "test"}) :existing-key))) - -(deftest test-make-mock - (testing "invalid arguments" - (is (thrown? IllegalArgumentException (mock/make-mock [5])))) - - (testing "valid counter and unevaluated returns" - (let [[mock counter count-checker] (mock/make-mock 'fn1 (mock/returns 5 (mock/times 1)))] - (is (fn? mock)) - (is (= 0 @counter)) - (is (= 5 (mock :ignore-me))) - (is (= 1 @counter)))) - - (testing "returns as expected" - (let [[mock] (mock/make-mock 'fn1 (mock/returns 5))] - (is (= 5 (mock :ignore)))) - (let [[mock] (mock/make-mock 'fn1 (mock/returns #(* 2 %)))] - (is (= 10 ((mock :ignore) 5)) ":returns a function should not automatically - evaluate it."))) - - (testing "calls replacement-fn and returns the result" - (let [[mock] (mock/make-mock 'fn1 (mock/calls #(* 3 %)))] - (is (= 15 (mock 5)))) - (let [[mock] (mock/make-mock 'fn1 (mock/calls #(* 2 %) (mock/returns 3)))] - (is (= 10 (mock 5))))) - - (testing "argument validation" - (let [[mock] (mock/make-mock 'fn1 (mock/has-args [#(= 5 %)]))] - (assert-called mock/unexpected-args true (mock "test")) - (is (nil? (mock 5)))))) - - -(deftest test-make-count-checker - (let [checker (mock/make-count-checker 5 5)] - (assert-called mock/incorrect-invocation-count false (checker 'fn1 5)) - (assert-called mock/incorrect-invocation-count true (checker 'fn1 3)))) - - -(deftest test-validate-counts - (assert-called mock/incorrect-invocation-count false - (mock/validate-counts (list [(fn []) (atom 0) (mock/make-count-checker #(< % 6) '#(< % 6)) 'fn1]))) - (assert-called mock/incorrect-invocation-count true - (mock/validate-counts (list [(fn []) (atom 0) (mock/make-count-checker 4 4) 'fn1])))) - - -(deftest test-expect-macro - (let [under-test (fn [x] (fn1 x))] - (is (true? (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 3 %)]))] - (under-test 3)))) - (assert-called mock/unexpected-args true (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 4 %)]))] - (under-test 3)))) - (let [under-test (fn [] (fn2 (fn1 1) 3))] - (is (true? (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 1 %)] (mock/returns 2))) - fn2 (mock/times 1 (mock/has-args [#(= 2 %) #(= 3 %)] (mock/returns 5)))] - (under-test)))))) \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_monads.clj --- a/src/clojure/contrib/test_contrib/test_monads.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,78 +0,0 @@ -;; Test routines for monads.clj - -;; by Konrad Hinsen -;; last updated March 28, 2009 - -;; Copyright (c) Konrad Hinsen, 2008. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns clojure.contrib.test-monads - (:use [clojure.test :only (deftest is are run-tests)] - [clojure.contrib.monads - :only (with-monad domonad m-lift m-seq m-chain - sequence-m maybe-m state-m maybe-t sequence-t)])) - -(deftest sequence-monad - (with-monad sequence-m - (are [a b] (= a b) - (domonad [x (range 3) y (range 2)] (+ x y)) - '(0 1 1 2 2 3) - (domonad [x (range 5) y (range (+ 1 x)) :when (= (+ x y) 2)] (list x y)) - '((1 1) (2 0)) - ((m-lift 2 #(list %1 %2)) (range 3) (range 2)) - '((0 0) (0 1) (1 0) (1 1) (2 0) (2 1)) - (m-seq (replicate 3 (range 2))) - '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1)) - ((m-chain (replicate 3 range)) 5) - '(0 0 0 1 0 0 1 0 1 2) - (m-plus (range 3) (range 2)) - '(0 1 2 0 1)))) - -(deftest maybe-monad - (with-monad maybe-m - (let [m+ (m-lift 2 +) - mdiv (fn [x y] (domonad [a x b y :when (not (zero? b))] (/ a b)))] - (are [a b] (= a b) - (m+ (m-result 1) (m-result 3)) - (m-result 4) - (mdiv (m-result 1) (m-result 3)) - (m-result (/ 1 3)) - (m+ 1 (mdiv (m-result 1) (m-result 0))) - m-zero - (m-plus m-zero (m-result 1) m-zero (m-result 2)) - (m-result 1))))) - -(deftest seq-maybe-monad - (with-monad (maybe-t sequence-m) - (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))] - (are [a b] (= a b) - ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n))) - '(nil 2 nil 4 nil 6 nil 8 nil 10) - (pairs (for [n (range 5)] (when (odd? n) n))) - '(nil nil (1 1) nil (1 3) nil nil nil (3 1) nil (3 3) nil nil))))) - -(deftest state-maybe-monad - (with-monad (maybe-t state-m) - (is (= (for [[a b c d] (list [1 2 3 4] [nil 2 3 4] [ 1 nil 3 4] - [nil nil 3 4] [1 2 nil nil])] - (let [f (domonad - [x (m-plus (m-result a) (m-result b)) - y (m-plus (m-result c) (m-result d))] - (+ x y))] - (f :state))) - (list [4 :state] [5 :state] [4 :state] [nil :state] [nil :state]))))) - -(deftest state-seq-monad - (with-monad (sequence-t state-m) - (is (= (let [[a b c d] [1 2 10 20] - f (domonad - [x (m-plus (m-result a) (m-result b)) - y (m-plus (m-result c) (m-result d))] - (+ x y))] - (f :state))) - (list [(list 11 21 12 22) :state])))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_profile.clj --- a/src/clojure/contrib/test_contrib/test_profile.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -(ns clojure.contrib.test-profile - (:use clojure.test - clojure.contrib.profile)) - -(deftest test-print-summary - (testing "doesn't blow up with no data (assembla #31)" - (is (= "Name mean min max count sum\n" - (with-out-str (print-summary {})))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_properties.clj --- a/src/clojure/contrib/test_contrib/test_properties.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,63 +0,0 @@ -(ns clojure.contrib.test-properties - (:refer-clojure :exclude (spit)) - (:use clojure.test clojure.contrib.properties - [clojure.contrib.io :only (spit)]) - (:import (java.util Properties) - (java.io File))) - -(deftest test-get-system-property - (testing "works the same with keywords, symbols, and strings" - (is (= (get-system-property "java.home") (get-system-property 'java.home))) - (is (= (get-system-property "java.home") (get-system-property :java.home)))) - (testing "treats second arg as default" - (is (= "default" (get-system-property "testing.test-system-property" "default")))) - (testing "returns nil for missing properties" - (is (nil? (get-system-property "testing.test-system-property"))))) - -(deftest test-set-system-properties - (testing "set and then unset a property using keywords" - (let [propname :clojure.contrib.java.test-set-system-properties] - (is (nil? (get-system-property propname))) - (set-system-properties {propname :foo}) - (is (= "foo") (get-system-property propname)) - (set-system-properties {propname nil}) - (is (nil? (get-system-property propname)))))) - -(deftest test-with-system-properties - (let [propname :clojure.contrib.java.test-with-system-properties] - (testing "sets a property only for the duration of a block" - (is (= "foo" - (with-system-properties {propname "foo"} - (get-system-property propname)))) - (is (nil? (get-system-property propname))))) - (testing "leaves other properties alone" - ; TODO: write this test better, using a properties -> map function - (let [propname :clojure.contrib.java.test-with-system-properties - propcount (count (System/getProperties))] - (with-system-properties {propname "foo"} - (is (= (inc propcount) (count (System/getProperties))))) - (is (= propcount (count (System/getProperties))))))) - -(deftest test-as-properties - (let [expected (doto (Properties.) - (.setProperty "a" "b") - (.setProperty "c" "d"))] - (testing "with a map" - (is (= expected - (as-properties {:a "b" :c "d"})))) - (testing "with a sequence of pairs" - (is (= expected - (as-properties [[:a :b] [:c :d]])))))) - -(deftest test-read-properties - (let [f (File/createTempFile "test" "properties")] - (spit f "a=b\nc=d") - (is (= {"a" "b" "c" "d"} - (read-properties f))))) - -(deftest test-write-properties - (let [f (File/createTempFile "test" "properties")] - (write-properties [['a 'b] ['c 'd]] f) - (is (= {"a" "b" "c" "d"} - (read-properties f))))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_prxml.clj --- a/src/clojure/contrib/test_contrib/test_prxml.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -(ns clojure.contrib.test-prxml - (:use clojure.test clojure.contrib.prxml)) - -(deftest prxml-basic - (is (= "

Hello, World!

" - (with-out-str (prxml [:p "Hello, World!"]))))) - -(deftest prxml-escaping - (is (= "foo<bar" - (with-out-str (prxml [:a {:href "foo&bar"} "foo= ? AND grade <= ?") - min max] - (doseq [rec res] - (println rec))))) - -(defn db-grade-a - "Print rows describing all grade a fruit (grade between 90 and 100)" - [] - (db-grade-range 90 100)) - -(defn db-get-tables - "Demonstrate getting table info" - [] - (sql/with-connection db - (into [] - (resultset-seq - (-> (sql/connection) - (.getMetaData) - (.getTables nil nil nil (into-array ["TABLE" "VIEW"]))))))) - -(defn db-exception - "Demonstrate rolling back a partially completed transaction on exception" - [] - (sql/with-connection db - (sql/transaction - (sql/insert-values - :fruit - [:name :appearance] - ["Grape" "yummy"] - ["Pear" "bruised"]) - ;; at this point the insert-values call is complete, but the transaction - ;; is not. the exception will cause it to roll back leaving the database - ;; untouched. - (throw (Exception. "sql/test exception"))))) - -(defn db-sql-exception - "Demonstrate an sql exception" - [] - (sql/with-connection db - (sql/transaction - (sql/insert-values - :fruit - [:name :appearance] - ["Grape" "yummy"] - ["Pear" "bruised"] - ["Apple" "strange" "whoops"])))) - -(defn db-batchupdate-exception - "Demonstrate a batch update exception" - [] - (sql/with-connection db - (sql/transaction - (sql/do-commands - "DROP TABLE fruit" - "DROP TABLE fruit")))) - -(defn db-rollback - "Demonstrate a rollback-only trasaction" - [] - (sql/with-connection db - (sql/transaction - (prn "is-rollback-only" (sql/is-rollback-only)) - (sql/set-rollback-only) - (sql/insert-values - :fruit - [:name :appearance] - ["Grape" "yummy"] - ["Pear" "bruised"]) - (prn "is-rollback-only" (sql/is-rollback-only)) - (sql/with-query-results res - ["SELECT * FROM fruit"] - (doseq [rec res] - (println rec)))) - (prn) - (sql/with-query-results res - ["SELECT * FROM fruit"] - (doseq [rec res] - (println rec))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_string.clj --- a/src/clojure/contrib/test_contrib/test_string.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,124 +0,0 @@ -(ns clojure.contrib.test-string - (:require [clojure.contrib.string :as s]) - (:use clojure.test)) - -(deftest t-codepoints - (is (= (list 102 111 111 65536 98 97 114) - (s/codepoints "foo\uD800\uDC00bar")) - "Handles Unicode supplementary characters")) - -(deftest t-escape - (is (= "<foo&bar>" - (s/escape {\& "&" \< "<" \> ">"} ""))) - (is (= " \\\"foo\\\" " - (s/escape {\" "\\\""} " \"foo\" " ))) - (is (= "faabor" (s/escape {\a \o, \o \a} "foobar")))) - -(deftest t-blank - (is (s/blank? nil)) - (is (s/blank? "")) - (is (s/blank? " ")) - (is (s/blank? " \t \n \r ")) - (is (not (s/blank? " foo ")))) - -(deftest t-take - (is (= "foo" (s/take 3 "foobar"))) - (is (= "foobar" (s/take 7 "foobar"))) - (is (= "" (s/take 0 "foo")))) - -(deftest t-drop - (is (= "bar" (s/drop 3 "foobar"))) - (is (= "" (s/drop 9 "foobar"))) - (is (= "foobar" (s/drop 0 "foobar")))) - -(deftest t-butlast - (is (= "foob" (s/butlast 2 "foobar"))) - (is (= "" (s/butlast 9 "foobar"))) - (is (= "foobar" (s/butlast 0 "foobar")))) - -(deftest t-tail - (is (= "ar" (s/tail 2 "foobar"))) - (is (= "foobar" (s/tail 9 "foobar"))) - (is (= "" (s/tail 0 "foobar")))) - -(deftest t-repeat - (is (= "foofoofoo" (s/repeat 3 "foo")))) - -(deftest t-reverse - (is (= "tab" (s/reverse "bat")))) - -(deftest t-replace - (is (= "faabar" (s/replace-char \o \a "foobar"))) - (is (= "barbarbar" (s/replace-str "foo" "bar" "foobarfoo"))) - (is (= "FOObarFOO" (s/replace-by #"foo" s/upper-case "foobarfoo")))) - -(deftest t-replace-first - (is (= "barbarfoo" (s/replace-first-re #"foo" "bar" "foobarfoo"))) - (is (= "FOObarfoo" (s/replace-first-by #"foo" s/upper-case "foobarfoo")))) - -(deftest t-partition - (is (= (list "" "abc" "123" "def") - (s/partition #"[a-z]+" "abc123def")))) - -(deftest t-join - (is (= "1,2,3" (s/join \, [1 2 3]))) - (is (= "" (s/join \, []))) - (is (= "1 and-a 2 and-a 3" (s/join " and-a " [1 2 3])))) - -(deftest t-chop - (is (= "fo" (s/chop "foo"))) - (is (= "") (s/chop "f")) - (is (= "") (s/chop ""))) - -(deftest t-chomp - (is (= "foo" (s/chomp "foo\n"))) - (is (= "foo" (s/chomp "foo\r\n"))) - (is (= "foo" (s/chomp "foo"))) - (is (= "" (s/chomp "")))) - -(deftest t-swap-case - (is (= "fOO!bAR" (s/swap-case "Foo!Bar"))) - (is (= "" (s/swap-case "")))) - -(deftest t-capitalize - (is (= "Foobar" (s/capitalize "foobar"))) - (is (= "Foobar" (s/capitalize "FOOBAR")))) - -(deftest t-ltrim - (is (= "foo " (s/ltrim " foo "))) - (is (= "" (s/ltrim " ")))) - -(deftest t-rtrim - (is (= " foo" (s/rtrim " foo "))) - (is (= "" (s/rtrim " ")))) - -(deftest t-split-lines - (is (= (list "one" "two" "three") - (s/split-lines "one\ntwo\r\nthree"))) - (is (= (list "foo") (s/split-lines "foo")))) - -(deftest t-upper-case - (is (= "FOOBAR" (s/upper-case "Foobar")))) - -(deftest t-lower-case - (is (= "foobar" (s/lower-case "FooBar")))) - -(deftest t-trim - (is (= "foo" (s/trim " foo \r\n")))) - -(deftest t-substring - (is (s/substring? "foo" "foobar")) - (is (not (s/substring? "baz" "foobar")))) - -(deftest t-get - (is (= \o (s/get "foo" 1)))) - -(deftest t-as-str - (testing "keyword to string" - (is (= "foo") (s/as-str :foo))) - (testing "symbol to string" - (is (= "foo") (s/as-str 'foo))) - (testing "string to string" - (is (= "foo") (s/as-str "foo"))) - (testing "stringifying non-namish things" - (is (= "42") (s/as-str 42)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_strint.clj --- a/src/clojure/contrib/test_contrib/test_strint.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,41 +0,0 @@ -; Copyright (c) Stuart Halloway, 2010-. All rights reserved. - -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this -; distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.contrib.test-strint - (:use clojure.test) - (:use [clojure.contrib strint with-ns])) - -(def silent-read (with-ns 'clojure.contrib.strint silent-read)) -(def interpolate (with-ns 'clojure.contrib.strint interpolate)) - -(deftest test-silent-read - (testing "reading a valid form returns [read form, rest of string]" - (is (= [[1] "[2]"] (silent-read "[1][2]")))) - (testing "reading an invalid form returns nil" - (is (= nil (silent-read "["))))) - -(deftest test-interpolate - (testing "a plain old string" - (is (= ["a plain old string"] (interpolate "a plain old string")))) - (testing "some value replacement forms" - (is (= '["" foo " and " bar ""] (interpolate "~{foo} and ~{bar}")))) - (testing "some fn-calling forms" - (is (= '["" (+ 1 2) " and " (vector 3) ""] (interpolate "~(+ 1 2) and ~(vector 3)"))))) - -(deftest test-<< - (testing "docstring examples" - (let [v 30.5 - m {:a [1 2 3]}] - (is (= "This trial required 30.5ml of solution." - (<< "This trial required ~{v}ml of solution."))) - (is (= "There are 30 days in November." - (<< "There are ~(int v) days in November."))) - (is (= "The total for your order is $6." - (<< "The total for your order is $~(->> m :a (apply +)).")))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_trace.clj --- a/src/clojure/contrib/test_contrib/test_trace.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -(ns clojure.contrib.test-trace - (:use clojure.test - clojure.contrib.trace)) - -(deftrace call-myself [n] - (when-not (< n 1) - (call-myself (dec n)))) - -(deftest test-tracing-a-function-that-calls-itself - (let [output (with-out-str (call-myself 1))] - (is (re-find #"^TRACE t\d+: (call-myself 1)\nTRACE t\d+: | (call-myself 0)\nTRACE t\d+: | => nil\nTRACE t\d+: => nil$" - output)))) - -;(deftest dotrace-on-core -; (let [output (with-out-str (dotrace [mod] (mod 11 5)))] -; (is (re-find #"\(mod 11 5\)" output)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/test_with_ns.clj --- a/src/clojure/contrib/test_contrib/test_with_ns.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -(ns clojure.contrib.test-with-ns - (:use clojure.test - clojure.contrib.with-ns)) - -(deftest test-namespace-gets-removed - (let [all-ns-names (fn [] (map #(.name %) (all-ns)))] - (testing "unexceptional return" - (let [ns-name (with-temp-ns (ns-name *ns*))] - (is (not (some #{ns-name} (all-ns-names)))))) - (testing "when an exception is thrown" - (let [ns-name-str - (try - (with-temp-ns - (throw (RuntimeException. (str (ns-name *ns*))))) - (catch clojure.lang.Compiler$CompilerException e - (-> e .getCause .getMessage)))] - (is (re-find #"^sym.*$" ns-name-str)) - (is (not (some #{(symbol ns-name-str)} (all-ns-names)))))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_contrib/types/examples.clj --- a/src/clojure/contrib/test_contrib/types/examples.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,152 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Application examples for data types -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for data type definitions"} - clojure.contrib.types.examples - (:refer-clojure :exclude (deftype)) - (:use [clojure.contrib.types - :only (deftype defadt match)]) - (:require [clojure.contrib.generic.collection :as gc]) - (:require [clojure.contrib.generic.functor :as gf])) - -; -; Multisets implemented as maps to integers -; - -; The most basic type definition. A more elaborate version could add -; a constructor that verifies that its argument is a map with integer values. -(deftype ::multiset multiset - "Multiset (demo implementation)") - -; Some set operations generalized to multisets -; Note that the multiset constructor is nowhere called explicitly, as the -; map operations all preserve the metadata. -(defmethod gc/conj ::multiset - ([ms x] - (assoc ms x (inc (get ms x 0)))) - ([ms x & xs] - (reduce gc/conj (gc/conj ms x) xs))) - -(defmulti union (fn [& sets] (type (first sets)))) - -(defmethod union clojure.lang.IPersistentSet - [& sets] - (apply clojure.set/union sets)) - -; Note: a production-quality implementation should accept standard sets -; and perhaps other collections for its second argument. -(defmethod union ::multiset - ([ms] ms) - ([ms1 ms2] - (letfn [(add-item [ms [item n]] - (assoc ms item (+ n (get ms item 0))))] - (reduce add-item ms1 ms2))) - ([ms1 ms2 & mss] - (reduce union (union ms1 ms2) mss))) - -; Let's use it: -(gc/conj #{} :a :a :b :c) -(gc/conj (multiset {}) :a :a :b :c) - -(union #{:a :b} #{:b :c}) -(union (multiset {:a 1 :b 1}) (multiset {:b 1 :c 2})) - -; -; A simple tree structure defined as an algebraic data type -; -(defadt ::tree - empty-tree - (leaf value) - (node left-tree right-tree)) - -(def a-tree (node (leaf :a) - (node (leaf :b) - (leaf :c)))) - -(defn depth - [t] - (match t - empty-tree 0 - (leaf _) 1 - (node l r) (inc (max (depth l) (depth r))))) - -(depth empty-tree) -(depth (leaf 42)) -(depth a-tree) - -; Algebraic data types with multimethods: fmap on a tree -(defmethod gf/fmap ::tree - [f t] - (match t - empty-tree empty-tree - (leaf v) (leaf (f v)) - (node l r) (node (gf/fmap f l) (gf/fmap f r)))) - -(gf/fmap str a-tree) - -; -; Nonsense examples to illustrate all the features of match -; for type constructors. -; -(defadt ::foo - (bar a b c)) - -(defn foo-to-int - [a-foo] - (match a-foo - (bar x x x) x - (bar 0 x y) (+ x y) - (bar 1 2 3) -1 - (bar a b 1) (* a b) - :else 42)) - -(foo-to-int (bar 0 0 0)) ; 0 -(foo-to-int (bar 0 5 6)) ; 11 -(foo-to-int (bar 1 2 3)) ; -1 -(foo-to-int (bar 3 3 1)) ; 9 -(foo-to-int (bar 0 3 1)) ; 4 -(foo-to-int (bar 10 20 30)) ; 42 - -; -; Match can also be used for lists, vectors, and maps. Note that since -; algebraic data types are represented as maps, they can be matched -; either with their type constructor and positional arguments, or -; with a map template. -; - -; Tree depth once again with map templates -(defn depth - [t] - (match t - empty-tree 0 - {:value _} 1 - {:left-tree l :right-tree r} (inc (max (depth l) (depth r))))) - -(depth empty-tree) -(depth (leaf 42)) -(depth a-tree) - -; Match for lists, vectors, and maps: - -(for [x ['(1 2 3) - [1 2 3] - {:x 1 :y 2 :z 3} - '(1 1 1) - [2 1 2] - {:x 1 :y 1 :z 2}]] - (match x - '(a a a) 'list-of-three-equal-values - '(a b c) 'list - [a a a] 'vector-of-three-equal-values - [a b a] 'vector-of-three-with-first-and-last-equal - [a b c] 'vector - {:x a :y z} 'map-with-x-equal-y - {} 'any-map)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/test_is.clj --- a/src/clojure/contrib/test_is.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,119 +0,0 @@ -;;; test_is.clj: Compatibility layer for old clojure.contrib.test-is - -;; by Stuart Sierra, http://stuartsierra.com/ -;; August 28, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -;; DEPRECATED in 1.2: Moved to clojure.test - -(ns ^{:deprecated "1.2" - :doc "Backwards-compatibility for clojure.contrib.test-is - - The clojure.contrib.test-is library moved from Contrib into the - Clojure distribution as clojure.test. - - This happened on or around clojure-contrib Git commit - 82cf0409d0fcb71be477ebfc4da18ee2128a2ad1 on June 25, 2009. - - This file makes the clojure.test interface available under the old - namespace clojure.contrib.test-is. - - This includes support for the old syntax of the 'are' macro. - - This was suggested by Howard Lewis Ship in ticket #26, - http://www.assembla.com/spaces/clojure-contrib/tickets/26" - :author "Stuart Sierra"} - clojure.contrib.test-is - (:require clojure.test - [clojure.walk :as walk])) - - -;;; COPY INTERNED VARS (EXCEPT are) FROM clojure.test - -(doseq [v (disj (set (vals (ns-interns 'clojure.test))) - #'clojure.test/are)] - (intern *ns* (with-meta (:name (meta v)) (meta v)) (var-get v))) - - -;;; REDEFINE OLD clojure.contrib.template - -(defn find-symbols - "Recursively finds all symbols in form." - [form] - (distinct (filter symbol? (tree-seq coll? seq form)))) - -(defn find-holes - "Recursively finds all symbols starting with _ in form." - [form] - (sort (distinct (filter #(.startsWith (name %) "_") - (find-symbols form))))) - -(defn find-pure-exprs - "Recursively finds all sub-expressions in form that do not contain - any symbols starting with _" - [form] - (filter #(and (list? %) - (empty? (find-holes %))) - (tree-seq seq? seq form))) - -(defn flatten-map - "Transforms a map into a vector like [key value key value]." - [m] - (reduce (fn [coll [k v]] (conj coll k v)) - [] m)) - -(defn template? - "Returns true if form is a valid template expression." - [form] - (if (seq (find-holes form)) true false)) - -(defn apply-template - "Replaces _1, _2, _3, etc. in expr with corresponding elements of - values. Returns the modified expression. For use in macros." - [expr values] - (when-not (template? expr) - (throw (IllegalArgumentException. (str (pr-str expr) " is not a valid template.")))) - (let [expr (walk/postwalk-replace {'_ '_1} expr) - holes (find-holes expr) - smap (zipmap holes values)] - (walk/prewalk-replace smap expr))) - -(defmacro do-template - "Repeatedly evaluates template expr (in a do block) using values in - args. args are grouped by the number of holes in the template. - Example: (do-template (check _1 _2) :a :b :c :d) - expands to (do (check :a :b) (check :c :d))" - [expr & args] - (when-not (template? expr) - (throw (IllegalArgumentException. (str (pr-str expr) " is not a valid template.")))) - (let [expr (walk/postwalk-replace {'_ '_1} expr) - argcount (count (find-holes expr))] - `(do ~@(map (fn [a] (apply-template expr a)) - (partition argcount args))))) - - - -;;; REDEFINE are MACRO TO MATCH OLD TEMPLATE BEHAVIOR - -(defmacro are - "Checks multiple assertions with a template expression. - See clojure.contrib.template/do-template for an explanation of - templates. - - Example: (are (= _1 _2) - 2 (+ 1 1) - 4 (* 2 2)) - Expands to: - (do (is (= 2 (+ 1 1))) - (is (= 4 (* 2 2)))) - - Note: This breaks some reporting features, such as line numbers." - [expr & args] - `(do-template (is ~expr) ~@args)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/trace.clj --- a/src/clojure/contrib/trace.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,97 +0,0 @@ -;;; trace.clj -- simple call-tracing macros for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; December 3, 2008 - -;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -;; This file defines simple "tracing" macros to help you see what your -;; code is doing. - - -;; CHANGE LOG -;; -;; December 3, 2008: -;; -;; * replaced *trace-out* with tracer -;; -;; * made trace a function instead of a macro -;; (suggestion from Stuart Halloway) -;; -;; * added trace-fn-call -;; -;; June 9, 2008: first version - - - -(ns - ^{:author "Stuart Sierra, Michel Salim", - :doc "This file defines simple \"tracing\" macros to help you see what your -code is doing."} - clojure.contrib.trace) - -(def - ^{:doc "Current stack depth of traced function calls."} - *trace-depth* 0) - -(defn tracer - "This function is called by trace. Prints to standard output, but - may be rebound to do anything you like. 'name' is optional." - [name value] - (println (str "TRACE" (when name (str " " name)) ": " value))) - -(defn trace - "Sends name (optional) and value to the tracer function, then - returns value. May be wrapped around any expression without - affecting the result." - ([value] (trace nil value)) - ([name value] - (tracer name (pr-str value)) - value)) - -(defn trace-indent - "Returns an indentation string based on *trace-depth*" - [] - (apply str (take *trace-depth* (repeat "| ")))) - -(defn trace-fn-call - "Traces a single call to a function f with args. 'name' is the - symbol name of the function." - [name f args] - (let [id (gensym "t")] - (tracer id (str (trace-indent) (pr-str (cons name args)))) - (let [value (binding [*trace-depth* (inc *trace-depth*)] - (apply f args))] - (tracer id (str (trace-indent) "=> " (pr-str value))) - value))) - -(defmacro deftrace - "Use in place of defn; traces each call/return of this fn, including - arguments. Nested calls to deftrace'd functions will print a - tree-like structure." - [name & definition] - `(do - (def ~name) - (let [f# (fn ~@definition)] - (defn ~name [& args#] - (trace-fn-call '~name f# args#))))) - -(defmacro dotrace - "Given a sequence of function identifiers, evaluate the body - expressions in an environment in which the identifiers are bound to - the traced functions. Does not work on inlined functions, - such as clojure.core/+" - [fnames & exprs] - `(binding [~@(interleave fnames - (for [fname fnames] - `(let [f# @(var ~fname)] - (fn [& args#] - (trace-fn-call '~fname f# args#)))))] - ~@exprs)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/types.clj --- a/src/clojure/contrib/types.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,275 +0,0 @@ -;; Data types - -;; by Konrad Hinsen -;; last updated May 3, 2009 - -;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - -(ns - ^{:author "Konrad Hinsen" - :doc "General and algebraic data types"} - clojure.contrib.types - (:refer-clojure :exclude (deftype)) - (:use [clojure.contrib.def :only (name-with-attributes)])) - -; -; Utility functions -; -(defn- qualified-symbol - [s] - (symbol (str *ns*) (str s))) - -(defn- qualified-keyword - [s] - (keyword (str *ns*) (str s))) - -(defn- unqualified-symbol - [s] - (let [s-str (str s)] - (symbol (subs s-str (inc (.indexOf s-str (int \/))))))) - -(defn- resolve-symbol - [s] - (if-let [var (resolve s)] - (symbol (str (.ns var)) (str (.sym var))) - s)) - -; -; Data type definition -; -(defmulti deconstruct type) - -(defmulti constructor-form type) -(defmethod constructor-form :default - [o] nil) -(defmethod constructor-form ::type - [o] (cons (::constructor (meta o)) (deconstruct o))) - -(defmacro deftype - "Define a data type by a type tag (a namespace-qualified keyword) - and a symbol naming the constructor function. Optionally, a - constructor and a deconstructor function can be given as well, - the defaults being clojure.core/identity and clojure.core/list. - The full constructor associated with constructor-name calls the - constructor function and attaches the type tag to its result - as metadata. The deconstructor function must return the arguments - to be passed to the constructor in order to create an equivalent - object. It is used for printing and matching." - {:arglists - '([type-tag constructor-name docstring? attr-map?] - [type-tag constructor-name docstring? attr-map? constructor] - [type-tag constructor-name docstring? attr-map? constructor deconstructor])} - [type-tag constructor-name & options] - (let [[constructor-name options] (name-with-attributes - constructor-name options) - [constructor deconstructor] options - constructor (if (nil? constructor) - 'clojure.core/identity - constructor) - deconstructor (if (nil? deconstructor) - 'clojure.core/list - deconstructor)] - `(do - (derive ~type-tag ::type) - (let [meta-map# {:type ~type-tag - ::constructor - (quote ~(qualified-symbol constructor-name))}] - (def ~constructor-name - (comp (fn [~'x] (with-meta ~'x meta-map#)) ~constructor)) - (defmethod deconstruct ~type-tag [~'x] - (~deconstructor (with-meta ~'x {}))))))) - -(defmacro deftype- - "Same as deftype but the constructor is private." - [type-tag constructor-name & optional] - `(deftype ~type-tag - ~(vary-meta constructor-name assoc :private true) - ~@optional)) - -(defmethod print-method ::type [o w] - (let [cf (constructor-form o)] - (if (symbol? cf) - (print-method (unqualified-symbol cf) w) - (print-method (cons (unqualified-symbol (first cf)) (rest cf)) w)))) - -; -; Algebraic types -; -(derive ::adt ::type) - -(defmethod constructor-form ::adt - [o] - (let [v (vals o)] - (if (= 1 (count v)) - (first v) - v))) - -(defn- constructor-code - [meta-map-symbol constructor] - (if (symbol? constructor) - `(def ~constructor - (with-meta {::tag (quote ~(qualified-symbol constructor))} - ~meta-map-symbol)) - (let [[name & args] constructor - keys (cons ::tag (map (comp keyword str) args))] - (if (empty? args) - (throw (IllegalArgumentException. "zero argument constructor")) - `(let [~'basis (create-struct ~@keys)] - (defn ~name ~(vec args) - (with-meta (struct ~'basis (quote ~(qualified-symbol name)) ~@args) - ~meta-map-symbol))))))) - -(defmacro defadt - "Define an algebraic data type name by an exhaustive list of constructors. - Each constructor can be a symbol (argument-free constructor) or a - list consisting of a tag symbol followed by the argument symbols. - The data type tag must be a keyword." - [type-tag & constructors] - (let [meta-map-symbol (gensym "mm")] - `(let [~meta-map-symbol {:type ~type-tag}] - (derive ~type-tag ::adt) - ~@(map (partial constructor-code meta-map-symbol) constructors) - ))) - -; -; Matching templates -; -(defn- symbol-tests-and-bindings - [template vsymbol] - [`(= (quote ~(resolve-symbol template)) ~vsymbol) - []]) - -(defn- sequential-tests-and-bindings - [template vsymbol] - (let [enum-values (map list template (range (count template))) - ; Non-symbols in the template create an equality test with the - ; corresponding value in the object's value list - tests (map (fn [[v i]] `(= ~v (nth ~vsymbol ~i))) - (filter (complement #(symbol? (first %))) enum-values)) - ; Symbols in the template become bindings to the corresponding - ; value in the object. However, if a symbol occurs more than once, - ; only one binding is generated, and equality tests are added - ; for the other values. - bindings (reduce (fn [map [symbol index]] - (assoc map symbol - (conj (get map symbol []) index))) - {} - (filter #(symbol? (first %)) enum-values)) - tests (concat tests - (map (fn [[symbol indices]] - (cons `= (map #(list `nth vsymbol %) indices))) - (filter #(> (count (second %)) 1) bindings))) - bindings (mapcat (fn [[symbol indices]] - [symbol (list `nth vsymbol (first indices))]) - bindings)] - [tests (vec bindings)])) - -(defn- constr-tests-and-bindings - [template cfsymbol] - (let [[tag & values] template - cfasymbol (gensym) - [tests bindings] (sequential-tests-and-bindings values cfasymbol) - argtests (if (empty? tests) - tests - `((let [~cfasymbol (rest ~cfsymbol)] ~@tests)))] - [`(and (seq? ~cfsymbol) - (= (quote ~(resolve-symbol tag)) (first ~cfsymbol)) - ~@argtests) - `[~cfasymbol (rest ~cfsymbol) ~@bindings]])) - -(defn- list-tests-and-bindings - [template vsymbol] - (let [[tests bindings] (sequential-tests-and-bindings template vsymbol)] - [`(and (list? ~vsymbol) ~@tests) - bindings])) - -(defn- vector-tests-and-bindings - [template vsymbol] - (let [[tests bindings] (sequential-tests-and-bindings template vsymbol)] - [`(and (vector? ~vsymbol) ~@tests) - bindings])) - -(defn- map-tests-and-bindings - [template vsymbol] - (let [; First test if the given keys are all present. - tests (map (fn [[k v]] `(contains? ~vsymbol ~k)) template) - ; Non-symbols in the template create an equality test with the - ; corresponding value in the object's value list. - tests (concat tests - (map (fn [[k v]] `(= ~v (~k ~vsymbol))) - (filter (complement #(symbol? (second %))) template))) - ; Symbols in the template become bindings to the corresponding - ; value in the object. However, if a symbol occurs more than once, - ; only one binding is generated, and equality tests are added - ; for the other values. - bindings (reduce (fn [map [key symbol]] - (assoc map symbol - (conj (get map symbol []) key))) - {} - (filter #(symbol? (second %)) template)) - tests (concat tests - (map (fn [[symbol keys]] - (cons `= (map #(list % vsymbol) keys))) - (filter #(> (count (second %)) 1) bindings))) - bindings (mapcat (fn [[symbol keys]] - [symbol (list (first keys) vsymbol)]) - bindings)] - [`(and (map? ~vsymbol) ~@tests) - (vec bindings)])) - -(defn- tests-and-bindings - [template vsymbol cfsymbol] - (cond (symbol? template) - (symbol-tests-and-bindings template cfsymbol) - (seq? template) - (if (= (first template) 'quote) - (list-tests-and-bindings (second template) vsymbol) - (constr-tests-and-bindings template cfsymbol)) - (vector? template) - (vector-tests-and-bindings template vsymbol) - (map? template) - (map-tests-and-bindings template vsymbol) - :else - (throw (IllegalArgumentException. "illegal template for match")))) - -(defmacro match - "Given a value and a list of template-expr clauses, evaluate the first - expr whose template matches the value. There are four kinds of templates: - 1) Lists of the form (tag x1 x2 ...) match instances of types - whose constructor has the same form as the list. - 2) Quoted lists of the form '(x1 x2 ...) match lists of the same - length. - 3) Vectors of the form [x1 x2 ...] match vectors of the same length. - 4) Maps of the form {:key1 x1 :key2 x2 ...} match maps that have - the same keys as the template, but which can have additional keys - that are not part of the template. - The values x1, x2, ... can be symbols or non-symbol values. Non-symbols - must be equal to the corresponding values in the object to be matched. - Symbols will be bound to the corresponding value in the object in the - evaluation of expr. If the same symbol occurs more than once in a, - template the corresponding elements of the object must be equal - for the template to match." - [value & clauses] - (when (odd? (count clauses)) - (throw (Exception. "Odd number of elements in match expression"))) - (let [vsymbol (gensym) - cfsymbol (gensym) - terms (mapcat (fn [[template expr]] - (if (= template :else) - [template expr] - (let [[tests bindings] - (tests-and-bindings template vsymbol cfsymbol)] - [tests - (if (empty? bindings) - expr - `(let ~bindings ~expr))]))) - (partition 2 clauses))] - `(let [~vsymbol ~value - ~cfsymbol (constructor-form ~vsymbol)] - (cond ~@terms)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/with_ns.clj --- a/src/clojure/contrib/with_ns.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -;;; with_ns.clj -- temporary namespace macro - -;; by Stuart Sierra, http://stuartsierra.com/ -;; March 28, 2009 - -;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use -;; and distribution terms for this software are covered by the Eclipse -;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -;; which can be found in the file epl-v10.html at the root of this -;; distribution. By using this software in any fashion, you are -;; agreeing to be bound by the terms of this license. You must not -;; remove this notice, or any other, from this software. - - -(ns - ^{:author "Stuart Sierra", - :doc "Temporary namespace macro"} - clojure.contrib.with-ns) - -(defmacro with-ns - "Evaluates body in another namespace. ns is either a namespace - object or a symbol. This makes it possible to define functions in - namespaces other than the current one." - [ns & body] - `(binding [*ns* (the-ns ~ns)] - ~@(map (fn [form] `(eval '~form)) body))) - -(defmacro with-temp-ns - "Evaluates body in an anonymous namespace, which is then immediately - removed. The temporary namespace will 'refer' clojure.core." - [& body] - `(try - (create-ns 'sym#) - (let [result# (with-ns 'sym# - (clojure.core/refer-clojure) - ~@body)] - result#) - (finally (remove-ns 'sym#)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/zip_filter.clj --- a/src/clojure/contrib/zip_filter.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,92 +0,0 @@ -; Copyright (c) Chris Houser, April 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; System for filtering trees and nodes generated by zip.clj in -; general, and xml trees in particular. - -(ns - ^{:author "Chris Houser", - :doc "System for filtering trees and nodes generated by zip.clj in -general, and xml trees in particular. -"} - clojure.contrib.zip-filter - (:refer-clojure :exclude (descendants ancestors)) - (:require [clojure.zip :as zip])) - -; This uses the negative form (no-auto) so that the result from any -; naive function, including user functions, defaults to "auto". -(defn auto - [v x] (with-meta x ((if v dissoc assoc) (meta x) :zip-filter/no-auto? true))) - -(defn auto? - [x] (not (:zip-filter/no-auto? (meta x)))) - -(defn right-locs - "Returns a lazy sequence of locations to the right of loc, starting with loc." - [loc] (lazy-seq (when loc (cons (auto false loc) (right-locs (zip/right loc)))))) - -(defn left-locs - "Returns a lazy sequence of locations to the left of loc, starting with loc." - [loc] (lazy-seq (when loc (cons (auto false loc) (left-locs (zip/left loc)))))) - -(defn leftmost? - "Returns true if there are no more nodes to the left of location loc." - [loc] (nil? (zip/left loc))) - -(defn rightmost? - "Returns true if there are no more nodes to the right of location loc." - [loc] (nil? (zip/right loc))) - -(defn children - "Returns a lazy sequence of all immediate children of location loc, - left-to-right." - [loc] - (when (zip/branch? loc) - (map #(auto false %) (right-locs (zip/down loc))))) - -(defn children-auto - "Returns a lazy sequence of all immediate children of location loc, - left-to-right, marked so that a following tag= predicate will auto-descend." - ^{:private true} - [loc] - (when (zip/branch? loc) - (map #(auto true %) (right-locs (zip/down loc))))) - -(defn descendants - "Returns a lazy sequence of all descendants of location loc, in - depth-first order, left-to-right, starting with loc." - [loc] (lazy-seq (cons (auto false loc) (mapcat descendants (children loc))))) - -(defn ancestors - "Returns a lazy sequence of all ancestors of location loc, starting - with loc and proceeding to loc's parent node and on through to the - root of the tree." - [loc] (lazy-seq (when loc (cons (auto false loc) (ancestors (zip/up loc)))))) - -(defn- fixup-apply - "Calls (pred loc), and then converts the result to the 'appropriate' - sequence." - ^{:private true} - [pred loc] - (let [rtn (pred loc)] - (cond (and (map? (meta rtn)) (:zip-filter/is-node? (meta rtn))) (list rtn) - (= rtn true) (list loc) - (= rtn false) nil - (nil? rtn) nil - (sequential? rtn) rtn - :else (list rtn)))) - -(defn mapcat-chain - ^{:private true} - [loc preds mkpred] - (reduce (fn [prevseq expr] - (mapcat #(fixup-apply (or (mkpred expr) expr) %) prevseq)) - (list (with-meta loc (assoc (meta loc) :zip-filter/is-node? true))) - preds)) - -; see clojure.contrib.zip-filter.xml for examples diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/contrib/zip_filter/xml.clj --- a/src/clojure/contrib/zip_filter/xml.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,170 +0,0 @@ -; Copyright (c) Chris Houser, April 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Specialization of zip-filter for xml trees. - -(ns clojure.contrib.zip-filter.xml - (:require [clojure.contrib.zip-filter :as zf] - [clojure.zip :as zip] - [clojure.xml :as xml])) - -(declare xml->) - -(defn attr - "Returns the xml attribute named attrname, of the xml node at location loc." - ([attrname] (fn [loc] (attr loc attrname))) - ([loc attrname] (when (zip/branch? loc) (-> loc zip/node :attrs attrname)))) - -(defn attr= - "Returns a query predicate that matches a node when it has an - attribute named attrname whose value is attrval." - [attrname attrval] (fn [loc] (= attrval (attr loc attrname)))) - -(defn tag= - "Returns a query predicate that matches a node when its is a tag - named tagname." - [tagname] - (fn [loc] - (filter #(and (zip/branch? %) (= tagname ((zip/node %) :tag))) - (if (zf/auto? loc) - (zf/children-auto loc) - (list (zf/auto true loc)))))) - -(defn text - "Returns the textual contents of the given location, similar to - xpaths's value-of" - [loc] - (.replaceAll - ^String (apply str (xml-> loc zf/descendants zip/node string?)) - (str "[\\s" (char 160) "]+") " ")) - -(defn text= - "Returns a query predicate that matches a node when its textual - content equals s." - [s] (fn [loc] (= (text loc) s))) - -(defn seq-test - "Returns a query predicate that matches a node when its xml content - matches the query expresions given." - ^{:private true} - [preds] (fn [loc] (and (seq (apply xml-> loc preds)) (list loc)))) - -(defn xml-> - "The loc is passed to the first predicate. If the predicate returns - a collection, each value of the collection is passed to the next - predicate. If it returns a location, the location is passed to the - next predicate. If it returns true, the input location is passed to - the next predicate. If it returns false or nil, the next predicate - is not called. - - This process is repeated, passing the processed results of each - predicate to the next predicate. xml-> returns the final sequence. - The entire chain is evaluated lazily. - - There are also special predicates: keywords are converted to tag=, - strings to text=, and vectors to sub-queries that return true if - they match. - - See the footer of zip-query.clj for examples." - [loc & preds] - (zf/mapcat-chain loc preds - #(cond (keyword? %) (tag= %) - (string? %) (text= %) - (vector? %) (seq-test %)))) - -(defn xml1-> - "Returns the first item from loc based on the query predicates - given. See xml->" - [loc & preds] (first (apply xml-> loc preds))) - - -; === examples === - -(comment - -(defn parse-str [s] - (zip/xml-zip (xml/parse (new org.xml.sax.InputSource - (new java.io.StringReader s))))) - -(def atom1 (parse-str " - - tag:blogger.com,1999:blog-28403206 - 2008-02-14T08:00:58.567-08:00 - n01senet - - - 1 - 2008-02-13 - clojure is the best lisp yet - Chouser - - - 2 - 2008-02-07 - experimenting with vnc - agriffis - - -")) - -; simple single-function filter -(assert (= (xml-> atom1 #((zip/node %) :tag)) - '(:feed))) - -; two-stage filter using helpful query prediates -(assert (= (xml-> atom1 (tag= :title) text) - '("n01senet"))) - -; same filter as above, this time using keyword shortcut -(assert (= (xml-> atom1 :title text) - '("n01senet"))) - -; multi-stage filter -(assert (= (xml-> atom1 :entry :author :name text) - '("Chouser" "agriffis"))) - -; test xml1-> -(assert (= (xml1-> atom1 :entry :author :name text) - "Chouser")) - -; multi-stage filter with subquery specified using a vector -(assert (= (xml-> atom1 :entry [:author :name (text= "agriffis")] - :id text) - '("2"))) - -; same filter as above, this time using a string shortcut -(assert (= (xml-> atom1 :entry [:author :name "agriffis"] :id text) - '("2"))) - -; attribute access -(assert (= (xml-> atom1 :title (attr :type)) - '("text"))) - -; attribute filtering -(assert (= (xml-> atom1 :link [(attr= :rel "alternate")] (attr :type)) - '("text/html"))) - -; ancestors -(assert (= (xml-> atom1 zf/descendants :id "2" zf/ancestors zip/node #(:tag %)) - '(:id :entry :feed))) - -; ancestors with non-auto tag= (:entry), followed by auto tag= (:id) -(assert (= (xml-> atom1 zf/descendants :name "Chouser" zf/ancestors - :entry :id text) - '("1"))) - -; left-locs and detection of returning a single loc (zip/up) -(assert (= (xml-> atom1 zf/descendants :name "Chouser" zip/up - zf/left-locs :id text) - '("1"))) - -; right-locs -(assert (= (xml-> atom1 zf/descendants :id zf/right-locs :author text) - '("Chouser" "agriffis"))) - -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/core.clj --- a/src/clojure/core.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5710 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.core) - -(def unquote) -(def unquote-splicing) - -(def - ^{:arglists '([& items]) - :doc "Creates a new list containing the items." - :added "1.0"} - list (. clojure.lang.PersistentList creator)) - -(def - ^{:arglists '([x seq]) - :doc "Returns a new seq where x is the first element and seq is - the rest." - :added "1.0"} - - cons (fn* cons [x seq] (. clojure.lang.RT (cons x seq)))) - -;during bootstrap we don't have destructuring let, loop or fn, will redefine later -(def - ^{:macro true - :added "1.0"} - let (fn* let [&form &env & decl] (cons 'let* decl))) - -(def - ^{:macro true - :added "1.0"} - loop (fn* loop [&form &env & decl] (cons 'loop* decl))) - -(def - ^{:macro true - :added "1.0"} - fn (fn* fn [&form &env & decl] - (.withMeta ^clojure.lang.IObj (cons 'fn* decl) - (.meta ^clojure.lang.IMeta &form)))) - -(def - ^{:arglists '([coll]) - :doc "Returns the first item in the collection. Calls seq on its - argument. If coll is nil, returns nil." - :added "1.0"} - first (fn first [coll] (. clojure.lang.RT (first coll)))) - -(def - ^{:arglists '([coll]) - :tag clojure.lang.ISeq - :doc "Returns a seq of the items after the first. Calls seq on its - argument. If there are no more items, returns nil." - :added "1.0"} - next (fn next [x] (. clojure.lang.RT (next x)))) - -(def - ^{:arglists '([coll]) - :tag clojure.lang.ISeq - :doc "Returns a possibly empty seq of the items after the first. Calls seq on its - argument." - :added "1.0"} - rest (fn rest [x] (. clojure.lang.RT (more x)))) - -(def - ^{:arglists '([coll x] [coll x & xs]) - :doc "conj[oin]. Returns a new collection with the xs - 'added'. (conj nil item) returns (item). The 'addition' may - happen at different 'places' depending on the concrete type." - :added "1.0"} - conj (fn conj - ([coll x] (. clojure.lang.RT (conj coll x))) - ([coll x & xs] - (if xs - (recur (conj coll x) (first xs) (next xs)) - (conj coll x))))) - -(def - ^{:doc "Same as (first (next x))" - :arglists '([x]) - :added "1.0"} - second (fn second [x] (first (next x)))) - -(def - ^{:doc "Same as (first (first x))" - :arglists '([x]) - :added "1.0"} - ffirst (fn ffirst [x] (first (first x)))) - -(def - ^{:doc "Same as (next (first x))" - :arglists '([x]) - :added "1.0"} - nfirst (fn nfirst [x] (next (first x)))) - -(def - ^{:doc "Same as (first (next x))" - :arglists '([x]) - :added "1.0"} - fnext (fn fnext [x] (first (next x)))) - -(def - ^{:doc "Same as (next (next x))" - :arglists '([x]) - :added "1.0"} - nnext (fn nnext [x] (next (next x)))) - -(def - ^{:arglists '([coll]) - :doc "Returns a seq on the collection. If the collection is - empty, returns nil. (seq nil) returns nil. seq also works on - Strings, native Java arrays (of reference types) and any objects - that implement Iterable." - :tag clojure.lang.ISeq - :added "1.0"} - seq (fn seq [coll] (. clojure.lang.RT (seq coll)))) - -(def - ^{:arglists '([^Class c x]) - :doc "Evaluates x and tests if it is an instance of the class - c. Returns true or false" - :added "1.0"} - instance? (fn instance? [^Class c x] (. c (isInstance x)))) - -(def - ^{:arglists '([x]) - :doc "Return true if x implements ISeq" - :added "1.0"} - seq? (fn seq? [x] (instance? clojure.lang.ISeq x))) - -(def - ^{:arglists '([x]) - :doc "Return true if x is a Character" - :added "1.0"} - char? (fn char? [x] (instance? Character x))) - -(def - ^{:arglists '([x]) - :doc "Return true if x is a String" - :added "1.0"} - string? (fn string? [x] (instance? String x))) - -(def - ^{:arglists '([x]) - :doc "Return true if x implements IPersistentMap" - :added "1.0"} - map? (fn map? [x] (instance? clojure.lang.IPersistentMap x))) - -(def - ^{:arglists '([x]) - :doc "Return true if x implements IPersistentVector" - :added "1.0"} - vector? (fn vector? [x] (instance? clojure.lang.IPersistentVector x))) - -(def - ^{:arglists '([map key val] [map key val & kvs]) - :doc "assoc[iate]. When applied to a map, returns a new map of the - same (hashed/sorted) type, that contains the mapping of key(s) to - val(s). When applied to a vector, returns a new vector that - contains val at index. Note - index must be <= (count vector)." - :added "1.0"} - assoc - (fn assoc - ([map key val] (. clojure.lang.RT (assoc map key val))) - ([map key val & kvs] - (let [ret (assoc map key val)] - (if kvs - (recur ret (first kvs) (second kvs) (nnext kvs)) - ret))))) - -;;;;;;;;;;;;;;;;; metadata ;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def - ^{:arglists '([obj]) - :doc "Returns the metadata of obj, returns nil if there is no metadata." - :added "1.0"} - meta (fn meta [x] - (if (instance? clojure.lang.IMeta x) - (. ^clojure.lang.IMeta x (meta))))) - -(def - ^{:arglists '([^clojure.lang.IObj obj m]) - :doc "Returns an object of the same type and value as obj, with - map m as its metadata." - :added "1.0"} - with-meta (fn with-meta [^clojure.lang.IObj x m] - (. x (withMeta m)))) - -(def ^{:private true :dynamic true} - assert-valid-fdecl (fn [fdecl])) - -(def - ^{:private true} - sigs - (fn [fdecl] - (assert-valid-fdecl fdecl) - (let [asig - (fn [fdecl] - (let [arglist (first fdecl) - ;elide implicit macro args - arglist (if (clojure.lang.Util/equals '&form (first arglist)) - (clojure.lang.RT/subvec arglist 2 (clojure.lang.RT/count arglist)) - arglist) - body (next fdecl)] - (if (map? (first body)) - (if (next body) - (with-meta arglist (conj (if (meta arglist) (meta arglist) {}) (first body))) - arglist) - arglist)))] - (if (seq? (first fdecl)) - (loop [ret [] fdecls fdecl] - (if fdecls - (recur (conj ret (asig (first fdecls))) (next fdecls)) - (seq ret))) - (list (asig fdecl)))))) - - -(def - ^{:arglists '([coll]) - :doc "Return the last item in coll, in linear time" - :added "1.0"} - last (fn last [s] - (if (next s) - (recur (next s)) - (first s)))) - -(def - ^{:arglists '([coll]) - :doc "Return a seq of all but the last item in coll, in linear time" - :added "1.0"} - butlast (fn butlast [s] - (loop [ret [] s s] - (if (next s) - (recur (conj ret (first s)) (next s)) - (seq ret))))) - -(def - - ^{:doc "Same as (def name (fn [params* ] exprs*)) or (def - name (fn ([params* ] exprs*)+)) with any doc-string or attrs added - to the var metadata" - :arglists '([name doc-string? attr-map? [params*] body] - [name doc-string? attr-map? ([params*] body)+ attr-map?]) - :added "1.0"} - defn (fn defn [&form &env name & fdecl] - (let [m (if (string? (first fdecl)) - {:doc (first fdecl)} - {}) - fdecl (if (string? (first fdecl)) - (next fdecl) - fdecl) - m (if (map? (first fdecl)) - (conj m (first fdecl)) - m) - fdecl (if (map? (first fdecl)) - (next fdecl) - fdecl) - fdecl (if (vector? (first fdecl)) - (list fdecl) - fdecl) - m (if (map? (last fdecl)) - (conj m (last fdecl)) - m) - fdecl (if (map? (last fdecl)) - (butlast fdecl) - fdecl) - m (conj {:arglists (list 'quote (sigs fdecl))} m) - m (let [inline (:inline m) - ifn (first inline) - iname (second inline)] - ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...) - (if (if (clojure.lang.Util/equiv 'fn ifn) - (if (instance? clojure.lang.Symbol iname) false true)) - ;; inserts the same fn name to the inline fn if it does not have one - (assoc m :inline (cons ifn (cons (clojure.lang.Symbol/intern (.concat (.getName name) "__inliner")) - (next inline)))) - m)) - m (conj (if (meta name) (meta name) {}) m)] - (list 'def (with-meta name m) - (list '.withMeta (cons `fn (cons name fdecl)) (list '.meta (list 'var name))))))) - -(. (var defn) (setMacro)) - -(defn cast - "Throws a ClassCastException if x is not a c, else returns x." - {:added "1.0"} - [^Class c x] - (. c (cast x))) - -(defn to-array - "Returns an array of Objects containing the contents of coll, which - can be any Collection. Maps to java.util.Collection.toArray()." - {:tag "[Ljava.lang.Object;" - :added "1.0"} - [coll] (. clojure.lang.RT (toArray coll))) - -(defn vector - "Creates a new vector containing the args." - {:added "1.0"} - ([] []) - ([a] [a]) - ([a b] [a b]) - ([a b c] [a b c]) - ([a b c d] [a b c d]) - ([a b c d & args] - (. clojure.lang.LazilyPersistentVector (create (cons a (cons b (cons c (cons d args)))))))) - -(defn vec - "Creates a new vector containing the contents of coll." - {:added "1.0"} - ([coll] - (if (instance? java.util.Collection coll) - (clojure.lang.LazilyPersistentVector/create coll) - (. clojure.lang.LazilyPersistentVector (createOwning (to-array coll)))))) - -(defn hash-map - "keyval => key val - Returns a new hash map with supplied mappings." - {:added "1.0"} - ([] {}) - ([& keyvals] - (. clojure.lang.PersistentHashMap (createWithCheck keyvals)))) - -(defn hash-set - "Returns a new hash set with supplied keys." - {:added "1.0"} - ([] #{}) - ([& keys] - (clojure.lang.PersistentHashSet/createWithCheck keys))) - -(defn sorted-map - "keyval => key val - Returns a new sorted map with supplied mappings." - {:added "1.0"} - ([& keyvals] - (clojure.lang.PersistentTreeMap/create keyvals))) - -(defn sorted-map-by - "keyval => key val - Returns a new sorted map with supplied mappings, using the supplied comparator." - {:added "1.0"} - ([comparator & keyvals] - (clojure.lang.PersistentTreeMap/create comparator keyvals))) - -(defn sorted-set - "Returns a new sorted set with supplied keys." - {:added "1.0"} - ([& keys] - (clojure.lang.PersistentTreeSet/create keys))) - -(defn sorted-set-by - "Returns a new sorted set with supplied keys, using the supplied comparator." - {:added "1.1"} - ([comparator & keys] - (clojure.lang.PersistentTreeSet/create comparator keys))) - - -;;;;;;;;;;;;;;;;;;;; -(defn nil? - "Returns true if x is nil, false otherwise." - {:tag Boolean - :added "1.0"} - [x] (clojure.lang.Util/identical x nil)) - -(def - - ^{:doc "Like defn, but the resulting function name is declared as a - macro and will be used as a macro by the compiler when it is - called." - :arglists '([name doc-string? attr-map? [params*] body] - [name doc-string? attr-map? ([params*] body)+ attr-map?]) - :added "1.0"} - defmacro (fn [&form &env - name & args] - (let [prefix (loop [p (list name) args args] - (let [f (first args)] - (if (string? f) - (recur (cons f p) (next args)) - (if (map? f) - (recur (cons f p) (next args)) - p)))) - fdecl (loop [fd args] - (if (string? (first fd)) - (recur (next fd)) - (if (map? (first fd)) - (recur (next fd)) - fd))) - fdecl (if (vector? (first fdecl)) - (list fdecl) - fdecl) - add-implicit-args (fn [fd] - (let [args (first fd)] - (cons (vec (cons '&form (cons '&env args))) (next fd)))) - add-args (fn [acc ds] - (if (nil? ds) - acc - (let [d (first ds)] - (if (map? d) - (conj acc d) - (recur (conj acc (add-implicit-args d)) (next ds)))))) - fdecl (seq (add-args [] fdecl)) - decl (loop [p prefix d fdecl] - (if p - (recur (next p) (cons (first p) d)) - d))] - (list 'do - (cons `defn decl) - (list '. (list 'var name) '(setMacro)) - (list 'var name))))) - - -(. (var defmacro) (setMacro)) - -(defmacro when - "Evaluates test. If logical true, evaluates body in an implicit do." - {:added "1.0"} - [test & body] - (list 'if test (cons 'do body))) - -(defmacro when-not - "Evaluates test. If logical false, evaluates body in an implicit do." - {:added "1.0"} - [test & body] - (list 'if test nil (cons 'do body))) - -(defn false? - "Returns true if x is the value false, false otherwise." - {:tag Boolean, - :added "1.0"} - [x] (clojure.lang.Util/identical x false)) - -(defn true? - "Returns true if x is the value true, false otherwise." - {:tag Boolean, - :added "1.0"} - [x] (clojure.lang.Util/identical x true)) - -(defn not - "Returns true if x is logical false, false otherwise." - {:tag Boolean - :added "1.0"} - [x] (if x false true)) - -(defn str - "With no args, returns the empty string. With one arg x, returns - x.toString(). (str nil) returns the empty string. With more than - one arg, returns the concatenation of the str values of the args." - {:tag String - :added "1.0"} - ([] "") - ([^Object x] - (if (nil? x) "" (. x (toString)))) - ([x & ys] - ((fn [^StringBuilder sb more] - (if more - (recur (. sb (append (str (first more)))) (next more)) - (str sb))) - (new StringBuilder ^String (str x)) ys))) - - -(defn symbol? - "Return true if x is a Symbol" - {:added "1.0"} - [x] (instance? clojure.lang.Symbol x)) - -(defn keyword? - "Return true if x is a Keyword" - {:added "1.0"} - [x] (instance? clojure.lang.Keyword x)) - -(defn symbol - "Returns a Symbol with the given namespace and name." - {:tag clojure.lang.Symbol - :added "1.0"} - ([name] (if (symbol? name) name (clojure.lang.Symbol/intern name))) - ([ns name] (clojure.lang.Symbol/intern ns name))) - -(defn gensym - "Returns a new symbol with a unique name. If a prefix string is - supplied, the name is prefix# where # is some unique number. If - prefix is not supplied, the prefix is 'G__'." - {:added "1.0"} - ([] (gensym "G__")) - ([prefix-string] (. clojure.lang.Symbol (intern (str prefix-string (str (. clojure.lang.RT (nextID)))))))) - -(defmacro cond - "Takes a set of test/expr pairs. It evaluates each test one at a - time. If a test returns logical true, cond evaluates and returns - the value of the corresponding expr and doesn't evaluate any of the - other tests or exprs. (cond) returns nil." - {:added "1.0"} - [& clauses] - (when clauses - (list 'if (first clauses) - (if (next clauses) - (second clauses) - (throw (IllegalArgumentException. - "cond requires an even number of forms"))) - (cons 'clojure.core/cond (next (next clauses)))))) - -(defn keyword - "Returns a Keyword with the given namespace and name. Do not use : - in the keyword strings, it will be added automatically." - {:tag clojure.lang.Keyword - :added "1.0"} - ([name] (cond (keyword? name) name - (symbol? name) (clojure.lang.Keyword/intern ^clojure.lang.Symbol name) - (string? name) (clojure.lang.Keyword/intern ^String name))) - ([ns name] (clojure.lang.Keyword/intern ns name))) - -(defn spread - {:private true} - [arglist] - (cond - (nil? arglist) nil - (nil? (next arglist)) (seq (first arglist)) - :else (cons (first arglist) (spread (next arglist))))) - -(defn list* - "Creates a new list containing the items prepended to the rest, the - last of which will be treated as a sequence." - {:added "1.0"} - ([args] (seq args)) - ([a args] (cons a args)) - ([a b args] (cons a (cons b args))) - ([a b c args] (cons a (cons b (cons c args)))) - ([a b c d & more] - (cons a (cons b (cons c (cons d (spread more))))))) - -(defn apply - "Applies fn f to the argument list formed by prepending args to argseq." - {:arglists '([f args* argseq]) - :added "1.0"} - ([^clojure.lang.IFn f args] - (. f (applyTo (seq args)))) - ([^clojure.lang.IFn f x args] - (. f (applyTo (list* x args)))) - ([^clojure.lang.IFn f x y args] - (. f (applyTo (list* x y args)))) - ([^clojure.lang.IFn f x y z args] - (. f (applyTo (list* x y z args)))) - ([^clojure.lang.IFn f a b c d & args] - (. f (applyTo (cons a (cons b (cons c (cons d (spread args))))))))) - -(defn vary-meta - "Returns an object of the same type and value as obj, with - (apply f (meta obj) args) as its metadata." - {:added "1.0"} - [obj f & args] - (with-meta obj (apply f (meta obj) args))) - -(defmacro lazy-seq - "Takes a body of expressions that returns an ISeq or nil, and yields - a Seqable object that will invoke the body only the first time seq - is called, and will cache the result and return it on all subsequent - seq calls." - {:added "1.0"} - [& body] - (list 'new 'clojure.lang.LazySeq (list* '^{:once true} fn* [] body))) - -(defn ^clojure.lang.ChunkBuffer chunk-buffer [capacity] - (clojure.lang.ChunkBuffer. capacity)) - -(defn chunk-append [^clojure.lang.ChunkBuffer b x] - (.add b x)) - -(defn chunk [^clojure.lang.ChunkBuffer b] - (.chunk b)) - -(defn ^clojure.lang.IChunk chunk-first [^clojure.lang.IChunkedSeq s] - (.chunkedFirst s)) - -(defn ^clojure.lang.ISeq chunk-rest [^clojure.lang.IChunkedSeq s] - (.chunkedMore s)) - -(defn ^clojure.lang.ISeq chunk-next [^clojure.lang.IChunkedSeq s] - (.chunkedNext s)) - -(defn chunk-cons [chunk rest] - (if (clojure.lang.Numbers/isZero (clojure.lang.RT/count chunk)) - rest - (clojure.lang.ChunkedCons. chunk rest))) - -(defn chunked-seq? [s] - (instance? clojure.lang.IChunkedSeq s)) - -(defn concat - "Returns a lazy seq representing the concatenation of the elements in the supplied colls." - {:added "1.0"} - ([] (lazy-seq nil)) - ([x] (lazy-seq x)) - ([x y] - (lazy-seq - (let [s (seq x)] - (if s - (if (chunked-seq? s) - (chunk-cons (chunk-first s) (concat (chunk-rest s) y)) - (cons (first s) (concat (rest s) y))) - y)))) - ([x y & zs] - (let [cat (fn cat [xys zs] - (lazy-seq - (let [xys (seq xys)] - (if xys - (if (chunked-seq? xys) - (chunk-cons (chunk-first xys) - (cat (chunk-rest xys) zs)) - (cons (first xys) (cat (rest xys) zs))) - (when zs - (cat (first zs) (next zs)))))))] - (cat (concat x y) zs)))) - -;;;;;;;;;;;;;;;;at this point all the support for syntax-quote exists;;;;;;;;;;;;;;;;;;;;;; -(defmacro delay - "Takes a body of expressions and yields a Delay object that will - invoke the body only the first time it is forced (with force or deref/@), and - will cache the result and return it on all subsequent force - calls." - {:added "1.0"} - [& body] - (list 'new 'clojure.lang.Delay (list* `^{:once true} fn* [] body))) - -(defn delay? - "returns true if x is a Delay created with delay" - {:added "1.0"} - [x] (instance? clojure.lang.Delay x)) - -(defn force - "If x is a Delay, returns the (possibly cached) value of its expression, else returns x" - {:added "1.0"} - [x] (. clojure.lang.Delay (force x))) - -(defmacro if-not - "Evaluates test. If logical false, evaluates and returns then expr, - otherwise else expr, if supplied, else nil." - {:added "1.0"} - ([test then] `(if-not ~test ~then nil)) - ([test then else] - `(if (not ~test) ~then ~else))) - -(defn identical? - "Tests if 2 arguments are the same object" - {:inline (fn [x y] `(. clojure.lang.Util identical ~x ~y)) - :inline-arities #{2} - :added "1.0"} - ([x y] (clojure.lang.Util/identical x y))) - -(defn = - "Equality. Returns true if x equals y, false if not. Same as - Java x.equals(y) except it also works for nil, and compares - numbers and collections in a type-independent manner. Clojure's immutable data - structures define equals() (and thus =) as a value, not an identity, - comparison." - {:inline (fn [x y] `(. clojure.lang.Util equiv ~x ~y)) - :inline-arities #{2} - :added "1.0"} - ([x] true) - ([x y] (clojure.lang.Util/equiv x y)) - ([x y & more] - (if (= x y) - (if (next more) - (recur y (first more) (next more)) - (= y (first more))) - false))) - -(defn not= - "Same as (not (= obj1 obj2))" - {:tag Boolean - :added "1.0"} - ([x] false) - ([x y] (not (= x y))) - ([x y & more] - (not (apply = x y more)))) - - - -(defn compare - "Comparator. Returns a negative number, zero, or a positive number - when x is logically 'less than', 'equal to', or 'greater than' - y. Same as Java x.compareTo(y) except it also works for nil, and - compares numbers and collections in a type-independent manner. x - must implement Comparable" - { - :inline (fn [x y] `(. clojure.lang.Util compare ~x ~y)) - :added "1.0"} - [x y] (. clojure.lang.Util (compare x y))) - -(defmacro and - "Evaluates exprs one at a time, from left to right. If a form - returns logical false (nil or false), and returns that value and - doesn't evaluate any of the other expressions, otherwise it returns - the value of the last expr. (and) returns true." - {:added "1.0"} - ([] true) - ([x] x) - ([x & next] - `(let [and# ~x] - (if and# (and ~@next) and#)))) - -(defmacro or - "Evaluates exprs one at a time, from left to right. If a form - returns a logical true value, or returns that value and doesn't - evaluate any of the other expressions, otherwise it returns the - value of the last expression. (or) returns nil." - {:added "1.0"} - ([] nil) - ([x] x) - ([x & next] - `(let [or# ~x] - (if or# or# (or ~@next))))) - -;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;; -(defn zero? - "Returns true if num is zero, else false" - { - :inline (fn [x] `(. clojure.lang.Numbers (isZero ~x))) - :added "1.0"} - [x] (. clojure.lang.Numbers (isZero x))) - -(defn count - "Returns the number of items in the collection. (count nil) returns - 0. Also works on strings, arrays, and Java Collections and Maps" - { - :inline (fn [x] `(. clojure.lang.RT (count ~x))) - :added "1.0"} - [coll] (clojure.lang.RT/count coll)) - -(defn int - "Coerce to int" - { - :inline (fn [x] `(. clojure.lang.RT (intCast ~x))) - :added "1.0"} - [x] (. clojure.lang.RT (intCast x))) - -(defn nth - "Returns the value at the index. get returns nil if index out of - bounds, nth throws an exception unless not-found is supplied. nth - also works for strings, Java arrays, regex Matchers and Lists, and, - in O(n) time, for sequences." - {:inline (fn [c i & nf] `(. clojure.lang.RT (nth ~c ~i ~@nf))) - :inline-arities #{2 3} - :added "1.0"} - ([coll index] (. clojure.lang.RT (nth coll index))) - ([coll index not-found] (. clojure.lang.RT (nth coll index not-found)))) - -(defn < - "Returns non-nil if nums are in monotonically increasing order, - otherwise false." - {:inline (fn [x y] `(. clojure.lang.Numbers (lt ~x ~y))) - :inline-arities #{2} - :added "1.0"} - ([x] true) - ([x y] (. clojure.lang.Numbers (lt x y))) - ([x y & more] - (if (< x y) - (if (next more) - (recur y (first more) (next more)) - (< y (first more))) - false))) - -(defn inc - "Returns a number one greater than num." - {:inline (fn [x] `(. clojure.lang.Numbers (inc ~x))) - :added "1.0"} - [x] (. clojure.lang.Numbers (inc x))) - -;; reduce is defined again later after InternalReduce loads -(def - ^{:arglists '([f coll] [f val coll]) - :doc "f should be a function of 2 arguments. If val is not supplied, - returns the result of applying f to the first 2 items in coll, then - applying f to that result and the 3rd item, etc. If coll contains no - items, f must accept no arguments as well, and reduce returns the - result of calling f with no arguments. If coll has only 1 item, it - is returned and f is not called. If val is supplied, returns the - result of applying f to val and the first item in coll, then - applying f to that result and the 2nd item, etc. If coll contains no - items, returns val and f is not called." - :added "1.0"} - reduce - (fn r - ([f coll] - (let [s (seq coll)] - (if s - (r f (first s) (next s)) - (f)))) - ([f val coll] - (let [s (seq coll)] - (if s - (if (chunked-seq? s) - (recur f - (.reduce (chunk-first s) f val) - (chunk-next s)) - (recur f (f val (first s)) (next s))) - val))))) - -(defn reverse - "Returns a seq of the items in coll in reverse order. Not lazy." - {:added "1.0"} - [coll] - (reduce conj () coll)) - -;;math stuff -(defn + - "Returns the sum of nums. (+) returns 0." - {:inline (fn [x y] `(. clojure.lang.Numbers (add ~x ~y))) - :inline-arities #{2} - :added "1.0"} - ([] 0) - ([x] (cast Number x)) - ([x y] (. clojure.lang.Numbers (add x y))) - ([x y & more] - (reduce + (+ x y) more))) - -(defn * - "Returns the product of nums. (*) returns 1." - {:inline (fn [x y] `(. clojure.lang.Numbers (multiply ~x ~y))) - :inline-arities #{2} - :added "1.0"} - ([] 1) - ([x] (cast Number x)) - ([x y] (. clojure.lang.Numbers (multiply x y))) - ([x y & more] - (reduce * (* x y) more))) - -(defn / - "If no denominators are supplied, returns 1/numerator, - else returns numerator divided by all of the denominators." - {:inline (fn [x y] `(. clojure.lang.Numbers (divide ~x ~y))) - :inline-arities #{2} - :added "1.0"} - ([x] (/ 1 x)) - ([x y] (. clojure.lang.Numbers (divide x y))) - ([x y & more] - (reduce / (/ x y) more))) - -(defn - - "If no ys are supplied, returns the negation of x, else subtracts - the ys from x and returns the result." - {:inline (fn [& args] `(. clojure.lang.Numbers (minus ~@args))) - :inline-arities #{1 2} - :added "1.0"} - ([x] (. clojure.lang.Numbers (minus x))) - ([x y] (. clojure.lang.Numbers (minus x y))) - ([x y & more] - (reduce - (- x y) more))) - -(defn <= - "Returns non-nil if nums are in monotonically non-decreasing order, - otherwise false." - {:inline (fn [x y] `(. clojure.lang.Numbers (lte ~x ~y))) - :inline-arities #{2} - :added "1.0"} - ([x] true) - ([x y] (. clojure.lang.Numbers (lte x y))) - ([x y & more] - (if (<= x y) - (if (next more) - (recur y (first more) (next more)) - (<= y (first more))) - false))) - -(defn > - "Returns non-nil if nums are in monotonically decreasing order, - otherwise false." - {:inline (fn [x y] `(. clojure.lang.Numbers (gt ~x ~y))) - :inline-arities #{2} - :added "1.0"} - ([x] true) - ([x y] (. clojure.lang.Numbers (gt x y))) - ([x y & more] - (if (> x y) - (if (next more) - (recur y (first more) (next more)) - (> y (first more))) - false))) - -(defn >= - "Returns non-nil if nums are in monotonically non-increasing order, - otherwise false." - {:inline (fn [x y] `(. clojure.lang.Numbers (gte ~x ~y))) - :inline-arities #{2} - :added "1.0"} - ([x] true) - ([x y] (. clojure.lang.Numbers (gte x y))) - ([x y & more] - (if (>= x y) - (if (next more) - (recur y (first more) (next more)) - (>= y (first more))) - false))) - -(defn == - "Returns non-nil if nums all have the same value, otherwise false" - {:inline (fn [x y] `(. clojure.lang.Numbers (equiv ~x ~y))) - :inline-arities #{2} - :added "1.0"} - ([x] true) - ([x y] (. clojure.lang.Numbers (equiv x y))) - ([x y & more] - (if (== x y) - (if (next more) - (recur y (first more) (next more)) - (== y (first more))) - false))) - -(defn max - "Returns the greatest of the nums." - {:added "1.0"} - ([x] x) - ([x y] (if (> x y) x y)) - ([x y & more] - (reduce max (max x y) more))) - -(defn min - "Returns the least of the nums." - {:added "1.0"} - ([x] x) - ([x y] (if (< x y) x y)) - ([x y & more] - (reduce min (min x y) more))) - -(defn dec - "Returns a number one less than num." - {:inline (fn [x] `(. clojure.lang.Numbers (dec ~x))) - :added "1.0"} - [x] (. clojure.lang.Numbers (dec x))) - -(defn unchecked-inc - "Returns a number one greater than x, an int or long. - Note - uses a primitive operator subject to overflow." - {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_inc ~x))) - :added "1.0"} - [x] (. clojure.lang.Numbers (unchecked_inc x))) - -(defn unchecked-dec - "Returns a number one less than x, an int or long. - Note - uses a primitive operator subject to overflow." - {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_dec ~x))) - :added "1.0"} - [x] (. clojure.lang.Numbers (unchecked_dec x))) - -(defn unchecked-negate - "Returns the negation of x, an int or long. - Note - uses a primitive operator subject to overflow." - {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_negate ~x))) - :added "1.0"} - [x] (. clojure.lang.Numbers (unchecked_negate x))) - -(defn unchecked-add - "Returns the sum of x and y, both int or long. - Note - uses a primitive operator subject to overflow." - {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_add ~x ~y))) - :added "1.0"} - [x y] (. clojure.lang.Numbers (unchecked_add x y))) - -(defn unchecked-subtract - "Returns the difference of x and y, both int or long. - Note - uses a primitive operator subject to overflow." - {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_subtract ~x ~y))) - :added "1.0"} - [x y] (. clojure.lang.Numbers (unchecked_subtract x y))) - -(defn unchecked-multiply - "Returns the product of x and y, both int or long. - Note - uses a primitive operator subject to overflow." - {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_multiply ~x ~y))) - :added "1.0"} - [x y] (. clojure.lang.Numbers (unchecked_multiply x y))) - -(defn unchecked-divide - "Returns the division of x by y, both int or long. - Note - uses a primitive operator subject to truncation." - {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_divide ~x ~y))) - :added "1.0"} - [x y] (. clojure.lang.Numbers (unchecked_divide x y))) - -(defn unchecked-remainder - "Returns the remainder of division of x by y, both int or long. - Note - uses a primitive operator subject to truncation." - {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_remainder ~x ~y))) - :added "1.0"} - [x y] (. clojure.lang.Numbers (unchecked_remainder x y))) - -(defn pos? - "Returns true if num is greater than zero, else false" - { - :inline (fn [x] `(. clojure.lang.Numbers (isPos ~x))) - :added "1.0"} - [x] (. clojure.lang.Numbers (isPos x))) - -(defn neg? - "Returns true if num is less than zero, else false" - { - :inline (fn [x] `(. clojure.lang.Numbers (isNeg ~x))) - :added "1.0"} - [x] (. clojure.lang.Numbers (isNeg x))) - -(defn quot - "quot[ient] of dividing numerator by denominator." - {:added "1.0"} - [num div] - (. clojure.lang.Numbers (quotient num div))) - -(defn rem - "remainder of dividing numerator by denominator." - {:added "1.0"} - [num div] - (. clojure.lang.Numbers (remainder num div))) - -(defn rationalize - "returns the rational value of num" - {:added "1.0"} - [num] - (. clojure.lang.Numbers (rationalize num))) - -;;Bit ops - -(defn bit-not - "Bitwise complement" - {:inline (fn [x] `(. clojure.lang.Numbers (not ~x))) - :added "1.0"} - [x] (. clojure.lang.Numbers not x)) - - -(defn bit-and - "Bitwise and" - {:inline (fn [x y] `(. clojure.lang.Numbers (and ~x ~y))) - :added "1.0"} - [x y] (. clojure.lang.Numbers and x y)) - -(defn bit-or - "Bitwise or" - {:inline (fn [x y] `(. clojure.lang.Numbers (or ~x ~y))) - :added "1.0"} - [x y] (. clojure.lang.Numbers or x y)) - -(defn bit-xor - "Bitwise exclusive or" - {:inline (fn [x y] `(. clojure.lang.Numbers (xor ~x ~y))) - :added "1.0"} - [x y] (. clojure.lang.Numbers xor x y)) - -(defn bit-and-not - "Bitwise and with complement" - {:added "1.0"} - [x y] (. clojure.lang.Numbers andNot x y)) - - -(defn bit-clear - "Clear bit at index n" - {:added "1.0"} - [x n] (. clojure.lang.Numbers clearBit x n)) - -(defn bit-set - "Set bit at index n" - {:added "1.0"} - [x n] (. clojure.lang.Numbers setBit x n)) - -(defn bit-flip - "Flip bit at index n" - {:added "1.0"} - [x n] (. clojure.lang.Numbers flipBit x n)) - -(defn bit-test - "Test bit at index n" - {:added "1.0"} - [x n] (. clojure.lang.Numbers testBit x n)) - - -(defn bit-shift-left - "Bitwise shift left" - {:inline (fn [x n] `(. clojure.lang.Numbers (shiftLeft ~x ~n))) - :added "1.0"} - [x n] (. clojure.lang.Numbers shiftLeft x n)) - -(defn bit-shift-right - "Bitwise shift right" - {:inline (fn [x n] `(. clojure.lang.Numbers (shiftRight ~x ~n))) - :added "1.0"} - [x n] (. clojure.lang.Numbers shiftRight x n)) - -(defn even? - "Returns true if n is even, throws an exception if n is not an integer" - {:added "1.0"} - [n] (zero? (bit-and n 1))) - -(defn odd? - "Returns true if n is odd, throws an exception if n is not an integer" - {:added "1.0"} - [n] (not (even? n))) - - -;; - -(defn complement - "Takes a fn f and returns a fn that takes the same arguments as f, - has the same effects, if any, and returns the opposite truth value." - {:added "1.0"} - [f] - (fn - ([] (not (f))) - ([x] (not (f x))) - ([x y] (not (f x y))) - ([x y & zs] (not (apply f x y zs))))) - -(defn constantly - "Returns a function that takes any number of arguments and returns x." - {:added "1.0"} - [x] (fn [& args] x)) - -(defn identity - "Returns its argument." - {:added "1.0"} - [x] x) - -;;Collection stuff - - - - - -;;list stuff -(defn peek - "For a list or queue, same as first, for a vector, same as, but much - more efficient than, last. If the collection is empty, returns nil." - {:added "1.0"} - [coll] (. clojure.lang.RT (peek coll))) - -(defn pop - "For a list or queue, returns a new list/queue without the first - item, for a vector, returns a new vector without the last item. If - the collection is empty, throws an exception. Note - not the same - as next/butlast." - {:added "1.0"} - [coll] (. clojure.lang.RT (pop coll))) - -;;map stuff - -(defn contains? - "Returns true if key is present in the given collection, otherwise - returns false. Note that for numerically indexed collections like - vectors and Java arrays, this tests if the numeric key is within the - range of indexes. 'contains?' operates constant or logarithmic time; - it will not perform a linear search for a value. See also 'some'." - {:added "1.0"} - [coll key] (. clojure.lang.RT (contains coll key))) - -(defn get - "Returns the value mapped to key, not-found or nil if key not present." - {:inline (fn [m k & nf] `(. clojure.lang.RT (get ~m ~k ~@nf))) - :inline-arities #{2 3} - :added "1.0"} - ([map key] - (. clojure.lang.RT (get map key))) - ([map key not-found] - (. clojure.lang.RT (get map key not-found)))) - -(defn dissoc - "dissoc[iate]. Returns a new map of the same (hashed/sorted) type, - that does not contain a mapping for key(s)." - {:added "1.0"} - ([map] map) - ([map key] - (. clojure.lang.RT (dissoc map key))) - ([map key & ks] - (let [ret (dissoc map key)] - (if ks - (recur ret (first ks) (next ks)) - ret)))) - -(defn disj - "disj[oin]. Returns a new set of the same (hashed/sorted) type, that - does not contain key(s)." - {:added "1.0"} - ([set] set) - ([^clojure.lang.IPersistentSet set key] - (when set - (. set (disjoin key)))) - ([set key & ks] - (when set - (let [ret (disj set key)] - (if ks - (recur ret (first ks) (next ks)) - ret))))) - -(defn find - "Returns the map entry for key, or nil if key not present." - {:added "1.0"} - [map key] (. clojure.lang.RT (find map key))) - -(defn select-keys - "Returns a map containing only those entries in map whose key is in keys" - {:added "1.0"} - [map keyseq] - (loop [ret {} keys (seq keyseq)] - (if keys - (let [entry (. clojure.lang.RT (find map (first keys)))] - (recur - (if entry - (conj ret entry) - ret) - (next keys))) - ret))) - -(defn keys - "Returns a sequence of the map's keys." - {:added "1.0"} - [map] (. clojure.lang.RT (keys map))) - -(defn vals - "Returns a sequence of the map's values." - {:added "1.0"} - [map] (. clojure.lang.RT (vals map))) - -(defn key - "Returns the key of the map entry." - {:added "1.0"} - [^java.util.Map$Entry e] - (. e (getKey))) - -(defn val - "Returns the value in the map entry." - {:added "1.0"} - [^java.util.Map$Entry e] - (. e (getValue))) - -(defn rseq - "Returns, in constant time, a seq of the items in rev (which - can be a vector or sorted-map), in reverse order. If rev is empty returns nil" - {:added "1.0"} - [^clojure.lang.Reversible rev] - (. rev (rseq))) - -(defn name - "Returns the name String of a string, symbol or keyword." - {:tag String - :added "1.0"} - [^clojure.lang.Named x] - (if (string? x) x (. x (getName)))) - -(defn namespace - "Returns the namespace String of a symbol or keyword, or nil if not present." - {:tag String - :added "1.0"} - [^clojure.lang.Named x] - (. x (getNamespace))) - -(defmacro locking - "Executes exprs in an implicit do, while holding the monitor of x. - Will release the monitor of x in all circumstances." - {:added "1.0"} - [x & body] - `(let [lockee# ~x] - (try - (monitor-enter lockee#) - ~@body - (finally - (monitor-exit lockee#))))) - -(defmacro .. - "form => fieldName-symbol or (instanceMethodName-symbol args*) - - Expands into a member access (.) of the first member on the first - argument, followed by the next member on the result, etc. For - instance: - - (.. System (getProperties) (get \"os.name\")) - - expands to: - - (. (. System (getProperties)) (get \"os.name\")) - - but is easier to write, read, and understand." - {:added "1.0"} - ([x form] `(. ~x ~form)) - ([x form & more] `(.. (. ~x ~form) ~@more))) - -(defmacro -> - "Threads the expr through the forms. Inserts x as the - second item in the first form, making a list of it if it is not a - list already. If there are more forms, inserts the first form as the - second item in second form, etc." - {:added "1.0"} - ([x] x) - ([x form] (if (seq? form) - (with-meta `(~(first form) ~x ~@(next form)) (meta form)) - (list form x))) - ([x form & more] `(-> (-> ~x ~form) ~@more))) - -(defmacro ->> - "Threads the expr through the forms. Inserts x as the - last item in the first form, making a list of it if it is not a - list already. If there are more forms, inserts the first form as the - last item in second form, etc." - {:added "1.1"} - ([x form] (if (seq? form) - (with-meta `(~(first form) ~@(next form) ~x) (meta form)) - (list form x))) - ([x form & more] `(->> (->> ~x ~form) ~@more))) - -;;multimethods -(def global-hierarchy) - -(defmacro defmulti - "Creates a new multimethod with the associated dispatch function. - The docstring and attribute-map are optional. - - Options are key-value pairs and may be one of: - :default the default dispatch value, defaults to :default - :hierarchy the isa? hierarchy to use for dispatching - defaults to the global hierarchy" - {:arglists '([name docstring? attr-map? dispatch-fn & options]) - :added "1.0"} - [mm-name & options] - (let [docstring (if (string? (first options)) - (first options) - nil) - options (if (string? (first options)) - (next options) - options) - m (if (map? (first options)) - (first options) - {}) - options (if (map? (first options)) - (next options) - options) - dispatch-fn (first options) - options (next options) - m (assoc m :tag 'clojure.lang.MultiFn) - m (if docstring - (assoc m :doc docstring) - m) - m (if (meta mm-name) - (conj (meta mm-name) m) - m)] - (when (= (count options) 1) - (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))) - (let [options (apply hash-map options) - default (get options :default :default) - hierarchy (get options :hierarchy #'global-hierarchy)] - `(let [v# (def ~mm-name)] - (when-not (and (.hasRoot v#) (instance? clojure.lang.MultiFn (deref v#))) - (def ~(with-meta mm-name m) - (new clojure.lang.MultiFn ~(name mm-name) ~dispatch-fn ~default ~hierarchy))))))) - -(defmacro defmethod - "Creates and installs a new method of multimethod associated with dispatch-value. " - {:added "1.0"} - [multifn dispatch-val & fn-tail] - `(. ~(with-meta multifn {:tag 'clojure.lang.MultiFn}) addMethod ~dispatch-val (fn ~@fn-tail))) - -(defn remove-all-methods - "Removes all of the methods of multimethod." - {:added "1.2"} - [^clojure.lang.MultiFn multifn] - (.reset multifn)) - -(defn remove-method - "Removes the method of multimethod associated with dispatch-value." - {:added "1.0"} - [^clojure.lang.MultiFn multifn dispatch-val] - (. multifn removeMethod dispatch-val)) - -(defn prefer-method - "Causes the multimethod to prefer matches of dispatch-val-x over dispatch-val-y - when there is a conflict" - {:added "1.0"} - [^clojure.lang.MultiFn multifn dispatch-val-x dispatch-val-y] - (. multifn preferMethod dispatch-val-x dispatch-val-y)) - -(defn methods - "Given a multimethod, returns a map of dispatch values -> dispatch fns" - {:added "1.0"} - [^clojure.lang.MultiFn multifn] (.getMethodTable multifn)) - -(defn get-method - "Given a multimethod and a dispatch value, returns the dispatch fn - that would apply to that value, or nil if none apply and no default" - {:added "1.0"} - [^clojure.lang.MultiFn multifn dispatch-val] (.getMethod multifn dispatch-val)) - -(defn prefers - "Given a multimethod, returns a map of preferred value -> set of other values" - {:added "1.0"} - [^clojure.lang.MultiFn multifn] (.getPreferTable multifn)) - -;;;;;;;;; var stuff - -(defmacro ^{:private true} assert-args [fnname & pairs] - `(do (when-not ~(first pairs) - (throw (IllegalArgumentException. - ~(str fnname " requires " (second pairs))))) - ~(let [more (nnext pairs)] - (when more - (list* `assert-args fnname more))))) - -(defmacro if-let - "bindings => binding-form test - - If test is true, evaluates then with binding-form bound to the value of - test, if not, yields else" - {:added "1.0"} - ([bindings then] - `(if-let ~bindings ~then nil)) - ([bindings then else & oldform] - (assert-args if-let - (and (vector? bindings) (nil? oldform)) "a vector for its binding" - (= 2 (count bindings)) "exactly 2 forms in binding vector") - (let [form (bindings 0) tst (bindings 1)] - `(let [temp# ~tst] - (if temp# - (let [~form temp#] - ~then) - ~else))))) - -(defmacro when-let - "bindings => binding-form test - - When test is true, evaluates body with binding-form bound to the value of test" - {:added "1.0"} - [bindings & body] - (assert-args when-let - (vector? bindings) "a vector for its binding" - (= 2 (count bindings)) "exactly 2 forms in binding vector") - (let [form (bindings 0) tst (bindings 1)] - `(let [temp# ~tst] - (when temp# - (let [~form temp#] - ~@body))))) - -(defn push-thread-bindings - "WARNING: This is a low-level function. Prefer high-level macros like - binding where ever possible. - - Takes a map of Var/value pairs. Binds each Var to the associated value for - the current thread. Each call *MUST* be accompanied by a matching call to - pop-thread-bindings wrapped in a try-finally! - - (push-thread-bindings bindings) - (try - ... - (finally - (pop-thread-bindings)))" - {:added "1.1"} - [bindings] - (clojure.lang.Var/pushThreadBindings bindings)) - -(defn pop-thread-bindings - "Pop one set of bindings pushed with push-binding before. It is an error to - pop bindings without pushing before." - {:added "1.1"} - [] - (clojure.lang.Var/popThreadBindings)) - -(defn get-thread-bindings - "Get a map with the Var/value pairs which is currently in effect for the - current thread." - {:added "1.1"} - [] - (clojure.lang.Var/getThreadBindings)) - -(defmacro binding - "binding => var-symbol init-expr - - Creates new bindings for the (already-existing) vars, with the - supplied initial values, executes the exprs in an implicit do, then - re-establishes the bindings that existed before. The new bindings - are made in parallel (unlike let); all init-exprs are evaluated - before the vars are bound to their new values." - {:added "1.0"} - [bindings & body] - (assert-args binding - (vector? bindings) "a vector for its binding" - (even? (count bindings)) "an even number of forms in binding vector") - (let [var-ize (fn [var-vals] - (loop [ret [] vvs (seq var-vals)] - (if vvs - (recur (conj (conj ret `(var ~(first vvs))) (second vvs)) - (next (next vvs))) - (seq ret))))] - `(let [] - (push-thread-bindings (hash-map ~@(var-ize bindings))) - (try - ~@body - (finally - (pop-thread-bindings)))))) - -(defn with-bindings* - "Takes a map of Var/value pairs. Installs for the given Vars the associated - values as thread-local bindings. Then calls f with the supplied arguments. - Pops the installed bindings after f returned. Returns whatever f returns." - {:added "1.1"} - [binding-map f & args] - (push-thread-bindings binding-map) - (try - (apply f args) - (finally - (pop-thread-bindings)))) - -(defmacro with-bindings - "Takes a map of Var/value pairs. Installs for the given Vars the associated - values as thread-local bindings. The executes body. Pops the installed - bindings after body was evaluated. Returns the value of body." - {:added "1.1"} - [binding-map & body] - `(with-bindings* ~binding-map (fn [] ~@body))) - -(defn bound-fn* - "Returns a function, which will install the same bindings in effect as in - the thread at the time bound-fn* was called and then call f with any given - arguments. This may be used to define a helper function which runs on a - different thread, but needs the same bindings in place." - {:added "1.1"} - [f] - (let [bindings (get-thread-bindings)] - (fn [& args] - (apply with-bindings* bindings f args)))) - -(defmacro bound-fn - "Returns a function defined by the given fntail, which will install the - same bindings in effect as in the thread at the time bound-fn was called. - This may be used to define a helper function which runs on a different - thread, but needs the same bindings in place." - {:added "1.1"} - [& fntail] - `(bound-fn* (fn ~@fntail))) - -(defn find-var - "Returns the global var named by the namespace-qualified symbol, or - nil if no var with that name." - {:added "1.0"} - [sym] (. clojure.lang.Var (find sym))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Refs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defn ^{:private true} - setup-reference [^clojure.lang.ARef r options] - (let [opts (apply hash-map options)] - (when (:meta opts) - (.resetMeta r (:meta opts))) - (when (:validator opts) - (.setValidator r (:validator opts))) - r)) - -(defn agent - "Creates and returns an agent with an initial value of state and - zero or more options (in any order): - - :meta metadata-map - - :validator validate-fn - - :error-handler handler-fn - - :error-mode mode-keyword - - If metadata-map is supplied, it will be come the metadata on the - agent. validate-fn must be nil or a side-effect-free fn of one - argument, which will be passed the intended new state on any state - change. If the new state is unacceptable, the validate-fn should - return false or throw an exception. handler-fn is called if an - action throws an exception or if validate-fn rejects a new state -- - see set-error-handler! for details. The mode-keyword may be either - :continue (the default if an error-handler is given) or :fail (the - default if no error-handler is given) -- see set-error-mode! for - details." - {:added "1.0"} - ([state & options] - (let [a (new clojure.lang.Agent state) - opts (apply hash-map options)] - (setup-reference a options) - (when (:error-handler opts) - (.setErrorHandler a (:error-handler opts))) - (.setErrorMode a (or (:error-mode opts) - (if (:error-handler opts) :continue :fail))) - a))) - -(defn send - "Dispatch an action to an agent. Returns the agent immediately. - Subsequently, in a thread from a thread pool, the state of the agent - will be set to the value of: - - (apply action-fn state-of-agent args)" - {:added "1.0"} - [^clojure.lang.Agent a f & args] - (. a (dispatch f args false))) - -(defn send-off - "Dispatch a potentially blocking action to an agent. Returns the - agent immediately. Subsequently, in a separate thread, the state of - the agent will be set to the value of: - - (apply action-fn state-of-agent args)" - {:added "1.0"} - [^clojure.lang.Agent a f & args] - (. a (dispatch f args true))) - -(defn release-pending-sends - "Normally, actions sent directly or indirectly during another action - are held until the action completes (changes the agent's - state). This function can be used to dispatch any pending sent - actions immediately. This has no impact on actions sent during a - transaction, which are still held until commit. If no action is - occurring, does nothing. Returns the number of actions dispatched." - {:added "1.0"} - [] (clojure.lang.Agent/releasePendingSends)) - -(defn add-watch - "Alpha - subject to change. - Adds a watch function to an agent/atom/var/ref reference. The watch - fn must be a fn of 4 args: a key, the reference, its old-state, its - new-state. Whenever the reference's state might have been changed, - any registered watches will have their functions called. The watch fn - will be called synchronously, on the agent's thread if an agent, - before any pending sends if agent or ref. Note that an atom's or - ref's state may have changed again prior to the fn call, so use - old/new-state rather than derefing the reference. Note also that watch - fns may be called from multiple threads simultaneously. Var watchers - are triggered only by root binding changes, not thread-local - set!s. Keys must be unique per reference, and can be used to remove - the watch with remove-watch, but are otherwise considered opaque by - the watch mechanism." - {:added "1.0"} - [^clojure.lang.IRef reference key fn] (.addWatch reference key fn)) - -(defn remove-watch - "Alpha - subject to change. - Removes a watch (set by add-watch) from a reference" - {:added "1.0"} - [^clojure.lang.IRef reference key] - (.removeWatch reference key)) - -(defn agent-error - "Returns the exception thrown during an asynchronous action of the - agent if the agent is failed. Returns nil if the agent is not - failed." - {:added "1.2"} - [^clojure.lang.Agent a] (.getError a)) - -(defn restart-agent - "When an agent is failed, changes the agent state to new-state and - then un-fails the agent so that sends are allowed again. If - a :clear-actions true option is given, any actions queued on the - agent that were being held while it was failed will be discarded, - otherwise those held actions will proceed. The new-state must pass - the validator if any, or restart will throw an exception and the - agent will remain failed with its old state and error. Watchers, if - any, will NOT be notified of the new state. Throws an exception if - the agent is not failed." - {:added "1.2"} - [^clojure.lang.Agent a, new-state & options] - (let [opts (apply hash-map options)] - (.restart a new-state (if (:clear-actions opts) true false)))) - -(defn set-error-handler! - "Sets the error-handler of agent a to handler-fn. If an action - being run by the agent throws an exception or doesn't pass the - validator fn, handler-fn will be called with two arguments: the - agent and the exception." - {:added "1.2"} - [^clojure.lang.Agent a, handler-fn] - (.setErrorHandler a handler-fn)) - -(defn error-handler - "Returns the error-handler of agent a, or nil if there is none. - See set-error-handler!" - {:added "1.2"} - [^clojure.lang.Agent a] - (.getErrorHandler a)) - -(defn set-error-mode! - "Sets the error-mode of agent a to mode-keyword, which must be - either :fail or :continue. If an action being run by the agent - throws an exception or doesn't pass the validator fn, an - error-handler may be called (see set-error-handler!), after which, - if the mode is :continue, the agent will continue as if neither the - action that caused the error nor the error itself ever happened. - - If the mode is :fail, the agent will become failed and will stop - accepting new 'send' and 'send-off' actions, and any previously - queued actions will be held until a 'restart-agent'. Deref will - still work, returning the state of the agent before the error." - {:added "1.2"} - [^clojure.lang.Agent a, mode-keyword] - (.setErrorMode a mode-keyword)) - -(defn error-mode - "Returns the error-mode of agent a. See set-error-mode!" - {:added "1.2"} - [^clojure.lang.Agent a] - (.getErrorMode a)) - -(defn agent-errors - "DEPRECATED: Use 'agent-error' instead. - Returns a sequence of the exceptions thrown during asynchronous - actions of the agent." - {:added "1.0" - :deprecated "1.2"} - [a] - (when-let [e (agent-error a)] - (list e))) - -(defn clear-agent-errors - "DEPRECATED: Use 'restart-agent' instead. - Clears any exceptions thrown during asynchronous actions of the - agent, allowing subsequent actions to occur." - {:added "1.0" - :deprecated "1.2"} - [^clojure.lang.Agent a] (restart-agent a (.deref a))) - -(defn shutdown-agents - "Initiates a shutdown of the thread pools that back the agent - system. Running actions will complete, but no new actions will be - accepted" - {:added "1.0"} - [] (. clojure.lang.Agent shutdown)) - -(defn ref - "Creates and returns a Ref with an initial value of x and zero or - more options (in any order): - - :meta metadata-map - - :validator validate-fn - - :min-history (default 0) - :max-history (default 10) - - If metadata-map is supplied, it will be come the metadata on the - ref. validate-fn must be nil or a side-effect-free fn of one - argument, which will be passed the intended new state on any state - change. If the new state is unacceptable, the validate-fn should - return false or throw an exception. validate-fn will be called on - transaction commit, when all refs have their final values. - - Normally refs accumulate history dynamically as needed to deal with - read demands. If you know in advance you will need history you can - set :min-history to ensure it will be available when first needed (instead - of after a read fault). History is limited, and the limit can be set - with :max-history." - {:added "1.0"} - ([x] (new clojure.lang.Ref x)) - ([x & options] - (let [r ^clojure.lang.Ref (setup-reference (ref x) options) - opts (apply hash-map options)] - (when (:max-history opts) - (.setMaxHistory r (:max-history opts))) - (when (:min-history opts) - (.setMinHistory r (:min-history opts))) - r))) - -(defn deref - "Also reader macro: @ref/@agent/@var/@atom/@delay/@future. Within a transaction, - returns the in-transaction-value of ref, else returns the - most-recently-committed value of ref. When applied to a var, agent - or atom, returns its current state. When applied to a delay, forces - it if not already forced. When applied to a future, will block if - computation not complete" - {:added "1.0"} - [^clojure.lang.IDeref ref] (.deref ref)) - -(defn atom - "Creates and returns an Atom with an initial value of x and zero or - more options (in any order): - - :meta metadata-map - - :validator validate-fn - - If metadata-map is supplied, it will be come the metadata on the - atom. validate-fn must be nil or a side-effect-free fn of one - argument, which will be passed the intended new state on any state - change. If the new state is unacceptable, the validate-fn should - return false or throw an exception." - {:added "1.0"} - ([x] (new clojure.lang.Atom x)) - ([x & options] (setup-reference (atom x) options))) - -(defn swap! - "Atomically swaps the value of atom to be: - (apply f current-value-of-atom args). Note that f may be called - multiple times, and thus should be free of side effects. Returns - the value that was swapped in." - {:added "1.0"} - ([^clojure.lang.Atom atom f] (.swap atom f)) - ([^clojure.lang.Atom atom f x] (.swap atom f x)) - ([^clojure.lang.Atom atom f x y] (.swap atom f x y)) - ([^clojure.lang.Atom atom f x y & args] (.swap atom f x y args))) - -(defn compare-and-set! - "Atomically sets the value of atom to newval if and only if the - current value of the atom is identical to oldval. Returns true if - set happened, else false" - {:added "1.0"} - [^clojure.lang.Atom atom oldval newval] (.compareAndSet atom oldval newval)) - -(defn reset! - "Sets the value of atom to newval without regard for the - current value. Returns newval." - {:added "1.0"} - [^clojure.lang.Atom atom newval] (.reset atom newval)) - -(defn set-validator! - "Sets the validator-fn for a var/ref/agent/atom. validator-fn must be nil or a - side-effect-free fn of one argument, which will be passed the intended - new state on any state change. If the new state is unacceptable, the - validator-fn should return false or throw an exception. If the current state (root - value if var) is not acceptable to the new validator, an exception - will be thrown and the validator will not be changed." - {:added "1.0"} - [^clojure.lang.IRef iref validator-fn] (. iref (setValidator validator-fn))) - -(defn get-validator - "Gets the validator-fn for a var/ref/agent/atom." - {:added "1.0"} - [^clojure.lang.IRef iref] (. iref (getValidator))) - -(defn alter-meta! - "Atomically sets the metadata for a namespace/var/ref/agent/atom to be: - - (apply f its-current-meta args) - - f must be free of side-effects" - {:added "1.0"} - [^clojure.lang.IReference iref f & args] (.alterMeta iref f args)) - -(defn reset-meta! - "Atomically resets the metadata for a namespace/var/ref/agent/atom" - {:added "1.0"} - [^clojure.lang.IReference iref metadata-map] (.resetMeta iref metadata-map)) - -(defn commute - "Must be called in a transaction. Sets the in-transaction-value of - ref to: - - (apply fun in-transaction-value-of-ref args) - - and returns the in-transaction-value of ref. - - At the commit point of the transaction, sets the value of ref to be: - - (apply fun most-recently-committed-value-of-ref args) - - Thus fun should be commutative, or, failing that, you must accept - last-one-in-wins behavior. commute allows for more concurrency than - ref-set." - {:added "1.0"} - - [^clojure.lang.Ref ref fun & args] - (. ref (commute fun args))) - -(defn alter - "Must be called in a transaction. Sets the in-transaction-value of - ref to: - - (apply fun in-transaction-value-of-ref args) - - and returns the in-transaction-value of ref." - {:added "1.0"} - [^clojure.lang.Ref ref fun & args] - (. ref (alter fun args))) - -(defn ref-set - "Must be called in a transaction. Sets the value of ref. - Returns val." - {:added "1.0"} - [^clojure.lang.Ref ref val] - (. ref (set val))) - -(defn ref-history-count - "Returns the history count of a ref" - {:added "1.1"} - [^clojure.lang.Ref ref] - (.getHistoryCount ref)) - -(defn ref-min-history - "Gets the min-history of a ref, or sets it and returns the ref" - {:added "1.1"} - ([^clojure.lang.Ref ref] - (.getMinHistory ref)) - ([^clojure.lang.Ref ref n] - (.setMinHistory ref n))) - -(defn ref-max-history - "Gets the max-history of a ref, or sets it and returns the ref" - {:added "1.1"} - ([^clojure.lang.Ref ref] - (.getMaxHistory ref)) - ([^clojure.lang.Ref ref n] - (.setMaxHistory ref n))) - -(defn ensure - "Must be called in a transaction. Protects the ref from modification - by other transactions. Returns the in-transaction-value of - ref. Allows for more concurrency than (ref-set ref @ref)" - {:added "1.0"} - [^clojure.lang.Ref ref] - (. ref (touch)) - (. ref (deref))) - -(defmacro sync - "transaction-flags => TBD, pass nil for now - - Runs the exprs (in an implicit do) in a transaction that encompasses - exprs and any nested calls. Starts a transaction if none is already - running on this thread. Any uncaught exception will abort the - transaction and flow out of sync. The exprs may be run more than - once, but any effects on Refs will be atomic." - {:added "1.0"} - [flags-ignored-for-now & body] - `(. clojure.lang.LockingTransaction - (runInTransaction (fn [] ~@body)))) - - -(defmacro io! - "If an io! block occurs in a transaction, throws an - IllegalStateException, else runs body in an implicit do. If the - first expression in body is a literal string, will use that as the - exception message." - {:added "1.0"} - [& body] - (let [message (when (string? (first body)) (first body)) - body (if message (next body) body)] - `(if (clojure.lang.LockingTransaction/isRunning) - (throw (new IllegalStateException ~(or message "I/O in transaction"))) - (do ~@body)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fn stuff ;;;;;;;;;;;;;;;; - - -(defn comp - "Takes a set of functions and returns a fn that is the composition - of those fns. The returned fn takes a variable number of args, - applies the rightmost of fns to the args, the next - fn (right-to-left) to the result, etc." - {:added "1.0"} - ([f] f) - ([f g] - (fn - ([] (f (g))) - ([x] (f (g x))) - ([x y] (f (g x y))) - ([x y z] (f (g x y z))) - ([x y z & args] (f (apply g x y z args))))) - ([f g h] - (fn - ([] (f (g (h)))) - ([x] (f (g (h x)))) - ([x y] (f (g (h x y)))) - ([x y z] (f (g (h x y z)))) - ([x y z & args] (f (g (apply h x y z args)))))) - ([f1 f2 f3 & fs] - (let [fs (reverse (list* f1 f2 f3 fs))] - (fn [& args] - (loop [ret (apply (first fs) args) fs (next fs)] - (if fs - (recur ((first fs) ret) (next fs)) - ret)))))) - -(defn juxt - "Alpha - name subject to change. - Takes a set of functions and returns a fn that is the juxtaposition - of those fns. The returned fn takes a variable number of args, and - returns a vector containing the result of applying each fn to the - args (left-to-right). - ((juxt a b c) x) => [(a x) (b x) (c x)]" - {:added "1.1"} - ([f] - (fn - ([] [(f)]) - ([x] [(f x)]) - ([x y] [(f x y)]) - ([x y z] [(f x y z)]) - ([x y z & args] [(apply f x y z args)]))) - ([f g] - (fn - ([] [(f) (g)]) - ([x] [(f x) (g x)]) - ([x y] [(f x y) (g x y)]) - ([x y z] [(f x y z) (g x y z)]) - ([x y z & args] [(apply f x y z args) (apply g x y z args)]))) - ([f g h] - (fn - ([] [(f) (g) (h)]) - ([x] [(f x) (g x) (h x)]) - ([x y] [(f x y) (g x y) (h x y)]) - ([x y z] [(f x y z) (g x y z) (h x y z)]) - ([x y z & args] [(apply f x y z args) (apply g x y z args) (apply h x y z args)]))) - ([f g h & fs] - (let [fs (list* f g h fs)] - (fn - ([] (reduce #(conj %1 (%2)) [] fs)) - ([x] (reduce #(conj %1 (%2 x)) [] fs)) - ([x y] (reduce #(conj %1 (%2 x y)) [] fs)) - ([x y z] (reduce #(conj %1 (%2 x y z)) [] fs)) - ([x y z & args] (reduce #(conj %1 (apply %2 x y z args)) [] fs)))))) - -(defn partial - "Takes a function f and fewer than the normal arguments to f, and - returns a fn that takes a variable number of additional args. When - called, the returned function calls f with args + additional args." - {:added "1.0"} - ([f arg1] - (fn [& args] (apply f arg1 args))) - ([f arg1 arg2] - (fn [& args] (apply f arg1 arg2 args))) - ([f arg1 arg2 arg3] - (fn [& args] (apply f arg1 arg2 arg3 args))) - ([f arg1 arg2 arg3 & more] - (fn [& args] (apply f arg1 arg2 arg3 (concat more args))))) - -;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;; -(defn sequence - "Coerces coll to a (possibly empty) sequence, if it is not already - one. Will not force a lazy seq. (sequence nil) yields ()" - {:added "1.0"} - [coll] - (if (seq? coll) coll - (or (seq coll) ()))) - -(defn every? - "Returns true if (pred x) is logical true for every x in coll, else - false." - {:tag Boolean - :added "1.0"} - [pred coll] - (cond - (nil? (seq coll)) true - (pred (first coll)) (recur pred (next coll)) - :else false)) - -(def - ^{:tag Boolean - :doc "Returns false if (pred x) is logical true for every x in - coll, else true." - :arglists '([pred coll]) - :added "1.0"} - not-every? (comp not every?)) - -(defn some - "Returns the first logical true value of (pred x) for any x in coll, - else nil. One common idiom is to use a set as pred, for example - this will return :fred if :fred is in the sequence, otherwise nil: - (some #{:fred} coll)" - {:added "1.0"} - [pred coll] - (when (seq coll) - (or (pred (first coll)) (recur pred (next coll))))) - -(def - ^{:tag Boolean - :doc "Returns false if (pred x) is logical true for any x in coll, - else true." - :arglists '([pred coll]) - :added "1.0"} - not-any? (comp not some)) - -;will be redefed later with arg checks -(defmacro dotimes - "bindings => name n - - Repeatedly executes body (presumably for side-effects) with name - bound to integers from 0 through n-1." - {:added "1.0"} - [bindings & body] - (let [i (first bindings) - n (second bindings)] - `(let [n# (int ~n)] - (loop [~i (int 0)] - (when (< ~i n#) - ~@body - (recur (inc ~i))))))) - -(defn map - "Returns a lazy sequence consisting of the result of applying f to the - set of first items of each coll, followed by applying f to the set - of second items in each coll, until any one of the colls is - exhausted. Any remaining items in other colls are ignored. Function - f should accept number-of-colls arguments." - {:added "1.0"} - ([f coll] - (lazy-seq - (when-let [s (seq coll)] - (if (chunked-seq? s) - (let [c (chunk-first s) - size (int (count c)) - b (chunk-buffer size)] - (dotimes [i size] - (chunk-append b (f (.nth c i)))) - (chunk-cons (chunk b) (map f (chunk-rest s)))) - (cons (f (first s)) (map f (rest s))))))) - ([f c1 c2] - (lazy-seq - (let [s1 (seq c1) s2 (seq c2)] - (when (and s1 s2) - (cons (f (first s1) (first s2)) - (map f (rest s1) (rest s2))))))) - ([f c1 c2 c3] - (lazy-seq - (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)] - (when (and s1 s2 s3) - (cons (f (first s1) (first s2) (first s3)) - (map f (rest s1) (rest s2) (rest s3))))))) - ([f c1 c2 c3 & colls] - (let [step (fn step [cs] - (lazy-seq - (let [ss (map seq cs)] - (when (every? identity ss) - (cons (map first ss) (step (map rest ss)))))))] - (map #(apply f %) (step (conj colls c3 c2 c1)))))) - -(defn mapcat - "Returns the result of applying concat to the result of applying map - to f and colls. Thus function f should return a collection." - {:added "1.0"} - [f & colls] - (apply concat (apply map f colls))) - -(defn filter - "Returns a lazy sequence of the items in coll for which - (pred item) returns true. pred must be free of side-effects." - {:added "1.0"} - ([pred coll] - (lazy-seq - (when-let [s (seq coll)] - (if (chunked-seq? s) - (let [c (chunk-first s) - size (count c) - b (chunk-buffer size)] - (dotimes [i size] - (when (pred (.nth c i)) - (chunk-append b (.nth c i)))) - (chunk-cons (chunk b) (filter pred (chunk-rest s)))) - (let [f (first s) r (rest s)] - (if (pred f) - (cons f (filter pred r)) - (filter pred r)))))))) - - -(defn remove - "Returns a lazy sequence of the items in coll for which - (pred item) returns false. pred must be free of side-effects." - {:added "1.0"} - [pred coll] - (filter (complement pred) coll)) - -(defn take - "Returns a lazy sequence of the first n items in coll, or all items if - there are fewer than n." - {:added "1.0"} - [n coll] - (lazy-seq - (when (pos? n) - (when-let [s (seq coll)] - (cons (first s) (take (dec n) (rest s))))))) - -(defn take-while - "Returns a lazy sequence of successive items from coll while - (pred item) returns true. pred must be free of side-effects." - {:added "1.0"} - [pred coll] - (lazy-seq - (when-let [s (seq coll)] - (when (pred (first s)) - (cons (first s) (take-while pred (rest s))))))) - -(defn drop - "Returns a lazy sequence of all but the first n items in coll." - {:added "1.0"} - [n coll] - (let [step (fn [n coll] - (let [s (seq coll)] - (if (and (pos? n) s) - (recur (dec n) (rest s)) - s)))] - (lazy-seq (step n coll)))) - -(defn drop-last - "Return a lazy sequence of all but the last n (default 1) items in coll" - {:added "1.0"} - ([s] (drop-last 1 s)) - ([n s] (map (fn [x _] x) s (drop n s)))) - -(defn take-last - "Returns a seq of the last n items in coll. Depending on the type - of coll may be no better than linear time. For vectors, see also subvec." - {:added "1.1"} - [n coll] - (loop [s (seq coll), lead (seq (drop n coll))] - (if lead - (recur (next s) (next lead)) - s))) - -(defn drop-while - "Returns a lazy sequence of the items in coll starting from the first - item for which (pred item) returns nil." - {:added "1.0"} - [pred coll] - (let [step (fn [pred coll] - (let [s (seq coll)] - (if (and s (pred (first s))) - (recur pred (rest s)) - s)))] - (lazy-seq (step pred coll)))) - -(defn cycle - "Returns a lazy (infinite!) sequence of repetitions of the items in coll." - {:added "1.0"} - [coll] (lazy-seq - (when-let [s (seq coll)] - (concat s (cycle s))))) - -(defn split-at - "Returns a vector of [(take n coll) (drop n coll)]" - {:added "1.0"} - [n coll] - [(take n coll) (drop n coll)]) - -(defn split-with - "Returns a vector of [(take-while pred coll) (drop-while pred coll)]" - {:added "1.0"} - [pred coll] - [(take-while pred coll) (drop-while pred coll)]) - -(defn repeat - "Returns a lazy (infinite!, or length n if supplied) sequence of xs." - {:added "1.0"} - ([x] (lazy-seq (cons x (repeat x)))) - ([n x] (take n (repeat x)))) - -(defn replicate - "Returns a lazy seq of n xs." - {:added "1.0"} - [n x] (take n (repeat x))) - -(defn iterate - "Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects" - {:added "1.0"} - [f x] (cons x (lazy-seq (iterate f (f x))))) - -(defn range - "Returns a lazy seq of nums from start (inclusive) to end - (exclusive), by step, where start defaults to 0, step to 1, and end - to infinity." - {:added "1.0"} - ([] (range 0 Double/POSITIVE_INFINITY 1)) - ([end] (range 0 end 1)) - ([start end] (range start end 1)) - ([start end step] - (lazy-seq - (let [b (chunk-buffer 32) - comp (if (pos? step) < >)] - (loop [i start] - (if (and (< (count b) 32) - (comp i end)) - (do - (chunk-append b i) - (recur (+ i step))) - (chunk-cons (chunk b) - (when (comp i end) - (range i end step))))))))) - -(defn merge - "Returns a map that consists of the rest of the maps conj-ed onto - the first. If a key occurs in more than one map, the mapping from - the latter (left-to-right) will be the mapping in the result." - {:added "1.0"} - [& maps] - (when (some identity maps) - (reduce #(conj (or %1 {}) %2) maps))) - -(defn merge-with - "Returns a map that consists of the rest of the maps conj-ed onto - the first. If a key occurs in more than one map, the mapping(s) - from the latter (left-to-right) will be combined with the mapping in - the result by calling (f val-in-result val-in-latter)." - {:added "1.0"} - [f & maps] - (when (some identity maps) - (let [merge-entry (fn [m e] - (let [k (key e) v (val e)] - (if (contains? m k) - (assoc m k (f (get m k) v)) - (assoc m k v)))) - merge2 (fn [m1 m2] - (reduce merge-entry (or m1 {}) (seq m2)))] - (reduce merge2 maps)))) - - - -(defn zipmap - "Returns a map with the keys mapped to the corresponding vals." - {:added "1.0"} - [keys vals] - (loop [map {} - ks (seq keys) - vs (seq vals)] - (if (and ks vs) - (recur (assoc map (first ks) (first vs)) - (next ks) - (next vs)) - map))) - -(defmacro declare - "defs the supplied var names with no bindings, useful for making forward declarations." - {:added "1.0"} - [& names] `(do ~@(map #(list 'def (vary-meta % assoc :declared true)) names))) - -(defn line-seq - "Returns the lines of text from rdr as a lazy sequence of strings. - rdr must implement java.io.BufferedReader." - {:added "1.0"} - [^java.io.BufferedReader rdr] - (when-let [line (.readLine rdr)] - (cons line (lazy-seq (line-seq rdr))))) - -(defn comparator - "Returns an implementation of java.util.Comparator based upon pred." - {:added "1.0"} - [pred] - (fn [x y] - (cond (pred x y) -1 (pred y x) 1 :else 0))) - -(defn sort - "Returns a sorted sequence of the items in coll. If no comparator is - supplied, uses compare. comparator must - implement java.util.Comparator." - {:added "1.0"} - ([coll] - (sort compare coll)) - ([^java.util.Comparator comp coll] - (if (seq coll) - (let [a (to-array coll)] - (. java.util.Arrays (sort a comp)) - (seq a)) - ()))) - -(defn sort-by - "Returns a sorted sequence of the items in coll, where the sort - order is determined by comparing (keyfn item). If no comparator is - supplied, uses compare. comparator must - implement java.util.Comparator." - {:added "1.0"} - ([keyfn coll] - (sort-by keyfn compare coll)) - ([keyfn ^java.util.Comparator comp coll] - (sort (fn [x y] (. comp (compare (keyfn x) (keyfn y)))) coll))) - -(defn partition - "Returns a lazy sequence of lists of n items each, at offsets step - apart. If step is not supplied, defaults to n, i.e. the partitions - do not overlap. If a pad collection is supplied, use its elements as - necessary to complete last partition upto n items. In case there are - not enough padding elements, return a partition with less than n items." - {:added "1.0"} - ([n coll] - (partition n n coll)) - ([n step coll] - (lazy-seq - (when-let [s (seq coll)] - (let [p (take n s)] - (when (= n (count p)) - (cons p (partition n step (drop step s)))))))) - ([n step pad coll] - (lazy-seq - (when-let [s (seq coll)] - (let [p (take n s)] - (if (= n (count p)) - (cons p (partition n step pad (drop step s))) - (list (take n (concat p pad))))))))) - -;; evaluation - -(defn eval - "Evaluates the form data structure (not text!) and returns the result." - {:added "1.0"} - [form] (. clojure.lang.Compiler (eval form))) - -(defmacro doseq - "Repeatedly executes body (presumably for side-effects) with - bindings and filtering as provided by \"for\". Does not retain - the head of the sequence. Returns nil." - {:added "1.0"} - [seq-exprs & body] - (assert-args doseq - (vector? seq-exprs) "a vector for its binding" - (even? (count seq-exprs)) "an even number of forms in binding vector") - (let [step (fn step [recform exprs] - (if-not exprs - [true `(do ~@body)] - (let [k (first exprs) - v (second exprs)] - (if (keyword? k) - (let [steppair (step recform (nnext exprs)) - needrec (steppair 0) - subform (steppair 1)] - (cond - (= k :let) [needrec `(let ~v ~subform)] - (= k :while) [false `(when ~v - ~subform - ~@(when needrec [recform]))] - (= k :when) [false `(if ~v - (do - ~subform - ~@(when needrec [recform])) - ~recform)])) - (let [seq- (gensym "seq_") - chunk- (with-meta (gensym "chunk_") - {:tag 'clojure.lang.IChunk}) - count- (gensym "count_") - i- (gensym "i_") - recform `(recur (next ~seq-) nil (int 0) (int 0)) - steppair (step recform (nnext exprs)) - needrec (steppair 0) - subform (steppair 1) - recform-chunk - `(recur ~seq- ~chunk- ~count- (unchecked-inc ~i-)) - steppair-chunk (step recform-chunk (nnext exprs)) - subform-chunk (steppair-chunk 1)] - [true - `(loop [~seq- (seq ~v), ~chunk- nil, - ~count- (int 0), ~i- (int 0)] - (if (< ~i- ~count-) - (let [~k (.nth ~chunk- ~i-)] - ~subform-chunk - ~@(when needrec [recform-chunk])) - (when-let [~seq- (seq ~seq-)] - (if (chunked-seq? ~seq-) - (let [c# (chunk-first ~seq-)] - (recur (chunk-rest ~seq-) c# - (int (count c#)) (int 0))) - (let [~k (first ~seq-)] - ~subform - ~@(when needrec [recform]))))))])))))] - (nth (step nil (seq seq-exprs)) 1))) - -(defn dorun - "When lazy sequences are produced via functions that have side - effects, any effects other than those needed to produce the first - element in the seq do not occur until the seq is consumed. dorun can - be used to force any effects. Walks through the successive nexts of - the seq, does not retain the head and returns nil." - {:added "1.0"} - ([coll] - (when (seq coll) - (recur (next coll)))) - ([n coll] - (when (and (seq coll) (pos? n)) - (recur (dec n) (next coll))))) - -(defn doall - "When lazy sequences are produced via functions that have side - effects, any effects other than those needed to produce the first - element in the seq do not occur until the seq is consumed. doall can - be used to force any effects. Walks through the successive nexts of - the seq, retains the head and returns it, thus causing the entire - seq to reside in memory at one time." - {:added "1.0"} - ([coll] - (dorun coll) - coll) - ([n coll] - (dorun n coll) - coll)) - -(defn await - "Blocks the current thread (indefinitely!) until all actions - dispatched thus far, from this thread or agent, to the agent(s) have - occurred. Will block on failed agents. Will never return if - a failed agent is restarted with :clear-actions true." - {:added "1.0"} - [& agents] - (io! "await in transaction" - (when *agent* - (throw (new Exception "Can't await in agent action"))) - (let [latch (new java.util.concurrent.CountDownLatch (count agents)) - count-down (fn [agent] (. latch (countDown)) agent)] - (doseq [agent agents] - (send agent count-down)) - (. latch (await))))) - -(defn await1 [^clojure.lang.Agent a] - (when (pos? (.getQueueCount a)) - (await a)) - a) - -(defn await-for - "Blocks the current thread until all actions dispatched thus - far (from this thread or agent) to the agents have occurred, or the - timeout (in milliseconds) has elapsed. Returns nil if returning due - to timeout, non-nil otherwise." - {:added "1.0"} - [timeout-ms & agents] - (io! "await-for in transaction" - (when *agent* - (throw (new Exception "Can't await in agent action"))) - (let [latch (new java.util.concurrent.CountDownLatch (count agents)) - count-down (fn [agent] (. latch (countDown)) agent)] - (doseq [agent agents] - (send agent count-down)) - (. latch (await timeout-ms (. java.util.concurrent.TimeUnit MILLISECONDS)))))) - -(defmacro dotimes - "bindings => name n - - Repeatedly executes body (presumably for side-effects) with name - bound to integers from 0 through n-1." - {:added "1.0"} - [bindings & body] - (assert-args dotimes - (vector? bindings) "a vector for its binding" - (= 2 (count bindings)) "exactly 2 forms in binding vector") - (let [i (first bindings) - n (second bindings)] - `(let [n# (int ~n)] - (loop [~i (int 0)] - (when (< ~i n#) - ~@body - (recur (unchecked-inc ~i))))))) - -#_(defn into - "Returns a new coll consisting of to-coll with all of the items of - from-coll conjoined." - {:added "1.0"} - [to from] - (let [ret to items (seq from)] - (if items - (recur (conj ret (first items)) (next items)) - ret))) - -;;;;;;;;;;;;;;;;;;;;; editable collections ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defn transient - "Alpha - subject to change. - Returns a new, transient version of the collection, in constant time." - {:added "1.1"} - [^clojure.lang.IEditableCollection coll] - (.asTransient coll)) - -(defn persistent! - "Alpha - subject to change. - Returns a new, persistent version of the transient collection, in - constant time. The transient collection cannot be used after this - call, any such use will throw an exception." - {:added "1.1"} - [^clojure.lang.ITransientCollection coll] - (.persistent coll)) - -(defn conj! - "Alpha - subject to change. - Adds x to the transient collection, and return coll. The 'addition' - may happen at different 'places' depending on the concrete type." - {:added "1.1"} - [^clojure.lang.ITransientCollection coll x] - (.conj coll x)) - -(defn assoc! - "Alpha - subject to change. - When applied to a transient map, adds mapping of key(s) to - val(s). When applied to a transient vector, sets the val at index. - Note - index must be <= (count vector). Returns coll." - {:added "1.1"} - ([^clojure.lang.ITransientAssociative coll key val] (.assoc coll key val)) - ([^clojure.lang.ITransientAssociative coll key val & kvs] - (let [ret (.assoc coll key val)] - (if kvs - (recur ret (first kvs) (second kvs) (nnext kvs)) - ret)))) - -(defn dissoc! - "Alpha - subject to change. - Returns a transient map that doesn't contain a mapping for key(s)." - {:added "1.1"} - ([^clojure.lang.ITransientMap map key] (.without map key)) - ([^clojure.lang.ITransientMap map key & ks] - (let [ret (.without map key)] - (if ks - (recur ret (first ks) (next ks)) - ret)))) - -(defn pop! - "Alpha - subject to change. - Removes the last item from a transient vector. If - the collection is empty, throws an exception. Returns coll" - {:added "1.1"} - [^clojure.lang.ITransientVector coll] - (.pop coll)) - -(defn disj! - "Alpha - subject to change. - disj[oin]. Returns a transient set of the same (hashed/sorted) type, that - does not contain key(s)." - {:added "1.1"} - ([set] set) - ([^clojure.lang.ITransientSet set key] - (. set (disjoin key))) - ([set key & ks] - (let [ret (disj set key)] - (if ks - (recur ret (first ks) (next ks)) - ret)))) - -;redef into with batch support -(defn into - "Returns a new coll consisting of to-coll with all of the items of - from-coll conjoined." - {:added "1.0"} - [to from] - (if (instance? clojure.lang.IEditableCollection to) - (persistent! (reduce conj! (transient to) from)) - (reduce conj to from))) - -(defmacro import - "import-list => (package-symbol class-name-symbols*) - - For each name in class-name-symbols, adds a mapping from name to the - class named by package.name to the current namespace. Use :import in the ns - macro in preference to calling this directly." - {:added "1.0"} - [& import-symbols-or-lists] - (let [specs (map #(if (and (seq? %) (= 'quote (first %))) (second %) %) - import-symbols-or-lists)] - `(do ~@(map #(list 'clojure.core/import* %) - (reduce (fn [v spec] - (if (symbol? spec) - (conj v (name spec)) - (let [p (first spec) cs (rest spec)] - (into v (map #(str p "." %) cs))))) - [] specs))))) - -(defn into-array - "Returns an array with components set to the values in aseq. The array's - component type is type if provided, or the type of the first value in - aseq if present, or Object. All values in aseq must be compatible with - the component type. Class objects for the primitive types can be obtained - using, e.g., Integer/TYPE." - {:added "1.0"} - ([aseq] - (clojure.lang.RT/seqToTypedArray (seq aseq))) - ([type aseq] - (clojure.lang.RT/seqToTypedArray type (seq aseq)))) - -(defn ^{:private true} - array [& items] - (into-array items)) - -(defn ^Class class - "Returns the Class of x" - {:added "1.0"} - [^Object x] (if (nil? x) x (. x (getClass)))) - -(defn type - "Returns the :type metadata of x, or its Class if none" - {:added "1.0"} - [x] - (or (:type (meta x)) (class x))) - -(defn num - "Coerce to Number" - {:tag Number - :inline (fn [x] `(. clojure.lang.Numbers (num ~x))) - :added "1.0"} - [x] (. clojure.lang.Numbers (num x))) - -(defn long - "Coerce to long" - {:tag Long - :inline (fn [x] `(. clojure.lang.RT (longCast ~x))) - :added "1.0"} - [^Number x] (clojure.lang.RT/longCast x)) - -(defn float - "Coerce to float" - {:tag Float - :inline (fn [x] `(. clojure.lang.RT (floatCast ~x))) - :added "1.0"} - [^Number x] (clojure.lang.RT/floatCast x)) - -(defn double - "Coerce to double" - {:tag Double - :inline (fn [x] `(. clojure.lang.RT (doubleCast ~x))) - :added "1.0"} - [^Number x] (clojure.lang.RT/doubleCast x)) - -(defn short - "Coerce to short" - {:tag Short - :inline (fn [x] `(. clojure.lang.RT (shortCast ~x))) - :added "1.0"} - [^Number x] (clojure.lang.RT/shortCast x)) - -(defn byte - "Coerce to byte" - {:tag Byte - :inline (fn [x] `(. clojure.lang.RT (byteCast ~x))) - :added "1.0"} - [^Number x] (clojure.lang.RT/byteCast x)) - -(defn char - "Coerce to char" - {:tag Character - :inline (fn [x] `(. clojure.lang.RT (charCast ~x))) - :added "1.1"} - [x] (. clojure.lang.RT (charCast x))) - -(defn boolean - "Coerce to boolean" - { - :inline (fn [x] `(. clojure.lang.RT (booleanCast ~x))) - :added "1.0"} - [x] (clojure.lang.RT/booleanCast x)) - -(defn number? - "Returns true if x is a Number" - {:added "1.0"} - [x] - (instance? Number x)) - -(defn integer? - "Returns true if n is an integer" - {:added "1.0"} - [n] - (or (instance? Integer n) - (instance? Long n) - (instance? BigInteger n) - (instance? Short n) - (instance? Byte n))) - -(defn mod - "Modulus of num and div. Truncates toward negative infinity." - {:added "1.0"} - [num div] - (let [m (rem num div)] - (if (or (zero? m) (pos? (* num div))) - m - (+ m div)))) - -(defn ratio? - "Returns true if n is a Ratio" - {:added "1.0"} - [n] (instance? clojure.lang.Ratio n)) - -(defn numerator - "Returns the numerator part of a Ratio." - {:tag BigInteger - :added "1.2"} - [r] - (.numerator ^clojure.lang.Ratio r)) - -(defn denominator - "Returns the denominator part of a Ratio." - {:tag BigInteger - :added "1.2"} - [r] - (.denominator ^clojure.lang.Ratio r)) - -(defn decimal? - "Returns true if n is a BigDecimal" - {:added "1.0"} - [n] (instance? BigDecimal n)) - -(defn float? - "Returns true if n is a floating point number" - {:added "1.0"} - [n] - (or (instance? Double n) - (instance? Float n))) - -(defn rational? [n] - "Returns true if n is a rational number" - {:added "1.0"} - (or (integer? n) (ratio? n) (decimal? n))) - -(defn bigint - "Coerce to BigInteger" - {:tag BigInteger - :added "1.0"} - [x] (cond - (instance? BigInteger x) x - (decimal? x) (.toBigInteger ^BigDecimal x) - (ratio? x) (.bigIntegerValue ^clojure.lang.Ratio x) - (number? x) (BigInteger/valueOf (long x)) - :else (BigInteger. x))) - -(defn bigdec - "Coerce to BigDecimal" - {:tag BigDecimal - :added "1.0"} - [x] (cond - (decimal? x) x - (float? x) (. BigDecimal valueOf (double x)) - (ratio? x) (/ (BigDecimal. (.numerator x)) (.denominator x)) - (instance? BigInteger x) (BigDecimal. ^BigInteger x) - (number? x) (BigDecimal/valueOf (long x)) - :else (BigDecimal. x))) - -(def ^{:private true} print-initialized false) - -(defmulti print-method (fn [x writer] (type x))) -(defmulti print-dup (fn [x writer] (class x))) - -(defn pr-on - {:private true} - [x w] - (if *print-dup* - (print-dup x w) - (print-method x w)) - nil) - -(defn pr - "Prints the object(s) to the output stream that is the current value - of *out*. Prints the object(s), separated by spaces if there is - more than one. By default, pr and prn print in a way that objects - can be read by the reader" - {:dynamic true - :added "1.0"} - ([] nil) - ([x] - (pr-on x *out*)) - ([x & more] - (pr x) - (. *out* (append \space)) - (if-let [nmore (next more)] - (recur (first more) nmore) - (apply pr more)))) - -(defn newline - "Writes a newline to the output stream that is the current value of - *out*" - {:added "1.0"} - [] - (. *out* (append \newline)) - nil) - -(defn flush - "Flushes the output stream that is the current value of - *out*" - {:added "1.0"} - [] - (. *out* (flush)) - nil) - -(defn prn - "Same as pr followed by (newline). Observes *flush-on-newline*" - {:added "1.0"} - [& more] - (apply pr more) - (newline) - (when *flush-on-newline* - (flush))) - -(defn print - "Prints the object(s) to the output stream that is the current value - of *out*. print and println produce output for human consumption." - {:added "1.0"} - [& more] - (binding [*print-readably* nil] - (apply pr more))) - -(defn println - "Same as print followed by (newline)" - {:added "1.0"} - [& more] - (binding [*print-readably* nil] - (apply prn more))) - -(defn read - "Reads the next object from stream, which must be an instance of - java.io.PushbackReader or some derivee. stream defaults to the - current value of *in* ." - {:added "1.0"} - ([] - (read *in*)) - ([stream] - (read stream true nil)) - ([stream eof-error? eof-value] - (read stream eof-error? eof-value false)) - ([stream eof-error? eof-value recursive?] - (. clojure.lang.LispReader (read stream (boolean eof-error?) eof-value recursive?)))) - -(defn read-line - "Reads the next line from stream that is the current value of *in* ." - {:added "1.0"} - [] - (if (instance? clojure.lang.LineNumberingPushbackReader *in*) - (.readLine ^clojure.lang.LineNumberingPushbackReader *in*) - (.readLine ^java.io.BufferedReader *in*))) - -(defn read-string - "Reads one object from the string s" - {:added "1.0"} - [s] (clojure.lang.RT/readString s)) - -(defn subvec - "Returns a persistent vector of the items in vector from - start (inclusive) to end (exclusive). If end is not supplied, - defaults to (count vector). This operation is O(1) and very fast, as - the resulting vector shares structure with the original and no - trimming is done." - {:added "1.0"} - ([v start] - (subvec v start (count v))) - ([v start end] - (. clojure.lang.RT (subvec v start end)))) - -(defmacro with-open - "bindings => [name init ...] - - Evaluates body in a try expression with names bound to the values - of the inits, and a finally clause that calls (.close name) on each - name in reverse order." - {:added "1.0"} - [bindings & body] - (assert-args with-open - (vector? bindings) "a vector for its binding" - (even? (count bindings)) "an even number of forms in binding vector") - (cond - (= (count bindings) 0) `(do ~@body) - (symbol? (bindings 0)) `(let ~(subvec bindings 0 2) - (try - (with-open ~(subvec bindings 2) ~@body) - (finally - (. ~(bindings 0) close)))) - :else (throw (IllegalArgumentException. - "with-open only allows Symbols in bindings")))) - -(defmacro doto - "Evaluates x then calls all of the methods and functions with the - value of x supplied at the front of the given arguments. The forms - are evaluated in order. Returns x. - - (doto (new java.util.HashMap) (.put \"a\" 1) (.put \"b\" 2))" - {:added "1.0"} - [x & forms] - (let [gx (gensym)] - `(let [~gx ~x] - ~@(map (fn [f] - (if (seq? f) - `(~(first f) ~gx ~@(next f)) - `(~f ~gx))) - forms) - ~gx))) - -(defmacro memfn - "Expands into code that creates a fn that expects to be passed an - object and any args and calls the named instance method on the - object passing the args. Use when you want to treat a Java method as - a first-class fn." - {:added "1.0"} - [name & args] - `(fn [target# ~@args] - (. target# (~name ~@args)))) - -(defmacro time - "Evaluates expr and prints the time it took. Returns the value of - expr." - {:added "1.0"} - [expr] - `(let [start# (. System (nanoTime)) - ret# ~expr] - (prn (str "Elapsed time: " (/ (double (- (. System (nanoTime)) start#)) 1000000.0) " msecs")) - ret#)) - - - -(import '(java.lang.reflect Array)) - -(defn alength - "Returns the length of the Java array. Works on arrays of all - types." - {:inline (fn [a] `(. clojure.lang.RT (alength ~a))) - :added "1.0"} - [array] (. clojure.lang.RT (alength array))) - -(defn aclone - "Returns a clone of the Java array. Works on arrays of known - types." - {:inline (fn [a] `(. clojure.lang.RT (aclone ~a))) - :added "1.0"} - [array] (. clojure.lang.RT (aclone array))) - -(defn aget - "Returns the value at the index/indices. Works on Java arrays of all - types." - {:inline (fn [a i] `(. clojure.lang.RT (aget ~a (int ~i)))) - :inline-arities #{2} - :added "1.0"} - ([array idx] - (clojure.lang.Reflector/prepRet (. Array (get array idx)))) - ([array idx & idxs] - (apply aget (aget array idx) idxs))) - -(defn aset - "Sets the value at the index/indices. Works on Java arrays of - reference types. Returns val." - {:inline (fn [a i v] `(. clojure.lang.RT (aset ~a (int ~i) ~v))) - :inline-arities #{3} - :added "1.0"} - ([array idx val] - (. Array (set array idx val)) - val) - ([array idx idx2 & idxv] - (apply aset (aget array idx) idx2 idxv))) - -(defmacro - ^{:private true} - def-aset [name method coerce] - `(defn ~name - {:arglists '([~'array ~'idx ~'val] [~'array ~'idx ~'idx2 & ~'idxv])} - ([array# idx# val#] - (. Array (~method array# idx# (~coerce val#))) - val#) - ([array# idx# idx2# & idxv#] - (apply ~name (aget array# idx#) idx2# idxv#)))) - -(def-aset - ^{:doc "Sets the value at the index/indices. Works on arrays of int. Returns val." - :added "1.0"} - aset-int setInt int) - -(def-aset - ^{:doc "Sets the value at the index/indices. Works on arrays of long. Returns val." - :added "1.0"} - aset-long setLong long) - -(def-aset - ^{:doc "Sets the value at the index/indices. Works on arrays of boolean. Returns val." - :added "1.0"} - aset-boolean setBoolean boolean) - -(def-aset - ^{:doc "Sets the value at the index/indices. Works on arrays of float. Returns val." - :added "1.0"} - aset-float setFloat float) - -(def-aset - ^{:doc "Sets the value at the index/indices. Works on arrays of double. Returns val." - :added "1.0"} - aset-double setDouble double) - -(def-aset - ^{:doc "Sets the value at the index/indices. Works on arrays of short. Returns val." - :added "1.0"} - aset-short setShort short) - -(def-aset - ^{:doc "Sets the value at the index/indices. Works on arrays of byte. Returns val." - :added "1.0"} - aset-byte setByte byte) - -(def-aset - ^{:doc "Sets the value at the index/indices. Works on arrays of char. Returns val." - :added "1.0"} - aset-char setChar char) - -(defn make-array - "Creates and returns an array of instances of the specified class of - the specified dimension(s). Note that a class object is required. - Class objects can be obtained by using their imported or - fully-qualified name. Class objects for the primitive types can be - obtained using, e.g., Integer/TYPE." - {:added "1.0"} - ([^Class type len] - (. Array (newInstance type (int len)))) - ([^Class type dim & more-dims] - (let [dims (cons dim more-dims) - ^"[I" dimarray (make-array (. Integer TYPE) (count dims))] - (dotimes [i (alength dimarray)] - (aset-int dimarray i (nth dims i))) - (. Array (newInstance type dimarray))))) - -(defn to-array-2d - "Returns a (potentially-ragged) 2-dimensional array of Objects - containing the contents of coll, which can be any Collection of any - Collection." - {:tag "[[Ljava.lang.Object;" - :added "1.0"} - [^java.util.Collection coll] - (let [ret (make-array (. Class (forName "[Ljava.lang.Object;")) (. coll (size)))] - (loop [i 0 xs (seq coll)] - (when xs - (aset ret i (to-array (first xs))) - (recur (inc i) (next xs)))) - ret)) - -(defn macroexpand-1 - "If form represents a macro form, returns its expansion, - else returns form." - {:added "1.0"} - [form] - (. clojure.lang.Compiler (macroexpand1 form))) - -(defn macroexpand - "Repeatedly calls macroexpand-1 on form until it no longer - represents a macro form, then returns it. Note neither - macroexpand-1 nor macroexpand expand macros in subforms." - {:added "1.0"} - [form] - (let [ex (macroexpand-1 form)] - (if (identical? ex form) - form - (macroexpand ex)))) - -(defn create-struct - "Returns a structure basis object." - {:added "1.0"} - [& keys] - (. clojure.lang.PersistentStructMap (createSlotMap keys))) - -(defmacro defstruct - "Same as (def name (create-struct keys...))" - {:added "1.0"} - [name & keys] - `(def ~name (create-struct ~@keys))) - -(defn struct-map - "Returns a new structmap instance with the keys of the - structure-basis. keyvals may contain all, some or none of the basis - keys - where values are not supplied they will default to nil. - keyvals can also contain keys not in the basis." - {:added "1.0"} - [s & inits] - (. clojure.lang.PersistentStructMap (create s inits))) - -(defn struct - "Returns a new structmap instance with the keys of the - structure-basis. vals must be supplied for basis keys in order - - where values are not supplied they will default to nil." - {:added "1.0"} - [s & vals] - (. clojure.lang.PersistentStructMap (construct s vals))) - -(defn accessor - "Returns a fn that, given an instance of a structmap with the basis, - returns the value at the key. The key must be in the basis. The - returned function should be (slightly) more efficient than using - get, but such use of accessors should be limited to known - performance-critical areas." - {:added "1.0"} - [s key] - (. clojure.lang.PersistentStructMap (getAccessor s key))) - -(defn load-reader - "Sequentially read and evaluate the set of forms contained in the - stream/file" - {:added "1.0"} - [rdr] (. clojure.lang.Compiler (load rdr))) - -(defn load-string - "Sequentially read and evaluate the set of forms contained in the - string" - {:added "1.0"} - [s] - (let [rdr (-> (java.io.StringReader. s) - (clojure.lang.LineNumberingPushbackReader.))] - (load-reader rdr))) - -(defn set - "Returns a set of the distinct elements of coll." - {:added "1.0"} - [coll] (clojure.lang.PersistentHashSet/create ^clojure.lang.ISeq (seq coll))) - -(defn ^{:private true} - filter-key [keyfn pred amap] - (loop [ret {} es (seq amap)] - (if es - (if (pred (keyfn (first es))) - (recur (assoc ret (key (first es)) (val (first es))) (next es)) - (recur ret (next es))) - ret))) - -(defn find-ns - "Returns the namespace named by the symbol or nil if it doesn't exist." - {:added "1.0"} - [sym] (clojure.lang.Namespace/find sym)) - -(defn create-ns - "Create a new namespace named by the symbol if one doesn't already - exist, returns it or the already-existing namespace of the same - name." - {:added "1.0"} - [sym] (clojure.lang.Namespace/findOrCreate sym)) - -(defn remove-ns - "Removes the namespace named by the symbol. Use with caution. - Cannot be used to remove the clojure namespace." - {:added "1.0"} - [sym] (clojure.lang.Namespace/remove sym)) - -(defn all-ns - "Returns a sequence of all namespaces." - {:added "1.0"} - [] (clojure.lang.Namespace/all)) - -(defn ^clojure.lang.Namespace the-ns - "If passed a namespace, returns it. Else, when passed a symbol, - returns the namespace named by it, throwing an exception if not - found." - {:added "1.0"} - [x] - (if (instance? clojure.lang.Namespace x) - x - (or (find-ns x) (throw (Exception. (str "No namespace: " x " found")))))) - -(defn ns-name - "Returns the name of the namespace, a symbol." - {:added "1.0"} - [ns] - (.getName (the-ns ns))) - -(defn ns-map - "Returns a map of all the mappings for the namespace." - {:added "1.0"} - [ns] - (.getMappings (the-ns ns))) - -(defn ns-unmap - "Removes the mappings for the symbol from the namespace." - {:added "1.0"} - [ns sym] - (.unmap (the-ns ns) sym)) - -;(defn export [syms] -; (doseq [sym syms] -; (.. *ns* (intern sym) (setExported true)))) - -(defn ns-publics - "Returns a map of the public intern mappings for the namespace." - {:added "1.0"} - [ns] - (let [ns (the-ns ns)] - (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v) - (= ns (.ns v)) - (.isPublic v))) - (ns-map ns)))) - -(defn ns-imports - "Returns a map of the import mappings for the namespace." - {:added "1.0"} - [ns] - (filter-key val (partial instance? Class) (ns-map ns))) - -(defn ns-interns - "Returns a map of the intern mappings for the namespace." - {:added "1.0"} - [ns] - (let [ns (the-ns ns)] - (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v) - (= ns (.ns v)))) - (ns-map ns)))) - -(defn refer - "refers to all public vars of ns, subject to filters. - filters can include at most one each of: - - :exclude list-of-symbols - :only list-of-symbols - :rename map-of-fromsymbol-tosymbol - - For each public interned var in the namespace named by the symbol, - adds a mapping from the name of the var to the var to the current - namespace. Throws an exception if name is already mapped to - something else in the current namespace. Filters can be used to - select a subset, via inclusion or exclusion, or to provide a mapping - to a symbol different from the var's name, in order to prevent - clashes. Use :use in the ns macro in preference to calling this directly." - {:added "1.0"} - [ns-sym & filters] - (let [ns (or (find-ns ns-sym) (throw (new Exception (str "No namespace: " ns-sym)))) - fs (apply hash-map filters) - nspublics (ns-publics ns) - rename (or (:rename fs) {}) - exclude (set (:exclude fs)) - to-do (or (:only fs) (keys nspublics))] - (doseq [sym to-do] - (when-not (exclude sym) - (let [v (nspublics sym)] - (when-not v - (throw (new java.lang.IllegalAccessError - (if (get (ns-interns ns) sym) - (str sym " is not public") - (str sym " does not exist"))))) - (. *ns* (refer (or (rename sym) sym) v))))))) - -(defn ns-refers - "Returns a map of the refer mappings for the namespace." - {:added "1.0"} - [ns] - (let [ns (the-ns ns)] - (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v) - (not= ns (.ns v)))) - (ns-map ns)))) - -(defn alias - "Add an alias in the current namespace to another - namespace. Arguments are two symbols: the alias to be used, and - the symbolic name of the target namespace. Use :as in the ns macro in preference - to calling this directly." - {:added "1.0"} - [alias namespace-sym] - (.addAlias *ns* alias (find-ns namespace-sym))) - -(defn ns-aliases - "Returns a map of the aliases for the namespace." - {:added "1.0"} - [ns] - (.getAliases (the-ns ns))) - -(defn ns-unalias - "Removes the alias for the symbol from the namespace." - {:added "1.0"} - [ns sym] - (.removeAlias (the-ns ns) sym)) - -(defn take-nth - "Returns a lazy seq of every nth item in coll." - {:added "1.0"} - [n coll] - (lazy-seq - (when-let [s (seq coll)] - (cons (first s) (take-nth n (drop n s)))))) - -(defn interleave - "Returns a lazy seq of the first item in each coll, then the second etc." - {:added "1.0"} - ([c1 c2] - (lazy-seq - (let [s1 (seq c1) s2 (seq c2)] - (when (and s1 s2) - (cons (first s1) (cons (first s2) - (interleave (rest s1) (rest s2)))))))) - ([c1 c2 & colls] - (lazy-seq - (let [ss (map seq (conj colls c2 c1))] - (when (every? identity ss) - (concat (map first ss) (apply interleave (map rest ss)))))))) - -(defn var-get - "Gets the value in the var object" - {:added "1.0"} - [^clojure.lang.Var x] (. x (get))) - -(defn var-set - "Sets the value in the var object to val. The var must be - thread-locally bound." - {:added "1.0"} - [^clojure.lang.Var x val] (. x (set val))) - -(defmacro with-local-vars - "varbinding=> symbol init-expr - - Executes the exprs in a context in which the symbols are bound to - vars with per-thread bindings to the init-exprs. The symbols refer - to the var objects themselves, and must be accessed with var-get and - var-set" - {:added "1.0"} - [name-vals-vec & body] - (assert-args with-local-vars - (vector? name-vals-vec) "a vector for its binding" - (even? (count name-vals-vec)) "an even number of forms in binding vector") - `(let [~@(interleave (take-nth 2 name-vals-vec) - (repeat '(. clojure.lang.Var (create))))] - (. clojure.lang.Var (pushThreadBindings (hash-map ~@name-vals-vec))) - (try - ~@body - (finally (. clojure.lang.Var (popThreadBindings)))))) - -(defn ns-resolve - "Returns the var or Class to which a symbol will be resolved in the - namespace, else nil. Note that if the symbol is fully qualified, - the var/Class to which it resolves need not be present in the - namespace." - {:added "1.0"} - [ns sym] - (clojure.lang.Compiler/maybeResolveIn (the-ns ns) sym)) - -(defn resolve - "same as (ns-resolve *ns* symbol)" - {:added "1.0"} - [sym] (ns-resolve *ns* sym)) - -(defn array-map - "Constructs an array-map." - {:added "1.0"} - ([] (. clojure.lang.PersistentArrayMap EMPTY)) - ([& keyvals] (clojure.lang.PersistentArrayMap/createWithCheck (to-array keyvals)))) - -(defn nthnext - "Returns the nth next of coll, (seq coll) when n is 0." - {:added "1.0"} - [coll n] - (loop [n n xs (seq coll)] - (if (and xs (pos? n)) - (recur (dec n) (next xs)) - xs))) - - -;redefine let and loop with destructuring -(defn destructure [bindings] - (let [bents (partition 2 bindings) - pb (fn pb [bvec b v] - (let [pvec - (fn [bvec b val] - (let [gvec (gensym "vec__")] - (loop [ret (-> bvec (conj gvec) (conj val)) - n 0 - bs b - seen-rest? false] - (if (seq bs) - (let [firstb (first bs)] - (cond - (= firstb '&) (recur (pb ret (second bs) (list `nthnext gvec n)) - n - (nnext bs) - true) - (= firstb :as) (pb ret (second bs) gvec) - :else (if seen-rest? - (throw (new Exception "Unsupported binding form, only :as can follow & parameter")) - (recur (pb ret firstb (list `nth gvec n nil)) - (inc n) - (next bs) - seen-rest?)))) - ret)))) - pmap - (fn [bvec b v] - (let [gmap (or (:as b) (gensym "map__")) - defaults (:or b)] - (loop [ret (-> bvec (conj gmap) (conj v) - (conj gmap) (conj `(if (seq? ~gmap) (apply hash-map ~gmap) ~gmap))) - bes (reduce - (fn [bes entry] - (reduce #(assoc %1 %2 ((val entry) %2)) - (dissoc bes (key entry)) - ((key entry) bes))) - (dissoc b :as :or) - {:keys #(keyword (str %)), :strs str, :syms #(list `quote %)})] - (if (seq bes) - (let [bb (key (first bes)) - bk (val (first bes)) - has-default (contains? defaults bb)] - (recur (pb ret bb (if has-default - (list `get gmap bk (defaults bb)) - (list `get gmap bk))) - (next bes))) - ret))))] - (cond - (symbol? b) (-> bvec (conj b) (conj v)) - (vector? b) (pvec bvec b v) - (map? b) (pmap bvec b v) - :else (throw (new Exception (str "Unsupported binding form: " b)))))) - process-entry (fn [bvec b] (pb bvec (first b) (second b)))] - (if (every? symbol? (map first bents)) - bindings - (reduce process-entry [] bents)))) - -(defmacro let - "Evaluates the exprs in a lexical context in which the symbols in - the binding-forms are bound to their respective init-exprs or parts - therein." - {:added "1.0"} - [bindings & body] - (assert-args let - (vector? bindings) "a vector for its binding" - (even? (count bindings)) "an even number of forms in binding vector") - `(let* ~(destructure bindings) ~@body)) - -(defn ^{:private true} - maybe-destructured - [params body] - (if (every? symbol? params) - (cons params body) - (loop [params params - new-params [] - lets []] - (if params - (if (symbol? (first params)) - (recur (next params) (conj new-params (first params)) lets) - (let [gparam (gensym "p__")] - (recur (next params) (conj new-params gparam) - (-> lets (conj (first params)) (conj gparam))))) - `(~new-params - (let ~lets - ~@body)))))) - -;redefine fn with destructuring and pre/post conditions -(defmacro fn - "(fn name? [params* ] exprs*) - (fn name? ([params* ] exprs*)+) - - params => positional-params* , or positional-params* & next-param - positional-param => binding-form - next-param => binding-form - name => symbol - - Defines a function" - {:added "1.0"} - [& sigs] - (let [name (if (symbol? (first sigs)) (first sigs) nil) - sigs (if name (next sigs) sigs) - sigs (if (vector? (first sigs)) (list sigs) sigs) - psig (fn* [sig] - (let [[params & body] sig - conds (when (and (next body) (map? (first body))) - (first body)) - body (if conds (next body) body) - conds (or conds (meta params)) - pre (:pre conds) - post (:post conds) - body (if post - `((let [~'% ~(if (< 1 (count body)) - `(do ~@body) - (first body))] - ~@(map (fn* [c] `(assert ~c)) post) - ~'%)) - body) - body (if pre - (concat (map (fn* [c] `(assert ~c)) pre) - body) - body)] - (maybe-destructured params body))) - new-sigs (map psig sigs)] - (with-meta - (if name - (list* 'fn* name new-sigs) - (cons 'fn* new-sigs)) - (meta &form)))) - -(defmacro loop - "Evaluates the exprs in a lexical context in which the symbols in - the binding-forms are bound to their respective init-exprs or parts - therein. Acts as a recur target." - {:added "1.0"} - [bindings & body] - (assert-args loop - (vector? bindings) "a vector for its binding" - (even? (count bindings)) "an even number of forms in binding vector") - (let [db (destructure bindings)] - (if (= db bindings) - `(loop* ~bindings ~@body) - (let [vs (take-nth 2 (drop 1 bindings)) - bs (take-nth 2 bindings) - gs (map (fn [b] (if (symbol? b) b (gensym))) bs) - bfs (reduce (fn [ret [b v g]] - (if (symbol? b) - (conj ret g v) - (conj ret g v b g))) - [] (map vector bs vs gs))] - `(let ~bfs - (loop* ~(vec (interleave gs gs)) - (let ~(vec (interleave bs gs)) - ~@body))))))) - -(defmacro when-first - "bindings => x xs - - Same as (when (seq xs) (let [x (first xs)] body))" - {:added "1.0"} - [bindings & body] - (assert-args when-first - (vector? bindings) "a vector for its binding" - (= 2 (count bindings)) "exactly 2 forms in binding vector") - (let [[x xs] bindings] - `(when (seq ~xs) - (let [~x (first ~xs)] - ~@body)))) - -(defmacro lazy-cat - "Expands to code which yields a lazy sequence of the concatenation - of the supplied colls. Each coll expr is not evaluated until it is - needed. - - (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))" - {:added "1.0"} - [& colls] - `(concat ~@(map #(list `lazy-seq %) colls))) - -(defmacro for - "List comprehension. Takes a vector of one or more - binding-form/collection-expr pairs, each followed by zero or more - modifiers, and yields a lazy sequence of evaluations of expr. - Collections are iterated in a nested fashion, rightmost fastest, - and nested coll-exprs can refer to bindings created in prior - binding-forms. Supported modifiers are: :let [binding-form expr ...], - :while test, :when test. - - (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)] [x y]))" - {:added "1.0"} - [seq-exprs body-expr] - (assert-args for - (vector? seq-exprs) "a vector for its binding" - (even? (count seq-exprs)) "an even number of forms in binding vector") - (let [to-groups (fn [seq-exprs] - (reduce (fn [groups [k v]] - (if (keyword? k) - (conj (pop groups) (conj (peek groups) [k v])) - (conj groups [k v]))) - [] (partition 2 seq-exprs))) - err (fn [& msg] (throw (IllegalArgumentException. ^String (apply str msg)))) - emit-bind (fn emit-bind [[[bind expr & mod-pairs] - & [[_ next-expr] :as next-groups]]] - (let [giter (gensym "iter__") - gxs (gensym "s__") - do-mod (fn do-mod [[[k v :as pair] & etc]] - (cond - (= k :let) `(let ~v ~(do-mod etc)) - (= k :while) `(when ~v ~(do-mod etc)) - (= k :when) `(if ~v - ~(do-mod etc) - (recur (rest ~gxs))) - (keyword? k) (err "Invalid 'for' keyword " k) - next-groups - `(let [iterys# ~(emit-bind next-groups) - fs# (seq (iterys# ~next-expr))] - (if fs# - (concat fs# (~giter (rest ~gxs))) - (recur (rest ~gxs)))) - :else `(cons ~body-expr - (~giter (rest ~gxs)))))] - (if next-groups - #_"not the inner-most loop" - `(fn ~giter [~gxs] - (lazy-seq - (loop [~gxs ~gxs] - (when-first [~bind ~gxs] - ~(do-mod mod-pairs))))) - #_"inner-most loop" - (let [gi (gensym "i__") - gb (gensym "b__") - do-cmod (fn do-cmod [[[k v :as pair] & etc]] - (cond - (= k :let) `(let ~v ~(do-cmod etc)) - (= k :while) `(when ~v ~(do-cmod etc)) - (= k :when) `(if ~v - ~(do-cmod etc) - (recur - (unchecked-inc ~gi))) - (keyword? k) - (err "Invalid 'for' keyword " k) - :else - `(do (chunk-append ~gb ~body-expr) - (recur (unchecked-inc ~gi)))))] - `(fn ~giter [~gxs] - (lazy-seq - (loop [~gxs ~gxs] - (when-let [~gxs (seq ~gxs)] - (if (chunked-seq? ~gxs) - (let [c# (chunk-first ~gxs) - size# (int (count c#)) - ~gb (chunk-buffer size#)] - (if (loop [~gi (int 0)] - (if (< ~gi size#) - (let [~bind (.nth c# ~gi)] - ~(do-cmod mod-pairs)) - true)) - (chunk-cons - (chunk ~gb) - (~giter (chunk-rest ~gxs))) - (chunk-cons (chunk ~gb) nil))) - (let [~bind (first ~gxs)] - ~(do-mod mod-pairs)))))))))))] - `(let [iter# ~(emit-bind (to-groups seq-exprs))] - (iter# ~(second seq-exprs))))) - -(defmacro comment - "Ignores body, yields nil" - {:added "1.0"} - [& body]) - -(defmacro with-out-str - "Evaluates exprs in a context in which *out* is bound to a fresh - StringWriter. Returns the string created by any nested printing - calls." - {:added "1.0"} - [& body] - `(let [s# (new java.io.StringWriter)] - (binding [*out* s#] - ~@body - (str s#)))) - -(defmacro with-in-str - "Evaluates body in a context in which *in* is bound to a fresh - StringReader initialized with the string s." - {:added "1.0"} - [s & body] - `(with-open [s# (-> (java.io.StringReader. ~s) clojure.lang.LineNumberingPushbackReader.)] - (binding [*in* s#] - ~@body))) - -(defn pr-str - "pr to a string, returning it" - {:tag String - :added "1.0"} - [& xs] - (with-out-str - (apply pr xs))) - -(defn prn-str - "prn to a string, returning it" - {:tag String - :added "1.0"} - [& xs] - (with-out-str - (apply prn xs))) - -(defn print-str - "print to a string, returning it" - {:tag String - :added "1.0"} - [& xs] - (with-out-str - (apply print xs))) - -(defn println-str - "println to a string, returning it" - {:tag String - :added "1.0"} - [& xs] - (with-out-str - (apply println xs))) - -(defmacro assert - "Evaluates expr and throws an exception if it does not evaluate to - logical true." - {:added "1.0"} - [x] - (when *assert* - `(when-not ~x - (throw (new AssertionError (str "Assert failed: " (pr-str '~x))))))) - -(defn test - "test [v] finds fn at key :test in var metadata and calls it, - presuming failure will throw exception" - {:added "1.0"} - [v] - (let [f (:test (meta v))] - (if f - (do (f) :ok) - :no-test))) - -(defn re-pattern - "Returns an instance of java.util.regex.Pattern, for use, e.g. in - re-matcher." - {:tag java.util.regex.Pattern - :added "1.0"} - [s] (if (instance? java.util.regex.Pattern s) - s - (. java.util.regex.Pattern (compile s)))) - -(defn re-matcher - "Returns an instance of java.util.regex.Matcher, for use, e.g. in - re-find." - {:tag java.util.regex.Matcher - :added "1.0"} - [^java.util.regex.Pattern re s] - (. re (matcher s))) - -(defn re-groups - "Returns the groups from the most recent match/find. If there are no - nested groups, returns a string of the entire match. If there are - nested groups, returns a vector of the groups, the first element - being the entire match." - {:added "1.0"} - [^java.util.regex.Matcher m] - (let [gc (. m (groupCount))] - (if (zero? gc) - (. m (group)) - (loop [ret [] c 0] - (if (<= c gc) - (recur (conj ret (. m (group c))) (inc c)) - ret))))) - -(defn re-seq - "Returns a lazy sequence of successive matches of pattern in string, - using java.util.regex.Matcher.find(), each such match processed with - re-groups." - {:added "1.0"} - [^java.util.regex.Pattern re s] - (let [m (re-matcher re s)] - ((fn step [] - (when (. m (find)) - (cons (re-groups m) (lazy-seq (step)))))))) - -(defn re-matches - "Returns the match, if any, of string to pattern, using - java.util.regex.Matcher.matches(). Uses re-groups to return the - groups." - {:added "1.0"} - [^java.util.regex.Pattern re s] - (let [m (re-matcher re s)] - (when (. m (matches)) - (re-groups m)))) - - -(defn re-find - "Returns the next regex match, if any, of string to pattern, using - java.util.regex.Matcher.find(). Uses re-groups to return the - groups." - {:added "1.0"} - ([^java.util.regex.Matcher m] - (when (. m (find)) - (re-groups m))) - ([^java.util.regex.Pattern re s] - (let [m (re-matcher re s)] - (re-find m)))) - -(defn rand - "Returns a random floating point number between 0 (inclusive) and - n (default 1) (exclusive)." - {:added "1.0"} - ([] (. Math (random))) - ([n] (* n (rand)))) - -(defn rand-int - "Returns a random integer between 0 (inclusive) and n (exclusive)." - {:added "1.0"} - [n] (int (rand n))) - -(defmacro defn- - "same as defn, yielding non-public def" - {:added "1.0"} - [name & decls] - (list* `defn (with-meta name (assoc (meta name) :private true)) decls)) - -(defn print-doc [v] - (println "-------------------------") - (println (str (ns-name (:ns (meta v))) "/" (:name (meta v)))) - (prn (:arglists (meta v))) - (when (:macro (meta v)) - (println "Macro")) - (println " " (:doc (meta v)))) - -(defn find-doc - "Prints documentation for any var whose documentation or name - contains a match for re-string-or-pattern" - {:added "1.0"} - [re-string-or-pattern] - (let [re (re-pattern re-string-or-pattern)] - (doseq [ns (all-ns) - v (sort-by (comp :name meta) (vals (ns-interns ns))) - :when (and (:doc (meta v)) - (or (re-find (re-matcher re (:doc (meta v)))) - (re-find (re-matcher re (str (:name (meta v)))))))] - (print-doc v)))) - -(defn special-form-anchor - "Returns the anchor tag on http://clojure.org/special_forms for the - special form x, or nil" - {:added "1.0"} - [x] - (#{'. 'def 'do 'fn 'if 'let 'loop 'monitor-enter 'monitor-exit 'new - 'quote 'recur 'set! 'throw 'try 'var} x)) - -(defn syntax-symbol-anchor - "Returns the anchor tag on http://clojure.org/special_forms for the - special form that uses syntax symbol x, or nil" - {:added "1.0"} - [x] - ({'& 'fn 'catch 'try 'finally 'try} x)) - -(defn print-special-doc - [name type anchor] - (println "-------------------------") - (println name) - (println type) - (println (str " Please see http://clojure.org/special_forms#" anchor))) - -(defn print-namespace-doc - "Print the documentation string of a Namespace." - {:added "1.0"} - [nspace] - (println "-------------------------") - (println (str (ns-name nspace))) - (println " " (:doc (meta nspace)))) - -(defmacro doc - "Prints documentation for a var or special form given its name" - {:added "1.0"} - [name] - (cond - (special-form-anchor `~name) - `(print-special-doc '~name "Special Form" (special-form-anchor '~name)) - (syntax-symbol-anchor `~name) - `(print-special-doc '~name "Syntax Symbol" (syntax-symbol-anchor '~name)) - :else - (let [nspace (find-ns name)] - (if nspace - `(print-namespace-doc ~nspace) - `(print-doc (var ~name)))))) - - (defn tree-seq - "Returns a lazy sequence of the nodes in a tree, via a depth-first walk. - branch? must be a fn of one arg that returns true if passed a node - that can have children (but may not). children must be a fn of one - arg that returns a sequence of the children. Will only be called on - nodes for which branch? returns true. Root is the root node of the - tree." - {:added "1.0"} - [branch? children root] - (let [walk (fn walk [node] - (lazy-seq - (cons node - (when (branch? node) - (mapcat walk (children node))))))] - (walk root))) - -(defn file-seq - "A tree seq on java.io.Files" - {:added "1.0"} - [dir] - (tree-seq - (fn [^java.io.File f] (. f (isDirectory))) - (fn [^java.io.File d] (seq (. d (listFiles)))) - dir)) - -(defn xml-seq - "A tree seq on the xml elements as per xml/parse" - {:added "1.0"} - [root] - (tree-seq - (complement string?) - (comp seq :content) - root)) - -(defn special-symbol? - "Returns true if s names a special form" - {:added "1.0"} - [s] - (contains? (. clojure.lang.Compiler specials) s)) - -(defn var? - "Returns true if v is of type clojure.lang.Var" - {:added "1.0"} - [v] (instance? clojure.lang.Var v)) - -(defn ^String subs - "Returns the substring of s beginning at start inclusive, and ending - at end (defaults to length of string), exclusive." - {:added "1.0"} - ([^String s start] (. s (substring start))) - ([^String s start end] (. s (substring start end)))) - -(defn max-key - "Returns the x for which (k x), a number, is greatest." - {:added "1.0"} - ([k x] x) - ([k x y] (if (> (k x) (k y)) x y)) - ([k x y & more] - (reduce #(max-key k %1 %2) (max-key k x y) more))) - -(defn min-key - "Returns the x for which (k x), a number, is least." - {:added "1.0"} - ([k x] x) - ([k x y] (if (< (k x) (k y)) x y)) - ([k x y & more] - (reduce #(min-key k %1 %2) (min-key k x y) more))) - -(defn distinct - "Returns a lazy sequence of the elements of coll with duplicates removed" - {:added "1.0"} - [coll] - (let [step (fn step [xs seen] - (lazy-seq - ((fn [[f :as xs] seen] - (when-let [s (seq xs)] - (if (contains? seen f) - (recur (rest s) seen) - (cons f (step (rest s) (conj seen f)))))) - xs seen)))] - (step coll #{}))) - - - -(defn replace - "Given a map of replacement pairs and a vector/collection, returns a - vector/seq with any elements = a key in smap replaced with the - corresponding val in smap" - {:added "1.0"} - [smap coll] - (if (vector? coll) - (reduce (fn [v i] - (if-let [e (find smap (nth v i))] - (assoc v i (val e)) - v)) - coll (range (count coll))) - (map #(if-let [e (find smap %)] (val e) %) coll))) - -(defmacro dosync - "Runs the exprs (in an implicit do) in a transaction that encompasses - exprs and any nested calls. Starts a transaction if none is already - running on this thread. Any uncaught exception will abort the - transaction and flow out of dosync. The exprs may be run more than - once, but any effects on Refs will be atomic." - {:added "1.0"} - [& exprs] - `(sync nil ~@exprs)) - -(defmacro with-precision - "Sets the precision and rounding mode to be used for BigDecimal operations. - - Usage: (with-precision 10 (/ 1M 3)) - or: (with-precision 10 :rounding HALF_DOWN (/ 1M 3)) - - The rounding mode is one of CEILING, FLOOR, HALF_UP, HALF_DOWN, - HALF_EVEN, UP, DOWN and UNNECESSARY; it defaults to HALF_UP." - {:added "1.0"} - [precision & exprs] - (let [[body rm] (if (= (first exprs) :rounding) - [(next (next exprs)) - `((. java.math.RoundingMode ~(second exprs)))] - [exprs nil])] - `(binding [*math-context* (java.math.MathContext. ~precision ~@rm)] - ~@body))) - -(defn mk-bound-fn - {:private true} - [^clojure.lang.Sorted sc test key] - (fn [e] - (test (.. sc comparator (compare (. sc entryKey e) key)) 0))) - -(defn subseq - "sc must be a sorted collection, test(s) one of <, <=, > or - >=. Returns a seq of those entries with keys ek for - which (test (.. sc comparator (compare ek key)) 0) is true" - {:added "1.0"} - ([^clojure.lang.Sorted sc test key] - (let [include (mk-bound-fn sc test key)] - (if (#{> >=} test) - (when-let [[e :as s] (. sc seqFrom key true)] - (if (include e) s (next s))) - (take-while include (. sc seq true))))) - ([^clojure.lang.Sorted sc start-test start-key end-test end-key] - (when-let [[e :as s] (. sc seqFrom start-key true)] - (take-while (mk-bound-fn sc end-test end-key) - (if ((mk-bound-fn sc start-test start-key) e) s (next s)))))) - -(defn rsubseq - "sc must be a sorted collection, test(s) one of <, <=, > or - >=. Returns a reverse seq of those entries with keys ek for - which (test (.. sc comparator (compare ek key)) 0) is true" - {:added "1.0"} - ([^clojure.lang.Sorted sc test key] - (let [include (mk-bound-fn sc test key)] - (if (#{< <=} test) - (when-let [[e :as s] (. sc seqFrom key false)] - (if (include e) s (next s))) - (take-while include (. sc seq false))))) - ([^clojure.lang.Sorted sc start-test start-key end-test end-key] - (when-let [[e :as s] (. sc seqFrom end-key false)] - (take-while (mk-bound-fn sc start-test start-key) - (if ((mk-bound-fn sc end-test end-key) e) s (next s)))))) - -(defn repeatedly - "Takes a function of no args, presumably with side effects, and - returns an infinite (or length n if supplied) lazy sequence of calls - to it" - {:added "1.0"} - ([f] (lazy-seq (cons (f) (repeatedly f)))) - ([n f] (take n (repeatedly f)))) - -(defn add-classpath - "DEPRECATED - - Adds the url (String or URL object) to the classpath per - URLClassLoader.addURL" - {:added "1.0" - :deprecated "1.1"} - [url] - (println "WARNING: add-classpath is deprecated") - (clojure.lang.RT/addURL url)) - - - -(defn hash - "Returns the hash code of its argument" - {:added "1.0"} - [x] (. clojure.lang.Util (hash x))) - -(defn interpose - "Returns a lazy seq of the elements of coll separated by sep" - {:added "1.0"} - [sep coll] (drop 1 (interleave (repeat sep) coll))) - -(defmacro definline - "Experimental - like defmacro, except defines a named function whose - body is the expansion, calls to which may be expanded inline as if - it were a macro. Cannot be used with variadic (&) args." - {:added "1.0"} - [name & decl] - (let [[pre-args [args expr]] (split-with (comp not vector?) decl)] - `(do - (defn ~name ~@pre-args ~args ~(apply (eval (list `fn args expr)) args)) - (alter-meta! (var ~name) assoc :inline (fn ~name ~args ~expr)) - (var ~name)))) - -(defn empty - "Returns an empty collection of the same category as coll, or nil" - {:added "1.0"} - [coll] - (when (instance? clojure.lang.IPersistentCollection coll) - (.empty ^clojure.lang.IPersistentCollection coll))) - -(defmacro amap - "Maps an expression across an array a, using an index named idx, and - return value named ret, initialized to a clone of a, then setting - each element of ret to the evaluation of expr, returning the new - array ret." - {:added "1.0"} - [a idx ret expr] - `(let [a# ~a - ~ret (aclone a#)] - (loop [~idx (int 0)] - (if (< ~idx (alength a#)) - (do - (aset ~ret ~idx ~expr) - (recur (unchecked-inc ~idx))) - ~ret)))) - -(defmacro areduce - "Reduces an expression across an array a, using an index named idx, - and return value named ret, initialized to init, setting ret to the - evaluation of expr at each step, returning ret." - {:added "1.0"} - [a idx ret init expr] - `(let [a# ~a] - (loop [~idx (int 0) ~ret ~init] - (if (< ~idx (alength a#)) - (recur (unchecked-inc ~idx) ~expr) - ~ret)))) - -(defn float-array - "Creates an array of floats" - {:inline (fn [& args] `(. clojure.lang.Numbers float_array ~@args)) - :inline-arities #{1 2} - :added "1.0"} - ([size-or-seq] (. clojure.lang.Numbers float_array size-or-seq)) - ([size init-val-or-seq] (. clojure.lang.Numbers float_array size init-val-or-seq))) - -(defn boolean-array - "Creates an array of booleans" - {:inline (fn [& args] `(. clojure.lang.Numbers boolean_array ~@args)) - :inline-arities #{1 2} - :added "1.1"} - ([size-or-seq] (. clojure.lang.Numbers boolean_array size-or-seq)) - ([size init-val-or-seq] (. clojure.lang.Numbers boolean_array size init-val-or-seq))) - -(defn byte-array - "Creates an array of bytes" - {:inline (fn [& args] `(. clojure.lang.Numbers byte_array ~@args)) - :inline-arities #{1 2} - :added "1.1"} - ([size-or-seq] (. clojure.lang.Numbers byte_array size-or-seq)) - ([size init-val-or-seq] (. clojure.lang.Numbers byte_array size init-val-or-seq))) - -(defn char-array - "Creates an array of chars" - {:inline (fn [& args] `(. clojure.lang.Numbers char_array ~@args)) - :inline-arities #{1 2} - :added "1.1"} - ([size-or-seq] (. clojure.lang.Numbers char_array size-or-seq)) - ([size init-val-or-seq] (. clojure.lang.Numbers char_array size init-val-or-seq))) - -(defn short-array - "Creates an array of shorts" - {:inline (fn [& args] `(. clojure.lang.Numbers short_array ~@args)) - :inline-arities #{1 2} - :added "1.1"} - ([size-or-seq] (. clojure.lang.Numbers short_array size-or-seq)) - ([size init-val-or-seq] (. clojure.lang.Numbers short_array size init-val-or-seq))) - -(defn double-array - "Creates an array of doubles" - {:inline (fn [& args] `(. clojure.lang.Numbers double_array ~@args)) - :inline-arities #{1 2} - :added "1.0"} - ([size-or-seq] (. clojure.lang.Numbers double_array size-or-seq)) - ([size init-val-or-seq] (. clojure.lang.Numbers double_array size init-val-or-seq))) - -(defn object-array - "Creates an array of objects" - {:inline (fn [arg] `(. clojure.lang.RT object_array ~arg)) - :inline-arities #{1} - :added "1.2"} - ([size-or-seq] (. clojure.lang.RT object_array size-or-seq))) - -(defn int-array - "Creates an array of ints" - {:inline (fn [& args] `(. clojure.lang.Numbers int_array ~@args)) - :inline-arities #{1 2} - :added "1.0"} - ([size-or-seq] (. clojure.lang.Numbers int_array size-or-seq)) - ([size init-val-or-seq] (. clojure.lang.Numbers int_array size init-val-or-seq))) - -(defn long-array - "Creates an array of longs" - {:inline (fn [& args] `(. clojure.lang.Numbers long_array ~@args)) - :inline-arities #{1 2} - :added "1.0"} - ([size-or-seq] (. clojure.lang.Numbers long_array size-or-seq)) - ([size init-val-or-seq] (. clojure.lang.Numbers long_array size init-val-or-seq))) - -(definline booleans - "Casts to boolean[]" - {:added "1.1"} - [xs] `(. clojure.lang.Numbers booleans ~xs)) - -(definline bytes - "Casts to bytes[]" - {:added "1.1"} - [xs] `(. clojure.lang.Numbers bytes ~xs)) - -(definline chars - "Casts to chars[]" - {:added "1.1"} - [xs] `(. clojure.lang.Numbers chars ~xs)) - -(definline shorts - "Casts to shorts[]" - {:added "1.1"} - [xs] `(. clojure.lang.Numbers shorts ~xs)) - -(definline floats - "Casts to float[]" - {:added "1.0"} - [xs] `(. clojure.lang.Numbers floats ~xs)) - -(definline ints - "Casts to int[]" - {:added "1.0"} - [xs] `(. clojure.lang.Numbers ints ~xs)) - -(definline doubles - "Casts to double[]" - {:added "1.0"} - [xs] `(. clojure.lang.Numbers doubles ~xs)) - -(definline longs - "Casts to long[]" - {:added "1.0"} - [xs] `(. clojure.lang.Numbers longs ~xs)) - -(import '(java.util.concurrent BlockingQueue LinkedBlockingQueue)) - -(defn seque - "Creates a queued seq on another (presumably lazy) seq s. The queued - seq will produce a concrete seq in the background, and can get up to - n items ahead of the consumer. n-or-q can be an integer n buffer - size, or an instance of java.util.concurrent BlockingQueue. Note - that reading from a seque can block if the reader gets ahead of the - producer." - {:added "1.0"} - ([s] (seque 100 s)) - ([n-or-q s] - (let [^BlockingQueue q (if (instance? BlockingQueue n-or-q) - n-or-q - (LinkedBlockingQueue. (int n-or-q))) - NIL (Object.) ;nil sentinel since LBQ doesn't support nils - agt (agent (seq s)) - fill (fn [s] - (try - (loop [[x & xs :as s] s] - (if s - (if (.offer q (if (nil? x) NIL x)) - (recur xs) - s) - (.put q q))) ; q itself is eos sentinel - (catch Exception e - (.put q q) - (throw e)))) - drain (fn drain [] - (lazy-seq - (let [x (.take q)] - (if (identical? x q) ;q itself is eos sentinel - (do @agt nil) ;touch agent just to propagate errors - (do - (send-off agt fill) - (cons (if (identical? x NIL) nil x) (drain)))))))] - (send-off agt fill) - (drain)))) - -(defn class? - "Returns true if x is an instance of Class" - {:added "1.0"} - [x] (instance? Class x)) - -(defn- is-annotation? [c] - (and (class? c) - (.isAssignableFrom java.lang.annotation.Annotation c))) - -(defn- is-runtime-annotation? [^Class c] - (boolean - (and (is-annotation? c) - (when-let [^java.lang.annotation.Retention r - (.getAnnotation c java.lang.annotation.Retention)] - (= (.value r) java.lang.annotation.RetentionPolicy/RUNTIME))))) - -(defn- descriptor [^Class c] (clojure.asm.Type/getDescriptor c)) - -(declare process-annotation) -(defn- add-annotation [^clojure.asm.AnnotationVisitor av name v] - (cond - (vector? v) (let [avec (.visitArray av name)] - (doseq [vval v] - (add-annotation avec "value" vval)) - (.visitEnd avec)) - (symbol? v) (let [ev (eval v)] - (cond - (instance? java.lang.Enum ev) - (.visitEnum av name (descriptor (class ev)) (str ev)) - (class? ev) (.visit av name (clojure.asm.Type/getType ev)) - :else (throw (IllegalArgumentException. - (str "Unsupported annotation value: " v " of class " (class ev)))))) - (seq? v) (let [[nested nv] v - c (resolve nested) - nav (.visitAnnotation av name (descriptor c))] - (process-annotation nav nv) - (.visitEnd nav)) - :else (.visit av name v))) - -(defn- process-annotation [av v] - (if (map? v) - (doseq [[k v] v] - (add-annotation av (name k) v)) - (add-annotation av "value" v))) - -(defn- add-annotations - ([visitor m] (add-annotations visitor m nil)) - ([visitor m i] - (doseq [[k v] m] - (when (symbol? k) - (when-let [c (resolve k)] - (when (is-annotation? c) - ;this is known duck/reflective as no common base of ASM Visitors - (let [av (if i - (.visitParameterAnnotation visitor i (descriptor c) - (is-runtime-annotation? c)) - (.visitAnnotation visitor (descriptor c) - (is-runtime-annotation? c)))] - (process-annotation av v) - (.visitEnd av)))))))) - -(defn alter-var-root - "Atomically alters the root binding of var v by applying f to its - current value plus any args" - {:added "1.0"} - [^clojure.lang.Var v f & args] (.alterRoot v f args)) - -(defn bound? - "Returns true if all of the vars provided as arguments have any bound value, root or thread-local. - Implies that deref'ing the provided vars will succeed. Returns true if no vars are provided." - {:added "1.2"} - [& vars] - (every? #(.isBound ^clojure.lang.Var %) vars)) - -(defn thread-bound? - "Returns true if all of the vars provided as arguments have thread-local bindings. - Implies that set!'ing the provided vars will succeed. Returns true if no vars are provided." - {:added "1.2"} - [& vars] - (every? #(.getThreadBinding ^clojure.lang.Var %) vars)) - -(defn make-hierarchy - "Creates a hierarchy object for use with derive, isa? etc." - {:added "1.0"} - [] {:parents {} :descendants {} :ancestors {}}) - -(def ^{:private true} - global-hierarchy (make-hierarchy)) - -(defn not-empty - "If coll is empty, returns nil, else coll" - {:added "1.0"} - [coll] (when (seq coll) coll)) - -(defn bases - "Returns the immediate superclass and direct interfaces of c, if any" - {:added "1.0"} - [^Class c] - (when c - (let [i (.getInterfaces c) - s (.getSuperclass c)] - (not-empty - (if s (cons s i) i))))) - -(defn supers - "Returns the immediate and indirect superclasses and interfaces of c, if any" - {:added "1.0"} - [^Class class] - (loop [ret (set (bases class)) cs ret] - (if (seq cs) - (let [c (first cs) bs (bases c)] - (recur (into ret bs) (into (disj cs c) bs))) - (not-empty ret)))) - -(defn isa? - "Returns true if (= child parent), or child is directly or indirectly derived from - parent, either via a Java type inheritance relationship or a - relationship established via derive. h must be a hierarchy obtained - from make-hierarchy, if not supplied defaults to the global - hierarchy" - {:added "1.0"} - ([child parent] (isa? global-hierarchy child parent)) - ([h child parent] - (or (= child parent) - (and (class? parent) (class? child) - (. ^Class parent isAssignableFrom child)) - (contains? ((:ancestors h) child) parent) - (and (class? child) (some #(contains? ((:ancestors h) %) parent) (supers child))) - (and (vector? parent) (vector? child) - (= (count parent) (count child)) - (loop [ret true i 0] - (if (or (not ret) (= i (count parent))) - ret - (recur (isa? h (child i) (parent i)) (inc i)))))))) - -(defn parents - "Returns the immediate parents of tag, either via a Java type - inheritance relationship or a relationship established via derive. h - must be a hierarchy obtained from make-hierarchy, if not supplied - defaults to the global hierarchy" - {:added "1.0"} - ([tag] (parents global-hierarchy tag)) - ([h tag] (not-empty - (let [tp (get (:parents h) tag)] - (if (class? tag) - (into (set (bases tag)) tp) - tp))))) - -(defn ancestors - "Returns the immediate and indirect parents of tag, either via a Java type - inheritance relationship or a relationship established via derive. h - must be a hierarchy obtained from make-hierarchy, if not supplied - defaults to the global hierarchy" - {:added "1.0"} - ([tag] (ancestors global-hierarchy tag)) - ([h tag] (not-empty - (let [ta (get (:ancestors h) tag)] - (if (class? tag) - (let [superclasses (set (supers tag))] - (reduce into superclasses - (cons ta - (map #(get (:ancestors h) %) superclasses)))) - ta))))) - -(defn descendants - "Returns the immediate and indirect children of tag, through a - relationship established via derive. h must be a hierarchy obtained - from make-hierarchy, if not supplied defaults to the global - hierarchy. Note: does not work on Java type inheritance - relationships." - {:added "1.0"} - ([tag] (descendants global-hierarchy tag)) - ([h tag] (if (class? tag) - (throw (java.lang.UnsupportedOperationException. "Can't get descendants of classes")) - (not-empty (get (:descendants h) tag))))) - -(defn derive - "Establishes a parent/child relationship between parent and - tag. Parent must be a namespace-qualified symbol or keyword and - child can be either a namespace-qualified symbol or keyword or a - class. h must be a hierarchy obtained from make-hierarchy, if not - supplied defaults to, and modifies, the global hierarchy." - {:added "1.0"} - ([tag parent] - (assert (namespace parent)) - (assert (or (class? tag) (and (instance? clojure.lang.Named tag) (namespace tag)))) - - (alter-var-root #'global-hierarchy derive tag parent) nil) - ([h tag parent] - (assert (not= tag parent)) - (assert (or (class? tag) (instance? clojure.lang.Named tag))) - (assert (instance? clojure.lang.Named parent)) - - (let [tp (:parents h) - td (:descendants h) - ta (:ancestors h) - tf (fn [m source sources target targets] - (reduce (fn [ret k] - (assoc ret k - (reduce conj (get targets k #{}) (cons target (targets target))))) - m (cons source (sources source))))] - (or - (when-not (contains? (tp tag) parent) - (when (contains? (ta tag) parent) - (throw (Exception. (print-str tag "already has" parent "as ancestor")))) - (when (contains? (ta parent) tag) - (throw (Exception. (print-str "Cyclic derivation:" parent "has" tag "as ancestor")))) - {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent)) - :ancestors (tf (:ancestors h) tag td parent ta) - :descendants (tf (:descendants h) parent ta tag td)}) - h)))) - -(declare flatten) - -(defn underive - "Removes a parent/child relationship between parent and - tag. h must be a hierarchy obtained from make-hierarchy, if not - supplied defaults to, and modifies, the global hierarchy." - {:added "1.0"} - ([tag parent] (alter-var-root #'global-hierarchy underive tag parent) nil) - ([h tag parent] - (let [parentMap (:parents h) - childsParents (if (parentMap tag) - (disj (parentMap tag) parent) #{}) - newParents (if (not-empty childsParents) - (assoc parentMap tag childsParents) - (dissoc parentMap tag)) - deriv-seq (flatten (map #(cons (key %) (interpose (key %) (val %))) - (seq newParents)))] - (if (contains? (parentMap tag) parent) - (reduce #(apply derive %1 %2) (make-hierarchy) - (partition 2 deriv-seq)) - h)))) - - -(defn distinct? - "Returns true if no two of the arguments are =" - {:tag Boolean - :added "1.0"} - ([x] true) - ([x y] (not (= x y))) - ([x y & more] - (if (not= x y) - (loop [s #{x y} [x & etc :as xs] more] - (if xs - (if (contains? s x) - false - (recur (conj s x) etc)) - true)) - false))) - -(defn resultset-seq - "Creates and returns a lazy sequence of structmaps corresponding to - the rows in the java.sql.ResultSet rs" - {:added "1.0"} - [^java.sql.ResultSet rs] - (let [rsmeta (. rs (getMetaData)) - idxs (range 1 (inc (. rsmeta (getColumnCount)))) - keys (map (comp keyword #(.toLowerCase ^String %)) - (map (fn [i] (. rsmeta (getColumnLabel i))) idxs)) - check-keys - (or (apply distinct? keys) - (throw (Exception. "ResultSet must have unique column labels"))) - row-struct (apply create-struct keys) - row-values (fn [] (map (fn [^Integer i] (. rs (getObject i))) idxs)) - rows (fn thisfn [] - (when (. rs (next)) - (cons (apply struct row-struct (row-values)) (lazy-seq (thisfn)))))] - (rows))) - -(defn iterator-seq - "Returns a seq on a java.util.Iterator. Note that most collections - providing iterators implement Iterable and thus support seq directly." - {:added "1.0"} - [iter] - (clojure.lang.IteratorSeq/create iter)) - -(defn enumeration-seq - "Returns a seq on a java.util.Enumeration" - {:added "1.0"} - [e] - (clojure.lang.EnumerationSeq/create e)) - -(defn format - "Formats a string using java.lang.String.format, see java.util.Formatter for format - string syntax" - {:tag String - :added "1.0"} - [fmt & args] - (String/format fmt (to-array args))) - -(defn printf - "Prints formatted output, as per format" - {:added "1.0"} - [fmt & args] - (print (apply format fmt args))) - -(declare gen-class) - -(defmacro with-loading-context [& body] - `((fn loading# [] - (. clojure.lang.Var (pushThreadBindings {clojure.lang.Compiler/LOADER - (.getClassLoader (.getClass ^Object loading#))})) - (try - ~@body - (finally - (. clojure.lang.Var (popThreadBindings))))))) - -(defmacro ns - "Sets *ns* to the namespace named by name (unevaluated), creating it - if needed. references can be zero or more of: (:refer-clojure ...) - (:require ...) (:use ...) (:import ...) (:load ...) (:gen-class) - with the syntax of refer-clojure/require/use/import/load/gen-class - respectively, except the arguments are unevaluated and need not be - quoted. (:gen-class ...), when supplied, defaults to :name - corresponding to the ns name, :main true, :impl-ns same as ns, and - :init-impl-ns true. All options of gen-class are - supported. The :gen-class directive is ignored when not - compiling. If :gen-class is not supplied, when compiled only an - nsname__init.class will be generated. If :refer-clojure is not used, a - default (refer 'clojure) is used. Use of ns is preferred to - individual calls to in-ns/require/use/import: - - (ns foo.bar - (:refer-clojure :exclude [ancestors printf]) - (:require (clojure.contrib sql sql.tests)) - (:use (my.lib this that)) - (:import (java.util Date Timer Random) - (java.sql Connection Statement)))" - {:arglists '([name docstring? attr-map? references*]) - :added "1.0"} - [name & references] - (let [process-reference - (fn [[kname & args]] - `(~(symbol "clojure.core" (clojure.core/name kname)) - ~@(map #(list 'quote %) args))) - docstring (when (string? (first references)) (first references)) - references (if docstring (next references) references) - name (if docstring - (vary-meta name assoc :doc docstring) - name) - metadata (when (map? (first references)) (first references)) - references (if metadata (next references) references) - name (if metadata - (vary-meta name merge metadata) - name) - gen-class-clause (first (filter #(= :gen-class (first %)) references)) - gen-class-call - (when gen-class-clause - (list* `gen-class :name (.replace (str name) \- \_) :impl-ns name :main true (next gen-class-clause))) - references (remove #(= :gen-class (first %)) references) - ;ns-effect (clojure.core/in-ns name) - ] - `(do - (clojure.core/in-ns '~name) - (with-loading-context - ~@(when gen-class-call (list gen-class-call)) - ~@(when (and (not= name 'clojure.core) (not-any? #(= :refer-clojure (first %)) references)) - `((clojure.core/refer '~'clojure.core))) - ~@(map process-reference references))))) - -(defmacro refer-clojure - "Same as (refer 'clojure.core )" - {:added "1.0"} - [& filters] - `(clojure.core/refer '~'clojure.core ~@filters)) - -(defmacro defonce - "defs name to have the root value of the expr iff the named var has no root value, - else expr is unevaluated" - {:added "1.0"} - [name expr] - `(let [v# (def ~name)] - (when-not (.hasRoot v#) - (def ~name ~expr)))) - -;;;;;;;;;;; require/use/load, contributed by Stephen C. Gilardi ;;;;;;;;;;;;;;;;;; - -(defonce - ^{:private true - :doc "A ref to a sorted set of symbols representing loaded libs"} - *loaded-libs* (ref (sorted-set))) - -(defonce - ^{:private true - :doc "the set of paths currently being loaded by this thread"} - *pending-paths* #{}) - -(defonce - ^{:private true :doc - "True while a verbose load is pending"} - *loading-verbosely* false) - -(defn- throw-if - "Throws an exception with a message if pred is true" - [pred fmt & args] - (when pred - (let [^String message (apply format fmt args) - exception (Exception. message) - raw-trace (.getStackTrace exception) - boring? #(not= (.getMethodName ^StackTraceElement %) "doInvoke") - trace (into-array (drop 2 (drop-while boring? raw-trace)))] - (.setStackTrace exception trace) - (throw exception)))) - -(defn- libspec? - "Returns true if x is a libspec" - [x] - (or (symbol? x) - (and (vector? x) - (or - (nil? (second x)) - (keyword? (second x)))))) - -(defn- prependss - "Prepends a symbol or a seq to coll" - [x coll] - (if (symbol? x) - (cons x coll) - (concat x coll))) - -(defn- root-resource - "Returns the root directory path for a lib" - {:tag String} - [lib] - (str \/ - (.. (name lib) - (replace \- \_) - (replace \. \/)))) - -(defn- root-directory - "Returns the root resource path for a lib" - [lib] - (let [d (root-resource lib)] - (subs d 0 (.lastIndexOf d "/")))) - -(declare load) - -(defn- load-one - "Loads a lib given its name. If need-ns, ensures that the associated - namespace exists after loading. If require, records the load so any - duplicate loads can be skipped." - [lib need-ns require] - (load (root-resource lib)) - (throw-if (and need-ns (not (find-ns lib))) - "namespace '%s' not found after loading '%s'" - lib (root-resource lib)) - (when require - (dosync - (commute *loaded-libs* conj lib)))) - -(defn- load-all - "Loads a lib given its name and forces a load of any libs it directly or - indirectly loads. If need-ns, ensures that the associated namespace - exists after loading. If require, records the load so any duplicate loads - can be skipped." - [lib need-ns require] - (dosync - (commute *loaded-libs* #(reduce conj %1 %2) - (binding [*loaded-libs* (ref (sorted-set))] - (load-one lib need-ns require) - @*loaded-libs*)))) - -(defn- load-lib - "Loads a lib with options" - [prefix lib & options] - (throw-if (and prefix (pos? (.indexOf (name lib) (int \.)))) - "lib names inside prefix lists must not contain periods") - (let [lib (if prefix (symbol (str prefix \. lib)) lib) - opts (apply hash-map options) - {:keys [as reload reload-all require use verbose]} opts - loaded (contains? @*loaded-libs* lib) - load (cond reload-all - load-all - (or reload (not require) (not loaded)) - load-one) - need-ns (or as use) - filter-opts (select-keys opts '(:exclude :only :rename))] - (binding [*loading-verbosely* (or *loading-verbosely* verbose)] - (if load - (load lib need-ns require) - (throw-if (and need-ns (not (find-ns lib))) - "namespace '%s' not found" lib)) - (when (and need-ns *loading-verbosely*) - (printf "(clojure.core/in-ns '%s)\n" (ns-name *ns*))) - (when as - (when *loading-verbosely* - (printf "(clojure.core/alias '%s '%s)\n" as lib)) - (alias as lib)) - (when use - (when *loading-verbosely* - (printf "(clojure.core/refer '%s" lib) - (doseq [opt filter-opts] - (printf " %s '%s" (key opt) (print-str (val opt)))) - (printf ")\n")) - (apply refer lib (mapcat seq filter-opts)))))) - -(defn- load-libs - "Loads libs, interpreting libspecs, prefix lists, and flags for - forwarding to load-lib" - [& args] - (let [flags (filter keyword? args) - opts (interleave flags (repeat true)) - args (filter (complement keyword?) args)] - ; check for unsupported options - (let [supported #{:as :reload :reload-all :require :use :verbose} - unsupported (seq (remove supported flags))] - (throw-if unsupported - (apply str "Unsupported option(s) supplied: " - (interpose \, unsupported)))) - ; check a load target was specified - (throw-if (not (seq args)) "Nothing specified to load") - (doseq [arg args] - (if (libspec? arg) - (apply load-lib nil (prependss arg opts)) - (let [[prefix & args] arg] - (throw-if (nil? prefix) "prefix cannot be nil") - (doseq [arg args] - (apply load-lib prefix (prependss arg opts)))))))) - -;; Public - - -(defn require - "Loads libs, skipping any that are already loaded. Each argument is - either a libspec that identifies a lib, a prefix list that identifies - multiple libs whose names share a common prefix, or a flag that modifies - how all the identified libs are loaded. Use :require in the ns macro - in preference to calling this directly. - - Libs - - A 'lib' is a named set of resources in classpath whose contents define a - library of Clojure code. Lib names are symbols and each lib is associated - with a Clojure namespace and a Java package that share its name. A lib's - name also locates its root directory within classpath using Java's - package name to classpath-relative path mapping. All resources in a lib - should be contained in the directory structure under its root directory. - All definitions a lib makes should be in its associated namespace. - - 'require loads a lib by loading its root resource. The root resource path - is derived from the lib name in the following manner: - Consider a lib named by the symbol 'x.y.z; it has the root directory - /x/y/, and its root resource is /x/y/z.clj. The root - resource should contain code to create the lib's namespace (usually by using - the ns macro) and load any additional lib resources. - - Libspecs - - A libspec is a lib name or a vector containing a lib name followed by - options expressed as sequential keywords and arguments. - - Recognized options: :as - :as takes a symbol as its argument and makes that symbol an alias to the - lib's namespace in the current namespace. - - Prefix Lists - - It's common for Clojure code to depend on several libs whose names have - the same prefix. When specifying libs, prefix lists can be used to reduce - repetition. A prefix list contains the shared prefix followed by libspecs - with the shared prefix removed from the lib names. After removing the - prefix, the names that remain must not contain any periods. - - Flags - - A flag is a keyword. - Recognized flags: :reload, :reload-all, :verbose - :reload forces loading of all the identified libs even if they are - already loaded - :reload-all implies :reload and also forces loading of all libs that the - identified libs directly or indirectly load via require or use - :verbose triggers printing information about each load, alias, and refer - - Example: - - The following would load the libraries clojure.zip and clojure.set - abbreviated as 's'. - - (require '(clojure zip [set :as s]))" - {:added "1.0"} - - [& args] - (apply load-libs :require args)) - -(defn use - "Like 'require, but also refers to each lib's namespace using - clojure.core/refer. Use :use in the ns macro in preference to calling - this directly. - - 'use accepts additional options in libspecs: :exclude, :only, :rename. - The arguments and semantics for :exclude, :only, and :rename are the same - as those documented for clojure.core/refer." - {:added "1.0"} - [& args] (apply load-libs :require :use args)) - -(defn loaded-libs - "Returns a sorted set of symbols naming the currently loaded libs" - {:added "1.0"} - [] @*loaded-libs*) - -(defn load - "Loads Clojure code from resources in classpath. A path is interpreted as - classpath-relative if it begins with a slash or relative to the root - directory for the current namespace otherwise." - {:added "1.0"} - [& paths] - (doseq [^String path paths] - (let [^String path (if (.startsWith path "/") - path - (str (root-directory (ns-name *ns*)) \/ path))] - (when *loading-verbosely* - (printf "(clojure.core/load \"%s\")\n" path) - (flush)) -; (throw-if (*pending-paths* path) -; "cannot load '%s' again while it is loading" -; path) - (when-not (*pending-paths* path) - (binding [*pending-paths* (conj *pending-paths* path)] - (clojure.lang.RT/load (.substring path 1))))))) - -(defn compile - "Compiles the namespace named by the symbol lib into a set of - classfiles. The source for the lib must be in a proper - classpath-relative directory. The output files will go into the - directory specified by *compile-path*, and that directory too must - be in the classpath." - {:added "1.0"} - [lib] - (binding [*compile-files* true] - (load-one lib true true)) - lib) - -;;;;;;;;;;;;; nested associative ops ;;;;;;;;;;; - -(defn get-in - "Returns the value in a nested associative structure, - where ks is a sequence of ke(ys. Returns nil if the key is not present, - or the not-found value if supplied." - {:added "1.2"} - ([m ks] - (reduce get m ks)) - ([m ks not-found] - (loop [sentinel (Object.) - m m - ks (seq ks)] - (if ks - (let [m (get m (first ks) sentinel)] - (if (identical? sentinel m) - not-found - (recur sentinel m (next ks)))) - m)))) - -(defn assoc-in - "Associates a value in a nested associative structure, where ks is a - sequence of keys and v is the new value and returns a new nested structure. - If any levels do not exist, hash-maps will be created." - {:added "1.0"} - [m [k & ks] v] - (if ks - (assoc m k (assoc-in (get m k) ks v)) - (assoc m k v))) - -(defn update-in - "'Updates' a value in a nested associative structure, where ks is a - sequence of keys and f is a function that will take the old value - and any supplied args and return the new value, and returns a new - nested structure. If any levels do not exist, hash-maps will be - created." - {:added "1.0"} - ([m [k & ks] f & args] - (if ks - (assoc m k (apply update-in (get m k) ks f args)) - (assoc m k (apply f (get m k) args))))) - - -(defn empty? - "Returns true if coll has no items - same as (not (seq coll)). - Please use the idiom (seq x) rather than (not (empty? x))" - {:added "1.0"} - [coll] (not (seq coll))) - -(defn coll? - "Returns true if x implements IPersistentCollection" - {:added "1.0"} - [x] (instance? clojure.lang.IPersistentCollection x)) - -(defn list? - "Returns true if x implements IPersistentList" - {:added "1.0"} - [x] (instance? clojure.lang.IPersistentList x)) - -(defn set? - "Returns true if x implements IPersistentSet" - {:added "1.0"} - [x] (instance? clojure.lang.IPersistentSet x)) - -(defn ifn? - "Returns true if x implements IFn. Note that many data structures - (e.g. sets and maps) implement IFn" - {:added "1.0"} - [x] (instance? clojure.lang.IFn x)) - -(defn fn? - "Returns true if x implements Fn, i.e. is an object created via fn." - {:added "1.0"} - [x] (instance? clojure.lang.Fn x)) - - -(defn associative? - "Returns true if coll implements Associative" - {:added "1.0"} - [coll] (instance? clojure.lang.Associative coll)) - -(defn sequential? - "Returns true if coll implements Sequential" - {:added "1.0"} - [coll] (instance? clojure.lang.Sequential coll)) - -(defn sorted? - "Returns true if coll implements Sorted" - {:added "1.0"} - [coll] (instance? clojure.lang.Sorted coll)) - -(defn counted? - "Returns true if coll implements count in constant time" - {:added "1.0"} - [coll] (instance? clojure.lang.Counted coll)) - -(defn reversible? - "Returns true if coll implements Reversible" - {:added "1.0"} - [coll] (instance? clojure.lang.Reversible coll)) - -(def - ^{:doc "bound in a repl thread to the most recent value printed" - :added "1.0"} - *1) - -(def - ^{:doc "bound in a repl thread to the second most recent value printed" - :added "1.0"} - *2) - -(def - ^{:doc "bound in a repl thread to the third most recent value printed" - :added "1.0"} - *3) - -(def - ^{:doc "bound in a repl thread to the most recent exception caught by the repl" - :added "1.0"} - *e) - -(defn trampoline - "trampoline can be used to convert algorithms requiring mutual - recursion without stack consumption. Calls f with supplied args, if - any. If f returns a fn, calls that fn with no arguments, and - continues to repeat, until the return value is not a fn, then - returns that non-fn value. Note that if you want to return a fn as a - final value, you must wrap it in some data structure and unpack it - after trampoline returns." - {:added "1.0"} - ([f] - (let [ret (f)] - (if (fn? ret) - (recur ret) - ret))) - ([f & args] - (trampoline #(apply f args)))) - -(defn intern - "Finds or creates a var named by the symbol name in the namespace - ns (which can be a symbol or a namespace), setting its root binding - to val if supplied. The namespace must exist. The var will adopt any - metadata from the name symbol. Returns the var." - {:added "1.0"} - ([ns ^clojure.lang.Symbol name] - (let [v (clojure.lang.Var/intern (the-ns ns) name)] - (when (meta name) (.setMeta v (meta name))) - v)) - ([ns name val] - (let [v (clojure.lang.Var/intern (the-ns ns) name val)] - (when (meta name) (.setMeta v (meta name))) - v))) - -(defmacro while - "Repeatedly executes body while test expression is true. Presumes - some side-effect will cause test to become false/nil. Returns nil" - {:added "1.0"} - [test & body] - `(loop [] - (when ~test - ~@body - (recur)))) - -(defn memoize - "Returns a memoized version of a referentially transparent function. The - memoized version of the function keeps a cache of the mapping from arguments - to results and, when calls with the same arguments are repeated often, has - higher performance at the expense of higher memory use." - {:added "1.0"} - [f] - (let [mem (atom {})] - (fn [& args] - (if-let [e (find @mem args)] - (val e) - (let [ret (apply f args)] - (swap! mem assoc args ret) - ret))))) - -(defmacro condp - "Takes a binary predicate, an expression, and a set of clauses. - Each clause can take the form of either: - - test-expr result-expr - - test-expr :>> result-fn - - Note :>> is an ordinary keyword. - - For each clause, (pred test-expr expr) is evaluated. If it returns - logical true, the clause is a match. If a binary clause matches, the - result-expr is returned, if a ternary clause matches, its result-fn, - which must be a unary function, is called with the result of the - predicate as its argument, the result of that call being the return - value of condp. A single default expression can follow the clauses, - and its value will be returned if no clause matches. If no default - expression is provided and no clause matches, an - IllegalArgumentException is thrown." - {:added "1.0"} - - [pred expr & clauses] - (let [gpred (gensym "pred__") - gexpr (gensym "expr__") - emit (fn emit [pred expr args] - (let [[[a b c :as clause] more] - (split-at (if (= :>> (second args)) 3 2) args) - n (count clause)] - (cond - (= 0 n) `(throw (IllegalArgumentException. (str "No matching clause: " ~expr))) - (= 1 n) a - (= 2 n) `(if (~pred ~a ~expr) - ~b - ~(emit pred expr more)) - :else `(if-let [p# (~pred ~a ~expr)] - (~c p#) - ~(emit pred expr more))))) - gres (gensym "res__")] - `(let [~gpred ~pred - ~gexpr ~expr] - ~(emit gpred gexpr clauses)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; var documentation ;;;;;;;;;;;;;;;;;;;;;;;;;; - -(alter-meta! #'*agent* assoc :added "1.0") -(alter-meta! #'in-ns assoc :added "1.0") -(alter-meta! #'load-file assoc :added "1.0") - -(defmacro add-doc-and-meta {:private true} [name docstring meta] - `(alter-meta! (var ~name) merge (assoc ~meta :doc ~docstring))) - -(add-doc-and-meta *file* - "The path of the file being evaluated, as a String. - - Evaluates to nil when there is no file, eg. in the REPL." - {:added "1.0"}) - -(add-doc-and-meta *command-line-args* - "A sequence of the supplied command line arguments, or nil if - none were supplied" - {:added "1.0"}) - -(add-doc-and-meta *warn-on-reflection* - "When set to true, the compiler will emit warnings when reflection is - needed to resolve Java method calls or field accesses. - - Defaults to false." - {:added "1.0"}) - -(add-doc-and-meta *compile-path* - "Specifies the directory where 'compile' will write out .class - files. This directory must be in the classpath for 'compile' to - work. - - Defaults to \"classes\"" - {:added "1.0"}) - -(add-doc-and-meta *compile-files* - "Set to true when compiling files, false otherwise." - {:added "1.0"}) - -(add-doc-and-meta *ns* - "A clojure.lang.Namespace object representing the current namespace." - {:added "1.0"}) - -(add-doc-and-meta *in* - "A java.io.Reader object representing standard input for read operations. - - Defaults to System/in, wrapped in a LineNumberingPushbackReader" - {:added "1.0"}) - -(add-doc-and-meta *out* - "A java.io.Writer object representing standard output for print operations. - - Defaults to System/out" - {:added "1.0"}) - -(add-doc-and-meta *err* - "A java.io.Writer object representing standard error for print operations. - - Defaults to System/err, wrapped in a PrintWriter" - {:added "1.0"}) - -(add-doc-and-meta *flush-on-newline* - "When set to true, output will be flushed whenever a newline is printed. - - Defaults to true." - {:added "1.0"}) - -(add-doc-and-meta *print-meta* - "If set to logical true, when printing an object, its metadata will also - be printed in a form that can be read back by the reader. - - Defaults to false." - {:added "1.0"}) - -(add-doc-and-meta *print-dup* - "When set to logical true, objects will be printed in a way that preserves - their type when read in later. - - Defaults to false." - {:added "1.0"}) - -(add-doc-and-meta *print-readably* - "When set to logical false, strings and characters will be printed with - non-alphanumeric characters converted to the appropriate escape sequences. - - Defaults to true" - {:added "1.0"}) - -(add-doc-and-meta *read-eval* - "When set to logical false, the EvalReader (#=(...)) is disabled in the - read/load in the thread-local binding. - Example: (binding [*read-eval* false] (read-string \"#=(eval (def x 3))\")) - - Defaults to true" - {:added "1.0"}) - -(defn future? - "Returns true if x is a future" - {:added "1.1"} - [x] (instance? java.util.concurrent.Future x)) - -(defn future-done? - "Returns true if future f is done" - {:added "1.1"} - [^java.util.concurrent.Future f] (.isDone f)) - - -(defmacro letfn - "Takes a vector of function specs and a body, and generates a set of - bindings of functions to their names. All of the names are available - in all of the definitions of the functions, as well as the body. - - fnspec ==> (fname [params*] exprs) or (fname ([params*] exprs)+)" - {:added "1.0"} - [fnspecs & body] - `(letfn* ~(vec (interleave (map first fnspecs) - (map #(cons `fn %) fnspecs))) - ~@body)) - - -;;;;;;; case ;;;;;;;;;;;;; -(defn- shift-mask [shift mask x] - (-> x (bit-shift-right shift) (bit-and mask))) - -(defn- min-hash - "takes a collection of keys and returns [shift mask]" - [keys] - (let [hashes (map hash keys) - cnt (count keys)] - (when-not (apply distinct? hashes) - (throw (IllegalArgumentException. "Hashes must be distinct"))) - (or (first - (filter (fn [[s m]] - (apply distinct? (map #(shift-mask s m %) hashes))) - (for [mask (map #(dec (bit-shift-left 1 %)) (range 1 14)) - shift (range 0 31)] - [shift mask]))) - (throw (IllegalArgumentException. "No distinct mapping found"))))) - -(defmacro case - "Takes an expression, and a set of clauses. - - Each clause can take the form of either: - - test-constant result-expr - - (test-constant1 ... test-constantN) result-expr - - The test-constants are not evaluated. They must be compile-time - literals, and need not be quoted. If the expression is equal to a - test-constant, the corresponding result-expr is returned. A single - default expression can follow the clauses, and its value will be - returned if no clause matches. If no default expression is provided - and no clause matches, an IllegalArgumentException is thrown. - - Unlike cond and condp, case does a constant-time dispatch, the - clauses are not considered sequentially. All manner of constant - expressions are acceptable in case, including numbers, strings, - symbols, keywords, and (Clojure) composites thereof. Note that since - lists are used to group multiple constants that map to the same - expression, a vector can be used to match a list if needed. The - test-constants need not be all of the same type." - {:added "1.2"} - - [e & clauses] - (let [ge (with-meta (gensym) {:tag Object}) - default (if (odd? (count clauses)) - (last clauses) - `(throw (IllegalArgumentException. (str "No matching clause: " ~ge)))) - cases (partition 2 clauses) - case-map (reduce (fn [m [test expr]] - (if (seq? test) - (into m (zipmap test (repeat expr))) - (assoc m test expr))) - {} cases) - [shift mask] (if (seq case-map) (min-hash (keys case-map)) [0 0]) - - hmap (reduce (fn [m [test expr :as te]] - (assoc m (shift-mask shift mask (hash test)) te)) - (sorted-map) case-map)] - `(let [~ge ~e] - ~(condp = (count clauses) - 0 default - 1 default - `(case* ~ge ~shift ~mask ~(key (first hmap)) ~(key (last hmap)) ~default ~hmap - ~(every? keyword? (keys case-map))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; helper files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(alter-meta! (find-ns 'clojure.core) assoc :doc "Fundamental library of the Clojure language") -(load "core_proxy") -(load "core_print") -(load "genclass") -(load "core_deftype") -(load "core/protocols") -(load "gvec") - -;; redefine reduce with internal-reduce -#_(defn reduce - "f should be a function of 2 arguments. If val is not supplied, - returns the result of applying f to the first 2 items in coll, then - applying f to that result and the 3rd item, etc. If coll contains no - items, f must accept no arguments as well, and reduce returns the - result of calling f with no arguments. If coll has only 1 item, it - is returned and f is not called. If val is supplied, returns the - result of applying f to val and the first item in coll, then - applying f to that result and the 2nd item, etc. If coll contains no - items, returns val and f is not called." - {:added "1.0"} - ([f coll] - (if-let [s (seq coll)] - (reduce f (first s) (next s)) - (f))) - ([f val coll] - (let [s (seq coll)] - (clojure.core.protocols/internal-reduce s f val)))) - -(require '[clojure.java.io :as jio]) - -(defn- normalize-slurp-opts - [opts] - (if (string? (first opts)) - (do - (println "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).") - [:encoding (first opts)]) - opts)) - -(defn slurp - "Reads the file named by f using the encoding enc into a string - and returns it." - {:added "1.0"} - ([f & opts] - (let [opts (normalize-slurp-opts opts) - sb (StringBuilder.)] - (with-open [#^java.io.Reader r (apply jio/reader f opts)] - (loop [c (.read r)] - (if (neg? c) - (str sb) - (do - (.append sb (char c)) - (recur (.read r))))))))) - -(defn spit - "Opposite of slurp. Opens f with writer, writes content, then - closes f. Options passed to clojure.java.io/writer." - {:added "1.2"} - [f content & options] - (with-open [#^java.io.Writer w (apply jio/writer f options)] - (.write w (str content)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;; -(defn future-call - "Takes a function of no args and yields a future object that will - invoke the function in another thread, and will cache the result and - return it on all subsequent calls to deref/@. If the computation has - not yet finished, calls to deref/@ will block." - {:added "1.1"} - [^Callable f] - (let [fut (.submit clojure.lang.Agent/soloExecutor f)] - (reify - clojure.lang.IDeref - (deref [_] (.get fut)) - java.util.concurrent.Future - (get [_] (.get fut)) - (get [_ timeout unit] (.get fut timeout unit)) - (isCancelled [_] (.isCancelled fut)) - (isDone [_] (.isDone fut)) - (cancel [_ interrupt?] (.cancel fut interrupt?))))) - -(defmacro future - "Takes a body of expressions and yields a future object that will - invoke the body in another thread, and will cache the result and - return it on all subsequent calls to deref/@. If the computation has - not yet finished, calls to deref/@ will block." - {:added "1.1"} - [& body] `(future-call (^{:once true} fn* [] ~@body))) - - -(defn future-cancel - "Cancels the future, if possible." - {:added "1.1"} - [^java.util.concurrent.Future f] (.cancel f true)) - -(defn future-cancelled? - "Returns true if future f is cancelled" - {:added "1.1"} - [^java.util.concurrent.Future f] (.isCancelled f)) - -(defn pmap - "Like map, except f is applied in parallel. Semi-lazy in that the - parallel computation stays ahead of the consumption, but doesn't - realize the entire result unless required. Only useful for - computationally intensive functions where the time of f dominates - the coordination overhead." - {:added "1.0"} - ([f coll] - (let [n (+ 2 (.. Runtime getRuntime availableProcessors)) - rets (map #(future (f %)) coll) - step (fn step [[x & xs :as vs] fs] - (lazy-seq - (if-let [s (seq fs)] - (cons (deref x) (step xs (rest s))) - (map deref vs))))] - (step rets (drop n rets)))) - ([f coll & colls] - (let [step (fn step [cs] - (lazy-seq - (let [ss (map seq cs)] - (when (every? identity ss) - (cons (map first ss) (step (map rest ss)))))))] - (pmap #(apply f %) (step (cons coll colls)))))) - -(defn pcalls - "Executes the no-arg fns in parallel, returning a lazy sequence of - their values" - {:added "1.0"} - [& fns] (pmap #(%) fns)) - -(defmacro pvalues - "Returns a lazy sequence of the values of the exprs, which are - evaluated in parallel" - {:added "1.0"} - [& exprs] - `(pcalls ~@(map #(list `fn [] %) exprs))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; clojure version number ;;;;;;;;;;;;;;;;;;;;;; - -(let [version-stream (.getResourceAsStream (clojure.lang.RT/baseLoader) - "clojure/version.properties") - properties (doto (new java.util.Properties) (.load version-stream)) - prop (fn [k] (.getProperty properties (str "clojure.version." k))) - clojure-version {:major (Integer/valueOf ^String (prop "major")) - :minor (Integer/valueOf ^String (prop "minor")) - :incremental (Integer/valueOf ^String (prop "incremental")) - :qualifier (prop "qualifier")}] - (def *clojure-version* - (if (not (= (prop "interim") "false")) - (clojure.lang.RT/assoc clojure-version :interim true) - clojure-version))) - -(add-doc-and-meta *clojure-version* - "The version info for Clojure core, as a map containing :major :minor - :incremental and :qualifier keys. Feature releases may increment - :minor and/or :major, bugfix releases will increment :incremental. - Possible values of :qualifier include \"GA\", \"SNAPSHOT\", \"RC-x\" \"BETA-x\"" - {:added "1.0"}) - -(defn - clojure-version - "Returns clojure version as a printable string." - {:added "1.0"} - [] - (str (:major *clojure-version*) - "." - (:minor *clojure-version*) - (when-let [i (:incremental *clojure-version*)] - (str "." i)) - (when-let [q (:qualifier *clojure-version*)] - (when (pos? (count q)) (str "-" q))) - (when (:interim *clojure-version*) - "-SNAPSHOT"))) - -(defn promise - "Alpha - subject to change. - Returns a promise object that can be read with deref/@, and set, - once only, with deliver. Calls to deref/@ prior to delivery will - block. All subsequent derefs will return the same delivered value - without blocking." - {:added "1.1"} - [] - (let [d (java.util.concurrent.CountDownLatch. 1) - v (atom nil)] - (reify - clojure.lang.IDeref - (deref [_] (.await d) @v) - clojure.lang.IFn - (invoke [this x] - (locking d - (if (pos? (.getCount d)) - (do (reset! v x) - (.countDown d) - this) - (throw (IllegalStateException. "Multiple deliver calls to a promise")))))))) - -(defn deliver - "Alpha - subject to change. - Delivers the supplied value to the promise, releasing any pending - derefs. A subsequent call to deliver on a promise will throw an exception." - {:added "1.1"} - [promise val] (promise val)) - - - -(defn flatten - "Takes any nested combination of sequential things (lists, vectors, - etc.) and returns their contents as a single, flat sequence. - (flatten nil) returns nil." - {:added "1.2"} - [x] - (filter (complement sequential?) - (rest (tree-seq sequential? seq x)))) - -(defn group-by - "Returns a map of the elements of coll keyed by the result of - f on each element. The value at each key will be a vector of the - corresponding elements, in the order they appeared in coll." - {:added "1.2"} - [f coll] - (persistent! - (reduce - (fn [ret x] - (let [k (f x)] - (assoc! ret k (conj (get ret k []) x)))) - (transient {}) coll))) - -(defn partition-by - "Applies f to each value in coll, splitting it each time f returns - a new value. Returns a lazy seq of partitions." - {:added "1.2"} - [f coll] - (lazy-seq - (when-let [s (seq coll)] - (let [fst (first s) - fv (f fst) - run (cons fst (take-while #(= fv (f %)) (rest s)))] - (cons run (partition-by f (drop (count run) s))))))) - -(defn frequencies - "Returns a map from distinct items in coll to the number of times - they appear." - {:added "1.2"} - [coll] - (persistent! - (reduce (fn [counts x] - (assoc! counts x (inc (get counts x 0)))) - (transient {}) coll))) - -(defn reductions - "Returns a lazy seq of the intermediate values of the reduction (as - per reduce) of coll by f, starting with init." - {:added "1.2"} - ([f coll] - (lazy-seq - (if-let [s (seq coll)] - (reductions f (first s) (rest s)) - (list (f))))) - ([f init coll] - (cons init - (lazy-seq - (when-let [s (seq coll)] - (reductions f (f init (first s)) (rest s))))))) - -(defn rand-nth - "Return a random element of the (sequential) collection. Will have - the same performance characteristics as nth for the given - collection." - {:added "1.2"} - [coll] - (nth coll (rand-int (count coll)))) - -(defn partition-all - "Returns a lazy sequence of lists like partition, but may include - partitions with fewer than n items at the end." - {:added "1.2"} - ([n coll] - (partition-all n n coll)) - ([n step coll] - (lazy-seq - (when-let [s (seq coll)] - (cons (take n s) (partition-all n step (drop step s))))))) - -(defn shuffle - "Return a random permutation of coll" - {:added "1.2"} - [coll] - (let [al (java.util.ArrayList. coll)] - (java.util.Collections/shuffle al) - (clojure.lang.RT/vector (.toArray al)))) - -(defn map-indexed - "Returns a lazy sequence consisting of the result of applying f to 0 - and the first item of coll, followed by applying f to 1 and the second - item in coll, etc, until coll is exhausted. Thus function f should - accept 2 arguments, index and item." - {:added "1.2"} - [f coll] - (letfn [(mapi [idx coll] - (lazy-seq - (when-let [s (seq coll)] - (if (chunked-seq? s) - (let [c (chunk-first s) - size (int (count c)) - b (chunk-buffer size)] - (dotimes [i size] - (chunk-append b (f (+ idx i) (.nth c i)))) - (chunk-cons (chunk b) (mapi (+ idx size) (chunk-rest s)))) - (cons (f idx (first s)) (mapi (inc idx) (rest s)))))))] - (mapi 0 coll))) - -(defn keep - "Returns a lazy sequence of the non-nil results of (f item). Note, - this means false return values will be included. f must be free of - side-effects." - {:added "1.2"} - ([f coll] - (lazy-seq - (when-let [s (seq coll)] - (if (chunked-seq? s) - (let [c (chunk-first s) - size (count c) - b (chunk-buffer size)] - (dotimes [i size] - (let [x (f (.nth c i))] - (when-not (nil? x) - (chunk-append b x)))) - (chunk-cons (chunk b) (keep f (chunk-rest s)))) - (let [x (f (first s))] - (if (nil? x) - (keep f (rest s)) - (cons x (keep f (rest s)))))))))) - -(defn keep-indexed - "Returns a lazy sequence of the non-nil results of (f index item). Note, - this means false return values will be included. f must be free of - side-effects." - {:added "1.2"} - ([f coll] - (letfn [(keepi [idx coll] - (lazy-seq - (when-let [s (seq coll)] - (if (chunked-seq? s) - (let [c (chunk-first s) - size (count c) - b (chunk-buffer size)] - (dotimes [i size] - (let [x (f (+ idx i) (.nth c i))] - (when-not (nil? x) - (chunk-append b x)))) - (chunk-cons (chunk b) (keepi (+ idx size) (chunk-rest s)))) - (let [x (f idx (first s))] - (if (nil? x) - (keepi (inc idx) (rest s)) - (cons x (keepi (inc idx) (rest s)))))))))] - (keepi 0 coll)))) - -(defn fnil - "Takes a function f, and returns a function that calls f, replacing - a nil first argument to f with the supplied value x. Higher arity - versions can replace arguments in the second and third - positions (y, z). Note that the function f can take any number of - arguments, not just the one(s) being nil-patched." - {:added "1.2"} - ([f x] - (fn - ([a] (f (if (nil? a) x a))) - ([a b] (f (if (nil? a) x a) b)) - ([a b c] (f (if (nil? a) x a) b c)) - ([a b c & ds] (apply f (if (nil? a) x a) b c ds)))) - ([f x y] - (fn - ([a b] (f (if (nil? a) x a) (if (nil? b) y b))) - ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) c)) - ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) c ds)))) - ([f x y z] - (fn - ([a b] (f (if (nil? a) x a) (if (nil? b) y b))) - ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c))) - ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) ds))))) - -(defn- ^{:dynamic true} assert-valid-fdecl - "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn." - [fdecl] - (if-let [bad-args (seq (remove #(vector? %) (map first fdecl)))] - (throw (IllegalArgumentException. (str "Parameter declaration " (first bad-args) " should be a vector"))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/core/protocols.clj --- a/src/clojure/core/protocols.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,94 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.core.protocols) - -(defprotocol InternalReduce - "Protocol for concrete seq types that can reduce themselves - faster than first/next recursion. Called by clojure.core/reduce." - (internal-reduce [seq f start])) - -(extend-protocol InternalReduce - nil - (internal-reduce - [s f val] - val) - - ;; handles vectors and ranges - clojure.lang.IChunkedSeq - (internal-reduce - [s f val] - (if-let [s (seq s)] - (if (chunked-seq? s) - (recur (chunk-next s) - f - (.reduce (chunk-first s) f val)) - (internal-reduce s f val)) - val)) - - clojure.lang.StringSeq - (internal-reduce - [str-seq f val] - (let [s (.s str-seq)] - (loop [i (.i str-seq) - val val] - (if (< i (.length s)) - (recur (inc i) (f val (.charAt s i))) - val)))) - - clojure.lang.ArraySeq - (internal-reduce - [a-seq f val] - (let [^objects arr (.array a-seq)] - (loop [i (.index a-seq) - val val] - (if (< i (alength arr)) - (recur (inc i) (f val (aget arr i))) - val)))) - - java.lang.Object - (internal-reduce - [s f val] - (loop [cls (class s) - s s - f f - val val] - (if-let [s (seq s)] - ;; roll over to faster implementation if underlying seq changes type - (if (identical? (class s) cls) - (recur cls (next s) f (f val (first s))) - (internal-reduce s f val)) - val)))) - -(def arr-impl - '(internal-reduce - [a-seq f val] - (let [arr (.array a-seq)] - (loop [i (.index a-seq) - val val] - (if (< i (alength arr)) - (recur (inc i) (f val (aget arr i))) - val))))) - -(defn- emit-array-impls* - [syms] - (apply - concat - (map - (fn [s] - [(symbol (str "clojure.lang.ArraySeq$ArraySeq_" s)) - arr-impl]) - syms))) - -(defmacro emit-array-impls - [& syms] - `(extend-protocol InternalReduce - ~@(emit-array-impls* syms))) - -(emit-array-impls int long float double byte char boolean) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/core_deftype.clj --- a/src/clojure/core_deftype.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,769 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(in-ns 'clojure.core) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; definterface ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn namespace-munge - "Convert a Clojure namespace name to a legal Java package name." - {:added "1.2"} - [ns] - (.replace (str ns) \- \_)) - -;for now, built on gen-interface -(defmacro definterface - [name & sigs] - (let [tag (fn [x] (or (:tag (meta x)) Object)) - psig (fn [[name [& args]]] - (vector name (vec (map tag args)) (tag name) (map meta args))) - cname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name))] - `(let [] - (gen-interface :name ~cname :methods ~(vec (map psig sigs))) - (import ~cname)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; reify/deftype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- parse-opts [s] - (loop [opts {} [k v & rs :as s] s] - (if (keyword? k) - (recur (assoc opts k v) rs) - [opts s]))) - -(defn- parse-impls [specs] - (loop [ret {} s specs] - (if (seq s) - (recur (assoc ret (first s) (take-while seq? (next s))) - (drop-while seq? (next s))) - ret))) - -(defn- parse-opts+specs [opts+specs] - (let [[opts specs] (parse-opts opts+specs) - impls (parse-impls specs) - interfaces (-> (map #(if (var? (resolve %)) - (:on (deref (resolve %))) - %) - (keys impls)) - set - (disj 'Object 'java.lang.Object) - vec) - methods (map (fn [[name params & body]] - (cons name (maybe-destructured params body))) - (apply concat (vals impls)))] - (when-let [bad-opts (seq (remove #{:no-print} (keys opts)))] - (throw (IllegalArgumentException. (apply print-str "Unsupported option(s) -" bad-opts)))) - [interfaces methods opts])) - -(defmacro reify - "reify is a macro with the following structure: - - (reify options* specs*) - - Currently there are no options. - - Each spec consists of the protocol or interface name followed by zero - or more method bodies: - - protocol-or-interface-or-Object - (methodName [args+] body)* - - Methods should be supplied for all methods of the desired - protocol(s) and interface(s). You can also define overrides for - methods of Object. Note that the first parameter must be supplied to - correspond to the target object ('this' in Java parlance). Thus - methods for interfaces will take one more argument than do the - interface declarations. Note also that recur calls to the method - head should *not* pass the target object, it will be supplied - automatically and can not be substituted. - - The return type can be indicated by a type hint on the method name, - and arg types can be indicated by a type hint on arg names. If you - leave out all hints, reify will try to match on same name/arity - method in the protocol(s)/interface(s) - this is preferred. If you - supply any hints at all, no inference is done, so all hints (or - default of Object) must be correct, for both arguments and return - type. If a method is overloaded in a protocol/interface, multiple - independent method definitions must be supplied. If overloaded with - same arity in an interface you must specify complete hints to - disambiguate - a missing hint implies Object. - - recur works to method heads The method bodies of reify are lexical - closures, and can refer to the surrounding local scope: - - (str (let [f \"foo\"] - (reify Object - (toString [this] f)))) - == \"foo\" - - (seq (let [f \"foo\"] - (reify clojure.lang.Seqable - (seq [this] (seq f))))) - == (\\f \\o \\o))" - {:added "1.2"} - [& opts+specs] - (let [[interfaces methods] (parse-opts+specs opts+specs)] - (with-meta `(reify* ~interfaces ~@methods) (meta &form)))) - -(defn hash-combine [x y] - (clojure.lang.Util/hashCombine x (clojure.lang.Util/hash y))) - -(defn munge [s] - ((if (symbol? s) symbol str) (clojure.lang.Compiler/munge (str s)))) - -(defn- imap-cons - [^IPersistentMap this o] - (cond - (instance? java.util.Map$Entry o) - (let [^java.util.Map$Entry pair o] - (.assoc this (.getKey pair) (.getValue pair))) - (instance? clojure.lang.IPersistentVector o) - (let [^clojure.lang.IPersistentVector vec o] - (.assoc this (.nth vec 0) (.nth vec 1))) - :else (loop [this this - o o] - (if (seq o) - (let [^java.util.Map$Entry pair (first o)] - (recur (.assoc this (.getKey pair) (.getValue pair)) (rest o))) - this)))) - -(defn- emit-defrecord - "Do not use this directly - use defrecord" - {:added "1.2"} - [tagname name fields interfaces methods] - (let [tag (keyword (str *ns*) (str tagname)) - classname (with-meta (symbol (str *ns* "." name)) (meta name)) - interfaces (vec interfaces) - interface-set (set (map resolve interfaces)) - methodname-set (set (map first methods)) - hinted-fields fields - fields (vec (map #(with-meta % nil) fields)) - base-fields fields - fields (conj fields '__meta '__extmap)] - (when (some #{:volatile-mutable :unsynchronized-mutable} (mapcat (comp keys meta) hinted-fields)) - (throw (IllegalArgumentException. ":volatile-mutable or :unsynchronized-mutable not supported for record fields"))) - (let [gs (gensym)] - (letfn - [(eqhash [[i m]] - [i - (conj m - `(hashCode [this#] (clojure.lang.APersistentMap/mapHash this#)) - `(equals [this# ~gs] (clojure.lang.APersistentMap/mapEquals this# ~gs)))]) - (iobj [[i m]] - [(conj i 'clojure.lang.IObj) - (conj m `(meta [this#] ~'__meta) - `(withMeta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields))))]) - (ilookup [[i m]] - [(conj i 'clojure.lang.ILookup 'clojure.lang.IKeywordLookup) - (conj m `(valAt [this# k#] (.valAt this# k# nil)) - `(valAt [this# k# else#] - (case k# ~@(mapcat (fn [fld] [(keyword fld) fld]) - base-fields) - (get ~'__extmap k# else#))) - `(getLookupThunk [this# k#] - (let [~'gclass (class this#)] - (case k# - ~@(let [hinted-target (with-meta 'gtarget {:tag tagname})] - (mapcat - (fn [fld] - [(keyword fld) - `(reify clojure.lang.ILookupThunk - (get [~'thunk ~'gtarget] - (if (identical? (class ~'gtarget) ~'gclass) - (. ~hinted-target ~(keyword fld)) - ~'thunk)))]) - base-fields)) - nil))))]) - (imap [[i m]] - [(conj i 'clojure.lang.IPersistentMap) - (conj m - `(count [this#] (+ ~(count base-fields) (count ~'__extmap))) - `(empty [this#] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname))))) - `(cons [this# e#] ((var imap-cons) this# e#)) - `(equiv [this# ~gs] - (boolean - (or (identical? this# ~gs) - (when (identical? (class this#) (class ~gs)) - (let [~gs ~(with-meta gs {:tag tagname})] - (and ~@(map (fn [fld] `(= ~fld (. ~gs ~fld))) base-fields) - (= ~'__extmap (. ~gs ~'__extmap)))))))) - `(containsKey [this# k#] (not (identical? this# (.valAt this# k# this#)))) - `(entryAt [this# k#] (let [v# (.valAt this# k# this#)] - (when-not (identical? this# v#) - (clojure.lang.MapEntry. k# v#)))) - `(seq [this#] (seq (concat [~@(map #(list `new `clojure.lang.MapEntry (keyword %) %) base-fields)] - ~'__extmap))) - `(assoc [this# k# ~gs] - (condp identical? k# - ~@(mapcat (fn [fld] - [(keyword fld) (list* `new tagname (replace {fld gs} fields))]) - base-fields) - (new ~tagname ~@(remove #{'__extmap} fields) (assoc ~'__extmap k# ~gs)))) - `(without [this# k#] (if (contains? #{~@(map keyword base-fields)} k#) - (dissoc (with-meta (into {} this#) ~'__meta) k#) - (new ~tagname ~@(remove #{'__extmap} fields) - (not-empty (dissoc ~'__extmap k#))))))]) - (ijavamap [[i m]] - [(conj i 'java.util.Map 'java.io.Serializable) - (conj m - `(size [this#] (.count this#)) - `(isEmpty [this#] (= 0 (.count this#))) - `(containsValue [this# v#] (boolean (some #{v#} (vals this#)))) - `(get [this# k#] (.valAt this# k#)) - `(put [this# k# v#] (throw (UnsupportedOperationException.))) - `(remove [this# k#] (throw (UnsupportedOperationException.))) - `(putAll [this# m#] (throw (UnsupportedOperationException.))) - `(clear [this#] (throw (UnsupportedOperationException.))) - `(keySet [this#] (set (keys this#))) - `(values [this#] (vals this#)) - `(entrySet [this#] (set this#)))]) - ] - (let [[i m] (-> [interfaces methods] eqhash iobj ilookup imap ijavamap)] - `(deftype* ~tagname ~classname ~(conj hinted-fields '__meta '__extmap) - :implements ~(vec i) - ~@m)))))) - -(defmacro defrecord - "Alpha - subject to change - - (defrecord name [fields*] options* specs*) - - Currently there are no options. - - Each spec consists of a protocol or interface name followed by zero - or more method bodies: - - protocol-or-interface-or-Object - (methodName [args*] body)* - - Dynamically generates compiled bytecode for class with the given - name, in a package with the same name as the current namespace, the - given fields, and, optionally, methods for protocols and/or - interfaces. - - The class will have the (immutable) fields named by - fields, which can have type hints. Protocols/interfaces and methods - are optional. The only methods that can be supplied are those - declared in the protocols/interfaces. Note that method bodies are - not closures, the local environment includes only the named fields, - and those fields can be accessed directy. - - Method definitions take the form: - - (methodname [args*] body) - - The argument and return types can be hinted on the arg and - methodname symbols. If not supplied, they will be inferred, so type - hints should be reserved for disambiguation. - - Methods should be supplied for all methods of the desired - protocol(s) and interface(s). You can also define overrides for - methods of Object. Note that a parameter must be supplied to - correspond to the target object ('this' in Java parlance). Thus - methods for interfaces will take one more argument than do the - interface declarations. Note also that recur calls to the method - head should *not* pass the target object, it will be supplied - automatically and can not be substituted. - - In the method bodies, the (unqualified) name can be used to name the - class (for calls to new, instance? etc). - - The class will have implementations of several (clojure.lang) - interfaces generated automatically: IObj (metadata support) and - IPersistentMap, and all of their superinterfaces. - - In addition, defrecord will define type-and-value-based equality and - hashCode. - - When AOT compiling, generates compiled bytecode for a class with the - given name (a symbol), prepends the current ns as the package, and - writes the .class file to the *compile-path* directory. - - Two constructors will be defined, one taking the designated fields - followed by a metadata map (nil for none) and an extension field - map (nil for none), and one taking only the fields (using nil for - meta and extension fields)." - {:added "1.2"} - - [name [& fields] & opts+specs] - (let [gname name - [interfaces methods opts] (parse-opts+specs opts+specs) - classname (symbol (str *ns* "." gname)) - tag (keyword (str *ns*) (str name)) - hinted-fields fields - fields (vec (map #(with-meta % nil) fields))] - `(let [] - ~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods) - (defmethod print-method ~classname [o# w#] - ((var print-defrecord) o# w#)) - (import ~classname) - #_(defn ~name - ([~@fields] (new ~classname ~@fields nil nil)) - ([~@fields meta# extmap#] (new ~classname ~@fields meta# extmap#)))))) - -(defn- print-defrecord [o ^Writer w] - (print-meta o w) - (.write w "#:") - (.write w (.getName (class o))) - (print-map - o - pr-on w)) - -(defn- emit-deftype* - "Do not use this directly - use deftype" - [tagname name fields interfaces methods] - (let [classname (with-meta (symbol (str *ns* "." name)) (meta name))] - `(deftype* ~tagname ~classname ~fields - :implements ~interfaces - ~@methods))) - -(defmacro deftype - "Alpha - subject to change - - (deftype name [fields*] options* specs*) - - Currently there are no options. - - Each spec consists of a protocol or interface name followed by zero - or more method bodies: - - protocol-or-interface-or-Object - (methodName [args*] body)* - - Dynamically generates compiled bytecode for class with the given - name, in a package with the same name as the current namespace, the - given fields, and, optionally, methods for protocols and/or - interfaces. - - The class will have the (by default, immutable) fields named by - fields, which can have type hints. Protocols/interfaces and methods - are optional. The only methods that can be supplied are those - declared in the protocols/interfaces. Note that method bodies are - not closures, the local environment includes only the named fields, - and those fields can be accessed directy. Fields can be qualified - with the metadata :volatile-mutable true or :unsynchronized-mutable - true, at which point (set! afield aval) will be supported in method - bodies. Note well that mutable fields are extremely difficult to use - correctly, and are present only to facilitate the building of higher - level constructs, such as Clojure's reference types, in Clojure - itself. They are for experts only - if the semantics and - implications of :volatile-mutable or :unsynchronized-mutable are not - immediately apparent to you, you should not be using them. - - Method definitions take the form: - - (methodname [args*] body) - - The argument and return types can be hinted on the arg and - methodname symbols. If not supplied, they will be inferred, so type - hints should be reserved for disambiguation. - - Methods should be supplied for all methods of the desired - protocol(s) and interface(s). You can also define overrides for - methods of Object. Note that a parameter must be supplied to - correspond to the target object ('this' in Java parlance). Thus - methods for interfaces will take one more argument than do the - interface declarations. Note also that recur calls to the method - head should *not* pass the target object, it will be supplied - automatically and can not be substituted. - - In the method bodies, the (unqualified) name can be used to name the - class (for calls to new, instance? etc). - - When AOT compiling, generates compiled bytecode for a class with the - given name (a symbol), prepends the current ns as the package, and - writes the .class file to the *compile-path* directory. - - One constructors will be defined, taking the designated fields." - {:added "1.2"} - - [name [& fields] & opts+specs] - (let [gname name - [interfaces methods opts] (parse-opts+specs opts+specs) - classname (symbol (str *ns* "." gname)) - tag (keyword (str *ns*) (str name)) - hinted-fields fields - fields (vec (map #(with-meta % nil) fields))] - `(let [] - ~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods) - (import ~classname)))) - - - - -;;;;;;;;;;;;;;;;;;;;;;; protocols ;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- expand-method-impl-cache [^clojure.lang.MethodImplCache cache c f] - (let [cs (into {} (remove (fn [[c e]] (nil? e)) (map vec (partition 2 (.table cache))))) - cs (assoc cs c (clojure.lang.MethodImplCache$Entry. c f)) - [shift mask] (min-hash (keys cs)) - table (make-array Object (* 2 (inc mask))) - table (reduce (fn [^objects t [c e]] - (let [i (* 2 (int (shift-mask shift mask (hash c))))] - (aset t i c) - (aset t (inc i) e) - t)) - table cs)] - (clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) shift mask table))) - -(defn- super-chain [^Class c] - (when c - (cons c (super-chain (.getSuperclass c))))) - -(defn- pref - ([] nil) - ([a] a) - ([^Class a ^Class b] - (if (.isAssignableFrom a b) b a))) - -(defn find-protocol-impl [protocol x] - (if (instance? (:on-interface protocol) x) - x - (let [c (class x) - impl #(get (:impls protocol) %)] - (or (impl c) - (and c (or (first (remove nil? (map impl (butlast (super-chain c))))) - (when-let [t (reduce pref (filter impl (disj (supers c) Object)))] - (impl t)) - (impl Object))))))) - -(defn find-protocol-method [protocol methodk x] - (get (find-protocol-impl protocol x) methodk)) - -(defn- protocol? - [maybe-p] - (boolean (:on-interface maybe-p))) - -(defn- implements? [protocol atype] - (and atype (.isAssignableFrom ^Class (:on-interface protocol) atype))) - -(defn extends? - "Returns true if atype extends protocol" - {:added "1.2"} - [protocol atype] - (boolean (or (implements? protocol atype) - (get (:impls protocol) atype)))) - -(defn extenders - "Returns a collection of the types explicitly extending protocol" - {:added "1.2"} - [protocol] - (keys (:impls protocol))) - -(defn satisfies? - "Returns true if x satisfies the protocol" - {:added "1.2"} - [protocol x] - (boolean (find-protocol-impl protocol x))) - -(defn -cache-protocol-fn [^clojure.lang.AFunction pf x ^Class c ^clojure.lang.IFn interf] - (let [cache (.__methodImplCache pf) - f (if (.isInstance c x) - interf - (find-protocol-method (.protocol cache) (.methodk cache) x))] - (when-not f - (throw (IllegalArgumentException. (str "No implementation of method: " (.methodk cache) - " of protocol: " (:var (.protocol cache)) - " found for class: " (if (nil? x) "nil" (.getName (class x))))))) - (set! (.__methodImplCache pf) (expand-method-impl-cache cache (class x) f)) - f)) - -(defn- emit-method-builder [on-interface method on-method arglists] - (let [methodk (keyword method) - gthis (with-meta (gensym) {:tag 'clojure.lang.AFunction}) - ginterf (gensym)] - `(fn [cache#] - (let [~ginterf - (fn - ~@(map - (fn [args] - (let [gargs (map #(gensym (str "gf__" % "__")) args) - target (first gargs)] - `([~@gargs] - (. ~(with-meta target {:tag on-interface}) ~(or on-method method) ~@(rest gargs))))) - arglists)) - ^clojure.lang.AFunction f# - (fn ~gthis - ~@(map - (fn [args] - (let [gargs (map #(gensym (str "gf__" % "__")) args) - target (first gargs)] - `([~@gargs] - (let [cache# (.__methodImplCache ~gthis) - f# (.fnFor cache# (clojure.lang.Util/classOf ~target))] - (if f# - (f# ~@gargs) - ((-cache-protocol-fn ~gthis ~target ~on-interface ~ginterf) ~@gargs)))))) - arglists))] - (set! (.__methodImplCache f#) cache#) - f#)))) - -(defn -reset-methods [protocol] - (doseq [[^clojure.lang.Var v build] (:method-builders protocol)] - (let [cache (clojure.lang.MethodImplCache. protocol (keyword (.sym v)))] - (.bindRoot v (build cache))))) - -(defn- assert-same-protocol [protocol-var method-syms] - (doseq [m method-syms] - (let [v (resolve m) - p (:protocol (meta v))] - (when (and v (bound? v) (not= protocol-var p)) - (binding [*out* *err*] - (println "Warning: protocol" protocol-var "is overwriting" - (if p - (str "method " (.sym v) " of protocol " (.sym p)) - (str "function " (.sym v))))))))) - -(defn- emit-protocol [name opts+sigs] - (let [iname (symbol (str (munge *ns*) "." (munge name))) - [opts sigs] - (loop [opts {:on (list 'quote iname) :on-interface iname} sigs opts+sigs] - (condp #(%1 %2) (first sigs) - string? (recur (assoc opts :doc (first sigs)) (next sigs)) - keyword? (recur (assoc opts (first sigs) (second sigs)) (nnext sigs)) - [opts sigs])) - sigs (reduce (fn [m s] - (let [name-meta (meta (first s)) - mname (with-meta (first s) nil) - [arglists doc] - (loop [as [] rs (rest s)] - (if (vector? (first rs)) - (recur (conj as (first rs)) (next rs)) - [(seq as) (first rs)]))] - (when (some #{0} (map count arglists)) - (throw (IllegalArgumentException. (str "Protocol fn: " mname " must take at least one arg")))) - (assoc m (keyword mname) - (merge name-meta - {:name (vary-meta mname assoc :doc doc :arglists arglists) - :arglists arglists - :doc doc})))) - {} sigs) - meths (mapcat (fn [sig] - (let [m (munge (:name sig))] - (map #(vector m (vec (repeat (dec (count %))'Object)) 'Object) - (:arglists sig)))) - (vals sigs))] - `(do - (defonce ~name {}) - (gen-interface :name ~iname :methods ~meths) - (alter-meta! (var ~name) assoc :doc ~(:doc opts)) - (#'assert-same-protocol (var ~name) '~(map :name (vals sigs))) - (alter-var-root (var ~name) merge - (assoc ~opts - :sigs '~sigs - :var (var ~name) - :method-map - ~(and (:on opts) - (apply hash-map - (mapcat - (fn [s] - [(keyword (:name s)) (keyword (or (:on s) (:name s)))]) - (vals sigs)))) - :method-builders - ~(apply hash-map - (mapcat - (fn [s] - [`(intern *ns* (with-meta '~(:name s) (merge '~s {:protocol (var ~name)}))) - (emit-method-builder (:on-interface opts) (:name s) (:on s) (:arglists s))]) - (vals sigs))))) - (-reset-methods ~name) - '~name))) - -(defmacro defprotocol - "A protocol is a named set of named methods and their signatures: - (defprotocol AProtocolName - - ;optional doc string - \"A doc string for AProtocol abstraction\" - - ;method signatures - (bar [this a b] \"bar docs\") - (baz [this a] [this a b] [this a b c] \"baz docs\")) - - No implementations are provided. Docs can be specified for the - protocol overall and for each method. The above yields a set of - polymorphic functions and a protocol object. All are - namespace-qualified by the ns enclosing the definition The resulting - functions dispatch on the type of their first argument, which is - required and corresponds to the implicit target object ('this' in - Java parlance). defprotocol is dynamic, has no special compile-time - effect, and defines no new types or classes. Implementations of - the protocol methods can be provided using extend. - - defprotocol will automatically generate a corresponding interface, - with the same name as the protocol, i.e. given a protocol: - my.ns/Protocol, an interface: my.ns.Protocol. The interface will - have methods corresponding to the protocol functions, and the - protocol will automatically work with instances of the interface. - - Note that you should not use this interface with deftype or - reify, as they support the protocol directly: - - (defprotocol P - (foo [this]) - (bar-me [this] [this y])) - - (deftype Foo [a b c] - P - (foo [this] a) - (bar-me [this] b) - (bar-me [this y] (+ c y))) - - (bar-me (Foo. 1 2 3) 42) - => 45 - - (foo - (let [x 42] - (reify P - (foo [this] 17) - (bar-me [this] x) - (bar-me [this y] x)))) - => 17" - {:added "1.2"} - [name & opts+sigs] - (emit-protocol name opts+sigs)) - -(defn extend - "Implementations of protocol methods can be provided using the extend construct: - - (extend AType - AProtocol - {:foo an-existing-fn - :bar (fn [a b] ...) - :baz (fn ([a]...) ([a b] ...)...)} - BProtocol - {...} - ...) - - extend takes a type/class (or interface, see below), and one or more - protocol + method map pairs. It will extend the polymorphism of the - protocol's methods to call the supplied methods when an AType is - provided as the first argument. - - Method maps are maps of the keyword-ized method names to ordinary - fns. This facilitates easy reuse of existing fns and fn maps, for - code reuse/mixins without derivation or composition. You can extend - an interface to a protocol. This is primarily to facilitate interop - with the host (e.g. Java) but opens the door to incidental multiple - inheritance of implementation since a class can inherit from more - than one interface, both of which extend the protocol. It is TBD how - to specify which impl to use. You can extend a protocol on nil. - - If you are supplying the definitions explicitly (i.e. not reusing - exsting functions or mixin maps), you may find it more convenient to - use the extend-type or extend-protocol macros. - - Note that multiple independent extend clauses can exist for the same - type, not all protocols need be defined in a single extend call. - - See also: - extends?, satisfies?, extenders" - {:added "1.2"} - [atype & proto+mmaps] - (doseq [[proto mmap] (partition 2 proto+mmaps)] - (when-not (protocol? proto) - (throw (IllegalArgumentException. - (str proto " is not a protocol")))) - (when (implements? proto atype) - (throw (IllegalArgumentException. - (str atype " already directly implements " (:on-interface proto) " for protocol:" - (:var proto))))) - (-reset-methods (alter-var-root (:var proto) assoc-in [:impls atype] mmap)))) - -(defn- emit-impl [[p fs]] - [p (zipmap (map #(-> % first keyword) fs) - (map #(cons 'fn (drop 1 %)) fs))]) - -(defn- emit-hinted-impl [c [p fs]] - (let [hint (fn [specs] - (let [specs (if (vector? (first specs)) - (list specs) - specs)] - (map (fn [[[target & args] & body]] - (cons (apply vector (vary-meta target assoc :tag c) args) - body)) - specs)))] - [p (zipmap (map #(-> % first keyword) fs) - (map #(cons 'fn (hint (drop 1 %))) fs))])) - -(defn- emit-extend-type [c specs] - (let [impls (parse-impls specs)] - `(extend ~c - ~@(mapcat (partial emit-hinted-impl c) impls)))) - -(defmacro extend-type - "A macro that expands into an extend call. Useful when you are - supplying the definitions explicitly inline, extend-type - automatically creates the maps required by extend. Propagates the - class as a type hint on the first argument of all fns. - - (extend-type MyType - Countable - (cnt [c] ...) - Foo - (bar [x y] ...) - (baz ([x] ...) ([x y & zs] ...))) - - expands into: - - (extend MyType - Countable - {:cnt (fn [c] ...)} - Foo - {:baz (fn ([x] ...) ([x y & zs] ...)) - :bar (fn [x y] ...)})" - {:added "1.2"} - [t & specs] - (emit-extend-type t specs)) - -(defn- emit-extend-protocol [p specs] - (let [impls (parse-impls specs)] - `(do - ~@(map (fn [[t fs]] - `(extend-type ~t ~p ~@fs)) - impls)))) - -(defmacro extend-protocol - "Useful when you want to provide several implementations of the same - protocol all at once. Takes a single protocol and the implementation - of that protocol for one or more types. Expands into calls to - extend-type: - - (extend-protocol Protocol - AType - (foo [x] ...) - (bar [x y] ...) - BType - (foo [x] ...) - (bar [x y] ...) - AClass - (foo [x] ...) - (bar [x y] ...) - nil - (foo [x] ...) - (bar [x y] ...)) - - expands into: - - (do - (clojure.core/extend-type AType Protocol - (foo [x] ...) - (bar [x y] ...)) - (clojure.core/extend-type BType Protocol - (foo [x] ...) - (bar [x y] ...)) - (clojure.core/extend-type AClass Protocol - (foo [x] ...) - (bar [x y] ...)) - (clojure.core/extend-type nil Protocol - (foo [x] ...) - (bar [x y] ...)))" - {:added "1.2"} - - [p & specs] - (emit-extend-protocol p specs)) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/core_print.clj --- a/src/clojure/core_print.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,320 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(in-ns 'clojure.core) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(import '(java.io Writer)) - -(def - ^{:doc "*print-length* controls how many items of each collection the - printer will print. If it is bound to logical false, there is no - limit. Otherwise, it must be bound to an integer indicating the maximum - number of items of each collection to print. If a collection contains - more items, the printer will print items up to the limit followed by - '...' to represent the remaining items. The root binding is nil - indicating no limit." - :added "1.0"} - *print-length* nil) - -(def - ^{:doc "*print-level* controls how many levels deep the printer will - print nested objects. If it is bound to logical false, there is no - limit. Otherwise, it must be bound to an integer indicating the maximum - level to print. Each argument to print is at level 0; if an argument is a - collection, its items are at level 1; and so on. If an object is a - collection and is at a level greater than or equal to the value bound to - *print-level*, the printer prints '#' to represent it. The root binding - is nil indicating no limit." - :added "1.0"} -*print-level* nil) - -(defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w] - (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))] - (if (and *print-level* (neg? *print-level*)) - (.write w "#") - (do - (.write w begin) - (when-let [xs (seq sequence)] - (if (and (not *print-dup*) *print-length*) - (loop [[x & xs] xs - print-length *print-length*] - (if (zero? print-length) - (.write w "...") - (do - (print-one x w) - (when xs - (.write w sep) - (recur xs (dec print-length)))))) - (loop [[x & xs] xs] - (print-one x w) - (when xs - (.write w sep) - (recur xs))))) - (.write w end))))) - -(defn- print-meta [o, ^Writer w] - (when-let [m (meta o)] - (when (and (pos? (count m)) - (or *print-dup* - (and *print-meta* *print-readably*))) - (.write w "^") - (if (and (= (count m) 1) (:tag m)) - (pr-on (:tag m) w) - (pr-on m w)) - (.write w " ")))) - -(defmethod print-method :default [o, ^Writer w] - (print-method (vary-meta o #(dissoc % :type)) w)) - -(defmethod print-method nil [o, ^Writer w] - (.write w "nil")) - -(defmethod print-dup nil [o w] (print-method o w)) - -(defn print-ctor [o print-args ^Writer w] - (.write w "#=(") - (.write w (.getName ^Class (class o))) - (.write w ". ") - (print-args o w) - (.write w ")")) - -(defmethod print-method Object [o, ^Writer w] - (.write w "#<") - (.write w (.getSimpleName (class o))) - (.write w " ") - (.write w (str o)) - (.write w ">")) - -(defmethod print-method clojure.lang.Keyword [o, ^Writer w] - (.write w (str o))) - -(defmethod print-dup clojure.lang.Keyword [o w] (print-method o w)) - -(defmethod print-method Number [o, ^Writer w] - (.write w (str o))) - -(defmethod print-dup Number [o, ^Writer w] - (print-ctor o - (fn [o w] - (print-dup (str o) w)) - w)) - -(defmethod print-dup clojure.lang.Fn [o, ^Writer w] - (print-ctor o (fn [o w]) w)) - -(prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.Fn) -(prefer-method print-dup java.util.Map clojure.lang.Fn) -(prefer-method print-dup java.util.Collection clojure.lang.Fn) - -(defmethod print-method Boolean [o, ^Writer w] - (.write w (str o))) - -(defmethod print-dup Boolean [o w] (print-method o w)) - -(defn print-simple [o, ^Writer w] - (print-meta o w) - (.write w (str o))) - -(defmethod print-method clojure.lang.Symbol [o, ^Writer w] - (print-simple o w)) - -(defmethod print-dup clojure.lang.Symbol [o w] (print-method o w)) - -(defmethod print-method clojure.lang.Var [o, ^Writer w] - (print-simple o w)) - -(defmethod print-dup clojure.lang.Var [^clojure.lang.Var o, ^Writer w] - (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")"))) - -(defmethod print-method clojure.lang.ISeq [o, ^Writer w] - (print-meta o w) - (print-sequential "(" pr-on " " ")" o w)) - -(defmethod print-dup clojure.lang.ISeq [o w] (print-method o w)) -(defmethod print-dup clojure.lang.IPersistentList [o w] (print-method o w)) -(prefer-method print-method clojure.lang.ISeq clojure.lang.IPersistentCollection) -(prefer-method print-dup clojure.lang.ISeq clojure.lang.IPersistentCollection) -(prefer-method print-method clojure.lang.ISeq java.util.Collection) -(prefer-method print-dup clojure.lang.ISeq java.util.Collection) - - - -(defmethod print-dup java.util.Collection [o, ^Writer w] - (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w)) - -(defmethod print-dup clojure.lang.IPersistentCollection [o, ^Writer w] - (print-meta o w) - (.write w "#=(") - (.write w (.getName ^Class (class o))) - (.write w "/create ") - (print-sequential "[" print-dup " " "]" o w) - (.write w ")")) - -(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection) - -(def ^{:tag String - :doc "Returns escape string for char or nil if none" - :added "1.0"} - char-escape-string - {\newline "\\n" - \tab "\\t" - \return "\\r" - \" "\\\"" - \\ "\\\\" - \formfeed "\\f" - \backspace "\\b"}) - -(defmethod print-method String [^String s, ^Writer w] - (if (or *print-dup* *print-readably*) - (do (.append w \") - (dotimes [n (count s)] - (let [c (.charAt s n) - e (char-escape-string c)] - (if e (.write w e) (.append w c)))) - (.append w \")) - (.write w s)) - nil) - -(defmethod print-dup String [s w] (print-method s w)) - -(defmethod print-method clojure.lang.IPersistentVector [v, ^Writer w] - (print-meta v w) - (print-sequential "[" pr-on " " "]" v w)) - -(defn- print-map [m print-one w] - (print-sequential - "{" - (fn [e ^Writer w] - (do (print-one (key e) w) (.append w \space) (print-one (val e) w))) - ", " - "}" - (seq m) w)) - -(defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w] - (print-meta m w) - (print-map m pr-on w)) - -(defmethod print-dup java.util.Map [m, ^Writer w] - (print-ctor m #(print-map (seq %1) print-dup %2) w)) - -(defmethod print-dup clojure.lang.IPersistentMap [m, ^Writer w] - (print-meta m w) - (.write w "#=(") - (.write w (.getName (class m))) - (.write w "/create ") - (print-map m print-dup w) - (.write w ")")) - -(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map) - -(defmethod print-method clojure.lang.IPersistentSet [s, ^Writer w] - (print-meta s w) - (print-sequential "#{" pr-on " " "}" (seq s) w)) - -(def ^{:tag String - :doc "Returns name string for char or nil if none" - :added "1.0"} - char-name-string - {\newline "newline" - \tab "tab" - \space "space" - \backspace "backspace" - \formfeed "formfeed" - \return "return"}) - -(defmethod print-method java.lang.Character [^Character c, ^Writer w] - (if (or *print-dup* *print-readably*) - (do (.append w \\) - (let [n (char-name-string c)] - (if n (.write w n) (.append w c)))) - (.append w c)) - nil) - -(defmethod print-dup java.lang.Character [c w] (print-method c w)) -(defmethod print-dup java.lang.Integer [o w] (print-method o w)) -(defmethod print-dup java.lang.Double [o w] (print-method o w)) -(defmethod print-dup clojure.lang.Ratio [o w] (print-method o w)) -(defmethod print-dup java.math.BigDecimal [o w] (print-method o w)) -(defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w)) -(defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w)) -(defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w)) -(defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w)) - -(def primitives-classnames - {Float/TYPE "Float/TYPE" - Integer/TYPE "Integer/TYPE" - Long/TYPE "Long/TYPE" - Boolean/TYPE "Boolean/TYPE" - Character/TYPE "Character/TYPE" - Double/TYPE "Double/TYPE" - Byte/TYPE "Byte/TYPE" - Short/TYPE "Short/TYPE"}) - -(defmethod print-method Class [^Class c, ^Writer w] - (.write w (.getName c))) - -(defmethod print-dup Class [^Class c, ^Writer w] - (cond - (.isPrimitive c) (do - (.write w "#=(identity ") - (.write w ^String (primitives-classnames c)) - (.write w ")")) - (.isArray c) (do - (.write w "#=(java.lang.Class/forName \"") - (.write w (.getName c)) - (.write w "\")")) - :else (do - (.write w "#=") - (.write w (.getName c))))) - -(defmethod print-method java.math.BigDecimal [b, ^Writer w] - (.write w (str b)) - (.write w "M")) - -(defmethod print-method java.util.regex.Pattern [p ^Writer w] - (.write w "#\"") - (loop [[^Character c & r :as s] (seq (.pattern ^java.util.regex.Pattern p)) - qmode false] - (when s - (cond - (= c \\) (let [[^Character c2 & r2] r] - (.append w \\) - (.append w c2) - (if qmode - (recur r2 (not= c2 \E)) - (recur r2 (= c2 \Q)))) - (= c \") (do - (if qmode - (.write w "\\E\\\"\\Q") - (.write w "\\\"")) - (recur r qmode)) - :else (do - (.append w c) - (recur r qmode))))) - (.append w \")) - -(defmethod print-dup java.util.regex.Pattern [p ^Writer w] (print-method p w)) - -(defmethod print-dup clojure.lang.Namespace [^clojure.lang.Namespace n ^Writer w] - (.write w "#=(find-ns ") - (print-dup (.name n) w) - (.write w ")")) - -(defmethod print-method clojure.lang.IDeref [o ^Writer w] - (print-sequential (format "#<%s@%x%s: " - (.getSimpleName (class o)) - (System/identityHashCode o) - (if (and (instance? clojure.lang.Agent o) - (agent-error o)) - " FAILED" - "")) - pr-on, "", ">", (list (if (and (future? o) (not (future-done? o))) :pending @o)), w)) - -(def ^{:private true} print-initialized true) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/core_proxy.clj --- a/src/clojure/core_proxy.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,407 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(in-ns 'clojure.core) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; proxy ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(import - '(clojure.asm ClassWriter ClassVisitor Opcodes Type) - '(java.lang.reflect Modifier Constructor) - '(clojure.asm.commons Method GeneratorAdapter) - '(clojure.lang IProxy Reflector DynamicClassLoader IPersistentMap PersistentHashMap RT)) - -(defn method-sig [^java.lang.reflect.Method meth] - [(. meth (getName)) (seq (. meth (getParameterTypes))) (. meth getReturnType)]) - -(defn- most-specific [rtypes] - (or (some (fn [t] (when (every? #(isa? t %) rtypes) t)) rtypes) - (throw (Exception. "Incompatible return types")))) - -(defn- group-by-sig [coll] - "takes a collection of [msig meth] and returns a seq of maps from return-types to meths." - (vals (reduce (fn [m [msig meth]] - (let [rtype (peek msig) - argsig (pop msig)] - (assoc m argsig (assoc (m argsig {}) rtype meth)))) - {} coll))) - -(defn proxy-name - {:tag String} - [^Class super interfaces] - (let [inames (into (sorted-set) (map #(.getName ^Class %) interfaces))] - (apply str (.replace (str *ns*) \- \_) ".proxy" - (interleave (repeat "$") - (concat - [(.getName super)] - (map #(subs % (inc (.lastIndexOf ^String % "."))) inames) - [(Integer/toHexString (hash inames))]))))) - -(defn- generate-proxy [^Class super interfaces] - (let [cv (new ClassWriter (. ClassWriter COMPUTE_MAXS)) - cname (.replace (proxy-name super interfaces) \. \/) ;(str "clojure/lang/" (gensym "Proxy__")) - ctype (. Type (getObjectType cname)) - iname (fn [^Class c] (.. Type (getType c) (getInternalName))) - fmap "__clojureFnMap" - totype (fn [^Class c] (. Type (getType c))) - to-types (fn [cs] (if (pos? (count cs)) - (into-array (map totype cs)) - (make-array Type 0))) - super-type ^Type (totype super) - imap-type ^Type (totype IPersistentMap) - ifn-type (totype clojure.lang.IFn) - obj-type (totype Object) - sym-type (totype clojure.lang.Symbol) - rt-type (totype clojure.lang.RT) - ex-type (totype java.lang.UnsupportedOperationException) - gen-bridge - (fn [^java.lang.reflect.Method meth ^java.lang.reflect.Method dest] - (let [pclasses (. meth (getParameterTypes)) - ptypes (to-types pclasses) - rtype ^Type (totype (. meth (getReturnType))) - m (new Method (. meth (getName)) rtype ptypes) - dtype (totype (.getDeclaringClass dest)) - dm (new Method (. dest (getName)) (totype (. dest (getReturnType))) (to-types (. dest (getParameterTypes)))) - gen (new GeneratorAdapter (bit-or (. Opcodes ACC_PUBLIC) (. Opcodes ACC_BRIDGE)) m nil nil cv)] - (. gen (visitCode)) - (. gen (loadThis)) - (dotimes [i (count ptypes)] - (. gen (loadArg i))) - (if (-> dest .getDeclaringClass .isInterface) - (. gen (invokeInterface dtype dm)) - (. gen (invokeVirtual dtype dm))) - (. gen (returnValue)) - (. gen (endMethod)))) - gen-method - (fn [^java.lang.reflect.Method meth else-gen] - (let [pclasses (. meth (getParameterTypes)) - ptypes (to-types pclasses) - rtype ^Type (totype (. meth (getReturnType))) - m (new Method (. meth (getName)) rtype ptypes) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv) - else-label (. gen (newLabel)) - end-label (. gen (newLabel)) - decl-type (. Type (getType (. meth (getDeclaringClass))))] - (. gen (visitCode)) - (if (> (count pclasses) 18) - (else-gen gen m) - (do - (. gen (loadThis)) - (. gen (getField ctype fmap imap-type)) - - (. gen (push (. meth (getName)))) - ;lookup fn in map - (. gen (invokeStatic rt-type (. Method (getMethod "Object get(Object, Object)")))) - (. gen (dup)) - (. gen (ifNull else-label)) - ;if found - (.checkCast gen ifn-type) - (. gen (loadThis)) - ;box args - (dotimes [i (count ptypes)] - (. gen (loadArg i)) - (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i)))) - ;call fn - (. gen (invokeInterface ifn-type (new Method "invoke" obj-type - (into-array (cons obj-type - (replicate (count ptypes) obj-type)))))) - ;unbox return - (. gen (unbox rtype)) - (when (= (. rtype (getSort)) (. Type VOID)) - (. gen (pop))) - (. gen (goTo end-label)) - - ;else call supplied alternative generator - (. gen (mark else-label)) - (. gen (pop)) - - (else-gen gen m) - - (. gen (mark end-label)))) - (. gen (returnValue)) - (. gen (endMethod))))] - - ;start class definition - (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER)) - cname nil (iname super) - (into-array (map iname (cons IProxy interfaces))))) - ;add field for fn mappings - (. cv (visitField (+ (. Opcodes ACC_PRIVATE) (. Opcodes ACC_VOLATILE)) - fmap (. imap-type (getDescriptor)) nil nil)) - ;add ctors matching/calling super's - (doseq [^Constructor ctor (. super (getDeclaredConstructors))] - (when-not (. Modifier (isPrivate (. ctor (getModifiers)))) - (let [ptypes (to-types (. ctor (getParameterTypes))) - m (new Method "" (. Type VOID_TYPE) ptypes) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] - (. gen (visitCode)) - ;call super ctor - (. gen (loadThis)) - (. gen (dup)) - (. gen (loadArgs)) - (. gen (invokeConstructor super-type m)) - - (. gen (returnValue)) - (. gen (endMethod))))) - ;add IProxy methods - (let [m (. Method (getMethod "void __initClojureFnMappings(clojure.lang.IPersistentMap)")) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] - (. gen (visitCode)) - (. gen (loadThis)) - (. gen (loadArgs)) - (. gen (putField ctype fmap imap-type)) - - (. gen (returnValue)) - (. gen (endMethod))) - (let [m (. Method (getMethod "void __updateClojureFnMappings(clojure.lang.IPersistentMap)")) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] - (. gen (visitCode)) - (. gen (loadThis)) - (. gen (dup)) - (. gen (getField ctype fmap imap-type)) - (.checkCast gen (totype clojure.lang.IPersistentCollection)) - (. gen (loadArgs)) - (. gen (invokeInterface (totype clojure.lang.IPersistentCollection) - (. Method (getMethod "clojure.lang.IPersistentCollection cons(Object)")))) - (. gen (checkCast imap-type)) - (. gen (putField ctype fmap imap-type)) - - (. gen (returnValue)) - (. gen (endMethod))) - (let [m (. Method (getMethod "clojure.lang.IPersistentMap __getClojureFnMappings()")) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] - (. gen (visitCode)) - (. gen (loadThis)) - (. gen (getField ctype fmap imap-type)) - (. gen (returnValue)) - (. gen (endMethod))) - - ;calc set of supers' non-private instance methods - (let [[mm considered] - (loop [mm {} considered #{} c super] - (if c - (let [[mm considered] - (loop [mm mm - considered considered - meths (concat - (seq (. c (getDeclaredMethods))) - (seq (. c (getMethods))))] - (if (seq meths) - (let [^java.lang.reflect.Method meth (first meths) - mods (. meth (getModifiers)) - mk (method-sig meth)] - (if (or (considered mk) - (not (or (Modifier/isPublic mods) (Modifier/isProtected mods))) - ;(. Modifier (isPrivate mods)) - (. Modifier (isStatic mods)) - (. Modifier (isFinal mods)) - (= "finalize" (.getName meth))) - (recur mm (conj considered mk) (next meths)) - (recur (assoc mm mk meth) (conj considered mk) (next meths)))) - [mm considered]))] - (recur mm considered (. c (getSuperclass)))) - [mm considered])) - ifaces-meths (into {} - (for [^Class iface interfaces meth (. iface (getMethods)) - :let [msig (method-sig meth)] :when (not (considered msig))] - {msig meth})) - mgroups (group-by-sig (concat mm ifaces-meths)) - rtypes (map #(most-specific (keys %)) mgroups) - mb (map #(vector (%1 %2) (vals (dissoc %1 %2))) mgroups rtypes) - bridge? (reduce into #{} (map second mb)) - ifaces-meths (remove bridge? (vals ifaces-meths)) - mm (remove bridge? (vals mm))] - ;add methods matching supers', if no mapping -> call super - (doseq [[^java.lang.reflect.Method dest bridges] mb - ^java.lang.reflect.Method meth bridges] - (gen-bridge meth dest)) - (doseq [^java.lang.reflect.Method meth mm] - (gen-method meth - (fn [^GeneratorAdapter gen ^Method m] - (. gen (loadThis)) - ;push args - (. gen (loadArgs)) - ;call super - (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) - (. super-type (getInternalName)) - (. m (getName)) - (. m (getDescriptor))))))) - - ;add methods matching interfaces', if no mapping -> throw - (doseq [^java.lang.reflect.Method meth ifaces-meths] - (gen-method meth - (fn [^GeneratorAdapter gen ^Method m] - (. gen (throwException ex-type (. m (getName)))))))) - - ;finish class def - (. cv (visitEnd)) - [cname (. cv toByteArray)])) - -(defn- get-super-and-interfaces [bases] - (if (. ^Class (first bases) (isInterface)) - [Object bases] - [(first bases) (next bases)])) - -(defn get-proxy-class - "Takes an optional single class followed by zero or more - interfaces. If not supplied class defaults to Object. Creates an - returns an instance of a proxy class derived from the supplied - classes. The resulting value is cached and used for any subsequent - requests for the same class set. Returns a Class object." - {:added "1.0"} - [& bases] - (let [[super interfaces] (get-super-and-interfaces bases) - pname (proxy-name super interfaces)] - (or (RT/loadClassForName pname) - (let [[cname bytecode] (generate-proxy super interfaces)] - (. ^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) (defineClass pname bytecode [super interfaces])))))) - -(defn construct-proxy - "Takes a proxy class and any arguments for its superclass ctor and - creates and returns an instance of the proxy." - {:added "1.0"} - [c & ctor-args] - (. Reflector (invokeConstructor c (to-array ctor-args)))) - -(defn init-proxy - "Takes a proxy instance and a map of strings (which must - correspond to methods of the proxy superclass/superinterfaces) to - fns (which must take arguments matching the corresponding method, - plus an additional (explicit) first arg corresponding to this, and - sets the proxy's fn map." - {:added "1.0"} - [^IProxy proxy mappings] - (. proxy (__initClojureFnMappings mappings))) - -(defn update-proxy - "Takes a proxy instance and a map of strings (which must - correspond to methods of the proxy superclass/superinterfaces) to - fns (which must take arguments matching the corresponding method, - plus an additional (explicit) first arg corresponding to this, and - updates (via assoc) the proxy's fn map. nil can be passed instead of - a fn, in which case the corresponding method will revert to the - default behavior. Note that this function can be used to update the - behavior of an existing instance without changing its identity." - {:added "1.0"} - [^IProxy proxy mappings] - (. proxy (__updateClojureFnMappings mappings))) - -(defn proxy-mappings - "Takes a proxy instance and returns the proxy's fn map." - {:added "1.0"} - [^IProxy proxy] - (. proxy (__getClojureFnMappings))) - -(defmacro proxy - "class-and-interfaces - a vector of class names - - args - a (possibly empty) vector of arguments to the superclass - constructor. - - f => (name [params*] body) or - (name ([params*] body) ([params+] body) ...) - - Expands to code which creates a instance of a proxy class that - implements the named class/interface(s) by calling the supplied - fns. A single class, if provided, must be first. If not provided it - defaults to Object. - - The interfaces names must be valid interface types. If a method fn - is not provided for a class method, the superclass methd will be - called. If a method fn is not provided for an interface method, an - UnsupportedOperationException will be thrown should it be - called. Method fns are closures and can capture the environment in - which proxy is called. Each method fn takes an additional implicit - first arg, which is bound to 'this. Note that while method fns can - be provided to override protected methods, they have no other access - to protected members, nor to super, as these capabilities cannot be - proxied." - {:added "1.0"} - [class-and-interfaces args & fs] - (let [bases (map #(or (resolve %) (throw (Exception. (str "Can't resolve: " %)))) - class-and-interfaces) - [super interfaces] (get-super-and-interfaces bases) - compile-effect (when *compile-files* - (let [[cname bytecode] (generate-proxy super interfaces)] - (clojure.lang.Compiler/writeClassFile cname bytecode))) - pc-effect (apply get-proxy-class bases) - pname (proxy-name super interfaces)] - ;remember the class to prevent it from disappearing before use - (intern *ns* (symbol pname) pc-effect) - `(let [;pc# (get-proxy-class ~@class-and-interfaces) - p# (new ~(symbol pname) ~@args)] ;(construct-proxy pc# ~@args)] - (init-proxy p# - ~(loop [fmap {} fs fs] - (if fs - (let [[sym & meths] (first fs) - meths (if (vector? (first meths)) - (list meths) - meths) - meths (map (fn [[params & body]] - (cons (apply vector 'this params) body)) - meths)] - (if-not (contains? fmap (name sym)) - (recur (assoc fmap (name sym) (cons `fn meths)) (next fs)) - (throw (IllegalArgumentException. - (str "Method '" (name sym) "' redefined"))))) - fmap))) - p#))) - -(defn proxy-call-with-super [call this meth] - (let [m (proxy-mappings this)] - (update-proxy this (assoc m meth nil)) - (let [ret (call)] - (update-proxy this m) - ret))) - -(defmacro proxy-super - "Use to call a superclass method in the body of a proxy method. - Note, expansion captures 'this" - {:added "1.0"} - [meth & args] - `(proxy-call-with-super (fn [] (. ~'this ~meth ~@args)) ~'this ~(name meth))) - -(defn bean - "Takes a Java object and returns a read-only implementation of the - map abstraction based upon its JavaBean properties." - {:added "1.0"} - [^Object x] - (let [c (. x (getClass)) - pmap (reduce (fn [m ^java.beans.PropertyDescriptor pd] - (let [name (. pd (getName)) - method (. pd (getReadMethod))] - (if (and method (zero? (alength (. method (getParameterTypes))))) - (assoc m (keyword name) (fn [] (clojure.lang.Reflector/prepRet (. method (invoke x nil))))) - m))) - {} - (seq (.. java.beans.Introspector - (getBeanInfo c) - (getPropertyDescriptors)))) - v (fn [k] ((pmap k))) - snapshot (fn [] - (reduce (fn [m e] - (assoc m (key e) ((val e)))) - {} (seq pmap)))] - (proxy [clojure.lang.APersistentMap] - [] - (containsKey [k] (contains? pmap k)) - (entryAt [k] (when (contains? pmap k) (new clojure.lang.MapEntry k (v k)))) - (valAt ([k] (v k)) - ([k default] (if (contains? pmap k) (v k) default))) - (cons [m] (conj (snapshot) m)) - (count [] (count pmap)) - (assoc [k v] (assoc (snapshot) k v)) - (without [k] (dissoc (snapshot) k)) - (seq [] ((fn thisfn [plseq] - (lazy-seq - (when-let [pseq (seq plseq)] - (cons (new clojure.lang.MapEntry (first pseq) (v (first pseq))) - (thisfn (rest pseq)))))) (keys pmap)))))) - - - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/genclass.clj --- a/src/clojure/genclass.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,714 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(in-ns 'clojure.core) - -(import '(java.lang.reflect Modifier Constructor) - '(clojure.asm ClassWriter ClassVisitor Opcodes Type) - '(clojure.asm.commons Method GeneratorAdapter) - '(clojure.lang IPersistentMap)) - -;(defn method-sig [^java.lang.reflect.Method meth] -; [(. meth (getName)) (seq (. meth (getParameterTypes)))]) - -(defn- non-private-methods [^Class c] - (loop [mm {} - considered #{} - c c] - (if c - (let [[mm considered] - (loop [mm mm - considered considered - meths (seq (concat - (seq (. c (getDeclaredMethods))) - (seq (. c (getMethods)))))] - (if meths - (let [^java.lang.reflect.Method meth (first meths) - mods (. meth (getModifiers)) - mk (method-sig meth)] - (if (or (considered mk) - (not (or (Modifier/isPublic mods) (Modifier/isProtected mods))) - ;(. Modifier (isPrivate mods)) - (. Modifier (isStatic mods)) - (. Modifier (isFinal mods)) - (= "finalize" (.getName meth))) - (recur mm (conj considered mk) (next meths)) - (recur (assoc mm mk meth) (conj considered mk) (next meths)))) - [mm considered]))] - (recur mm considered (. c (getSuperclass)))) - mm))) - -(defn- ctor-sigs [^Class super] - (for [^Constructor ctor (. super (getDeclaredConstructors)) - :when (not (. Modifier (isPrivate (. ctor (getModifiers)))))] - (apply vector (. ctor (getParameterTypes))))) - -(defn- escape-class-name [^Class c] - (.. (.getSimpleName c) - (replace "[]" "<>"))) - -(defn- overload-name [mname pclasses] - (if (seq pclasses) - (apply str mname (interleave (repeat \-) - (map escape-class-name pclasses))) - (str mname "-void"))) - -(defn- ^java.lang.reflect.Field find-field [^Class c f] - (let [start-class c] - (loop [c c] - (if (= c Object) - (throw (new Exception (str "field, " f ", not defined in class, " start-class ", or its ancestors"))) - (let [dflds (.getDeclaredFields c) - rfld (first (filter #(= f (.getName ^java.lang.reflect.Field %)) dflds))] - (or rfld (recur (.getSuperclass c)))))))) - -;(distinct (map first(keys (mapcat non-private-methods [Object IPersistentMap])))) - -(def ^{:private true} prim->class - {'int Integer/TYPE - 'long Long/TYPE - 'float Float/TYPE - 'double Double/TYPE - 'void Void/TYPE - 'short Short/TYPE - 'boolean Boolean/TYPE - 'byte Byte/TYPE - 'char Character/TYPE}) - -(defn- ^Class the-class [x] - (cond - (class? x) x - (contains? prim->class x) (prim->class x) - :else (let [strx (str x)] - (clojure.lang.RT/classForName - (if (some #{\. \[} strx) - strx - (str "java.lang." strx)))))) - -;; someday this can be made codepoint aware -(defn- valid-java-method-name - [^String s] - (= s (clojure.lang.Compiler/munge s))) - -(defn- validate-generate-class-options - [{:keys [methods]}] - (let [[mname] (remove valid-java-method-name (map (comp str first) methods))] - (when mname (throw (IllegalArgumentException. (str "Not a valid method name: " mname)))))) - -(defn- generate-class [options-map] - (validate-generate-class-options options-map) - (let [default-options {:prefix "-" :load-impl-ns true :impl-ns (ns-name *ns*)} - {:keys [name extends implements constructors methods main factory state init exposes - exposes-methods prefix load-impl-ns impl-ns post-init]} - (merge default-options options-map) - name-meta (meta name) - name (str name) - super (if extends (the-class extends) Object) - interfaces (map the-class implements) - supers (cons super interfaces) - ctor-sig-map (or constructors (zipmap (ctor-sigs super) (ctor-sigs super))) - cv (new ClassWriter (. ClassWriter COMPUTE_MAXS)) - cname (. name (replace "." "/")) - pkg-name name - impl-pkg-name (str impl-ns) - impl-cname (.. impl-pkg-name (replace "." "/") (replace \- \_)) - ctype (. Type (getObjectType cname)) - iname (fn [^Class c] (.. Type (getType c) (getInternalName))) - totype (fn [^Class c] (. Type (getType c))) - to-types (fn [cs] (if (pos? (count cs)) - (into-array (map totype cs)) - (make-array Type 0))) - obj-type ^Type (totype Object) - arg-types (fn [n] (if (pos? n) - (into-array (replicate n obj-type)) - (make-array Type 0))) - super-type ^Type (totype super) - init-name (str init) - post-init-name (str post-init) - factory-name (str factory) - state-name (str state) - main-name "main" - var-name (fn [s] (clojure.lang.Compiler/munge (str s "__var"))) - class-type (totype Class) - rt-type (totype clojure.lang.RT) - var-type ^Type (totype clojure.lang.Var) - ifn-type (totype clojure.lang.IFn) - iseq-type (totype clojure.lang.ISeq) - ex-type (totype java.lang.UnsupportedOperationException) - all-sigs (distinct (concat (map #(let[[m p] (key %)] {m [p]}) (mapcat non-private-methods supers)) - (map (fn [[m p]] {(str m) [p]}) methods))) - sigs-by-name (apply merge-with concat {} all-sigs) - overloads (into {} (filter (fn [[m s]] (next s)) sigs-by-name)) - var-fields (concat (when init [init-name]) - (when post-init [post-init-name]) - (when main [main-name]) - ;(when exposes-methods (map str (vals exposes-methods))) - (distinct (concat (keys sigs-by-name) - (mapcat (fn [[m s]] (map #(overload-name m (map the-class %)) s)) overloads) - (mapcat (comp (partial map str) vals val) exposes)))) - emit-get-var (fn [^GeneratorAdapter gen v] - (let [false-label (. gen newLabel) - end-label (. gen newLabel)] - (. gen getStatic ctype (var-name v) var-type) - (. gen dup) - (. gen invokeVirtual var-type (. Method (getMethod "boolean isBound()"))) - (. gen ifZCmp (. GeneratorAdapter EQ) false-label) - (. gen invokeVirtual var-type (. Method (getMethod "Object get()"))) - (. gen goTo end-label) - (. gen mark false-label) - (. gen pop) - (. gen visitInsn (. Opcodes ACONST_NULL)) - (. gen mark end-label))) - emit-unsupported (fn [^GeneratorAdapter gen ^Method m] - (. gen (throwException ex-type (str (. m (getName)) " (" - impl-pkg-name "/" prefix (.getName m) - " not defined?)")))) - emit-forwarding-method - (fn [name pclasses rclass as-static else-gen] - (let [mname (str name) - pmetas (map meta pclasses) - pclasses (map the-class pclasses) - rclass (the-class rclass) - ptypes (to-types pclasses) - rtype ^Type (totype rclass) - m (new Method mname rtype ptypes) - is-overload (seq (overloads mname)) - gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (if as-static (. Opcodes ACC_STATIC) 0)) - m nil nil cv) - found-label (. gen (newLabel)) - else-label (. gen (newLabel)) - end-label (. gen (newLabel))] - (add-annotations gen (meta name)) - (dotimes [i (count pmetas)] - (add-annotations gen (nth pmetas i) i)) - (. gen (visitCode)) - (if (> (count pclasses) 18) - (else-gen gen m) - (do - (when is-overload - (emit-get-var gen (overload-name mname pclasses)) - (. gen (dup)) - (. gen (ifNonNull found-label)) - (. gen (pop))) - (emit-get-var gen mname) - (. gen (dup)) - (. gen (ifNull else-label)) - (when is-overload - (. gen (mark found-label))) - ;if found - (.checkCast gen ifn-type) - (when-not as-static - (. gen (loadThis))) - ;box args - (dotimes [i (count ptypes)] - (. gen (loadArg i)) - (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i)))) - ;call fn - (. gen (invokeInterface ifn-type (new Method "invoke" obj-type - (to-types (replicate (+ (count ptypes) - (if as-static 0 1)) - Object))))) - ;(into-array (cons obj-type - ; (replicate (count ptypes) obj-type)))))) - ;unbox return - (. gen (unbox rtype)) - (when (= (. rtype (getSort)) (. Type VOID)) - (. gen (pop))) - (. gen (goTo end-label)) - - ;else call supplied alternative generator - (. gen (mark else-label)) - (. gen (pop)) - - (else-gen gen m) - - (. gen (mark end-label)))) - (. gen (returnValue)) - (. gen (endMethod)))) - ] - ;start class definition - (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER)) - cname nil (iname super) - (when-let [ifc (seq interfaces)] - (into-array (map iname ifc))))) - - ; class annotations - (add-annotations cv name-meta) - - ;static fields for vars - (doseq [v var-fields] - (. cv (visitField (+ (. Opcodes ACC_PRIVATE) (. Opcodes ACC_FINAL) (. Opcodes ACC_STATIC)) - (var-name v) - (. var-type getDescriptor) - nil nil))) - - ;instance field for state - (when state - (. cv (visitField (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_FINAL)) - state-name - (. obj-type getDescriptor) - nil nil))) - - ;static init to set up var fields and load init - (let [gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) - (. Method getMethod "void ()") - nil nil cv)] - (. gen (visitCode)) - (doseq [v var-fields] - (. gen push impl-pkg-name) - (. gen push (str prefix v)) - (. gen (invokeStatic var-type (. Method (getMethod "clojure.lang.Var internPrivate(String,String)")))) - (. gen putStatic ctype (var-name v) var-type)) - - (when load-impl-ns - (. gen push "clojure.core") - (. gen push "load") - (. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.Var var(String,String)")))) - (. gen push (str "/" impl-cname)) - (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (to-types [Object])))) -; (. gen push (str (.replace impl-pkg-name \- \_) "__init")) -; (. gen (invokeStatic class-type (. Method (getMethod "Class forName(String)")))) - (. gen pop)) - - (. gen (returnValue)) - (. gen (endMethod))) - - ;ctors - (doseq [[pclasses super-pclasses] ctor-sig-map] - (let [pclasses (map the-class pclasses) - super-pclasses (map the-class super-pclasses) - ptypes (to-types pclasses) - super-ptypes (to-types super-pclasses) - m (new Method "" (. Type VOID_TYPE) ptypes) - super-m (new Method "" (. Type VOID_TYPE) super-ptypes) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv) - no-init-label (. gen newLabel) - end-label (. gen newLabel) - no-post-init-label (. gen newLabel) - end-post-init-label (. gen newLabel) - nth-method (. Method (getMethod "Object nth(Object,int)")) - local (. gen newLocal obj-type)] - (. gen (visitCode)) - - (if init - (do - (emit-get-var gen init-name) - (. gen dup) - (. gen ifNull no-init-label) - (.checkCast gen ifn-type) - ;box init args - (dotimes [i (count pclasses)] - (. gen (loadArg i)) - (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i)))) - ;call init fn - (. gen (invokeInterface ifn-type (new Method "invoke" obj-type - (arg-types (count ptypes))))) - ;expecting [[super-ctor-args] state] returned - (. gen dup) - (. gen push 0) - (. gen (invokeStatic rt-type nth-method)) - (. gen storeLocal local) - - (. gen (loadThis)) - (. gen dupX1) - (dotimes [i (count super-pclasses)] - (. gen loadLocal local) - (. gen push i) - (. gen (invokeStatic rt-type nth-method)) - (. clojure.lang.Compiler$HostExpr (emitUnboxArg nil gen (nth super-pclasses i)))) - (. gen (invokeConstructor super-type super-m)) - - (if state - (do - (. gen push 1) - (. gen (invokeStatic rt-type nth-method)) - (. gen (putField ctype state-name obj-type))) - (. gen pop)) - - (. gen goTo end-label) - ;no init found - (. gen mark no-init-label) - (. gen (throwException ex-type (str impl-pkg-name "/" prefix init-name " not defined"))) - (. gen mark end-label)) - (if (= pclasses super-pclasses) - (do - (. gen (loadThis)) - (. gen (loadArgs)) - (. gen (invokeConstructor super-type super-m))) - (throw (new Exception ":init not specified, but ctor and super ctor args differ")))) - - (when post-init - (emit-get-var gen post-init-name) - (. gen dup) - (. gen ifNull no-post-init-label) - (.checkCast gen ifn-type) - (. gen (loadThis)) - ;box init args - (dotimes [i (count pclasses)] - (. gen (loadArg i)) - (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i)))) - ;call init fn - (. gen (invokeInterface ifn-type (new Method "invoke" obj-type - (arg-types (inc (count ptypes)))))) - (. gen pop) - (. gen goTo end-post-init-label) - ;no init found - (. gen mark no-post-init-label) - (. gen (throwException ex-type (str impl-pkg-name "/" prefix post-init-name " not defined"))) - (. gen mark end-post-init-label)) - - (. gen (returnValue)) - (. gen (endMethod)) - ;factory - (when factory - (let [fm (new Method factory-name ctype ptypes) - gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) - fm nil nil cv)] - (. gen (visitCode)) - (. gen newInstance ctype) - (. gen dup) - (. gen (loadArgs)) - (. gen (invokeConstructor ctype m)) - (. gen (returnValue)) - (. gen (endMethod)))))) - - ;add methods matching supers', if no fn -> call super - (let [mm (non-private-methods super)] - (doseq [^java.lang.reflect.Method meth (vals mm)] - (emit-forwarding-method (.getName meth) (.getParameterTypes meth) (.getReturnType meth) false - (fn [^GeneratorAdapter gen ^Method m] - (. gen (loadThis)) - ;push args - (. gen (loadArgs)) - ;call super - (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) - (. super-type (getInternalName)) - (. m (getName)) - (. m (getDescriptor))))))) - ;add methods matching interfaces', if no fn -> throw - (reduce (fn [mm ^java.lang.reflect.Method meth] - (if (contains? mm (method-sig meth)) - mm - (do - (emit-forwarding-method (.getName meth) (.getParameterTypes meth) (.getReturnType meth) false - emit-unsupported) - (assoc mm (method-sig meth) meth)))) - mm (mapcat #(.getMethods ^Class %) interfaces)) - ;extra methods - (doseq [[mname pclasses rclass :as msig] methods] - (emit-forwarding-method mname pclasses rclass (:static (meta msig)) - emit-unsupported)) - ;expose specified overridden superclass methods - (doseq [[local-mname ^java.lang.reflect.Method m] (reduce (fn [ms [[name _ _] m]] - (if (contains? exposes-methods (symbol name)) - (conj ms [((symbol name) exposes-methods) m]) - ms)) [] (seq mm))] - (let [ptypes (to-types (.getParameterTypes m)) - rtype (totype (.getReturnType m)) - exposer-m (new Method (str local-mname) rtype ptypes) - target-m (new Method (.getName m) rtype ptypes) - gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) exposer-m nil nil cv)] - (. gen (loadThis)) - (. gen (loadArgs)) - (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) - (. super-type (getInternalName)) - (. target-m (getName)) - (. target-m (getDescriptor)))) - (. gen (returnValue)) - (. gen (endMethod))))) - ;main - (when main - (let [m (. Method getMethod "void main (String[])") - gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) - m nil nil cv) - no-main-label (. gen newLabel) - end-label (. gen newLabel)] - (. gen (visitCode)) - - (emit-get-var gen main-name) - (. gen dup) - (. gen ifNull no-main-label) - (.checkCast gen ifn-type) - (. gen loadArgs) - (. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.ISeq seq(Object)")))) - (. gen (invokeInterface ifn-type (new Method "applyTo" obj-type - (into-array [iseq-type])))) - (. gen pop) - (. gen goTo end-label) - ;no main found - (. gen mark no-main-label) - (. gen (throwException ex-type (str impl-pkg-name "/" prefix main-name " not defined"))) - (. gen mark end-label) - (. gen (returnValue)) - (. gen (endMethod)))) - ;field exposers - (doseq [[f {getter :get setter :set}] exposes] - (let [fld (find-field super (str f)) - ftype (totype (.getType fld)) - static? (Modifier/isStatic (.getModifiers fld)) - acc (+ Opcodes/ACC_PUBLIC (if static? Opcodes/ACC_STATIC 0))] - (when getter - (let [m (new Method (str getter) ftype (to-types [])) - gen (new GeneratorAdapter acc m nil nil cv)] - (. gen (visitCode)) - (if static? - (. gen getStatic ctype (str f) ftype) - (do - (. gen loadThis) - (. gen getField ctype (str f) ftype))) - (. gen (returnValue)) - (. gen (endMethod)))) - (when setter - (let [m (new Method (str setter) Type/VOID_TYPE (into-array [ftype])) - gen (new GeneratorAdapter acc m nil nil cv)] - (. gen (visitCode)) - (if static? - (do - (. gen loadArgs) - (. gen putStatic ctype (str f) ftype)) - (do - (. gen loadThis) - (. gen loadArgs) - (. gen putField ctype (str f) ftype))) - (. gen (returnValue)) - (. gen (endMethod)))))) - ;finish class def - (. cv (visitEnd)) - [cname (. cv (toByteArray))])) - -(defmacro gen-class - "When compiling, generates compiled bytecode for a class with the - given package-qualified :name (which, as all names in these - parameters, can be a string or symbol), and writes the .class file - to the *compile-path* directory. When not compiling, does - nothing. The gen-class construct contains no implementation, as the - implementation will be dynamically sought by the generated class in - functions in an implementing Clojure namespace. Given a generated - class org.mydomain.MyClass with a method named mymethod, gen-class - will generate an implementation that looks for a function named by - (str prefix mymethod) (default prefix: \"-\") in a - Clojure namespace specified by :impl-ns - (defaults to the current namespace). All inherited methods, - generated methods, and init and main functions (see :methods, :init, - and :main below) will be found similarly prefixed. By default, the - static initializer for the generated class will attempt to load the - Clojure support code for the class as a resource from the classpath, - e.g. in the example case, ``org/mydomain/MyClass__init.class``. This - behavior can be controlled by :load-impl-ns - - Note that methods with a maximum of 18 parameters are supported. - - In all subsequent sections taking types, the primitive types can be - referred to by their Java names (int, float etc), and classes in the - java.lang package can be used without a package qualifier. All other - classes must be fully qualified. - - Options should be a set of key/value pairs, all except for :name are optional: - - :name aname - - The package-qualified name of the class to be generated - - :extends aclass - - Specifies the superclass, the non-private methods of which will be - overridden by the class. If not provided, defaults to Object. - - :implements [interface ...] - - One or more interfaces, the methods of which will be implemented by the class. - - :init name - - If supplied, names a function that will be called with the arguments - to the constructor. Must return [ [superclass-constructor-args] state] - If not supplied, the constructor args are passed directly to - the superclass constructor and the state will be nil - - :constructors {[param-types] [super-param-types], ...} - - By default, constructors are created for the generated class which - match the signature(s) of the constructors for the superclass. This - parameter may be used to explicitly specify constructors, each entry - providing a mapping from a constructor signature to a superclass - constructor signature. When you supply this, you must supply an :init - specifier. - - :post-init name - - If supplied, names a function that will be called with the object as - the first argument, followed by the arguments to the constructor. - It will be called every time an object of this class is created, - immediately after all the inherited constructors have completed. - It's return value is ignored. - - :methods [ [name [param-types] return-type], ...] - - The generated class automatically defines all of the non-private - methods of its superclasses/interfaces. This parameter can be used - to specify the signatures of additional methods of the generated - class. Static methods can be specified with ^{:static true} in the - signature's metadata. Do not repeat superclass/interface signatures - here. - - :main boolean - - If supplied and true, a static public main function will be generated. It will - pass each string of the String[] argument as a separate argument to - a function called (str prefix main). - - :factory name - - If supplied, a (set of) public static factory function(s) will be - created with the given name, and the same signature(s) as the - constructor(s). - - :state name - - If supplied, a public final instance field with the given name will be - created. You must supply an :init function in order to provide a - value for the state. Note that, though final, the state can be a ref - or agent, supporting the creation of Java objects with transactional - or asynchronous mutation semantics. - - :exposes {protected-field-name {:get name :set name}, ...} - - Since the implementations of the methods of the generated class - occur in Clojure functions, they have no access to the inherited - protected fields of the superclass. This parameter can be used to - generate public getter/setter methods exposing the protected field(s) - for use in the implementation. - - :exposes-methods {super-method-name exposed-name, ...} - - It is sometimes necessary to call the superclass' implementation of an - overridden method. Those methods may be exposed and referred in - the new method implementation by a local name. - - :prefix string - - Default: \"-\" Methods called e.g. Foo will be looked up in vars called - prefixFoo in the implementing ns. - - :impl-ns name - - Default: the name of the current ns. Implementations of methods will be - looked up in this namespace. - - :load-impl-ns boolean - - Default: true. Causes the static initializer for the generated class - to reference the load code for the implementing namespace. Should be - true when implementing-ns is the default, false if you intend to - load the code via some other method." - {:added "1.0"} - - [& options] - (when *compile-files* - (let [options-map (into {} (map vec (partition 2 options))) - [cname bytecode] (generate-class options-map)] - (clojure.lang.Compiler/writeClassFile cname bytecode)))) - -;;;;;;;;;;;;;;;;;;;; gen-interface ;;;;;;;;;;;;;;;;;;;;;; -;; based on original contribution by Chris Houser - -(defn- ^Type asm-type - "Returns an asm Type object for c, which may be a primitive class - (such as Integer/TYPE), any other class (such as Double), or a - fully-qualified class name given as a string or symbol - (such as 'java.lang.String)" - [c] - (if (or (instance? Class c) (prim->class c)) - (Type/getType (the-class c)) - (let [strx (str c)] - (Type/getObjectType - (.replace (if (some #{\.} strx) - strx - (str "java.lang." strx)) - "." "/"))))) - -(defn- generate-interface - [{:keys [name extends methods]}] - (let [iname (.replace (str name) "." "/") - cv (ClassWriter. ClassWriter/COMPUTE_MAXS)] - (. cv visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC - Opcodes/ACC_ABSTRACT - Opcodes/ACC_INTERFACE) - iname nil "java/lang/Object" - (when (seq extends) - (into-array (map #(.getInternalName (asm-type %)) extends)))) - (add-annotations cv (meta name)) - (doseq [[mname pclasses rclass pmetas] methods] - (let [mv (. cv visitMethod (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) - (str mname) - (Type/getMethodDescriptor (asm-type rclass) - (if pclasses - (into-array Type (map asm-type pclasses)) - (make-array Type 0))) - nil nil)] - (add-annotations mv (meta mname)) - (dotimes [i (count pmetas)] - (add-annotations mv (nth pmetas i) i)) - (. mv visitEnd))) - (. cv visitEnd) - [iname (. cv toByteArray)])) - -(defmacro gen-interface - "When compiling, generates compiled bytecode for an interface with - the given package-qualified :name (which, as all names in these - parameters, can be a string or symbol), and writes the .class file - to the *compile-path* directory. When not compiling, does nothing. - - In all subsequent sections taking types, the primitive types can be - referred to by their Java names (int, float etc), and classes in the - java.lang package can be used without a package qualifier. All other - classes must be fully qualified. - - Options should be a set of key/value pairs, all except for :name are - optional: - - :name aname - - The package-qualified name of the class to be generated - - :extends [interface ...] - - One or more interfaces, which will be extended by this interface. - - :methods [ [name [param-types] return-type], ...] - - This parameter is used to specify the signatures of the methods of - the generated interface. Do not repeat superinterface signatures - here." - {:added "1.0"} - - [& options] - (let [options-map (apply hash-map options) - [cname bytecode] (generate-interface options-map)] - (if *compile-files* - (clojure.lang.Compiler/writeClassFile cname bytecode) - (.defineClass ^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) - (str (:name options-map)) bytecode options)))) - -(comment - -(defn gen-and-load-class - "Generates and immediately loads the bytecode for the specified - class. Note that a class generated this way can be loaded only once - - the JVM supports only one class with a given name per - classloader. Subsequent to generation you can import it into any - desired namespaces just like any other class. See gen-class for a - description of the options." - {:added "1.0"} - - [& options] - (let [options-map (apply hash-map options) - [cname bytecode] (generate-class options-map)] - (.. (clojure.lang.RT/getRootClassLoader) (defineClass cname bytecode options)))) - -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/gvec.clj --- a/src/clojure/gvec.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,460 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;;; a generic vector implementation for vectors of primitives - -(in-ns 'clojure.core) - -;(set! *warn-on-reflection* true) - -(deftype VecNode [edit arr]) - -(def EMPTY-NODE (VecNode. nil (object-array 32))) - -(definterface IVecImpl - (^int tailoff []) - (arrayFor [^int i]) - (pushTail [^int level ^clojure.core.VecNode parent ^clojure.core.VecNode tailnode]) - (popTail [^int level node]) - (newPath [edit ^int level node]) - (doAssoc [^int level node ^int i val])) - -(definterface ArrayManager - (array [^int size]) - (^int alength [arr]) - (aclone [arr]) - (aget [arr ^int i]) - (aset [arr ^int i val])) - -(deftype ArrayChunk [^clojure.core.ArrayManager am arr ^int off ^int end] - - clojure.lang.Indexed - (nth [_ i] (.aget am arr (+ off i))) - - (count [_] (- end off)) - - clojure.lang.IChunk - (dropFirst [_] - (if (= off end) - (throw (IllegalStateException. "dropFirst of empty chunk")) - (new ArrayChunk am arr (inc off) end))) - - (reduce [_ f init] - (loop [ret init i off] - (if (< i end) - (recur (f ret (.aget am arr i)) (inc i)) - ret))) - ) - -(deftype VecSeq [^clojure.core.ArrayManager am ^clojure.core.IVecImpl vec anode ^int i ^int offset] - :no-print true - - clojure.core.protocols.InternalReduce - (internal-reduce - [_ f val] - (loop [result val - aidx offset] - (if (< aidx (count vec)) - (let [node (.arrayFor vec aidx) - result (loop [result result - node-idx (bit-and (int 0x1f) aidx)] - (if (< node-idx (.alength am node)) - (recur (f result (.aget am node node-idx)) (inc node-idx)) - result))] - (recur result (bit-and (int 0xffe0) (+ aidx (int 32))))) - result))) - - clojure.lang.ISeq - (first [_] (.aget am anode offset)) - (next [this] - (if (< (inc offset) (.alength am anode)) - (new VecSeq am vec anode i (inc offset)) - (.chunkedNext this))) - (more [this] - (let [s (.next this)] - (or s (clojure.lang.PersistentList/EMPTY)))) - (cons [this o] - (clojure.lang.Cons. o this)) - (count [this] - (loop [i 1 - s (next this)] - (if s - (if (instance? clojure.lang.Counted s) - (+ i (.count s)) - (recur (inc i) (next s))) - i))) - (equiv [this o] - (cond - (identical? this o) true - (or (instance? clojure.lang.Sequential o) (instance? java.util.List o)) - (loop [me this - you (seq o)] - (if (nil? me) - (nil? you) - (and (clojure.lang.Util/equiv (first me) (first you)) - (recur (next me) (next you))))) - :else false)) - (empty [_] - clojure.lang.PersistentList/EMPTY) - - - clojure.lang.Seqable - (seq [this] this) - - clojure.lang.IChunkedSeq - (chunkedFirst [_] (ArrayChunk. am anode offset (.alength am anode))) - (chunkedNext [_] - (let [nexti (+ i (.alength am anode))] - (when (< nexti (count vec)) - (new VecSeq am vec (.arrayFor vec nexti) nexti 0)))) - (chunkedMore [this] - (let [s (.chunkedNext this)] - (or s (clojure.lang.PersistentList/EMPTY))))) - -(defmethod print-method ::VecSeq [v w] - ((get (methods print-method) clojure.lang.ISeq) v w)) - -(deftype Vec [^clojure.core.ArrayManager am ^int cnt ^int shift ^clojure.core.VecNode root tail _meta] - Object - (equals [this o] - (cond - (identical? this o) true - (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o)) - (and (= cnt (count o)) - (loop [i (int 0)] - (cond - (= i cnt) true - (.equals (.nth this i) (nth o i)) (recur (inc i)) - :else false))) - (or (instance? clojure.lang.Sequential o) (instance? java.util.List o)) - (.equals (seq this) (seq o)) - :else false)) - - ;todo - cache - (hashCode [this] - (loop [hash (int 1) i (int 0)] - (if (= i cnt) - hash - (let [val (.nth this i)] - (recur (unchecked-add (unchecked-multiply (int 31) hash) - (clojure.lang.Util/hash val)) - (inc i)))))) - - clojure.lang.Counted - (count [_] cnt) - - clojure.lang.IMeta - (meta [_] _meta) - - clojure.lang.IObj - (withMeta [_ m] (new Vec am cnt shift root tail m)) - - clojure.lang.Indexed - (nth [this i] - (let [a (.arrayFor this i)] - (.aget am a (bit-and i (int 0x1f))))) - (nth [this i not-found] - (let [z (int 0)] - (if (and (>= i z) (< i (.count this))) - (.nth this i) - not-found))) - - clojure.lang.IPersistentCollection - (cons [this val] - (if (< (- cnt (.tailoff this)) (int 32)) - (let [new-tail (.array am (inc (.alength am tail)))] - (System/arraycopy tail 0 new-tail 0 (.alength am tail)) - (.aset am new-tail (.alength am tail) val) - (new Vec am (inc cnt) shift root new-tail (meta this))) - (let [tail-node (VecNode. (.edit root) tail)] - (if (> (bit-shift-right cnt (int 5)) (bit-shift-left (int 1) shift)) ;overflow root? - (let [new-root (VecNode. (.edit root) (object-array 32))] - (doto ^objects (.arr new-root) - (aset 0 root) - (aset 1 (.newPath this (.edit root) shift tail-node))) - (new Vec am (inc cnt) (+ shift (int 5)) new-root (let [tl (.array am 1)] (.aset am tl 0 val) tl) (meta this))) - (new Vec am (inc cnt) shift (.pushTail this shift root tail-node) - (let [tl (.array am 1)] (.aset am tl 0 val) tl) (meta this)))))) - - (empty [_] (new Vec am 0 5 EMPTY-NODE (.array am 0) nil)) - (equiv [this o] - (cond - (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o)) - (and (= cnt (count o)) - (loop [i (int 0)] - (cond - (= i cnt) true - (= (.nth this i) (nth o i)) (recur (inc i)) - :else false))) - (or (instance? clojure.lang.Sequential o) (instance? java.util.List o)) - (= (seq this) (seq o)) - :else false)) - - clojure.lang.IPersistentStack - (peek [this] - (when (> cnt (int 0)) - (.nth this (dec cnt)))) - - (pop [this] - (cond - (zero? cnt) - (throw (IllegalStateException. "Can't pop empty vector")) - (= 1 cnt) - (new Vec am 0 5 EMPTY-NODE (.array am 0) (meta this)) - (> (- cnt (.tailoff this)) 1) - (let [new-tail (.array am (dec (.alength am tail)))] - (System/arraycopy tail 0 new-tail 0 (.alength am new-tail)) - (new Vec am (dec cnt) shift root new-tail (meta this))) - :else - (let [new-tail (.arrayFor this (- cnt 2)) - new-root ^clojure.core.VecNode (.popTail this shift root)] - (cond - (nil? new-root) - (new Vec am (dec cnt) shift EMPTY-NODE new-tail (meta this)) - (and (> shift 5) (nil? (aget ^objects (.arr new-root) 1))) - (new Vec am (dec cnt) (- shift 5) (aget ^objects (.arr new-root) 0) new-tail (meta this)) - :else - (new Vec am (dec cnt) shift new-root new-tail (meta this)))))) - - clojure.lang.IPersistentVector - (assocN [this i val] - (cond - (and (<= (int 0) i) (< i cnt)) - (if (>= i (.tailoff this)) - (let [new-tail (.array am (.alength am tail))] - (System/arraycopy tail 0 new-tail 0 (.alength am tail)) - (.aset am new-tail (bit-and i (int 0x1f)) val) - (new Vec am cnt shift root new-tail (meta this))) - (new Vec am cnt shift (.doAssoc this shift root i val) tail (meta this))) - (= i cnt) (.cons this val) - :else (throw (IndexOutOfBoundsException.)))) - - clojure.lang.Reversible - (rseq [this] - (if (> (.count this) 0) - (clojure.lang.APersistentVector$RSeq. this (dec (.count this))) - nil)) - - clojure.lang.Associative - (assoc [this k v] - (if (clojure.lang.Util/isInteger k) - (.assocN this k v) - (throw (IllegalArgumentException. "Key must be integer")))) - (containsKey [this k] - (and (clojure.lang.Util/isInteger k) - (<= 0 (int k)) - (< (int k) cnt))) - (entryAt [this k] - (if (.containsKey this k) - (clojure.lang.MapEntry. k (.nth this (int k))) - nil)) - - clojure.lang.ILookup - (valAt [this k not-found] - (if (clojure.lang.Util/isInteger k) - (let [i (int k)] - (if (and (>= i 0) (< i cnt)) - (.nth this i) - not-found)) - not-found)) - - (valAt [this k] (.valAt this k nil)) - - clojure.lang.IFn - (invoke [this k] - (if (clojure.lang.Util/isInteger k) - (let [i (int k)] - (if (and (>= i 0) (< i cnt)) - (.nth this i) - (throw (IndexOutOfBoundsException.)))) - (throw (IllegalArgumentException. "Key must be integer")))) - - - clojure.lang.Seqable - (seq [this] - (if (zero? cnt) - nil - (VecSeq. am this (.arrayFor this 0) 0 0))) - - clojure.lang.Sequential ;marker, no methods - - clojure.core.IVecImpl - (tailoff [_] - (- cnt (.alength am tail))) - - (arrayFor [this i] - (if (and (<= (int 0) i) (< i cnt)) - (if (>= i (.tailoff this)) - tail - (loop [node root level shift] - (if (zero? level) - (.arr node) - (recur (aget ^objects (.arr node) (bit-and (bit-shift-right i level) (int 0x1f))) - (- level (int 5)))))) - (throw (IndexOutOfBoundsException.)))) - - (pushTail [this level parent tailnode] - (let [subidx (bit-and (bit-shift-right (dec cnt) level) (int 0x1f)) - parent ^clojure.core.VecNode parent - ret (VecNode. (.edit parent) (aclone ^objects (.arr parent))) - node-to-insert (if (= level (int 5)) - tailnode - (let [child (aget ^objects (.arr parent) subidx)] - (if child - (.pushTail this (- level (int 5)) child tailnode) - (.newPath this (.edit root) (- level (int 5)) tailnode))))] - (aset ^objects (.arr ret) subidx node-to-insert) - ret)) - - (popTail [this level node] - (let [node ^clojure.core.VecNode node - subidx (bit-and (bit-shift-right (- cnt (int 2)) level) (int 0x1f))] - (cond - (> level 5) - (let [new-child (.popTail this (- level 5) (aget ^objects (.arr node) subidx))] - (if (and (nil? new-child) (zero? subidx)) - nil - (let [arr (aclone ^objects (.arr node))] - (aset arr subidx new-child) - (VecNode. (.edit root) arr)))) - (zero? subidx) nil - :else (let [arr (aclone ^objects (.arr node))] - (aset arr subidx nil) - (VecNode. (.edit root) arr))))) - - (newPath [this edit ^int level node] - (if (zero? level) - node - (let [ret (VecNode. edit (object-array 32))] - (aset ^objects (.arr ret) 0 (.newPath this edit (- level (int 5)) node)) - ret))) - - (doAssoc [this level node i val] - (let [node ^clojure.core.VecNode node] - (if (zero? level) - ;on this branch, array will need val type - (let [arr (.aclone am (.arr node))] - (.aset am arr (bit-and i (int 0x1f)) val) - (VecNode. (.edit node) arr)) - (let [arr (aclone ^objects (.arr node)) - subidx (bit-and (bit-shift-right i level) (int 0x1f))] - (aset arr subidx (.doAssoc this (- level (int 5)) (aget arr subidx) i val)) - (VecNode. (.edit node) arr))))) - - java.lang.Comparable - (compareTo [this o] - (if (identical? this o) - 0 - (let [#^clojure.lang.IPersistentVector v (cast clojure.lang.IPersistentVector o) - vcnt (.count v)] - (cond - (< cnt vcnt) -1 - (> cnt vcnt) 1 - :else - (loop [i (int 0)] - (if (= i cnt) - 0 - (let [comp (clojure.lang.Util/compare (.nth this i) (.nth v i))] - (if (= 0 comp) - (recur (inc i)) - comp)))))))) - - java.lang.Iterable - (iterator [this] - (let [i (java.util.concurrent.atomic.AtomicInteger. 0)] - (reify java.util.Iterator - (hasNext [_] (< (.get i) cnt)) - (next [_] (.nth this (dec (.incrementAndGet i)))) - (remove [_] (throw (UnsupportedOperationException.)))))) - - java.util.Collection - (contains [this o] (boolean (some #(= % o) this))) - (containsAll [this c] (every? #(.contains this %) c)) - (isEmpty [_] (zero? cnt)) - (toArray [this] (into-array Object this)) - (toArray [this arr] - (if (>= (count arr) cnt) - (do - (dotimes [i cnt] - (aset arr i (.nth this i))) - arr) - (into-array Object this))) - (size [_] cnt) - (add [_ o] (throw (UnsupportedOperationException.))) - (addAll [_ c] (throw (UnsupportedOperationException.))) - (clear [_] (throw (UnsupportedOperationException.))) - (^boolean remove [_ o] (throw (UnsupportedOperationException.))) - (removeAll [_ c] (throw (UnsupportedOperationException.))) - (retainAll [_ c] (throw (UnsupportedOperationException.))) - - java.util.List - (get [this i] (.nth this i)) - (indexOf [this o] - (loop [i (int 0)] - (cond - (== i cnt) -1 - (= o (.nth this i)) i - :else (recur (inc i))))) - (lastIndexOf [this o] - (loop [i (dec cnt)] - (cond - (< i 0) -1 - (= o (.nth this i)) i - :else (recur (dec i))))) - (listIterator [this] (.listIterator this 0)) - (listIterator [this i] - (let [i (java.util.concurrent.atomic.AtomicInteger. i)] - (reify java.util.ListIterator - (hasNext [_] (< (.get i) cnt)) - (hasPrevious [_] (pos? i)) - (next [_] (.nth this (dec (.incrementAndGet i)))) - (nextIndex [_] (.get i)) - (previous [_] (.nth this (.decrementAndGet i))) - (previousIndex [_] (dec (.get i))) - (add [_ e] (throw (UnsupportedOperationException.))) - (remove [_] (throw (UnsupportedOperationException.))) - (set [_ e] (throw (UnsupportedOperationException.)))))) - (subList [this a z] (subvec this a z)) - (add [_ i o] (throw (UnsupportedOperationException.))) - (addAll [_ i c] (throw (UnsupportedOperationException.))) - (^Object remove [_ ^int i] (throw (UnsupportedOperationException.))) - (set [_ i e] (throw (UnsupportedOperationException.))) -) - -(defmethod print-method ::Vec [v w] - ((get (methods print-method) clojure.lang.IPersistentVector) v w)) - -(defmacro mk-am {:private true} [t] - (let [garr (gensym) - tgarr (with-meta garr {:tag (symbol (str t "s"))})] - `(reify clojure.core.ArrayManager - (array [_ size#] (~(symbol (str t "-array")) size#)) - (alength [_ ~garr] (alength ~tgarr)) - (aclone [_ ~garr] (aclone ~tgarr)) - (aget [_ ~garr i#] (aget ~tgarr i#)) - (aset [_ ~garr i# val#] (aset ~tgarr i# (~t val#)))))) - -(def ^{:private true} ams - {:int (mk-am int) - :long (mk-am long) - :float (mk-am float) - :double (mk-am double) - :byte (mk-am byte) - :short (mk-am short) - :char (mk-am char) - :boolean (mk-am boolean)}) - -(defn vector-of - "Creates a new vector of a single primitive type t, where t is one - of :int :long :float :double :byte :short :char or :boolean. The - resulting vector complies with the interface of vectors in general, - but stores the values unboxed internally." - {:added "1.2"} - [t] - (let [am ^clojure.core.ArrayManager (ams t)] - (Vec. am 0 5 EMPTY-NODE (.array am 0) nil))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/inspector.clj --- a/src/clojure/inspector.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,185 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns ^{:doc "Graphical object inspector for Clojure data structures." - :author "Rich Hickey"} - clojure.inspector - (:import - (java.awt BorderLayout) - (java.awt.event ActionEvent ActionListener) - (javax.swing.tree TreeModel) - (javax.swing.table TableModel AbstractTableModel) - (javax.swing JPanel JTree JTable JScrollPane JFrame JToolBar JButton SwingUtilities))) - -(defn atom? [x] - (not (coll? x))) - -(defn collection-tag [x] - (cond - (instance? java.util.Map$Entry x) :entry - (instance? java.util.Map x) :map - (sequential? x) :seq - :else :atom)) - -(defmulti is-leaf collection-tag) -(defmulti get-child (fn [parent index] (collection-tag parent))) -(defmulti get-child-count collection-tag) - -(defmethod is-leaf :default [node] - (atom? node)) -(defmethod get-child :default [parent index] - (nth parent index)) -(defmethod get-child-count :default [parent] - (count parent)) - -(defmethod is-leaf :entry [e] - (is-leaf (val e))) -(defmethod get-child :entry [e index] - (get-child (val e) index)) -(defmethod get-child-count :entry [e] - (count (val e))) - -(defmethod is-leaf :map [m] - false) -(defmethod get-child :map [m index] - (nth (seq m) index)) - -(defn tree-model [data] - (proxy [TreeModel] [] - (getRoot [] data) - (addTreeModelListener [treeModelListener]) - (getChild [parent index] - (get-child parent index)) - (getChildCount [parent] - (get-child-count parent)) - (isLeaf [node] - (is-leaf node)) - (valueForPathChanged [path newValue]) - (getIndexOfChild [parent child] - -1) - (removeTreeModelListener [treeModelListener]))) - - -(defn old-table-model [data] - (let [row1 (first data) - colcnt (count row1) - cnt (count data) - vals (if (map? row1) vals identity)] - (proxy [TableModel] [] - (addTableModelListener [tableModelListener]) - (getColumnClass [columnIndex] Object) - (getColumnCount [] colcnt) - (getColumnName [columnIndex] - (if (map? row1) - (name (nth (keys row1) columnIndex)) - (str columnIndex))) - (getRowCount [] cnt) - (getValueAt [rowIndex columnIndex] - (nth (vals (nth data rowIndex)) columnIndex)) - (isCellEditable [rowIndex columnIndex] false) - (removeTableModelListener [tableModelListener])))) - -(defn inspect-tree - "creates a graphical (Swing) inspector on the supplied hierarchical data" - {:added "1.0"} - [data] - (doto (JFrame. "Clojure Inspector") - (.add (JScrollPane. (JTree. (tree-model data)))) - (.setSize 400 600) - (.setVisible true))) - -(defn inspect-table - "creates a graphical (Swing) inspector on the supplied regular - data, which must be a sequential data structure of data structures - of equal length" - {:added "1.0"} - [data] - (doto (JFrame. "Clojure Inspector") - (.add (JScrollPane. (JTable. (old-table-model data)))) - (.setSize 400 600) - (.setVisible true))) - - -(defmulti list-provider class) - -(defmethod list-provider :default [x] - {:nrows 1 :get-value (fn [i] x) :get-label (fn [i] (.getName (class x)))}) - -(defmethod list-provider java.util.List [c] - (let [v (if (vector? c) c (vec c))] - {:nrows (count v) - :get-value (fn [i] (v i)) - :get-label (fn [i] i)})) - -(defmethod list-provider java.util.Map [c] - (let [v (vec (sort (map (fn [[k v]] (vector k v)) c)))] - {:nrows (count v) - :get-value (fn [i] ((v i) 1)) - :get-label (fn [i] ((v i) 0))})) - -(defn list-model [provider] - (let [{:keys [nrows get-value get-label]} provider] - (proxy [AbstractTableModel] [] - (getColumnCount [] 2) - (getRowCount [] nrows) - (getValueAt [rowIndex columnIndex] - (cond - (= 0 columnIndex) (get-label rowIndex) - (= 1 columnIndex) (print-str (get-value rowIndex))))))) - -(defmulti table-model class) - -(defmethod table-model :default [x] - (proxy [AbstractTableModel] [] - (getColumnCount [] 2) - (getRowCount [] 1) - (getValueAt [rowIndex columnIndex] - (if (zero? columnIndex) - (class x) - x)))) - -;(defn make-inspector [x] -; (agent {:frame frame :data x :parent nil :index 0})) - - -(defn inspect - "creates a graphical (Swing) inspector on the supplied object" - {:added "1.0"} - [x] - (doto (JFrame. "Clojure Inspector") - (.add - (doto (JPanel. (BorderLayout.)) - (.add (doto (JToolBar.) - (.add (JButton. "Back")) - (.addSeparator) - (.add (JButton. "List")) - (.add (JButton. "Table")) - (.add (JButton. "Bean")) - (.add (JButton. "Line")) - (.add (JButton. "Bar")) - (.addSeparator) - (.add (JButton. "Prev")) - (.add (JButton. "Next"))) - BorderLayout/NORTH) - (.add - (JScrollPane. - (doto (JTable. (list-model (list-provider x))) - (.setAutoResizeMode JTable/AUTO_RESIZE_LAST_COLUMN))) - BorderLayout/CENTER))) - (.setSize 400 400) - (.setVisible true))) - - -(comment - -(load-file "src/inspector.clj") -(refer 'inspector) -(inspect-tree {:a 1 :b 2 :c [1 2 3 {:d 4 :e 5 :f [6 7 8]}]}) -(inspect-table [[1 2 3][4 5 6][7 8 9][10 11 12]]) - -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/java/browse.clj --- a/src/clojure/java/browse.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns - ^{:author "Christophe Grand", - :doc "Start a web browser from Clojure"} - clojure.java.browse - (:require [clojure.java.shell :as sh]) - (:import (java.net URI))) - -(defn- macosx? [] - (-> "os.name" System/getProperty .toLowerCase - (.startsWith "mac os x"))) - -(def *open-url-script* (when (macosx?) "/usr/bin/open")) - -(defn- open-url-in-browser - "Opens url (a string) in the default system web browser. May not - work on all platforms. Returns url on success, nil if not - supported." - [url] - (try - (when (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" - "isDesktopSupported" (to-array nil)) - (-> (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" - "getDesktop" (to-array nil)) - (.browse (URI. url))) - url) - (catch ClassNotFoundException e - nil))) - -(defn- open-url-in-swing - "Opens url (a string) in a Swing window." - [url] - ; the implementation of this function resides in another namespace to be loaded "on demand" - ; this fixes a bug on mac os x where the process turns into a GUI app - ; see http://code.google.com/p/clojure-contrib/issues/detail?id=32 - (require 'clojure.java.browse-ui) - ((find-var 'clojure.java.browse-ui/open-url-in-swing) url)) - -(defn browse-url - "Open url in a browser" - {:added "1.2"} - [url] - (or (open-url-in-browser url) - (when *open-url-script* (sh/sh *open-url-script* (str url)) true) - (open-url-in-swing url))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/java/browse_ui.clj --- a/src/clojure/java/browse_ui.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,30 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns - ^{:author "Christophe Grand", - :doc "Helper namespace for clojure.java.browse. - Prevents console apps from becoming GUI unnecessarily."} - clojure.java.browse-ui) - -(defn- open-url-in-swing - [url] - (let [htmlpane (javax.swing.JEditorPane. url)] - (.setEditable htmlpane false) - (.addHyperlinkListener htmlpane - (proxy [javax.swing.event.HyperlinkListener] [] - (hyperlinkUpdate [#^javax.swing.event.HyperlinkEvent e] - (when (= (.getEventType e) (. javax.swing.event.HyperlinkEvent$EventType ACTIVATED)) - (if (instance? javax.swing.text.html.HTMLFrameHyperlinkEvent e) - (-> htmlpane .getDocument (.processHTMLFrameHyperlinkEvent e)) - (.setPage htmlpane (.getURL e))))))) - (doto (javax.swing.JFrame.) - (.setContentPane (javax.swing.JScrollPane. htmlpane)) - (.setBounds 32 32 700 900) - (.show)))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/java/io.clj --- a/src/clojure/java/io.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,427 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns - ^{:author "Stuart Sierra, Chas Emerick, Stuart Halloway", - :doc "This file defines polymorphic I/O utility functions for Clojure."} - clojure.java.io - (:import - (java.io Reader InputStream InputStreamReader PushbackReader - BufferedReader File OutputStream - OutputStreamWriter BufferedWriter Writer - FileInputStream FileOutputStream ByteArrayOutputStream - StringReader ByteArrayInputStream - BufferedInputStream BufferedOutputStream - CharArrayReader Closeable) - (java.net URI URL MalformedURLException Socket))) - -(def - ^{:doc "Type object for a Java primitive byte array." - :private true - } - byte-array-type (class (make-array Byte/TYPE 0))) - -(def - ^{:doc "Type object for a Java primitive char array." - :private true} - char-array-type (class (make-array Character/TYPE 0))) - -(defprotocol ^{:added "1.2"} Coercions - "Coerce between various 'resource-namish' things." - (^{:tag java.io.File, :added "1.2"} as-file [x] "Coerce argument to a file.") - (^{:tag java.net.URL, :added "1.2"} as-url [x] "Coerce argument to a URL.")) - -(extend-protocol Coercions - nil - (as-file [_] nil) - (as-url [_] nil) - - String - (as-file [s] (File. s)) - (as-url [s] (URL. s)) - - File - (as-file [f] f) - (as-url [f] (.toURL f)) - - URL - (as-url [u] u) - (as-file [u] - (if (= "file" (.getProtocol u)) - (as-file (.getPath u)) - (throw (IllegalArgumentException. "Not a file: " u)))) - - URI - (as-url [u] (.toURL u)) - (as-file [u] (as-file (as-url u)))) - -(defprotocol ^{:added "1.2"} IOFactory - "Factory functions that create ready-to-use, buffered versions of - the various Java I/O stream types, on top of anything that can - be unequivocally converted to the requested kind of stream. - - Common options include - - :append true to open stream in append mode - :encoding string name of encoding to use, e.g. \"UTF-8\". - - Callers should generally prefer the higher level API provided by - reader, writer, input-stream, and output-stream." - (^{:added "1.2"} make-reader [x opts] "Creates a BufferedReader. See also IOFactory docs.") - (^{:added "1.2"} make-writer [x opts] "Creates a BufferedWriter. See also IOFactory docs.") - (^{:added "1.2"} make-input-stream [x opts] "Creates a BufferedInputStream. See also IOFactory docs.") - (^{:added "1.2"} make-output-stream [x opts] "Creates a BufferedOutputStream. See also IOFactory docs.")) - -(defn ^Reader reader - "Attempts to coerce its argument into an open java.io.Reader. - Default implementations always return a java.io.BufferedReader. - - Default implementations are provided for Reader, BufferedReader, - InputStream, File, URI, URL, Socket, byte arrays, character arrays, - and String. - - If argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the Reader is properly - closed." - {:added "1.2"} - [x & opts] - (make-reader x (when opts (apply hash-map opts)))) - -(defn ^Writer writer - "Attempts to coerce its argument into an open java.io.Writer. - Default implementations always return a java.io.BufferedWriter. - - Default implementations are provided for Writer, BufferedWriter, - OutputStream, File, URI, URL, Socket, and String. - - If the argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the Writer is properly - closed." - {:added "1.2"} - [x & opts] - (make-writer x (when opts (apply hash-map opts)))) - -(defn ^InputStream input-stream - "Attempts to coerce its argument into an open java.io.InputStream. - Default implementations always return a java.io.BufferedInputStream. - - Default implementations are defined for OutputStream, File, URI, URL, - Socket, byte array, and String arguments. - - If the argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the InputStream is properly - closed." - {:added "1.2"} - [x & opts] - (make-input-stream x (when opts (apply hash-map opts)))) - -(defn ^OutputStream output-stream - "Attempts to coerce its argument into an open java.io.OutputStream. - Default implementations always return a java.io.BufferedOutputStream. - - Default implementations are defined for OutputStream, File, URI, URL, - Socket, and String arguments. - - If the argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the OutputStream is - properly closed." - {:added "1.2"} - [x & opts] - (make-output-stream x (when opts (apply hash-map opts)))) - -(defn- ^Boolean append? [opts] - (boolean (:append opts))) - -(defn- ^String encoding [opts] - (or (:encoding opts) "UTF-8")) - -(defn- buffer-size [opts] - (or (:buffer-size opts) 1024)) - -(def default-streams-impl - {:make-reader (fn [x opts] (make-reader (make-input-stream x opts) opts)) - :make-writer (fn [x opts] (make-writer (make-output-stream x opts) opts)) - :make-input-stream (fn [x opts] - (throw (IllegalArgumentException. - (str "Cannot open <" (pr-str x) "> as an InputStream.")))) - :make-output-stream (fn [x opts] - (throw (IllegalArgumentException. - (str "Cannot open <" (pr-str x) "> as an OutputStream."))))}) - -(defn- inputstream->reader - [^InputStream is opts] - (make-reader (InputStreamReader. is (encoding opts)) opts)) - -(defn- outputstream->writer - [^OutputStream os opts] - (make-writer (OutputStreamWriter. os (encoding opts)) opts)) - -(extend BufferedInputStream - IOFactory - (assoc default-streams-impl - :make-input-stream (fn [x opts] x) - :make-reader inputstream->reader)) - -(extend InputStream - IOFactory - (assoc default-streams-impl - :make-input-stream (fn [x opts] (BufferedInputStream. x)) - :make-reader inputstream->reader)) - -(extend Reader - IOFactory - (assoc default-streams-impl - :make-reader (fn [x opts] (BufferedReader. x)))) - -(extend BufferedReader - IOFactory - (assoc default-streams-impl - :make-reader (fn [x opts] x))) - -(extend Writer - IOFactory - (assoc default-streams-impl - :make-writer (fn [x opts] (BufferedWriter. x)))) - -(extend BufferedWriter - IOFactory - (assoc default-streams-impl - :make-writer (fn [x opts] x))) - -(extend OutputStream - IOFactory - (assoc default-streams-impl - :make-output-stream (fn [x opts] (BufferedOutputStream. x)) - :make-writer outputstream->writer)) - -(extend BufferedOutputStream - IOFactory - (assoc default-streams-impl - :make-output-stream (fn [x opts] x) - :make-writer outputstream->writer)) - -(extend File - IOFactory - (assoc default-streams-impl - :make-input-stream (fn [^File x opts] (make-input-stream (FileInputStream. x) opts)) - :make-output-stream (fn [^File x opts] (make-output-stream (FileOutputStream. x (append? opts)) opts)))) - -(extend URL - IOFactory - (assoc default-streams-impl - :make-input-stream (fn [^URL x opts] - (make-input-stream - (if (= "file" (.getProtocol x)) - (FileInputStream. (.getPath x)) - (.openStream x)) opts)) - :make-output-stream (fn [^URL x opts] - (if (= "file" (.getProtocol x)) - (make-output-stream (File. (.getPath x)) opts) - (throw (IllegalArgumentException. (str "Can not write to non-file URL <" x ">"))))))) - -(extend URI - IOFactory - (assoc default-streams-impl - :make-input-stream (fn [^URI x opts] (make-input-stream (.toURL x) opts)) - :make-output-stream (fn [^URI x opts] (make-output-stream (.toURL x) opts)))) - -(extend String - IOFactory - (assoc default-streams-impl - :make-input-stream (fn [^String x opts] - (try - (make-input-stream (URL. x) opts) - (catch MalformedURLException e - (make-input-stream (File. x) opts)))) - :make-output-stream (fn [^String x opts] - (try - (make-output-stream (URL. x) opts) - (catch MalformedURLException err - (make-output-stream (File. x) opts)))))) - -(extend Socket - IOFactory - (assoc default-streams-impl - :make-input-stream (fn [^Socket x opts] (make-input-stream (.getInputStream x) opts)) - :make-output-stream (fn [^Socket x opts] (make-output-stream (.getOutputStream x) opts)))) - -(extend byte-array-type - IOFactory - (assoc default-streams-impl - :make-input-stream (fn [x opts] (make-input-stream (ByteArrayInputStream. x) opts)))) - -(extend char-array-type - IOFactory - (assoc default-streams-impl - :make-reader (fn [x opts] (make-reader (CharArrayReader. x) opts)))) - -(extend Object - IOFactory - default-streams-impl) - -(defmulti - #^{:doc "Internal helper for copy" - :private true - :arglists '([input output opts])} - do-copy - (fn [input output opts] [(type input) (type output)])) - -(defmethod do-copy [InputStream OutputStream] [#^InputStream input #^OutputStream output opts] - (let [buffer (make-array Byte/TYPE (buffer-size opts))] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (do (.write output buffer 0 size) - (recur))))))) - -(defmethod do-copy [InputStream Writer] [#^InputStream input #^Writer output opts] - (let [#^"[B" buffer (make-array Byte/TYPE (buffer-size opts))] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (let [chars (.toCharArray (String. buffer 0 size (encoding opts)))] - (do (.write output chars) - (recur)))))))) - -(defmethod do-copy [InputStream File] [#^InputStream input #^File output opts] - (with-open [out (FileOutputStream. output)] - (do-copy input out opts))) - -(defmethod do-copy [Reader OutputStream] [#^Reader input #^OutputStream output opts] - (let [#^"[C" buffer (make-array Character/TYPE (buffer-size opts))] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (let [bytes (.getBytes (String. buffer 0 size) (encoding opts))] - (do (.write output bytes) - (recur)))))))) - -(defmethod do-copy [Reader Writer] [#^Reader input #^Writer output opts] - (let [#^"[C" buffer (make-array Character/TYPE (buffer-size opts))] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (do (.write output buffer 0 size) - (recur))))))) - -(defmethod do-copy [Reader File] [#^Reader input #^File output opts] - (with-open [out (FileOutputStream. output)] - (do-copy input out opts))) - -(defmethod do-copy [File OutputStream] [#^File input #^OutputStream output opts] - (with-open [in (FileInputStream. input)] - (do-copy in output opts))) - -(defmethod do-copy [File Writer] [#^File input #^Writer output opts] - (with-open [in (FileInputStream. input)] - (do-copy in output opts))) - -(defmethod do-copy [File File] [#^File input #^File output opts] - (with-open [in (FileInputStream. input) - out (FileOutputStream. output)] - (do-copy in out opts))) - -(defmethod do-copy [String OutputStream] [#^String input #^OutputStream output opts] - (do-copy (StringReader. input) output opts)) - -(defmethod do-copy [String Writer] [#^String input #^Writer output opts] - (do-copy (StringReader. input) output opts)) - -(defmethod do-copy [String File] [#^String input #^File output opts] - (do-copy (StringReader. input) output opts)) - -(defmethod do-copy [char-array-type OutputStream] [input #^OutputStream output opts] - (do-copy (CharArrayReader. input) output opts)) - -(defmethod do-copy [char-array-type Writer] [input #^Writer output opts] - (do-copy (CharArrayReader. input) output opts)) - -(defmethod do-copy [char-array-type File] [input #^File output opts] - (do-copy (CharArrayReader. input) output opts)) - -(defmethod do-copy [byte-array-type OutputStream] [#^"[B" input #^OutputStream output opts] - (do-copy (ByteArrayInputStream. input) output opts)) - -(defmethod do-copy [byte-array-type Writer] [#^"[B" input #^Writer output opts] - (do-copy (ByteArrayInputStream. input) output opts)) - -(defmethod do-copy [byte-array-type File] [#^"[B" input #^Writer output opts] - (do-copy (ByteArrayInputStream. input) output opts)) - -(defn copy - "Copies input to output. Returns nil or throws IOException. - Input may be an InputStream, Reader, File, byte[], or String. - Output may be an OutputStream, Writer, or File. - - Options are key/value pairs and may be one of - - :buffer-size buffer size to use, default is 1024. - :encoding encoding to use if converting between - byte and char streams. - - Does not close any streams except those it opens itself - (on a File)." - {:added "1.2"} - [input output & opts] - (do-copy input output (when opts (apply hash-map opts)))) - -(defn ^String as-relative-path - "Take an as-file-able thing and return a string if it is - a relative path, else IllegalArgumentException." - {:added "1.2"} - [x] - (let [^File f (as-file x)] - (if (.isAbsolute f) - (throw (IllegalArgumentException. (str f " is not a relative path"))) - (.getPath f)))) - -(defn ^File file - "Returns a java.io.File, passing each arg to as-file. Multiple-arg - versions treat the first argument as parent and subsequent args as - children relative to the parent." - {:added "1.2"} - ([arg] - (as-file arg)) - ([parent child] - (File. ^File (as-file parent) ^String (as-relative-path child))) - ([parent child & more] - (reduce file (file parent child) more))) - -(defn delete-file - "Delete file f. Raise an exception if it fails unless silently is true." - {:added "1.2"} - [f & [silently]] - (or (.delete (file f)) - silently - (throw (java.io.IOException. (str "Couldn't delete " f))))) - -(defn make-parents - "Given the same arg(s) as for file, creates all parent directories of - the file they represent." - {:added "1.2"} - [f & more] - (.mkdirs (.getParentFile ^File (apply file f more)))) - -(defn ^URL resource - "Returns the URL for a named resource. Use the context class loader - if no loader is specified." - {:added "1.2"} - ([n] (resource n (.getContextClassLoader (Thread/currentThread)))) - ([n ^ClassLoader loader] (.getResource loader n))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/java/javadoc.clj --- a/src/clojure/java/javadoc.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,82 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. -(ns - ^{:author "Christophe Grand, Stuart Sierra", - :doc "A repl helper to quickly open javadocs."} - clojure.java.javadoc - (:use [clojure.java.browse :only (browse-url)] ) - (:import - (java.io File))) - -(def *feeling-lucky-url* "http://www.google.com/search?btnI=I%27m%20Feeling%20Lucky&q=allinurl:") -(def *feeling-lucky* true) - -(def *local-javadocs* (ref (list))) - -(def *core-java-api* - (if (= "1.5" (System/getProperty "java.specification.version")) - "http://java.sun.com/j2se/1.5.0/docs/api/" - "http://java.sun.com/javase/6/docs/api/")) - -(def *remote-javadocs* - (ref (sorted-map - "java." *core-java-api* - "javax." *core-java-api* - "org.ietf.jgss." *core-java-api* - "org.omg." *core-java-api* - "org.w3c.dom." *core-java-api* - "org.xml.sax." *core-java-api* - "org.apache.commons.codec." "http://commons.apache.org/codec/api-release/" - "org.apache.commons.io." "http://commons.apache.org/io/api-release/" - "org.apache.commons.lang." "http://commons.apache.org/lang/api-release/"))) - -(defn add-local-javadoc - "Adds to the list of local Javadoc paths." - {:added "1.2"} - [path] - (dosync (commute *local-javadocs* conj path))) - -(defn add-remote-javadoc - "Adds to the list of remote Javadoc URLs. package-prefix is the - beginning of the package name that has docs at this URL." - {:added "1.2"} - [package-prefix url] - (dosync (commute *remote-javadocs* assoc package-prefix url))) - -(defn- javadoc-url - "Searches for a URL for the given class name. Tries - *local-javadocs* first, then *remote-javadocs*. Returns a string." - {:tag String, - :added "1.2"} - [^String classname] - (let [file-path (.replace classname \. File/separatorChar) - url-path (.replace classname \. \/)] - (if-let [file ^File (first - (filter #(.exists ^File %) - (map #(File. (str %) (str file-path ".html")) - @*local-javadocs*)))] - (-> file .toURI str) - ;; If no local file, try remote URLs: - (or (some (fn [[prefix url]] - (when (.startsWith classname prefix) - (str url url-path ".html"))) - @*remote-javadocs*) - ;; if *feeling-lucky* try a web search - (when *feeling-lucky* (str *feeling-lucky-url* url-path ".html")))))) - -(defn javadoc - "Opens a browser window displaying the javadoc for the argument. - Tries *local-javadocs* first, then *remote-javadocs*." - {:added "1.2"} - [class-or-object] - (let [^Class c (if (instance? Class class-or-object) - class-or-object - (class class-or-object))] - (if-let [url (javadoc-url (.getName c))] - (browse-url url) - (println "Could not find Javadoc for" c)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/java/shell.clj --- a/src/clojure/java/shell.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,143 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns - ^{:author "Chris Houser, Stuart Halloway", - :doc "Conveniently launch a sub-process providing its stdin and -collecting its stdout"} - clojure.java.shell - (:use [clojure.java.io :only (as-file copy)]) - (:import (java.io OutputStreamWriter ByteArrayOutputStream StringWriter) - (java.nio.charset Charset))) - -(def *sh-dir* nil) -(def *sh-env* nil) - -(defmacro with-sh-dir - "Sets the directory for use with sh, see sh for details." - {:added "1.2"} - [dir & forms] - `(binding [*sh-dir* ~dir] - ~@forms)) - -(defmacro with-sh-env - "Sets the environment for use with sh, see sh for details." - {:added "1.2"} - [env & forms] - `(binding [*sh-env* ~env] - ~@forms)) - -(defn- aconcat - "Concatenates arrays of given type." - [type & xs] - (let [target (make-array type (apply + (map count xs)))] - (loop [i 0 idx 0] - (when-let [a (nth xs i nil)] - (System/arraycopy a 0 target idx (count a)) - (recur (inc i) (+ idx (count a))))) - target)) - -(defn- parse-args - [args] - (let [default-encoding "UTF-8" ;; see sh doc string - default-opts {:out-enc default-encoding :in-enc default-encoding :dir *sh-dir* :env *sh-env*} - [cmd opts] (split-with string? args)] - [cmd (merge default-opts (apply hash-map opts))])) - -(defn- ^"[Ljava.lang.String;" as-env-strings - "Helper so that callers can pass a Clojure map for the :env to sh." - [arg] - (cond - (nil? arg) nil - (map? arg) (into-array String (map (fn [[k v]] (str (name k) "=" v)) arg)) - true arg)) - -(defn- stream-to-bytes - [in] - (with-open [bout (ByteArrayOutputStream.)] - (copy in bout) - (.toByteArray bout))) - -(defn- stream-to-string - ([in] (stream-to-string in (.name (Charset/defaultCharset)))) - ([in enc] - (with-open [bout (StringWriter.)] - (copy in bout :encoding enc) - (.toString bout)))) - -(defn- stream-to-enc - [stream enc] - (if (= enc :bytes) - (stream-to-bytes stream) - (stream-to-string stream enc))) - -(defn sh - "Passes the given strings to Runtime.exec() to launch a sub-process. - - Options are - - :in may be given followed by a String or byte array specifying input - to be fed to the sub-process's stdin. - :in-enc option may be given followed by a String, used as a character - encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to - convert the input string specified by the :in option to the - sub-process's stdin. Defaults to UTF-8. - If the :in option provides a byte array, then the bytes are passed - unencoded, and this option is ignored. - :out-enc option may be given followed by :bytes or a String. If a - String is given, it will be used as a character encoding - name (for example \"UTF-8\" or \"ISO-8859-1\") to convert - the sub-process's stdout to a String which is returned. - If :bytes is given, the sub-process's stdout will be stored - in a byte array and returned. Defaults to UTF-8. - :env override the process env with a map (or the underlying Java - String[] if you are a masochist). - :dir override the process dir with a String or java.io.File. - - You can bind :env or :dir for multiple operations using with-sh-env - and with-sh-dir. - - sh returns a map of - :exit => sub-process's exit code - :out => sub-process's stdout (as byte[] or String) - :err => sub-process's stderr (String via platform default encoding)" - {:added "1.2"} - [& args] - (let [[cmd opts] (parse-args args) - proc (.exec (Runtime/getRuntime) - ^"[Ljava.lang.String;" (into-array cmd) - (as-env-strings (:env opts)) - (as-file (:dir opts))) - {:keys [in in-enc out-enc]} opts] - (if in - (future - (if (instance? (class (byte-array 0)) in) - (with-open [os (.getOutputStream proc)] - (.write os ^"[B" in)) - (with-open [osw (OutputStreamWriter. (.getOutputStream proc) ^String in-enc)] - (.write osw ^String in)))) - (.close (.getOutputStream proc))) - (with-open [stdout (.getInputStream proc) - stderr (.getErrorStream proc)] - (let [out (future (stream-to-enc stdout out-enc)) - err (future (stream-to-string stderr)) - exit-code (.waitFor proc)] - {:exit exit-code :out @out :err @err})))) - -(comment - -(println (sh "ls" "-l")) -(println (sh "ls" "-l" "/no-such-thing")) -(println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n")) -(println (sh "cat" :in "x\u25bax\n")) -(println (sh "echo" "x\u25bax")) -(println (sh "echo" "x\u25bax" :out-enc "ISO-8859-1")) ; reads 4 single-byte chars -(println (sh "cat" "myimage.png" :out-enc :bytes)) ; reads binary file into bytes[] -(println (sh "cmd" "/c dir 1>&2")) - -) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/AFn.java --- a/src/clojure/lang/AFn.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,442 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 25, 2006 4:05:37 PM */ - -package clojure.lang; - -public abstract class AFn implements IFn { - -public Object call() throws Exception{ - return invoke(); -} - -public void run(){ - try - { - invoke(); - } - catch(Exception e) - { - throw new RuntimeException(e); - } -} - - - -public Object invoke() throws Exception{ - return throwArity(0); -} - -public Object invoke(Object arg1) throws Exception{ - return throwArity(1); -} - -public Object invoke(Object arg1, Object arg2) throws Exception{ - return throwArity(2); -} - -public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ - return throwArity(3); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ - return throwArity(4); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ - return throwArity(5); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ - return throwArity(6); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) - throws Exception{ - return throwArity(7); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8) throws Exception{ - return throwArity(8); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9) throws Exception{ - return throwArity(9); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10) throws Exception{ - return throwArity(10); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ - return throwArity(11); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ - return throwArity(12); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) - throws Exception{ - return throwArity(13); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) - throws Exception{ - return throwArity(14); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15) throws Exception{ - return throwArity(15); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16) throws Exception{ - return throwArity(16); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17) throws Exception{ - return throwArity(17); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ - return throwArity(18); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ - return throwArity(19); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) - throws Exception{ - return throwArity(20); -} - - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, - Object... args) - throws Exception{ - return throwArity(21); -} - -public Object applyTo(ISeq arglist) throws Exception{ - return applyToHelper(this, Util.ret1(arglist,arglist = null)); -} - -static public Object applyToHelper(IFn ifn, ISeq arglist) throws Exception{ - switch(RT.boundedLength(arglist, 20)) - { - case 0: - arglist = null; - return ifn.invoke(); - case 1: - Object a1 = arglist.first(); - arglist = null; - return ifn.invoke(a1); - case 2: - return ifn.invoke(arglist.first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 3: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 4: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 5: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 6: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 7: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 8: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 9: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 10: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 11: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 12: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 13: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 14: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 15: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 16: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 17: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 18: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 19: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - case 20: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , Util.ret1((arglist = arglist.next()).first(),arglist = null) - ); - default: - return ifn.invoke(arglist.first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , (arglist = arglist.next()).first() - , RT.seqToArray(Util.ret1(arglist.next(),arglist = null))); - } -} - -public Object throwArity(int n){ - String name = getClass().getSimpleName(); - int suffix = name.lastIndexOf("__"); - throw new IllegalArgumentException("Wrong number of args (" + n + ") passed to: " - + (suffix == -1 ? name : name.substring(0, suffix)).replace('_', '-')); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/AFunction.java --- a/src/clojure/lang/AFunction.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,42 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Dec 16, 2008 */ - -package clojure.lang; - -import java.io.Serializable; -import java.util.Comparator; - -public abstract class AFunction extends AFn implements IObj, Comparator, Fn, Serializable { - -public volatile MethodImplCache __methodImplCache; - -public int compare(Object o1, Object o2){ - try - { - Object o = invoke(o1, o2); - - if(o instanceof Boolean) - { - if(RT.booleanCast(o)) - return -1; - return RT.booleanCast(invoke(o2,o1))? 1 : 0; - } - - Number n = (Number) o; - return n.intValue(); - } - catch(Exception e) - { - throw new RuntimeException(e); - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/AMapEntry.java --- a/src/clojure/lang/AMapEntry.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 1, 2008 */ - -package clojure.lang; - -import java.io.StringWriter; - -public abstract class AMapEntry extends APersistentVector implements IMapEntry{ - -public Object nth(int i){ - if(i == 0) - return key(); - else if(i == 1) - return val(); - else - throw new IndexOutOfBoundsException(); -} - -private IPersistentVector asVector(){ - return LazilyPersistentVector.createOwning(key(), val()); -} - -public IPersistentVector assocN(int i, Object val){ - return asVector().assocN(i, val); -} - -public int count(){ - return 2; -} - -public ISeq seq(){ - return asVector().seq(); -} - -public IPersistentVector cons(Object o){ - return asVector().cons(o); -} - -public IPersistentCollection empty(){ - return null; -} - -public IPersistentStack pop(){ - return LazilyPersistentVector.createOwning(key()); -} - -public Object setValue(Object value){ - throw new UnsupportedOperationException(); -} - -/* - -public boolean equals(Object obj){ - return APersistentVector.doEquals(this, obj); -} - -public int hashCode(){ - //must match logic in APersistentVector - return 31 * (31 + Util.hash(key())) + Util.hash(val()); -// return Util.hashCombine(Util.hashCombine(0, Util.hash(key())), Util.hash(val())); -} - -public String toString(){ - StringWriter sw = new StringWriter(); - try - { - RT.print(this, sw); - } - catch(Exception e) - { - //checked exceptions stink! - throw new RuntimeException(e); - } - return sw.toString(); -} - -public int length(){ - return 2; -} - -public Object nth(int i){ - if(i == 0) - return key(); - else if(i == 1) - return val(); - else - throw new IndexOutOfBoundsException(); -} - -private IPersistentVector asVector(){ - return LazilyPersistentVector.createOwning(key(), val()); -} - -public IPersistentVector assocN(int i, Object val){ - return asVector().assocN(i, val); -} - -public int count(){ - return 2; -} - -public ISeq seq(){ - return asVector().seq(); -} - -public IPersistentVector cons(Object o){ - return asVector().cons(o); -} - -public boolean containsKey(Object key){ - return asVector().containsKey(key); -} - -public IMapEntry entryAt(Object key){ - return asVector().entryAt(key); -} - -public Associative assoc(Object key, Object val){ - return asVector().assoc(key, val); -} - -public Object valAt(Object key){ - return asVector().valAt(key); -} - -public Object valAt(Object key, Object notFound){ - return asVector().valAt(key, notFound); -} - -public Object peek(){ - return val(); -} - - -public ISeq rseq() throws Exception{ - return asVector().rseq(); -} -*/ - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/APersistentMap.java --- a/src/clojure/lang/APersistentMap.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,384 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -import java.io.Serializable; -import java.util.*; - -public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable, MapEquivalence { -int _hash = -1; - -public String toString(){ - return RT.printString(this); -} - -public IPersistentCollection cons(Object o){ - if(o instanceof Map.Entry) - { - Map.Entry e = (Map.Entry) o; - - return assoc(e.getKey(), e.getValue()); - } - else if(o instanceof IPersistentVector) - { - IPersistentVector v = (IPersistentVector) o; - if(v.count() != 2) - throw new IllegalArgumentException("Vector arg to map conj must be a pair"); - return assoc(v.nth(0), v.nth(1)); - } - - IPersistentMap ret = this; - for(ISeq es = RT.seq(o); es != null; es = es.next()) - { - Map.Entry e = (Map.Entry) es.first(); - ret = ret.assoc(e.getKey(), e.getValue()); - } - return ret; -} - -public boolean equals(Object obj){ - return mapEquals(this, obj); -} - -static public boolean mapEquals(IPersistentMap m1, Object obj){ - if(m1 == obj) return true; - if(!(obj instanceof Map)) - return false; - Map m = (Map) obj; - - if(m.size() != m1.count() || m.hashCode() != m1.hashCode()) - return false; - - for(ISeq s = m1.seq(); s != null; s = s.next()) - { - Map.Entry e = (Map.Entry) s.first(); - boolean found = m.containsKey(e.getKey()); - - if(!found || !Util.equals(e.getValue(), m.get(e.getKey()))) - return false; - } - - return true; -} - -public boolean equiv(Object obj){ - if(!(obj instanceof Map)) - return false; - if(obj instanceof IPersistentMap && !(obj instanceof MapEquivalence)) - return false; - - Map m = (Map) obj; - - if(m.size() != size()) - return false; - - for(ISeq s = seq(); s != null; s = s.next()) - { - Map.Entry e = (Map.Entry) s.first(); - boolean found = m.containsKey(e.getKey()); - - if(!found || !Util.equiv(e.getValue(), m.get(e.getKey()))) - return false; - } - - return true; -} -public int hashCode(){ - if(_hash == -1) - { - this._hash = mapHash(this); - } - return _hash; -} - -static public int mapHash(IPersistentMap m){ - int hash = 0; - for(ISeq s = m.seq(); s != null; s = s.next()) - { - Map.Entry e = (Map.Entry) s.first(); - hash += (e.getKey() == null ? 0 : e.getKey().hashCode()) ^ - (e.getValue() == null ? 0 : e.getValue().hashCode()); - } - return hash; -} - -static public class KeySeq extends ASeq{ - ISeq seq; - - static public KeySeq create(ISeq seq){ - if(seq == null) - return null; - return new KeySeq(seq); - } - - private KeySeq(ISeq seq){ - this.seq = seq; - } - - private KeySeq(IPersistentMap meta, ISeq seq){ - super(meta); - this.seq = seq; - } - - public Object first(){ - return ((Map.Entry) seq.first()).getKey(); - } - - public ISeq next(){ - return create(seq.next()); - } - - public KeySeq withMeta(IPersistentMap meta){ - return new KeySeq(meta, seq); - } -} - -static public class ValSeq extends ASeq{ - ISeq seq; - - static public ValSeq create(ISeq seq){ - if(seq == null) - return null; - return new ValSeq(seq); - } - - private ValSeq(ISeq seq){ - this.seq = seq; - } - - private ValSeq(IPersistentMap meta, ISeq seq){ - super(meta); - this.seq = seq; - } - - public Object first(){ - return ((Map.Entry) seq.first()).getValue(); - } - - public ISeq next(){ - return create(seq.next()); - } - - public ValSeq withMeta(IPersistentMap meta){ - return new ValSeq(meta, seq); - } -} - - -public Object invoke(Object arg1) throws Exception{ - return valAt(arg1); -} - -public Object invoke(Object arg1, Object notFound) throws Exception{ - return valAt(arg1, notFound); -} - -// java.util.Map implementation - -public void clear(){ - throw new UnsupportedOperationException(); -} - -public boolean containsValue(Object value){ - return values().contains(value); -} - -public Set entrySet(){ - return new AbstractSet(){ - - public Iterator iterator(){ - return APersistentMap.this.iterator(); - } - - public int size(){ - return count(); - } - - public int hashCode(){ - return APersistentMap.this.hashCode(); - } - - public boolean contains(Object o){ - if(o instanceof Entry) - { - Entry e = (Entry) o; - Entry found = entryAt(e.getKey()); - if(found != null && Util.equals(found.getValue(), e.getValue())) - return true; - } - return false; - } - }; -} - -public Object get(Object key){ - return valAt(key); -} - -public boolean isEmpty(){ - return count() == 0; -} - -public Set keySet(){ - return new AbstractSet(){ - - public Iterator iterator(){ - final Iterator mi = APersistentMap.this.iterator(); - - return new Iterator(){ - - - public boolean hasNext(){ - return mi.hasNext(); - } - - public Object next(){ - Entry e = (Entry) mi.next(); - return e.getKey(); - } - - public void remove(){ - throw new UnsupportedOperationException(); - } - }; - } - - public int size(){ - return count(); - } - - public boolean contains(Object o){ - return APersistentMap.this.containsKey(o); - } - }; -} - -public Object put(Object key, Object value){ - throw new UnsupportedOperationException(); -} - -public void putAll(Map t){ - throw new UnsupportedOperationException(); -} - -public Object remove(Object key){ - throw new UnsupportedOperationException(); -} - -public int size(){ - return count(); -} - -public Collection values(){ - return new AbstractCollection(){ - - public Iterator iterator(){ - final Iterator mi = APersistentMap.this.iterator(); - - return new Iterator(){ - - - public boolean hasNext(){ - return mi.hasNext(); - } - - public Object next(){ - Entry e = (Entry) mi.next(); - return e.getValue(); - } - - public void remove(){ - throw new UnsupportedOperationException(); - } - }; - } - - public int size(){ - return count(); - } - }; -} - -/* -// java.util.Collection implementation - -public Object[] toArray(){ - return RT.seqToArray(seq()); -} - -public boolean add(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean remove(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean addAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public void clear(){ - throw new UnsupportedOperationException(); -} - -public boolean retainAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean removeAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean containsAll(Collection c){ - for(Object o : c) - { - if(!contains(o)) - return false; - } - return true; -} - -public Object[] toArray(Object[] a){ - if(a.length >= count()) - { - ISeq s = seq(); - for(int i = 0; s != null; ++i, s = s.rest()) - { - a[i] = s.first(); - } - if(a.length > count()) - a[count()] = null; - return a; - } - else - return toArray(); -} - -public int size(){ - return count(); -} - -public boolean isEmpty(){ - return count() == 0; -} - -public boolean contains(Object o){ - if(o instanceof Map.Entry) - { - Map.Entry e = (Map.Entry) o; - Map.Entry v = entryAt(e.getKey()); - return (v != null && Util.equal(v.getValue(), e.getValue())); - } - return false; -} -*/ -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/APersistentSet.java --- a/src/clojure/lang/APersistentSet.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,160 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 3, 2008 */ - -package clojure.lang; - -import java.io.Serializable; -import java.util.Collection; -import java.util.Iterator; -import java.util.Set; - -public abstract class APersistentSet extends AFn implements IPersistentSet, Collection, Set, Serializable { -int _hash = -1; -final IPersistentMap impl; - -protected APersistentSet(IPersistentMap impl){ - this.impl = impl; -} - -public String toString(){ - return RT.printString(this); -} - -public boolean contains(Object key){ - return impl.containsKey(key); -} - -public Object get(Object key){ - return impl.valAt(key); -} - -public int count(){ - return impl.count(); -} - -public ISeq seq(){ - return RT.keys(impl); -} - -public Object invoke(Object arg1) throws Exception{ - return get(arg1); -} - -public boolean equals(Object obj){ - if(this == obj) return true; - if(!(obj instanceof Set)) - return false; - Set m = (Set) obj; - - if(m.size() != count() || m.hashCode() != hashCode()) - return false; - - for(Object aM : m) - { - if(!contains(aM)) - return false; - } -// for(ISeq s = seq(); s != null; s = s.rest()) -// { -// if(!m.contains(s.first())) -// return false; -// } - - return true; -} - -public boolean equiv(Object o){ - return equals(o); -} - -public int hashCode(){ - if(_hash == -1) - { - //int hash = count(); - int hash = 0; - for(ISeq s = seq(); s != null; s = s.next()) - { - Object e = s.first(); -// hash = Util.hashCombine(hash, Util.hash(e)); - hash += Util.hash(e); - } - this._hash = hash; - } - return _hash; -} - -public Object[] toArray(){ - return RT.seqToArray(seq()); -} - -public boolean add(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean remove(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean addAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public void clear(){ - throw new UnsupportedOperationException(); -} - -public boolean retainAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean removeAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean containsAll(Collection c){ - for(Object o : c) - { - if(!contains(o)) - return false; - } - return true; -} - -public Object[] toArray(Object[] a){ - if(a.length >= count()) - { - ISeq s = seq(); - for(int i = 0; s != null; ++i, s = s.next()) - { - a[i] = s.first(); - } - if(a.length > count()) - a[count()] = null; - return a; - } - else - return toArray(); -} - -public int size(){ - return count(); -} - -public boolean isEmpty(){ - return count() == 0; -} - -public Iterator iterator(){ - return new SeqIterator(seq()); -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/APersistentVector.java --- a/src/clojure/lang/APersistentVector.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,568 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Dec 18, 2007 */ - -package clojure.lang; - -import java.io.Serializable; -import java.util.*; - -public abstract class APersistentVector extends AFn implements IPersistentVector, Iterable, - List, - RandomAccess, Comparable, - Serializable { -int _hash = -1; - -public String toString(){ - return RT.printString(this); -} - -public ISeq seq(){ - if(count() > 0) - return new Seq(this, 0); - return null; -} - -public ISeq rseq(){ - if(count() > 0) - return new RSeq(this, count() - 1); - return null; -} - -static boolean doEquals(IPersistentVector v, Object obj){ - if(v == obj) return true; - if(obj instanceof List || obj instanceof IPersistentVector) - { - Collection ma = (Collection) obj; - if(ma.size() != v.count() || ma.hashCode() != v.hashCode()) - return false; - for(Iterator i1 = ((List) v).iterator(), i2 = ma.iterator(); - i1.hasNext();) - { - if(!Util.equals(i1.next(), i2.next())) - return false; - } - return true; - } -// if(obj instanceof IPersistentVector) -// { -// IPersistentVector ma = (IPersistentVector) obj; -// if(ma.count() != v.count() || ma.hashCode() != v.hashCode()) -// return false; -// for(int i = 0; i < v.count(); i++) -// { -// if(!Util.equal(v.nth(i), ma.nth(i))) -// return false; -// } -// } - else - { - if(!(obj instanceof Sequential)) - return false; - ISeq ms = RT.seq(obj); - for(int i = 0; i < v.count(); i++, ms = ms.next()) - { - if(ms == null || !Util.equals(v.nth(i), ms.first())) - return false; - } - if(ms != null) - return false; - } - - return true; - -} - -static boolean doEquiv(IPersistentVector v, Object obj){ - if(obj instanceof List || obj instanceof IPersistentVector) - { - Collection ma = (Collection) obj; - if(ma.size() != v.count()) - return false; - for(Iterator i1 = ((List) v).iterator(), i2 = ma.iterator(); - i1.hasNext();) - { - if(!Util.equiv(i1.next(), i2.next())) - return false; - } - return true; - } -// if(obj instanceof IPersistentVector) -// { -// IPersistentVector ma = (IPersistentVector) obj; -// if(ma.count() != v.count() || ma.hashCode() != v.hashCode()) -// return false; -// for(int i = 0; i < v.count(); i++) -// { -// if(!Util.equal(v.nth(i), ma.nth(i))) -// return false; -// } -// } - else - { - if(!(obj instanceof Sequential)) - return false; - ISeq ms = RT.seq(obj); - for(int i = 0; i < v.count(); i++, ms = ms.next()) - { - if(ms == null || !Util.equiv(v.nth(i), ms.first())) - return false; - } - if(ms != null) - return false; - } - - return true; - -} - -public boolean equals(Object obj){ - return doEquals(this, obj); -} - -public boolean equiv(Object obj){ - return doEquiv(this, obj); -} - -public int hashCode(){ - if(_hash == -1) - { - int hash = 1; - Iterator i = iterator(); - while(i.hasNext()) - { - Object obj = i.next(); - hash = 31 * hash + (obj == null ? 0 : obj.hashCode()); - } -// int hash = 0; -// for(int i = 0; i < count(); i++) -// { -// hash = Util.hashCombine(hash, Util.hash(nth(i))); -// } - this._hash = hash; - } - return _hash; -} - -public Object get(int index){ - return nth(index); -} - -public Object nth(int i, Object notFound){ - if(i >= 0 && i < count()) - return nth(i); - return notFound; -} - -public Object remove(int i){ - throw new UnsupportedOperationException(); -} - -public int indexOf(Object o){ - for(int i = 0; i < count(); i++) - if(Util.equiv(nth(i), o)) - return i; - return -1; -} - -public int lastIndexOf(Object o){ - for(int i = count() - 1; i >= 0; i--) - if(Util.equiv(nth(i), o)) - return i; - return -1; -} - -public ListIterator listIterator(){ - return listIterator(0); -} - -public ListIterator listIterator(final int index){ - return new ListIterator(){ - int nexti = index; - - public boolean hasNext(){ - return nexti < count(); - } - - public Object next(){ - return nth(nexti++); - } - - public boolean hasPrevious(){ - return nexti > 0; - } - - public Object previous(){ - return nth(--nexti); - } - - public int nextIndex(){ - return nexti; - } - - public int previousIndex(){ - return nexti - 1; - } - - public void remove(){ - throw new UnsupportedOperationException(); - } - - public void set(Object o){ - throw new UnsupportedOperationException(); - } - - public void add(Object o){ - throw new UnsupportedOperationException(); - } - }; -} - -public List subList(int fromIndex, int toIndex){ - return (List) RT.subvec(this, fromIndex, toIndex); -} - - -public Object set(int i, Object o){ - throw new UnsupportedOperationException(); -} - -public void add(int i, Object o){ - throw new UnsupportedOperationException(); -} - -public boolean addAll(int i, Collection c){ - throw new UnsupportedOperationException(); -} - - -public Object invoke(Object arg1) throws Exception{ - if(Util.isInteger(arg1)) - return nth(((Number) arg1).intValue()); - throw new IllegalArgumentException("Key must be integer"); -} - -public Iterator iterator(){ - //todo - something more efficient - return new Iterator(){ - int i = 0; - - public boolean hasNext(){ - return i < count(); - } - - public Object next(){ - return nth(i++); - } - - public void remove(){ - throw new UnsupportedOperationException(); - } - }; -} - -public Object peek(){ - if(count() > 0) - return nth(count() - 1); - return null; -} - -public boolean containsKey(Object key){ - if(!(Util.isInteger(key))) - return false; - int i = ((Number) key).intValue(); - return i >= 0 && i < count(); -} - -public IMapEntry entryAt(Object key){ - if(Util.isInteger(key)) - { - int i = ((Number) key).intValue(); - if(i >= 0 && i < count()) - return new MapEntry(key, nth(i)); - } - return null; -} - -public IPersistentVector assoc(Object key, Object val){ - if(Util.isInteger(key)) - { - int i = ((Number) key).intValue(); - return assocN(i, val); - } - throw new IllegalArgumentException("Key must be integer"); -} - -public Object valAt(Object key, Object notFound){ - if(Util.isInteger(key)) - { - int i = ((Number) key).intValue(); - if(i >= 0 && i < count()) - return nth(i); - } - return notFound; -} - -public Object valAt(Object key){ - return valAt(key, null); -} - -// java.util.Collection implementation - -public Object[] toArray(){ - return RT.seqToArray(seq()); -} - -public boolean add(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean remove(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean addAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public void clear(){ - throw new UnsupportedOperationException(); -} - -public boolean retainAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean removeAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean containsAll(Collection c){ - for(Object o : c) - { - if(!contains(o)) - return false; - } - return true; -} - -public Object[] toArray(Object[] a){ - if(a.length >= count()) - { - ISeq s = seq(); - for(int i = 0; s != null; ++i, s = s.next()) - { - a[i] = s.first(); - } - if(a.length > count()) - a[count()] = null; - return a; - } - else - return toArray(); -} - -public int size(){ - return count(); -} - -public boolean isEmpty(){ - return count() == 0; -} - -public boolean contains(Object o){ - for(ISeq s = seq(); s != null; s = s.next()) - { - if(Util.equiv(s.first(), o)) - return true; - } - return false; -} - -public int length(){ - return count(); -} - -public int compareTo(Object o){ - IPersistentVector v = (IPersistentVector) o; - if(count() < v.count()) - return -1; - else if(count() > v.count()) - return 1; - for(int i = 0; i < count(); i++) - { - int c = Util.compare(nth(i),v.nth(i)); - if(c != 0) - return c; - } - return 0; -} - - static class Seq extends ASeq implements IndexedSeq, IReduce{ - //todo - something more efficient - final IPersistentVector v; - final int i; - - - public Seq(IPersistentVector v, int i){ - this.v = v; - this.i = i; - } - - Seq(IPersistentMap meta, IPersistentVector v, int i){ - super(meta); - this.v = v; - this.i = i; - } - - public Object first(){ - return v.nth(i); - } - - public ISeq next(){ - if(i + 1 < v.count()) - return new APersistentVector.Seq(v, i + 1); - return null; - } - - public int index(){ - return i; - } - - public int count(){ - return v.count() - i; - } - - public APersistentVector.Seq withMeta(IPersistentMap meta){ - return new APersistentVector.Seq(meta, v, i); - } - - public Object reduce(IFn f) throws Exception{ - Object ret = v.nth(i); - for(int x = i + 1; x < v.count(); x++) - ret = f.invoke(ret, v.nth(x)); - return ret; - } - - public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start, v.nth(i)); - for(int x = i + 1; x < v.count(); x++) - ret = f.invoke(ret, v.nth(x)); - return ret; - } - } - -public static class RSeq extends ASeq implements IndexedSeq, Counted{ - final IPersistentVector v; - final int i; - - public RSeq(IPersistentVector vector, int i){ - this.v = vector; - this.i = i; - } - - RSeq(IPersistentMap meta, IPersistentVector v, int i){ - super(meta); - this.v = v; - this.i = i; - } - - public Object first(){ - return v.nth(i); - } - - public ISeq next(){ - if(i > 0) - return new APersistentVector.RSeq(v, i - 1); - return null; - } - - public int index(){ - return i; - } - - public int count(){ - return i + 1; - } - - public APersistentVector.RSeq withMeta(IPersistentMap meta){ - return new APersistentVector.RSeq(meta, v, i); - } -} - -static class SubVector extends APersistentVector implements IObj{ - final IPersistentVector v; - final int start; - final int end; - final IPersistentMap _meta; - - - - public SubVector(IPersistentMap meta, IPersistentVector v, int start, int end){ - this._meta = meta; - - if(v instanceof APersistentVector.SubVector) - { - APersistentVector.SubVector sv = (APersistentVector.SubVector) v; - start += sv.start; - end += sv.start; - v = sv.v; - } - this.v = v; - this.start = start; - this.end = end; - } - - public Object nth(int i){ - if(start + i >= end) - throw new IndexOutOfBoundsException(); - return v.nth(start + i); - } - - public IPersistentVector assocN(int i, Object val){ - if(start + i > end) - throw new IndexOutOfBoundsException(); - else if(start + i == end) - return cons(val); - return new SubVector(_meta, v.assocN(start + i, val), start, end); - } - - public int count(){ - return end - start; - } - - public IPersistentVector cons(Object o){ - return new SubVector(_meta, v.assocN(end, o), start, end + 1); - } - - public IPersistentCollection empty(){ - return PersistentVector.EMPTY.withMeta(meta()); - } - - public IPersistentStack pop(){ - if(end - 1 == start) - { - return PersistentVector.EMPTY; - } - return new SubVector(_meta, v, start, end - 1); - } - - public SubVector withMeta(IPersistentMap meta){ - if(meta == _meta) - return this; - return new SubVector(meta, v, start, end); - } - - public IPersistentMap meta(){ - return _meta; - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ARef.java --- a/src/clojure/lang/ARef.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,107 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jan 1, 2009 */ - -package clojure.lang; - -import java.util.Map; - -public abstract class ARef extends AReference implements IRef{ -protected volatile IFn validator = null; -private volatile IPersistentMap watches = PersistentHashMap.EMPTY; - -public ARef(){ - super(); -} - -public ARef(IPersistentMap meta){ - super(meta); -} - -void validate(IFn vf, Object val){ - try - { - if(vf != null && !RT.booleanCast(vf.invoke(val))) - throw new IllegalStateException("Invalid reference state"); - } - catch(RuntimeException re) - { - throw re; - } - catch(Exception e) - { - throw new IllegalStateException("Invalid reference state", e); - } -} - -void validate(Object val){ - validate(validator, val); -} - -public void setValidator(IFn vf){ - try - { - validate(vf, deref()); - } - catch(Exception e) - { - throw new RuntimeException(e); - } - validator = vf; -} - -public IFn getValidator(){ - return validator; -} - -public IPersistentMap getWatches(){ - return watches; -} - -synchronized public IRef addWatch(Object key, IFn callback){ - watches = watches.assoc(key, callback); - return this; -} - -synchronized public IRef removeWatch(Object key){ - try - { - watches = watches.without(key); - } - catch(Exception e) - { - throw new RuntimeException(e); - } - - return this; -} - -public void notifyWatches(Object oldval, Object newval){ - IPersistentMap ws = watches; - if(ws.count() > 0) - { - for(ISeq s = ws.seq(); s != null; s = s.next()) - { - Map.Entry e = (Map.Entry) s.first(); - IFn fn = (IFn) e.getValue(); - try - { - if(fn != null) - fn.invoke(e.getKey(), this, oldval, newval); - } - catch(Exception e1) - { - throw new RuntimeException(e1); - } - } - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/AReference.java --- a/src/clojure/lang/AReference.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Dec 31, 2008 */ - -package clojure.lang; - -public class AReference implements IReference { - private IPersistentMap _meta; - - public AReference() { - this(null); - } - - public AReference(IPersistentMap meta) { - _meta = meta; - } - - synchronized public IPersistentMap meta() { - return _meta; - } - - synchronized public IPersistentMap alterMeta(IFn alter, ISeq args) throws Exception { - _meta = (IPersistentMap) alter.applyTo(new Cons(_meta, args)); - return _meta; - } - - synchronized public IPersistentMap resetMeta(IPersistentMap m) { - _meta = m; - return m; - } - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ASeq.java --- a/src/clojure/lang/ASeq.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,259 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -import java.io.Serializable; -import java.util.*; - -public abstract class ASeq extends Obj implements ISeq, List, Serializable { -transient int _hash = -1; - -public String toString(){ - return RT.printString(this); -} - -public IPersistentCollection empty(){ - return PersistentList.EMPTY; -} - -protected ASeq(IPersistentMap meta){ - super(meta); -} - - -protected ASeq(){ -} - -public boolean equiv(Object obj){ - - if(!(obj instanceof Sequential || obj instanceof List)) - return false; - ISeq ms = RT.seq(obj); - for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next()) - { - if(ms == null || !Util.equiv(s.first(), ms.first())) - return false; - } - return ms == null; - -} - -public boolean equals(Object obj){ - if(this == obj) return true; - if(!(obj instanceof Sequential || obj instanceof List)) - return false; - ISeq ms = RT.seq(obj); - for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next()) - { - if(ms == null || !Util.equals(s.first(), ms.first())) - return false; - } - return ms == null; - -} - -public int hashCode(){ - if(_hash == -1) - { - int hash = 1; - for(ISeq s = seq(); s != null; s = s.next()) - { - hash = 31 * hash + (s.first() == null ? 0 : s.first().hashCode()); - } - this._hash = hash; - } - return _hash; -} - - -//public Object reduce(IFn f) throws Exception{ -// Object ret = first(); -// for(ISeq s = rest(); s != null; s = s.rest()) -// ret = f.invoke(ret, s.first()); -// return ret; -//} -// -//public Object reduce(IFn f, Object start) throws Exception{ -// Object ret = f.invoke(start, first()); -// for(ISeq s = rest(); s != null; s = s.rest()) -// ret = f.invoke(ret, s.first()); -// return ret; -//} - -//public Object peek(){ -// return first(); -//} -// -//public IPersistentList pop(){ -// return rest(); -//} - -public int count(){ - int i = 1; - for(ISeq s = next(); s != null; s = s.next(), i++) - if(s instanceof Counted) - return i + s.count(); - return i; -} - -final public ISeq seq(){ - return this; -} - -public ISeq cons(Object o){ - return new Cons(o, this); -} - -public ISeq more(){ - ISeq s = next(); - if(s == null) - return PersistentList.EMPTY; - return s; -} - -//final public ISeq rest(){ -// Seqable m = more(); -// if(m == null) -// return null; -// return m.seq(); -//} - -// java.util.Collection implementation - -public Object[] toArray(){ - return RT.seqToArray(seq()); -} - -public boolean add(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean remove(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean addAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public void clear(){ - throw new UnsupportedOperationException(); -} - -public boolean retainAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean removeAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean containsAll(Collection c){ - for(Object o : c) - { - if(!contains(o)) - return false; - } - return true; -} - -public Object[] toArray(Object[] a){ - if(a.length >= count()) - { - ISeq s = seq(); - for(int i = 0; s != null; ++i, s = s.next()) - { - a[i] = s.first(); - } - if(a.length > count()) - a[count()] = null; - return a; - } - else - return toArray(); -} - -public int size(){ - return count(); -} - -public boolean isEmpty(){ - return seq() == null; -} - -public boolean contains(Object o){ - for(ISeq s = seq(); s != null; s = s.next()) - { - if(Util.equiv(s.first(), o)) - return true; - } - return false; -} - - -public Iterator iterator(){ - return new SeqIterator(this); -} - - - -//////////// List stuff ///////////////// -private List reify(){ - return Collections.unmodifiableList(new ArrayList(this)); -} - -public List subList(int fromIndex, int toIndex){ - return reify().subList(fromIndex, toIndex); -} - -public Object set(int index, Object element){ - throw new UnsupportedOperationException(); -} - -public Object remove(int index){ - throw new UnsupportedOperationException(); -} - -public int indexOf(Object o){ - ISeq s = seq(); - for(int i = 0; s != null; s = s.next(), i++) - { - if(Util.equiv(s.first(), o)) - return i; - } - return -1; -} - -public int lastIndexOf(Object o){ - return reify().lastIndexOf(o); -} - -public ListIterator listIterator(){ - return reify().listIterator(); -} - -public ListIterator listIterator(int index){ - return reify().listIterator(index); -} - -public Object get(int index){ - return RT.nth(this, index); -} - -public void add(int index, Object element){ - throw new UnsupportedOperationException(); -} - -public boolean addAll(int index, Collection c){ - throw new UnsupportedOperationException(); -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ATransientMap.java --- a/src/clojure/lang/ATransientMap.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,86 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -import java.util.Map; - -import clojure.lang.PersistentHashMap.INode; - -abstract class ATransientMap extends AFn implements ITransientMap { - abstract void ensureEditable(); - abstract ITransientMap doAssoc(Object key, Object val); - abstract ITransientMap doWithout(Object key); - abstract Object doValAt(Object key, Object notFound); - abstract int doCount(); - abstract IPersistentMap doPersistent(); - - public ITransientMap conj(Object o) { - ensureEditable(); - if(o instanceof Map.Entry) - { - Map.Entry e = (Map.Entry) o; - - return assoc(e.getKey(), e.getValue()); - } - else if(o instanceof IPersistentVector) - { - IPersistentVector v = (IPersistentVector) o; - if(v.count() != 2) - throw new IllegalArgumentException("Vector arg to map conj must be a pair"); - return assoc(v.nth(0), v.nth(1)); - } - - ITransientMap ret = this; - for(ISeq es = RT.seq(o); es != null; es = es.next()) - { - Map.Entry e = (Map.Entry) es.first(); - ret = ret.assoc(e.getKey(), e.getValue()); - } - return ret; - } - - public final Object invoke(Object arg1) throws Exception{ - return valAt(arg1); - } - - public final Object invoke(Object arg1, Object notFound) throws Exception{ - return valAt(arg1, notFound); - } - - public final Object valAt(Object key) { - return valAt(key, null); - } - - public final ITransientMap assoc(Object key, Object val) { - ensureEditable(); - return doAssoc(key, val); - } - - public final ITransientMap without(Object key) { - ensureEditable(); - return doWithout(key); - } - - public final IPersistentMap persistent() { - ensureEditable(); - return doPersistent(); - } - - public final Object valAt(Object key, Object notFound) { - ensureEditable(); - return doValAt(key, notFound); - } - - public final int count() { - ensureEditable(); - return doCount(); - } -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ATransientSet.java --- a/src/clojure/lang/ATransientSet.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 3, 2008 */ - -package clojure.lang; - -public abstract class ATransientSet extends AFn implements ITransientSet{ - ITransientMap impl; - - ATransientSet(ITransientMap impl) { - this.impl = impl; - } - - public int count() { - return impl.count(); - } - - public ITransientSet conj(Object val) { - ITransientMap m = impl.assoc(val, val); - if (m != impl) this.impl = m; - return this; - } - - public boolean contains(Object key) { - return this != impl.valAt(key, this); - } - - public ITransientSet disjoin(Object key) throws Exception { - ITransientMap m = impl.without(key); - if (m != impl) this.impl = m; - return this; - } - - public Object get(Object key) { - return impl.valAt(key); - } - - public Object invoke(Object key, Object notFound) throws Exception { - return impl.valAt(key, notFound); - } - - public Object invoke(Object key) throws Exception { - return impl.valAt(key); - } - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Agent.java --- a/src/clojure/lang/Agent.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,274 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Nov 17, 2007 */ - -package clojure.lang; - -import java.util.concurrent.*; -import java.util.concurrent.atomic.AtomicReference; -import java.util.Map; - -public class Agent extends ARef { - -static class ActionQueue { - public final IPersistentStack q; - public final Throwable error; // non-null indicates fail state - static final ActionQueue EMPTY = new ActionQueue(PersistentQueue.EMPTY, null); - - public ActionQueue( IPersistentStack q, Throwable error ) - { - this.q = q; - this.error = error; - } -} - -static final Keyword CONTINUE = Keyword.intern(null, "continue"); -static final Keyword FAIL = Keyword.intern(null, "fail"); - -volatile Object state; - AtomicReference aq = new AtomicReference(ActionQueue.EMPTY); - - volatile Keyword errorMode = CONTINUE; - volatile IFn errorHandler = null; - -final public static ExecutorService pooledExecutor = - Executors.newFixedThreadPool(2 + Runtime.getRuntime().availableProcessors()); - -final public static ExecutorService soloExecutor = Executors.newCachedThreadPool(); - -final static ThreadLocal nested = new ThreadLocal(); - - -public static void shutdown(){ - soloExecutor.shutdown(); - pooledExecutor.shutdown(); -} - -static class Action implements Runnable{ - final Agent agent; - final IFn fn; - final ISeq args; - final boolean solo; - - - public Action(Agent agent, IFn fn, ISeq args, boolean solo){ - this.agent = agent; - this.args = args; - this.fn = fn; - this.solo = solo; - } - - void execute(){ - try - { - if(solo) - soloExecutor.execute(this); - else - pooledExecutor.execute(this); - } - catch(Throwable error) - { - if(agent.errorHandler != null) - { - try - { - agent.errorHandler.invoke(agent, error); - } - catch(Throwable e) {} // ignore errorHandler errors - } - } - } - - static void doRun(Action action){ - try - { - Var.pushThreadBindings(RT.map(RT.AGENT, action.agent)); - nested.set(PersistentVector.EMPTY); - - Throwable error = null; - try - { - Object oldval = action.agent.state; - Object newval = action.fn.applyTo(RT.cons(action.agent.state, action.args)); - action.agent.setState(newval); - action.agent.notifyWatches(oldval,newval); - } - catch(Throwable e) - { - error = e; - } - - if(error == null) - { - releasePendingSends(); - } - else - { - nested.set(PersistentVector.EMPTY); - if(action.agent.errorHandler != null) - { - try - { - action.agent.errorHandler.invoke(action.agent, error); - } - catch(Throwable e) {} // ignore errorHandler errors - } - if(action.agent.errorMode == CONTINUE) - { - error = null; - } - } - - boolean popped = false; - ActionQueue next = null; - while(!popped) - { - ActionQueue prior = action.agent.aq.get(); - next = new ActionQueue(prior.q.pop(), error); - popped = action.agent.aq.compareAndSet(prior, next); - } - - if(error == null && next.q.count() > 0) - ((Action) next.q.peek()).execute(); - } - finally - { - nested.set(null); - Var.popThreadBindings(); - } - } - - public void run(){ - doRun(this); - } -} - -public Agent(Object state) throws Exception{ - this(state,null); -} - -public Agent(Object state, IPersistentMap meta) throws Exception { - super(meta); - setState(state); -} - -boolean setState(Object newState) throws Exception{ - validate(newState); - boolean ret = state != newState; - state = newState; - return ret; -} - -public Object deref() throws Exception{ - return state; -} - -public Throwable getError(){ - return aq.get().error; -} - -public void setErrorMode(Keyword k){ - errorMode = k; -} - -public Keyword getErrorMode(){ - return errorMode; -} - -public void setErrorHandler(IFn f){ - errorHandler = f; -} - -public IFn getErrorHandler(){ - return errorHandler; -} - -synchronized public Object restart(Object newState, boolean clearActions){ - if(getError() == null) - { - throw new RuntimeException("Agent does not need a restart"); - } - validate(newState); - state = newState; - - if(clearActions) - aq.set(ActionQueue.EMPTY); - else - { - boolean restarted = false; - ActionQueue prior = null; - while(!restarted) - { - prior = aq.get(); - restarted = aq.compareAndSet(prior, new ActionQueue(prior.q, null)); - } - - if(prior.q.count() > 0) - ((Action) prior.q.peek()).execute(); - } - - return newState; -} - -public Object dispatch(IFn fn, ISeq args, boolean solo) { - Throwable error = getError(); - if(error != null) - { - throw new RuntimeException("Agent is failed, needs restart", error); - } - Action action = new Action(this, fn, args, solo); - dispatchAction(action); - - return this; -} - -static void dispatchAction(Action action){ - LockingTransaction trans = LockingTransaction.getRunning(); - if(trans != null) - trans.enqueue(action); - else if(nested.get() != null) - { - nested.set(nested.get().cons(action)); - } - else - action.agent.enqueue(action); -} - -void enqueue(Action action){ - boolean queued = false; - ActionQueue prior = null; - while(!queued) - { - prior = aq.get(); - queued = aq.compareAndSet(prior, new ActionQueue((IPersistentStack)prior.q.cons(action), prior.error)); - } - - if(prior.q.count() == 0 && prior.error == null) - action.execute(); -} - -public int getQueueCount(){ - return aq.get().q.count(); -} - -static public int releasePendingSends(){ - IPersistentVector sends = nested.get(); - if(sends == null) - return 0; - for(int i=0;i= 0 && i < count()) - return nth(i); - return notFound; -} - -public int count(){ - return end - off; -} - -public IChunk dropFirst(){ - if(off==end) - throw new IllegalStateException("dropFirst of empty chunk"); - return new ArrayChunk(array, off + 1, end); -} - -public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start, array[off]); - for(int x = off + 1; x < end; x++) - ret = f.invoke(ret, array[x]); - return ret; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ArraySeq.java --- a/src/clojure/lang/ArraySeq.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,692 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jun 19, 2006 */ - -package clojure.lang; - -import java.lang.reflect.Array; - -public class ArraySeq extends ASeq implements IndexedSeq, IReduce{ -public final Object array; -final int i; -final Object[] oa; -//ISeq _rest; - -static public ArraySeq create(){ - return null; -} - -static public ArraySeq create(Object... array){ - if(array == null || array.length == 0) - return null; - return new ArraySeq(array, 0); -} - -static ISeq createFromObject(Object array){ - if(array == null || Array.getLength(array) == 0) - return null; - Class aclass = array.getClass(); - if(aclass == int[].class) - return new ArraySeq_int(null, (int[]) array, 0); - if(aclass == float[].class) - return new ArraySeq_float(null, (float[]) array, 0); - if(aclass == double[].class) - return new ArraySeq_double(null, (double[]) array, 0); - if(aclass == long[].class) - return new ArraySeq_long(null, (long[]) array, 0); - if(aclass == byte[].class) - return new ArraySeq_byte(null, (byte[]) array, 0); - if(aclass == char[].class) - return new ArraySeq_char(null, (char[]) array, 0); - if(aclass == boolean[].class) - return new ArraySeq_boolean(null, (boolean[]) array, 0); - return new ArraySeq(array, 0); -} - -ArraySeq(Object array, int i){ - this.array = array; - this.i = i; - this.oa = (Object[]) (array instanceof Object[] ? array : null); -// this._rest = this; -} - -ArraySeq(IPersistentMap meta, Object array, int i){ - super(meta); - this.array = array; - this.i = i; - this.oa = (Object[]) (array instanceof Object[] ? array : null); -} - -public Object first(){ - if(oa != null) - return oa[i]; - return Reflector.prepRet(Array.get(array, i)); -} - -public ISeq next(){ - if(oa != null) - { - if(i + 1 < oa.length) - return new ArraySeq(array, i + 1); - } - else - { - if(i + 1 < Array.getLength(array)) - return new ArraySeq(array, i + 1); - } - return null; -} - -public int count(){ - if(oa != null) - return oa.length - i; - return Array.getLength(array) - i; -} - -public int index(){ - return i; -} - -public ArraySeq withMeta(IPersistentMap meta){ - return new ArraySeq(meta, array, i); -} - -public Object reduce(IFn f) throws Exception{ - if(oa != null) - { - Object ret = oa[i]; - for(int x = i + 1; x < oa.length; x++) - ret = f.invoke(ret, oa[x]); - return ret; - } - - Object ret = Reflector.prepRet(Array.get(array, i)); - for(int x = i + 1; x < Array.getLength(array); x++) - ret = f.invoke(ret, Reflector.prepRet(Array.get(array, x))); - return ret; -} - -public Object reduce(IFn f, Object start) throws Exception{ - if(oa != null) - { - Object ret = f.invoke(start, oa[i]); - for(int x = i + 1; x < oa.length; x++) - ret = f.invoke(ret, oa[x]); - return ret; - } - Object ret = f.invoke(start, Reflector.prepRet(Array.get(array, i))); - for(int x = i + 1; x < Array.getLength(array); x++) - ret = f.invoke(ret, Reflector.prepRet(Array.get(array, x))); - return ret; -} - -public int indexOf(Object o) { - if (oa != null) { - for (int j = i; j < oa.length; j++) - if (Util.equals(o, oa[j])) return j - i; - } else { - int n = Array.getLength(array); - for (int j = i; j < n; j++) - if (Util.equals(o, Reflector.prepRet(Array.get(array, j)))) return j - i; - } - return -1; -} - -public int lastIndexOf(Object o) { - if (oa != null) { - if (o == null) { - for (int j = oa.length - 1 ; j >= i; j--) - if (oa[j] == null) return j - i; - } else { - for (int j = oa.length - 1 ; j >= i; j--) - if (o.equals(oa[j])) return j - i; - } - } else { - if (o == null) { - for (int j = Array.getLength(array) - 1 ; j >= i; j--) - if (Reflector.prepRet(Array.get(array, j)) == null) return j - i; - } else { - for (int j = Array.getLength(array) - 1 ; j >= i; j--) - if (o.equals(Reflector.prepRet(Array.get(array, j)))) return j - i; - } - } - return -1; -} - -//////////////////////////////////// specialized primitive versions /////////////////////////////// - -static public class ArraySeq_int extends ASeq implements IndexedSeq, IReduce{ - public final int[] array; - final int i; - - ArraySeq_int(IPersistentMap meta, int[] array, int i){ - super(meta); - this.array = array; - this.i = i; - } - - public Object first(){ - return array[i]; - } - - public ISeq next(){ - if(i + 1 < array.length) - return new ArraySeq_int(meta(), array, i + 1); - return null; - } - - public int count(){ - return array.length - i; - } - - public int index(){ - return i; - } - - public ArraySeq_int withMeta(IPersistentMap meta){ - return new ArraySeq_int(meta, array, i); - } - - public Object reduce(IFn f) throws Exception{ - Object ret = array[i]; - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start, array[i]); - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public int indexOf(Object o) { - if (o instanceof Integer) { - int k = ((Integer) o).intValue(); - for (int j = i; j < array.length; j++) - if (k == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = i; j < array.length; j++) - if (o.equals(array[j])) return j - i; - return -1; - } - - public int lastIndexOf(Object o) { - if (o instanceof Integer) { - int k = ((Integer) o).intValue(); - for (int j = array.length - 1; j >= i; j--) - if (k == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = array.length - 1; j >= i; j--) - if (o.equals(array[j])) return j - i; - return -1; - } -} - - -static public class ArraySeq_float extends ASeq implements IndexedSeq, IReduce{ - public final float[] array; - final int i; - - ArraySeq_float(IPersistentMap meta, float[] array, int i){ - super(meta); - this.array = array; - this.i = i; - } - - public Object first(){ - return array[i]; - } - - public ISeq next(){ - if(i + 1 < array.length) - return new ArraySeq_float(meta(), array, i + 1); - return null; - } - - public int count(){ - return array.length - i; - } - - public int index(){ - return i; - } - - public ArraySeq_float withMeta(IPersistentMap meta){ - return new ArraySeq_float(meta, array, i); - } - - public Object reduce(IFn f) throws Exception{ - Object ret = array[i]; - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start, array[i]); - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public int indexOf(Object o) { - if (o instanceof Float) { - float f = ((Float) o).floatValue(); - for (int j = i; j < array.length; j++) - if (f == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = i; j < array.length; j++) - if (o.equals(array[j])) return j - i; - return -1; - } - - public int lastIndexOf(Object o) { - if (o instanceof Float) { - float f = ((Float) o).floatValue(); - for (int j = array.length - 1; j >= i; j--) - if (f == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = array.length - 1; j >= i; j--) - if (o.equals(array[j])) return j - i; - return -1; - } -} - -static public class ArraySeq_double extends ASeq implements IndexedSeq, IReduce{ - public final double[] array; - final int i; - - ArraySeq_double(IPersistentMap meta, double[] array, int i){ - super(meta); - this.array = array; - this.i = i; - } - - public Object first(){ - return array[i]; - } - - public ISeq next(){ - if(i + 1 < array.length) - return new ArraySeq_double(meta(), array, i + 1); - return null; - } - - public int count(){ - return array.length - i; - } - - public int index(){ - return i; - } - - public ArraySeq_double withMeta(IPersistentMap meta){ - return new ArraySeq_double(meta, array, i); - } - - public Object reduce(IFn f) throws Exception{ - Object ret = array[i]; - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start, array[i]); - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public int indexOf(Object o) { - if (o instanceof Double) { - double d = ((Double) o).doubleValue(); - for (int j = i; j < array.length; j++) - if (d == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = i; j < array.length; j++) - if (o.equals(array[j])) return j - i; - return -1; - } - - public int lastIndexOf(Object o) { - if (o instanceof Double) { - double d = ((Double) o).doubleValue(); - for (int j = array.length - 1; j >= i; j--) - if (d == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = array.length - 1; j >= i; j--) - if (o.equals(array[j])) return j - i; - return -1; - } -} - -static public class ArraySeq_long extends ASeq implements IndexedSeq, IReduce{ - public final long[] array; - final int i; - - ArraySeq_long(IPersistentMap meta, long[] array, int i){ - super(meta); - this.array = array; - this.i = i; - } - - public Object first(){ - return array[i]; - } - - public ISeq next(){ - if(i + 1 < array.length) - return new ArraySeq_long(meta(), array, i + 1); - return null; - } - - public int count(){ - return array.length - i; - } - - public int index(){ - return i; - } - - public ArraySeq_long withMeta(IPersistentMap meta){ - return new ArraySeq_long(meta, array, i); - } - - public Object reduce(IFn f) throws Exception{ - Object ret = array[i]; - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start, array[i]); - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public int indexOf(Object o) { - if (o instanceof Long) { - long l = ((Long) o).longValue(); - for (int j = i; j < array.length; j++) - if (l == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = i; j < array.length; j++) - if (o.equals(array[j])) return j - i; - return -1; - } - - public int lastIndexOf(Object o) { - if (o instanceof Long) { - long l = ((Long) o).longValue(); - for (int j = array.length - 1; j >= i; j--) - if (l == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = array.length - 1; j >= i; j--) - if (o.equals(array[j])) return j - i; - return -1; - } -} - -static public class ArraySeq_byte extends ASeq implements IndexedSeq, IReduce{ - public final byte[] array; - final int i; - - ArraySeq_byte(IPersistentMap meta, byte[] array, int i){ - super(meta); - this.array = array; - this.i = i; - } - - public Object first(){ - return array[i]; - } - - public ISeq next(){ - if(i + 1 < array.length) - return new ArraySeq_byte(meta(), array, i + 1); - return null; - } - - public int count(){ - return array.length - i; - } - - public int index(){ - return i; - } - - public ArraySeq_byte withMeta(IPersistentMap meta){ - return new ArraySeq_byte(meta, array, i); - } - - public Object reduce(IFn f) throws Exception{ - Object ret = array[i]; - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start, array[i]); - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public int indexOf(Object o) { - if (o instanceof Byte) { - byte b = ((Byte) o).byteValue(); - for (int j = i; j < array.length; j++) - if (b == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = i; j < array.length; j++) - if (o.equals(array[j])) return j - i; - return -1; - } - - public int lastIndexOf(Object o) { - if (o instanceof Byte) { - byte b = ((Byte) o).byteValue(); - for (int j = array.length - 1; j >= i; j--) - if (b == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = array.length - 1; j >= i; j--) - if (o.equals(array[j])) return j - i; - return -1; - } -} - -static public class ArraySeq_char extends ASeq implements IndexedSeq, IReduce{ - public final char[] array; - final int i; - - ArraySeq_char(IPersistentMap meta, char[] array, int i){ - super(meta); - this.array = array; - this.i = i; - } - - public Object first(){ - return array[i]; - } - - public ISeq next(){ - if(i + 1 < array.length) - return new ArraySeq_char(meta(), array, i + 1); - return null; - } - - public int count(){ - return array.length - i; - } - - public int index(){ - return i; - } - - public ArraySeq_char withMeta(IPersistentMap meta){ - return new ArraySeq_char(meta, array, i); - } - - public Object reduce(IFn f) throws Exception{ - Object ret = array[i]; - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start, array[i]); - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public int indexOf(Object o) { - if (o instanceof Character) { - char c = ((Character) o).charValue(); - for (int j = i; j < array.length; j++) - if (c == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = i; j < array.length; j++) - if (o.equals(array[j])) return j - i; - return -1; - } - - public int lastIndexOf(Object o) { - if (o instanceof Character) { - char c = ((Character) o).charValue(); - for (int j = array.length - 1; j >= i; j--) - if (c == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = array.length - 1; j >= i; j--) - if (o.equals(array[j])) return j - i; - return -1; - } -} - -static public class ArraySeq_boolean extends ASeq implements IndexedSeq, IReduce{ - public final boolean[] array; - final int i; - - ArraySeq_boolean(IPersistentMap meta, boolean[] array, int i){ - super(meta); - this.array = array; - this.i = i; - } - - public Object first(){ - return array[i]; - } - - public ISeq next(){ - if(i + 1 < array.length) - return new ArraySeq_boolean(meta(), array, i + 1); - return null; - } - - public int count(){ - return array.length - i; - } - - public int index(){ - return i; - } - - public ArraySeq_boolean withMeta(IPersistentMap meta){ - return new ArraySeq_boolean(meta, array, i); - } - - public Object reduce(IFn f) throws Exception{ - Object ret = array[i]; - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start, array[i]); - for(int x = i + 1; x < array.length; x++) - ret = f.invoke(ret, array[x]); - return ret; - } - - public int indexOf(Object o) { - if (o instanceof Boolean) { - boolean b = ((Boolean) o).booleanValue(); - for (int j = i; j < array.length; j++) - if (b == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = i; j < array.length; j++) - if (o.equals(array[j])) return j - i; - return -1; - } - - public int lastIndexOf(Object o) { - if (o instanceof Boolean) { - boolean b = ((Boolean) o).booleanValue(); - for (int j = array.length - 1; j >= i; j--) - if (b == array[j]) return j - i; - } - if (o == null) { - return -1; - } - for (int j = array.length - 1; j >= i; j--) - if (o.equals(array[j])) return j - i; - return -1; - } -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Associative.java --- a/src/clojure/lang/Associative.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -package clojure.lang; - -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ -public interface Associative extends IPersistentCollection, ILookup{ -boolean containsKey(Object key); - -IMapEntry entryAt(Object key); - -Associative assoc(Object key, Object val); - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Atom.java --- a/src/clojure/lang/Atom.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,104 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jan 1, 2009 */ - -package clojure.lang; - -import java.util.concurrent.atomic.AtomicReference; - -final public class Atom extends ARef{ -final AtomicReference state; - -public Atom(Object state){ - this.state = new AtomicReference(state); -} - -public Atom(Object state, IPersistentMap meta){ - super(meta); - this.state = new AtomicReference(state); -} - -public Object deref(){ - return state.get(); -} - -public Object swap(IFn f) throws Exception{ - for(; ;) - { - Object v = deref(); - Object newv = f.invoke(v); - validate(newv); - if(state.compareAndSet(v, newv)) - { - notifyWatches(v, newv); - return newv; - } - } -} - -public Object swap(IFn f, Object arg) throws Exception{ - for(; ;) - { - Object v = deref(); - Object newv = f.invoke(v, arg); - validate(newv); - if(state.compareAndSet(v, newv)) - { - notifyWatches(v, newv); - return newv; - } - } -} - -public Object swap(IFn f, Object arg1, Object arg2) throws Exception{ - for(; ;) - { - Object v = deref(); - Object newv = f.invoke(v, arg1, arg2); - validate(newv); - if(state.compareAndSet(v, newv)) - { - notifyWatches(v, newv); - return newv; - } - } -} - -public Object swap(IFn f, Object x, Object y, ISeq args) throws Exception{ - for(; ;) - { - Object v = deref(); - Object newv = f.applyTo(RT.listStar(v, x, y, args)); - validate(newv); - if(state.compareAndSet(v, newv)) - { - notifyWatches(v, newv); - return newv; - } - } -} - -public boolean compareAndSet(Object oldv, Object newv){ - validate(newv); - boolean ret = state.compareAndSet(oldv, newv); - if(ret) - notifyWatches(oldv, newv); - return ret; -} - -public Object reset(Object newval){ - Object oldval = state.get(); - validate(newval); - state.set(newval); - notifyWatches(oldval, newval); - return newval; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Binding.java --- a/src/clojure/lang/Binding.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,26 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -public class Binding{ -public T val; -public final Binding rest; - -public Binding(T val){ - this.val = val; - this.rest = null; -} - -public Binding(T val, Binding rest){ - this.val = val; - this.rest = rest; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Box.java --- a/src/clojure/lang/Box.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 27, 2006 8:40:19 PM */ - -package clojure.lang; - -public class Box{ - -public Object val; - -public Box(Object val){ - this.val = val; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ChunkBuffer.java --- a/src/clojure/lang/ChunkBuffer.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich May 26, 2009 */ - -package clojure.lang; - -final public class ChunkBuffer implements Counted{ - Object[] buffer; - int end; - -public ChunkBuffer(int capacity){ - buffer = new Object[capacity]; - end = 0; -} - -public void add(Object o){ - buffer[end++] = o; -} - -public IChunk chunk(){ - ArrayChunk ret = new ArrayChunk(buffer, 0, end); - buffer = null; - return ret; -} - -public int count(){ - return end; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ChunkedCons.java --- a/src/clojure/lang/ChunkedCons.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,67 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich May 25, 2009 */ - -package clojure.lang; - -final public class ChunkedCons extends ASeq implements IChunkedSeq{ - -final IChunk chunk; -final ISeq _more; - -ChunkedCons(IPersistentMap meta, IChunk chunk, ISeq more){ - super(meta); - this.chunk = chunk; - this._more = more; -} - -public ChunkedCons(IChunk chunk, ISeq more){ - this(null,chunk, more); -} - -public Obj withMeta(IPersistentMap meta){ - if(meta != _meta) - return new ChunkedCons(meta, chunk, _more); - return this; -} - -public Object first(){ - return chunk.nth(0); -} - -public ISeq next(){ - if(chunk.count() > 1) - return new ChunkedCons(chunk.dropFirst(), _more); - return chunkedNext(); -} - -public ISeq more(){ - if(chunk.count() > 1) - return new ChunkedCons(chunk.dropFirst(), _more); - if(_more == null) - return PersistentList.EMPTY; - return _more; -} - -public IChunk chunkedFirst(){ - return chunk; -} - -public ISeq chunkedNext(){ - return chunkedMore().seq(); -} - -public ISeq chunkedMore(){ - if(_more == null) - return PersistentList.EMPTY; - return _more; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Compile.java --- a/src/clojure/lang/Compile.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,73 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - - -package clojure.lang; - -import java.io.OutputStreamWriter; -import java.io.PrintWriter; -import java.io.IOException; - -// Compiles libs and generates class files stored within the directory -// named by the Java System property "clojure.compile.path". Arguments are -// strings naming the libs to be compiled. The libs and compile-path must -// all be within CLASSPATH. - -public class Compile{ - -private static final String PATH_PROP = "clojure.compile.path"; -private static final String REFLECTION_WARNING_PROP = "clojure.compile.warn-on-reflection"; -private static final Var compile_path = RT.var("clojure.core", "*compile-path*"); -private static final Var compile = RT.var("clojure.core", "compile"); -private static final Var warn_on_reflection = RT.var("clojure.core", "*warn-on-reflection*"); - -public static void main(String[] args) throws Exception{ - - OutputStreamWriter out = (OutputStreamWriter) RT.OUT.deref(); - PrintWriter err = RT.errPrintWriter(); - String path = System.getProperty(PATH_PROP); - int count = args.length; - - if(path == null) - { - err.println("ERROR: Must set system property " + PATH_PROP + - "\nto the location for compiled .class files." + - "\nThis directory must also be on your CLASSPATH."); - System.exit(1); - } - - boolean warnOnReflection = System.getProperty(REFLECTION_WARNING_PROP, "false").equals("true"); - - try - { - Var.pushThreadBindings(RT.map(compile_path, path, warn_on_reflection, warnOnReflection)); - - for(String lib : args) - { - out.write("Compiling " + lib + " to " + path + "\n"); - out.flush(); - compile.invoke(Symbol.intern(lib)); - } - } - finally - { - Var.popThreadBindings(); - try - { - out.flush(); - out.close(); - } - catch(IOException e) - { - e.printStackTrace(err); - } - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Compiler.java --- a/src/clojure/lang/Compiler.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6897 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Aug 21, 2007 */ - -package clojure.lang; - -//* - -import clojure.asm.*; -import clojure.asm.commons.Method; -import clojure.asm.commons.GeneratorAdapter; -//*/ -/* - -import org.objectweb.asm.*; -import org.objectweb.asm.commons.Method; -import org.objectweb.asm.commons.GeneratorAdapter; -import org.objectweb.asm.util.TraceClassVisitor; -import org.objectweb.asm.util.CheckClassAdapter; -//*/ - -import java.io.*; -import java.util.*; -import java.lang.reflect.Constructor; -import java.lang.reflect.Modifier; - -public class Compiler implements Opcodes{ - -static final Symbol DEF = Symbol.create("def"); -static final Symbol LOOP = Symbol.create("loop*"); -static final Symbol RECUR = Symbol.create("recur"); -static final Symbol IF = Symbol.create("if"); -static final Symbol LET = Symbol.create("let*"); -static final Symbol LETFN = Symbol.create("letfn*"); -static final Symbol DO = Symbol.create("do"); -static final Symbol FN = Symbol.create("fn*"); -static final Symbol QUOTE = Symbol.create("quote"); -static final Symbol THE_VAR = Symbol.create("var"); -static final Symbol DOT = Symbol.create("."); -static final Symbol ASSIGN = Symbol.create("set!"); -//static final Symbol TRY_FINALLY = Symbol.create("try-finally"); -static final Symbol TRY = Symbol.create("try"); -static final Symbol CATCH = Symbol.create("catch"); -static final Symbol FINALLY = Symbol.create("finally"); -static final Symbol THROW = Symbol.create("throw"); -static final Symbol MONITOR_ENTER = Symbol.create("monitor-enter"); -static final Symbol MONITOR_EXIT = Symbol.create("monitor-exit"); -static final Symbol IMPORT = Symbol.create("clojure.core", "import*"); -//static final Symbol INSTANCE = Symbol.create("instance?"); -static final Symbol DEFTYPE = Symbol.create("deftype*"); -static final Symbol CASE = Symbol.create("case*"); - -//static final Symbol THISFN = Symbol.create("thisfn"); -static final Symbol CLASS = Symbol.create("Class"); -static final Symbol NEW = Symbol.create("new"); -static final Symbol THIS = Symbol.create("this"); -static final Symbol REIFY = Symbol.create("reify*"); -//static final Symbol UNQUOTE = Symbol.create("unquote"); -//static final Symbol UNQUOTE_SPLICING = Symbol.create("unquote-splicing"); -//static final Symbol SYNTAX_QUOTE = Symbol.create("clojure.core", "syntax-quote"); -static final Symbol LIST = Symbol.create("clojure.core", "list"); -static final Symbol HASHMAP = Symbol.create("clojure.core", "hash-map"); -static final Symbol VECTOR = Symbol.create("clojure.core", "vector"); -static final Symbol IDENTITY = Symbol.create("clojure.core", "identity"); - -static final Symbol _AMP_ = Symbol.create("&"); -static final Symbol ISEQ = Symbol.create("clojure.lang.ISeq"); - -static final Keyword inlineKey = Keyword.intern(null, "inline"); -static final Keyword inlineAritiesKey = Keyword.intern(null, "inline-arities"); - -static final Keyword volatileKey = Keyword.intern(null, "volatile"); -static final Keyword implementsKey = Keyword.intern(null, "implements"); -static final String COMPILE_STUB_PREFIX = "compile__stub"; - -static final Keyword protocolKey = Keyword.intern(null, "protocol"); -static final Keyword onKey = Keyword.intern(null, "on"); - -static final Symbol NS = Symbol.create("ns"); -static final Symbol IN_NS = Symbol.create("in-ns"); - -//static final Symbol IMPORT = Symbol.create("import"); -//static final Symbol USE = Symbol.create("use"); - -//static final Symbol IFN = Symbol.create("clojure.lang", "IFn"); - -static final public IPersistentMap specials = PersistentHashMap.create( - DEF, new DefExpr.Parser(), - LOOP, new LetExpr.Parser(), - RECUR, new RecurExpr.Parser(), - IF, new IfExpr.Parser(), - CASE, new CaseExpr.Parser(), - LET, new LetExpr.Parser(), - LETFN, new LetFnExpr.Parser(), - DO, new BodyExpr.Parser(), - FN, null, - QUOTE, new ConstantExpr.Parser(), - THE_VAR, new TheVarExpr.Parser(), - IMPORT, new ImportExpr.Parser(), - DOT, new HostExpr.Parser(), - ASSIGN, new AssignExpr.Parser(), - DEFTYPE, new NewInstanceExpr.DeftypeParser(), - REIFY, new NewInstanceExpr.ReifyParser(), -// TRY_FINALLY, new TryFinallyExpr.Parser(), -TRY, new TryExpr.Parser(), -THROW, new ThrowExpr.Parser(), -MONITOR_ENTER, new MonitorEnterExpr.Parser(), -MONITOR_EXIT, new MonitorExitExpr.Parser(), -// INSTANCE, new InstanceExpr.Parser(), -// IDENTICAL, new IdenticalExpr.Parser(), -//THISFN, null, -CATCH, null, -FINALLY, null, -// CLASS, new ClassExpr.Parser(), -NEW, new NewExpr.Parser(), -// UNQUOTE, null, -// UNQUOTE_SPLICING, null, -// SYNTAX_QUOTE, null, -_AMP_, null -); - -private static final int MAX_POSITIONAL_ARITY = 20; -private static final Type OBJECT_TYPE; -private static final Type KEYWORD_TYPE = Type.getType(Keyword.class); -private static final Type VAR_TYPE = Type.getType(Var.class); -private static final Type SYMBOL_TYPE = Type.getType(Symbol.class); -//private static final Type NUM_TYPE = Type.getType(Num.class); -private static final Type IFN_TYPE = Type.getType(IFn.class); -private static final Type AFUNCTION_TYPE = Type.getType(AFunction.class); -private static final Type RT_TYPE = Type.getType(RT.class); -final static Type CLASS_TYPE = Type.getType(Class.class); -final static Type NS_TYPE = Type.getType(Namespace.class); -final static Type UTIL_TYPE = Type.getType(Util.class); -final static Type REFLECTOR_TYPE = Type.getType(Reflector.class); -final static Type THROWABLE_TYPE = Type.getType(Throwable.class); -final static Type BOOLEAN_OBJECT_TYPE = Type.getType(Boolean.class); -final static Type IPERSISTENTMAP_TYPE = Type.getType(IPersistentMap.class); -final static Type IOBJ_TYPE = Type.getType(IObj.class); - -private static final Type[][] ARG_TYPES; -private static final Type[] EXCEPTION_TYPES = {Type.getType(Exception.class)}; - -static - { - OBJECT_TYPE = Type.getType(Object.class); - ARG_TYPES = new Type[MAX_POSITIONAL_ARITY + 2][]; - for(int i = 0; i <= MAX_POSITIONAL_ARITY; ++i) - { - Type[] a = new Type[i]; - for(int j = 0; j < i; j++) - a[j] = OBJECT_TYPE; - ARG_TYPES[i] = a; - } - Type[] a = new Type[MAX_POSITIONAL_ARITY + 1]; - for(int j = 0; j < MAX_POSITIONAL_ARITY; j++) - a[j] = OBJECT_TYPE; - a[MAX_POSITIONAL_ARITY] = Type.getType("[Ljava/lang/Object;"); - ARG_TYPES[MAX_POSITIONAL_ARITY + 1] = a; - - - } - - -//symbol->localbinding -static final public Var LOCAL_ENV = Var.create(null); - -//vector -static final public Var LOOP_LOCALS = Var.create(); - -//Label -static final public Var LOOP_LABEL = Var.create(); - -//vector -static final public Var CONSTANTS = Var.create(); - -//IdentityHashMap -static final public Var CONSTANT_IDS = Var.create(); - -//vector -static final public Var KEYWORD_CALLSITES = Var.create(); - -//vector -static final public Var PROTOCOL_CALLSITES = Var.create(); - -//vector -static final public Var VAR_CALLSITES = Var.create(); - -//keyword->constid -static final public Var KEYWORDS = Var.create(); - -//var->constid -static final public Var VARS = Var.create(); - -//FnFrame -static final public Var METHOD = Var.create(null); - -//null or not -static final public Var IN_CATCH_FINALLY = Var.create(null); - -//DynamicClassLoader -static final public Var LOADER = Var.create(); - -//String -static final public Var SOURCE = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), - Symbol.create("*source-path*"), "NO_SOURCE_FILE"); - -//String -static final public Var SOURCE_PATH = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), - Symbol.create("*file*"), "NO_SOURCE_PATH"); - -//String -static final public Var COMPILE_PATH = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), - Symbol.create("*compile-path*"), null); -//boolean -static final public Var COMPILE_FILES = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), - Symbol.create("*compile-files*"), Boolean.FALSE); - -static final public Var INSTANCE = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), - Symbol.create("instance?")); - -static final public Var ADD_ANNOTATIONS = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), - Symbol.create("add-annotations")); - -//Integer -static final public Var LINE = Var.create(0); - -//Integer -static final public Var LINE_BEFORE = Var.create(0); -static final public Var LINE_AFTER = Var.create(0); - -//Integer -static final public Var NEXT_LOCAL_NUM = Var.create(0); - -//Integer -static final public Var RET_LOCAL_NUM = Var.create(); - - -static final public Var COMPILE_STUB_SYM = Var.create(null); -static final public Var COMPILE_STUB_CLASS = Var.create(null); - - -//PathNode chain -static final public Var CLEAR_PATH = Var.create(null); - -//tail of PathNode chain -static final public Var CLEAR_ROOT = Var.create(null); - -//LocalBinding -> Set -static final public Var CLEAR_SITES = Var.create(null); - - public enum C{ - STATEMENT, //value ignored - EXPRESSION, //value required - RETURN, //tail position relative to enclosing recur frame - EVAL -} - -interface Expr{ - Object eval() throws Exception; - - void emit(C context, ObjExpr objx, GeneratorAdapter gen); - - boolean hasJavaClass() throws Exception; - - Class getJavaClass() throws Exception; -} - -public static abstract class UntypedExpr implements Expr{ - - public Class getJavaClass(){ - throw new IllegalArgumentException("Has no Java class"); - } - - public boolean hasJavaClass(){ - return false; - } -} - -interface IParser{ - Expr parse(C context, Object form) throws Exception; -} - -static boolean isSpecial(Object sym){ - return specials.containsKey(sym); -} - -static Symbol resolveSymbol(Symbol sym){ - //already qualified or classname? - if(sym.name.indexOf('.') > 0) - return sym; - if(sym.ns != null) - { - Namespace ns = namespaceFor(sym); - if(ns == null || ns.name.name == sym.ns) - return sym; - return Symbol.create(ns.name.name, sym.name); - } - Object o = currentNS().getMapping(sym); - if(o == null) - return Symbol.intern(currentNS().name.name, sym.name); - else if(o instanceof Class) - return Symbol.intern(null, ((Class) o).getName()); - else if(o instanceof Var) - { - Var v = (Var) o; - return Symbol.create(v.ns.name.name, v.sym.name); - } - return null; - -} - -static class DefExpr implements Expr{ - public final Var var; - public final Expr init; - public final Expr meta; - public final boolean initProvided; - public final String source; - public final int line; - final static Method bindRootMethod = Method.getMethod("void bindRoot(Object)"); - final static Method setTagMethod = Method.getMethod("void setTag(clojure.lang.Symbol)"); - final static Method setMetaMethod = Method.getMethod("void setMeta(clojure.lang.IPersistentMap)"); - final static Method symcreate = Method.getMethod("clojure.lang.Symbol create(String, String)"); - - public DefExpr(String source, int line, Var var, Expr init, Expr meta, boolean initProvided){ - this.source = source; - this.line = line; - this.var = var; - this.init = init; - this.meta = meta; - this.initProvided = initProvided; - } - - private boolean includesExplicitMetadata(MapExpr expr) { - for(int i=0; i < expr.keyvals.count(); i += 2) - { - Keyword k = ((KeywordExpr) expr.keyvals.nth(i)).k; - if ((k != RT.FILE_KEY) && - (k != RT.DECLARED_KEY) && - (k != RT.LINE_KEY)) - return true; - } - return false; - } - - public Object eval() throws Exception{ - try - { - if(initProvided) - { -// if(init instanceof FnExpr && ((FnExpr) init).closes.count()==0) -// var.bindRoot(new FnLoaderThunk((FnExpr) init,var)); -// else - var.bindRoot(init.eval()); - } - if(meta != null) - { - IPersistentMap metaMap = (IPersistentMap) meta.eval(); - if (initProvided || includesExplicitMetadata((MapExpr) meta)) - var.setMeta((IPersistentMap) meta.eval()); - } - return var; - } - catch(Throwable e) - { - if(!(e instanceof CompilerException)) - throw new CompilerException(source, line, e); - else - throw (CompilerException) e; - } - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - objx.emitVar(gen, var); - if(meta != null) - { - if (initProvided || includesExplicitMetadata((MapExpr) meta)) - { - gen.dup(); - meta.emit(C.EXPRESSION, objx, gen); - gen.checkCast(IPERSISTENTMAP_TYPE); - gen.invokeVirtual(VAR_TYPE, setMetaMethod); - } - } - if(initProvided) - { - gen.dup(); - init.emit(C.EXPRESSION, objx, gen); - gen.invokeVirtual(VAR_TYPE, bindRootMethod); - } - - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass(){ - return true; - } - - public Class getJavaClass(){ - return Var.class; - } - - static class Parser implements IParser{ - public Expr parse(C context, Object form) throws Exception{ - //(def x) or (def x initexpr) - if(RT.count(form) > 3) - throw new Exception("Too many arguments to def"); - else if(RT.count(form) < 2) - throw new Exception("Too few arguments to def"); - else if(!(RT.second(form) instanceof Symbol)) - throw new Exception("First argument to def must be a Symbol"); - Symbol sym = (Symbol) RT.second(form); - Var v = lookupVar(sym, true); - if(v == null) - throw new Exception("Can't refer to qualified var that doesn't exist"); - if(!v.ns.equals(currentNS())) - { - if(sym.ns == null) - v = currentNS().intern(sym); -// throw new Exception("Name conflict, can't def " + sym + " because namespace: " + currentNS().name + -// " refers to:" + v); - else - throw new Exception("Can't create defs outside of current ns"); - } - IPersistentMap mm = sym.meta(); - Object source_path = SOURCE_PATH.get(); - source_path = source_path == null ? "NO_SOURCE_FILE" : source_path; - mm = (IPersistentMap) RT.assoc(mm, RT.LINE_KEY, LINE.get()).assoc(RT.FILE_KEY, source_path); - Expr meta = analyze(context == C.EVAL ? context : C.EXPRESSION, mm); - return new DefExpr((String) SOURCE.deref(), (Integer) LINE.deref(), - v, analyze(context == C.EVAL ? context : C.EXPRESSION, RT.third(form), v.sym.name), - meta, RT.count(form) == 3); - } - } -} - -public static class AssignExpr implements Expr{ - public final AssignableExpr target; - public final Expr val; - - public AssignExpr(AssignableExpr target, Expr val){ - this.target = target; - this.val = val; - } - - public Object eval() throws Exception{ - return target.evalAssign(val); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - target.emitAssign(context, objx, gen, val); - } - - public boolean hasJavaClass() throws Exception{ - return val.hasJavaClass(); - } - - public Class getJavaClass() throws Exception{ - return val.getJavaClass(); - } - - static class Parser implements IParser{ - public Expr parse(C context, Object frm) throws Exception{ - ISeq form = (ISeq) frm; - if(RT.length(form) != 3) - throw new IllegalArgumentException("Malformed assignment, expecting (set! target val)"); - Expr target = analyze(C.EXPRESSION, RT.second(form)); - if(!(target instanceof AssignableExpr)) - throw new IllegalArgumentException("Invalid assignment target"); - return new AssignExpr((AssignableExpr) target, analyze(C.EXPRESSION, RT.third(form))); - } - } -} - -public static class VarExpr implements Expr, AssignableExpr{ - public final Var var; - public final Object tag; - final static Method getMethod = Method.getMethod("Object get()"); - final static Method setMethod = Method.getMethod("Object set(Object)"); - - public VarExpr(Var var, Symbol tag){ - this.var = var; - this.tag = tag != null ? tag : var.getTag(); - } - - public Object eval() throws Exception{ - return var.deref(); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - objx.emitVar(gen, var); - gen.invokeVirtual(VAR_TYPE, getMethod); - if(context == C.STATEMENT) - { - gen.pop(); - } - } - - public boolean hasJavaClass(){ - return tag != null; - } - - public Class getJavaClass() throws Exception{ - return HostExpr.tagToClass(tag); - } - - public Object evalAssign(Expr val) throws Exception{ - return var.set(val.eval()); - } - - public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, - Expr val){ - objx.emitVar(gen, var); - val.emit(C.EXPRESSION, objx, gen); - gen.invokeVirtual(VAR_TYPE, setMethod); - if(context == C.STATEMENT) - gen.pop(); - } -} - -public static class TheVarExpr implements Expr{ - public final Var var; - - public TheVarExpr(Var var){ - this.var = var; - } - - public Object eval() throws Exception{ - return var; - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - objx.emitVar(gen, var); - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass(){ - return true; - } - - public Class getJavaClass() throws ClassNotFoundException{ - return Var.class; - } - - static class Parser implements IParser{ - public Expr parse(C context, Object form) throws Exception{ - Symbol sym = (Symbol) RT.second(form); - Var v = lookupVar(sym, false); - if(v != null) - return new TheVarExpr(v); - throw new Exception("Unable to resolve var: " + sym + " in this context"); - } - } -} - -public static class KeywordExpr implements Expr{ - public final Keyword k; - - public KeywordExpr(Keyword k){ - this.k = k; - } - - public Object eval() throws Exception{ - return k; - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - objx.emitKeyword(gen, k); - if(context == C.STATEMENT) - gen.pop(); - - } - - public boolean hasJavaClass(){ - return true; - } - - public Class getJavaClass() throws ClassNotFoundException{ - return Keyword.class; - } -} - -public static class ImportExpr implements Expr{ - public final String c; - final static Method forNameMethod = Method.getMethod("Class forName(String)"); - final static Method importClassMethod = Method.getMethod("Class importClass(Class)"); - final static Method derefMethod = Method.getMethod("Object deref()"); - - public ImportExpr(String c){ - this.c = c; - } - - public Object eval() throws Exception{ - Namespace ns = (Namespace) RT.CURRENT_NS.deref(); - ns.importClass(RT.classForName(c)); - return null; - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.getStatic(RT_TYPE,"CURRENT_NS",VAR_TYPE); - gen.invokeVirtual(VAR_TYPE, derefMethod); - gen.checkCast(NS_TYPE); - gen.push(c); - gen.invokeStatic(CLASS_TYPE, forNameMethod); - gen.invokeVirtual(NS_TYPE, importClassMethod); - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass(){ - return false; - } - - public Class getJavaClass() throws ClassNotFoundException{ - throw new IllegalArgumentException("ImportExpr has no Java class"); - } - - static class Parser implements IParser{ - public Expr parse(C context, Object form) throws Exception{ - return new ImportExpr((String) RT.second(form)); - } - } -} - -public static abstract class LiteralExpr implements Expr{ - abstract Object val(); - - public Object eval(){ - return val(); - } -} - -static interface AssignableExpr{ - Object evalAssign(Expr val) throws Exception; - - void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, Expr val); -} - -static public interface MaybePrimitiveExpr extends Expr{ - public boolean canEmitPrimitive(); - public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen); -} - -static public abstract class HostExpr implements Expr, MaybePrimitiveExpr{ - final static Type BOOLEAN_TYPE = Type.getType(Boolean.class); - final static Type CHAR_TYPE = Type.getType(Character.class); - final static Type INTEGER_TYPE = Type.getType(Integer.class); - final static Type LONG_TYPE = Type.getType(Long.class); - final static Type FLOAT_TYPE = Type.getType(Float.class); - final static Type DOUBLE_TYPE = Type.getType(Double.class); - final static Type SHORT_TYPE = Type.getType(Short.class); - final static Type BYTE_TYPE = Type.getType(Byte.class); - final static Type NUMBER_TYPE = Type.getType(Number.class); - - final static Method charValueMethod = Method.getMethod("char charValue()"); - final static Method booleanValueMethod = Method.getMethod("boolean booleanValue()"); - - final static Method charValueOfMethod = Method.getMethod("Character valueOf(char)"); - final static Method intValueOfMethod = Method.getMethod("Integer valueOf(int)"); - final static Method longValueOfMethod = Method.getMethod("Long valueOf(long)"); - final static Method floatValueOfMethod = Method.getMethod("Float valueOf(float)"); - final static Method doubleValueOfMethod = Method.getMethod("Double valueOf(double)"); - final static Method shortValueOfMethod = Method.getMethod("Short valueOf(short)"); - final static Method byteValueOfMethod = Method.getMethod("Byte valueOf(byte)"); - - final static Method intValueMethod = Method.getMethod("int intValue()"); - final static Method longValueMethod = Method.getMethod("long longValue()"); - final static Method floatValueMethod = Method.getMethod("float floatValue()"); - final static Method doubleValueMethod = Method.getMethod("double doubleValue()"); - final static Method byteValueMethod = Method.getMethod("byte byteValue()"); - final static Method shortValueMethod = Method.getMethod("short shortValue()"); - - final static Method fromIntMethod = Method.getMethod("clojure.lang.Num from(int)"); - final static Method fromLongMethod = Method.getMethod("clojure.lang.Num from(long)"); - final static Method fromDoubleMethod = Method.getMethod("clojure.lang.Num from(double)"); - - - //* - public static void emitBoxReturn(ObjExpr objx, GeneratorAdapter gen, Class returnType){ - if(returnType.isPrimitive()) - { - if(returnType == boolean.class) - { - Label falseLabel = gen.newLabel(); - Label endLabel = gen.newLabel(); - gen.ifZCmp(GeneratorAdapter.EQ, falseLabel); - gen.getStatic(BOOLEAN_OBJECT_TYPE, "TRUE", BOOLEAN_OBJECT_TYPE); - gen.goTo(endLabel); - gen.mark(falseLabel); - gen.getStatic(BOOLEAN_OBJECT_TYPE, "FALSE", BOOLEAN_OBJECT_TYPE); -// NIL_EXPR.emit(C.EXPRESSION, fn, gen); - gen.mark(endLabel); - } - else if(returnType == void.class) - { - NIL_EXPR.emit(C.EXPRESSION, objx, gen); - } - else if(returnType == char.class) - { - gen.invokeStatic(CHAR_TYPE, charValueOfMethod); - } - else - { - if(returnType == int.class) - //gen.invokeStatic(NUM_TYPE, fromIntMethod); - gen.invokeStatic(INTEGER_TYPE, intValueOfMethod); - else if(returnType == float.class) - { - //gen.visitInsn(F2D); - gen.invokeStatic(FLOAT_TYPE, floatValueOfMethod); - //m = floatValueOfMethod; - } - else if(returnType == double.class) - gen.invokeStatic(DOUBLE_TYPE, doubleValueOfMethod); - else if(returnType == long.class) - gen.invokeStatic(LONG_TYPE, longValueOfMethod); - else if(returnType == byte.class) - gen.invokeStatic(BYTE_TYPE, byteValueOfMethod); - else if(returnType == short.class) - gen.invokeStatic(SHORT_TYPE, shortValueOfMethod); - } - } - } - - //*/ - public static void emitUnboxArg(ObjExpr objx, GeneratorAdapter gen, Class paramType){ - if(paramType.isPrimitive()) - { - if(paramType == boolean.class) - { - gen.checkCast(BOOLEAN_TYPE); - gen.invokeVirtual(BOOLEAN_TYPE, booleanValueMethod); -// Label falseLabel = gen.newLabel(); -// Label endLabel = gen.newLabel(); -// gen.ifNull(falseLabel); -// gen.push(1); -// gen.goTo(endLabel); -// gen.mark(falseLabel); -// gen.push(0); -// gen.mark(endLabel); - } - else if(paramType == char.class) - { - gen.checkCast(CHAR_TYPE); - gen.invokeVirtual(CHAR_TYPE, charValueMethod); - } - else - { - Method m = intValueMethod; - gen.checkCast(NUMBER_TYPE); - if(paramType == int.class) - m = intValueMethod; - else if(paramType == float.class) - m = floatValueMethod; - else if(paramType == double.class) - m = doubleValueMethod; - else if(paramType == long.class) - m = longValueMethod; - else if(paramType == byte.class) - m = byteValueMethod; - else if(paramType == short.class) - m = shortValueMethod; - gen.invokeVirtual(NUMBER_TYPE, m); - } - } - else - { - gen.checkCast(Type.getType(paramType)); - } - } - - static class Parser implements IParser{ - public Expr parse(C context, Object frm) throws Exception{ - ISeq form = (ISeq) frm; - //(. x fieldname-sym) or - //(. x 0-ary-method) - // (. x methodname-sym args+) - // (. x (methodname-sym args?)) - if(RT.length(form) < 3) - throw new IllegalArgumentException("Malformed member expression, expecting (. target member ...)"); - //determine static or instance - //static target must be symbol, either fully.qualified.Classname or Classname that has been imported - int line = (Integer) LINE.deref(); - String source = (String) SOURCE.deref(); - Class c = maybeClass(RT.second(form), false); - //at this point c will be non-null if static - Expr instance = null; - if(c == null) - instance = analyze(context == C.EVAL ? context : C.EXPRESSION, RT.second(form)); - boolean maybeField = RT.length(form) == 3 && - (RT.third(form) instanceof Symbol - || RT.third(form) instanceof Keyword); - if(maybeField && !(RT.third(form) instanceof Keyword)) - { - Symbol sym = (Symbol) RT.third(form); - if(c != null) - maybeField = Reflector.getMethods(c, 0, munge(sym.name), true).size() == 0; - else if(instance != null && instance.hasJavaClass() && instance.getJavaClass() != null) - maybeField = Reflector.getMethods(instance.getJavaClass(), 0, munge(sym.name), false).size() == 0; - } - if(maybeField) //field - { - Symbol sym = (RT.third(form) instanceof Keyword)? - ((Keyword)RT.third(form)).sym - :(Symbol) RT.third(form); - Symbol tag = tagOf(form); - if(c != null) { - return new StaticFieldExpr(line, c, munge(sym.name), tag); - } else - return new InstanceFieldExpr(line, instance, munge(sym.name), tag); - } - else - { - ISeq call = (ISeq) ((RT.third(form) instanceof ISeq) ? RT.third(form) : RT.next(RT.next(form))); - if(!(RT.first(call) instanceof Symbol)) - throw new IllegalArgumentException("Malformed member expression"); - Symbol sym = (Symbol) RT.first(call); - Symbol tag = tagOf(form); - PersistentVector args = PersistentVector.EMPTY; - for(ISeq s = RT.next(call); s != null; s = s.next()) - args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first())); - if(c != null) - return new StaticMethodExpr(source, line, tag, c, munge(sym.name), args); - else - return new InstanceMethodExpr(source, line, tag, instance, munge(sym.name), args); - } - } - } - - private static Class maybeClass(Object form, boolean stringOk) throws Exception{ - if(form instanceof Class) - return (Class) form; - Class c = null; - if(form instanceof Symbol) - { - Symbol sym = (Symbol) form; - if(sym.ns == null) //if ns-qualified can't be classname - { - if(Util.equals(sym,COMPILE_STUB_SYM.get())) - return (Class) COMPILE_STUB_CLASS.get(); - if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[') - c = RT.classForName(sym.name); - else - { - Object o = currentNS().getMapping(sym); - if(o instanceof Class) - c = (Class) o; - } - } - } - else if(stringOk && form instanceof String) - c = RT.classForName((String) form); - return c; - } - - /* - private static String maybeClassName(Object form, boolean stringOk){ - String className = null; - if(form instanceof Symbol) - { - Symbol sym = (Symbol) form; - if(sym.ns == null) //if ns-qualified can't be classname - { - if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[') - className = sym.name; - else - { - IPersistentMap imports = (IPersistentMap) ((Var) RT.NS_IMPORTS.get()).get(); - className = (String) imports.valAt(sym); - } - } - } - else if(stringOk && form instanceof String) - className = (String) form; - return className; - } - */ - static Class tagToClass(Object tag) throws Exception{ - Class c = maybeClass(tag, true); - if(tag instanceof Symbol) - { - Symbol sym = (Symbol) tag; - if(sym.ns == null) //if ns-qualified can't be classname - { - if(sym.name.equals("objects")) - c = Object[].class; - else if(sym.name.equals("ints")) - c = int[].class; - else if(sym.name.equals("longs")) - c = long[].class; - else if(sym.name.equals("floats")) - c = float[].class; - else if(sym.name.equals("doubles")) - c = double[].class; - else if(sym.name.equals("chars")) - c = char[].class; - else if(sym.name.equals("shorts")) - c = short[].class; - else if(sym.name.equals("bytes")) - c = byte[].class; - else if(sym.name.equals("booleans")) - c = boolean[].class; - } - } - if(c != null) - return c; - throw new IllegalArgumentException("Unable to resolve classname: " + tag); - } -} - -static abstract class FieldExpr extends HostExpr{ -} - -static class InstanceFieldExpr extends FieldExpr implements AssignableExpr{ - public final Expr target; - public final Class targetClass; - public final java.lang.reflect.Field field; - public final String fieldName; - public final int line; - public final Symbol tag; - final static Method invokeNoArgInstanceMember = Method.getMethod("Object invokeNoArgInstanceMember(Object,String)"); - final static Method setInstanceFieldMethod = Method.getMethod("Object setInstanceField(Object,String,Object)"); - - - public InstanceFieldExpr(int line, Expr target, String fieldName, Symbol tag) throws Exception{ - this.target = target; - this.targetClass = target.hasJavaClass() ? target.getJavaClass() : null; - this.field = targetClass != null ? Reflector.getField(targetClass, fieldName, false) : null; - this.fieldName = fieldName; - this.line = line; - this.tag = tag; - if(field == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref())) - { - RT.errPrintWriter() - .format("Reflection warning, %s:%d - reference to field %s can't be resolved.\n", - SOURCE_PATH.deref(), line, fieldName); - } - } - - public Object eval() throws Exception{ - return Reflector.invokeNoArgInstanceMember(target.eval(), fieldName); - } - - public boolean canEmitPrimitive(){ - return targetClass != null && field != null && - Util.isPrimitive(field.getType()); - } - - public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitLineNumber(line, gen.mark()); - if(targetClass != null && field != null) - { - target.emit(C.EXPRESSION, objx, gen); - gen.checkCast(getType(targetClass)); - gen.getField(getType(targetClass), fieldName, Type.getType(field.getType())); - } - else - throw new UnsupportedOperationException("Unboxed emit of unknown member"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitLineNumber(line, gen.mark()); - if(targetClass != null && field != null) - { - target.emit(C.EXPRESSION, objx, gen); - gen.checkCast(getType(targetClass)); - gen.getField(getType(targetClass), fieldName, Type.getType(field.getType())); - //if(context != C.STATEMENT) - HostExpr.emitBoxReturn(objx, gen, field.getType()); - if(context == C.STATEMENT) - { - gen.pop(); - } - } - else - { - target.emit(C.EXPRESSION, objx, gen); - gen.push(fieldName); - gen.invokeStatic(REFLECTOR_TYPE, invokeNoArgInstanceMember); - if(context == C.STATEMENT) - gen.pop(); - } - } - - public boolean hasJavaClass() throws Exception{ - return field != null || tag != null; - } - - public Class getJavaClass() throws Exception{ - return tag != null ? HostExpr.tagToClass(tag) : field.getType(); - } - - public Object evalAssign(Expr val) throws Exception{ - return Reflector.setInstanceField(target.eval(), fieldName, val.eval()); - } - - public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, - Expr val){ - gen.visitLineNumber(line, gen.mark()); - if(targetClass != null && field != null) - { - target.emit(C.EXPRESSION, objx, gen); - gen.checkCast(Type.getType(targetClass)); - val.emit(C.EXPRESSION, objx, gen); - gen.dupX1(); - HostExpr.emitUnboxArg(objx, gen, field.getType()); - gen.putField(Type.getType(targetClass), fieldName, Type.getType(field.getType())); - } - else - { - target.emit(C.EXPRESSION, objx, gen); - gen.push(fieldName); - val.emit(C.EXPRESSION, objx, gen); - gen.invokeStatic(REFLECTOR_TYPE, setInstanceFieldMethod); - } - if(context == C.STATEMENT) - gen.pop(); - } -} - -static class StaticFieldExpr extends FieldExpr implements AssignableExpr{ - //final String className; - public final String fieldName; - public final Class c; - public final java.lang.reflect.Field field; - public final Symbol tag; -// final static Method getStaticFieldMethod = Method.getMethod("Object getStaticField(String,String)"); -// final static Method setStaticFieldMethod = Method.getMethod("Object setStaticField(String,String,Object)"); - final int line; - - public StaticFieldExpr(int line, Class c, String fieldName, Symbol tag) throws Exception{ - //this.className = className; - this.fieldName = fieldName; - this.line = line; - //c = Class.forName(className); - this.c = c; - field = c.getField(fieldName); - this.tag = tag; - } - - public Object eval() throws Exception{ - return Reflector.getStaticField(c, fieldName); - } - - public boolean canEmitPrimitive(){ - return Util.isPrimitive(field.getType()); - } - - public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitLineNumber(line, gen.mark()); - gen.getStatic(Type.getType(c), fieldName, Type.getType(field.getType())); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitLineNumber(line, gen.mark()); - - gen.getStatic(Type.getType(c), fieldName, Type.getType(field.getType())); - //if(context != C.STATEMENT) - HostExpr.emitBoxReturn(objx, gen, field.getType()); - if(context == C.STATEMENT) - { - gen.pop(); - } -// gen.push(className); -// gen.push(fieldName); -// gen.invokeStatic(REFLECTOR_TYPE, getStaticFieldMethod); - } - - public boolean hasJavaClass(){ - return true; - } - - public Class getJavaClass() throws Exception{ - //Class c = Class.forName(className); - //java.lang.reflect.Field field = c.getField(fieldName); - return tag != null ? HostExpr.tagToClass(tag) : field.getType(); - } - - public Object evalAssign(Expr val) throws Exception{ - return Reflector.setStaticField(c, fieldName, val.eval()); - } - - public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, - Expr val){ - gen.visitLineNumber(line, gen.mark()); - val.emit(C.EXPRESSION, objx, gen); - gen.dup(); - HostExpr.emitUnboxArg(objx, gen, field.getType()); - gen.putStatic(Type.getType(c), fieldName, Type.getType(field.getType())); - if(context == C.STATEMENT) - gen.pop(); - } - - -} - -static Class maybePrimitiveType(Expr e){ - try - { - if(e instanceof MaybePrimitiveExpr && e.hasJavaClass() && ((MaybePrimitiveExpr)e).canEmitPrimitive()) - { - Class c = e.getJavaClass(); - if(Util.isPrimitive(c)) - return c; - } - } - catch(Exception ex) - { - throw new RuntimeException(ex); - } - return null; -} - -static abstract class MethodExpr extends HostExpr{ - static void emitArgsAsArray(IPersistentVector args, ObjExpr objx, GeneratorAdapter gen){ - gen.push(args.count()); - gen.newArray(OBJECT_TYPE); - for(int i = 0; i < args.count(); i++) - { - gen.dup(); - gen.push(i); - ((Expr) args.nth(i)).emit(C.EXPRESSION, objx, gen); - gen.arrayStore(OBJECT_TYPE); - } - } - - public static void emitTypedArgs(ObjExpr objx, GeneratorAdapter gen, Class[] parameterTypes, IPersistentVector args){ - for(int i = 0; i < parameterTypes.length; i++) - { - Expr e = (Expr) args.nth(i); - try - { - if(maybePrimitiveType(e) == parameterTypes[i]) - { - ((MaybePrimitiveExpr) e).emitUnboxed(C.EXPRESSION, objx, gen); - } - else - { - e.emit(C.EXPRESSION, objx, gen); - HostExpr.emitUnboxArg(objx, gen, parameterTypes[i]); - } - } - catch(Exception e1) - { - e1.printStackTrace(RT.errPrintWriter()); - } - - } - } -} - -static class InstanceMethodExpr extends MethodExpr{ - public final Expr target; - public final String methodName; - public final IPersistentVector args; - public final String source; - public final int line; - public final Symbol tag; - public final java.lang.reflect.Method method; - - final static Method invokeInstanceMethodMethod = - Method.getMethod("Object invokeInstanceMethod(Object,String,Object[])"); - - - public InstanceMethodExpr(String source, int line, Symbol tag, Expr target, String methodName, IPersistentVector args) - throws Exception{ - this.source = source; - this.line = line; - this.args = args; - this.methodName = methodName; - this.target = target; - this.tag = tag; - if(target.hasJavaClass() && target.getJavaClass() != null) - { - List methods = Reflector.getMethods(target.getJavaClass(), args.count(), methodName, false); - if(methods.isEmpty()) - method = null; - //throw new IllegalArgumentException("No matching method found"); - else - { - int methodidx = 0; - if(methods.size() > 1) - { - ArrayList params = new ArrayList(); - ArrayList rets = new ArrayList(); - for(int i = 0; i < methods.size(); i++) - { - java.lang.reflect.Method m = (java.lang.reflect.Method) methods.get(i); - params.add(m.getParameterTypes()); - rets.add(m.getReturnType()); - } - methodidx = getMatchingParams(methodName, params, args, rets); - } - java.lang.reflect.Method m = - (java.lang.reflect.Method) (methodidx >= 0 ? methods.get(methodidx) : null); - if(m != null && !Modifier.isPublic(m.getDeclaringClass().getModifiers())) - { - //public method of non-public class, try to find it in hierarchy - m = Reflector.getAsMethodOfPublicBase(m.getDeclaringClass(), m); - } - method = m; - } - } - else - method = null; - - if(method == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref())) - { - RT.errPrintWriter() - .format("Reflection warning, %s:%d - call to %s can't be resolved.\n", - SOURCE_PATH.deref(), line, methodName); - } - } - - public Object eval() throws Exception{ - try - { - Object targetval = target.eval(); - Object[] argvals = new Object[args.count()]; - for(int i = 0; i < args.count(); i++) - argvals[i] = ((Expr) args.nth(i)).eval(); - if(method != null) - { - LinkedList ms = new LinkedList(); - ms.add(method); - return Reflector.invokeMatchingMethod(methodName, ms, targetval, argvals); - } - return Reflector.invokeInstanceMethod(targetval, methodName, argvals); - } - catch(Throwable e) - { - if(!(e instanceof CompilerException)) - throw new CompilerException(source, line, e); - else - throw (CompilerException) e; - } - } - - public boolean canEmitPrimitive(){ - return method != null && Util.isPrimitive(method.getReturnType()); - } - - public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitLineNumber(line, gen.mark()); - if(method != null) - { - Type type = Type.getType(method.getDeclaringClass()); - target.emit(C.EXPRESSION, objx, gen); - //if(!method.getDeclaringClass().isInterface()) - gen.checkCast(type); - MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } - Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); - if(method.getDeclaringClass().isInterface()) - gen.invokeInterface(type, m); - else - gen.invokeVirtual(type, m); - } - else - throw new UnsupportedOperationException("Unboxed emit of unknown member"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitLineNumber(line, gen.mark()); - if(method != null) - { - Type type = Type.getType(method.getDeclaringClass()); - target.emit(C.EXPRESSION, objx, gen); - //if(!method.getDeclaringClass().isInterface()) - gen.checkCast(type); - MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } - Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); - if(method.getDeclaringClass().isInterface()) - gen.invokeInterface(type, m); - else - gen.invokeVirtual(type, m); - //if(context != C.STATEMENT || method.getReturnType() == Void.TYPE) - HostExpr.emitBoxReturn(objx, gen, method.getReturnType()); - } - else - { - target.emit(C.EXPRESSION, objx, gen); - gen.push(methodName); - emitArgsAsArray(args, objx, gen); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } - gen.invokeStatic(REFLECTOR_TYPE, invokeInstanceMethodMethod); - } - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass(){ - return method != null || tag != null; - } - - public Class getJavaClass() throws Exception{ - return tag != null ? HostExpr.tagToClass(tag) : method.getReturnType(); - } -} - - -static class StaticMethodExpr extends MethodExpr{ - //final String className; - public final Class c; - public final String methodName; - public final IPersistentVector args; - public final String source; - public final int line; - public final java.lang.reflect.Method method; - public final Symbol tag; - final static Method forNameMethod = Method.getMethod("Class forName(String)"); - final static Method invokeStaticMethodMethod = - Method.getMethod("Object invokeStaticMethod(Class,String,Object[])"); - - - public StaticMethodExpr(String source, int line, Symbol tag, Class c, String methodName, IPersistentVector args) - throws Exception{ - this.c = c; - this.methodName = methodName; - this.args = args; - this.source = source; - this.line = line; - this.tag = tag; - - List methods = Reflector.getMethods(c, args.count(), methodName, true); - if(methods.isEmpty()) - throw new IllegalArgumentException("No matching method: " + methodName); - - int methodidx = 0; - if(methods.size() > 1) - { - ArrayList params = new ArrayList(); - ArrayList rets = new ArrayList(); - for(int i = 0; i < methods.size(); i++) - { - java.lang.reflect.Method m = (java.lang.reflect.Method) methods.get(i); - params.add(m.getParameterTypes()); - rets.add(m.getReturnType()); - } - methodidx = getMatchingParams(methodName, params, args, rets); - } - method = (java.lang.reflect.Method) (methodidx >= 0 ? methods.get(methodidx) : null); - if(method == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref())) - { - RT.errPrintWriter() - .format("Reflection warning, %s:%d - call to %s can't be resolved.\n", - SOURCE_PATH.deref(), line, methodName); - } - } - - public Object eval() throws Exception{ - try - { - Object[] argvals = new Object[args.count()]; - for(int i = 0; i < args.count(); i++) - argvals[i] = ((Expr) args.nth(i)).eval(); - if(method != null) - { - LinkedList ms = new LinkedList(); - ms.add(method); - return Reflector.invokeMatchingMethod(methodName, ms, null, argvals); - } - return Reflector.invokeStaticMethod(c, methodName, argvals); - } - catch(Throwable e) - { - if(!(e instanceof CompilerException)) - throw new CompilerException(source, line, e); - else - throw (CompilerException) e; - } - } - - public boolean canEmitPrimitive(){ - return method != null && Util.isPrimitive(method.getReturnType()); - } - - public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitLineNumber(line, gen.mark()); - if(method != null) - { - MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); - //Type type = Type.getObjectType(className.replace('.', '/')); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } - Type type = Type.getType(c); - Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); - gen.invokeStatic(type, m); - } - else - throw new UnsupportedOperationException("Unboxed emit of unknown member"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitLineNumber(line, gen.mark()); - if(method != null) - { - MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); - //Type type = Type.getObjectType(className.replace('.', '/')); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } - Type type = Type.getType(c); - Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); - gen.invokeStatic(type, m); - //if(context != C.STATEMENT || method.getReturnType() == Void.TYPE) - HostExpr.emitBoxReturn(objx, gen, method.getReturnType()); - } - else - { - gen.push(c.getName()); - gen.invokeStatic(CLASS_TYPE, forNameMethod); - gen.push(methodName); - emitArgsAsArray(args, objx, gen); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } - gen.invokeStatic(REFLECTOR_TYPE, invokeStaticMethodMethod); - } - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass(){ - return method != null || tag != null; - } - - public Class getJavaClass() throws Exception{ - return tag != null ? HostExpr.tagToClass(tag) : method.getReturnType(); - } -} - -static class UnresolvedVarExpr implements Expr{ - public final Symbol symbol; - - public UnresolvedVarExpr(Symbol symbol){ - this.symbol = symbol; - } - - public boolean hasJavaClass(){ - return false; - } - - public Class getJavaClass() throws Exception{ - throw new IllegalArgumentException( - "UnresolvedVarExpr has no Java class"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - } - - public Object eval() throws Exception{ - throw new IllegalArgumentException( - "UnresolvedVarExpr cannot be evalled"); - } -} - -static class ConstantExpr extends LiteralExpr{ - //stuff quoted vals in classloader at compile time, pull out at runtime - //this won't work for static compilation... - public final Object v; - public final int id; - - public ConstantExpr(Object v){ - this.v = v; - this.id = registerConstant(v); -// this.id = RT.nextID(); -// DynamicClassLoader loader = (DynamicClassLoader) LOADER.get(); -// loader.registerQuotedVal(id, v); - } - - Object val(){ - return v; - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - objx.emitConstant(gen, id); - if(context == C.STATEMENT) - { - gen.pop(); -// gen.loadThis(); -// gen.invokeVirtual(OBJECT_TYPE, getClassMethod); -// gen.invokeVirtual(CLASS_TYPE, getClassLoaderMethod); -// gen.checkCast(DYNAMIC_CLASSLOADER_TYPE); -// gen.push(id); -// gen.invokeVirtual(DYNAMIC_CLASSLOADER_TYPE, getQuotedValMethod); - } - } - - public boolean hasJavaClass(){ - return Modifier.isPublic(v.getClass().getModifiers()); - //return false; - } - - public Class getJavaClass() throws Exception{ - return v.getClass(); - //throw new IllegalArgumentException("Has no Java class"); - } - - static class Parser implements IParser{ - public Expr parse(C context, Object form){ - Object v = RT.second(form); - - if(v == null) - return NIL_EXPR; -// Class fclass = v.getClass(); -// if(fclass == Keyword.class) -// return registerKeyword((Keyword) v); -// else if(v instanceof Num) -// return new NumExpr((Num) v); -// else if(fclass == String.class) -// return new StringExpr((String) v); -// else if(fclass == Character.class) -// return new CharExpr((Character) v); -// else if(v instanceof IPersistentCollection && ((IPersistentCollection) v).count() == 0) -// return new EmptyExpr(v); - else - return new ConstantExpr(v); - } - } -} - -static class NilExpr extends LiteralExpr{ - Object val(){ - return null; - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitInsn(Opcodes.ACONST_NULL); - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass(){ - return true; - } - - public Class getJavaClass() throws Exception{ - return null; - } -} - -final static NilExpr NIL_EXPR = new NilExpr(); - -static class BooleanExpr extends LiteralExpr{ - public final boolean val; - - - public BooleanExpr(boolean val){ - this.val = val; - } - - Object val(){ - return val ? RT.T : RT.F; - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - if(val) - gen.getStatic(BOOLEAN_OBJECT_TYPE, "TRUE", BOOLEAN_OBJECT_TYPE); - else - gen.getStatic(BOOLEAN_OBJECT_TYPE, "FALSE", BOOLEAN_OBJECT_TYPE); - if(context == C.STATEMENT) - { - gen.pop(); - } - } - - public boolean hasJavaClass(){ - return true; - } - - public Class getJavaClass() throws Exception{ - return Boolean.class; - } -} - -final static BooleanExpr TRUE_EXPR = new BooleanExpr(true); -final static BooleanExpr FALSE_EXPR = new BooleanExpr(false); - -static class StringExpr extends LiteralExpr{ - public final String str; - - public StringExpr(String str){ - this.str = str; - } - - Object val(){ - return str; - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - if(context != C.STATEMENT) - gen.push(str); - } - - public boolean hasJavaClass(){ - return true; - } - - public Class getJavaClass() throws Exception{ - return String.class; - } -} - - -static class MonitorEnterExpr extends UntypedExpr{ - final Expr target; - - public MonitorEnterExpr(Expr target){ - this.target = target; - } - - public Object eval() throws Exception{ - throw new UnsupportedOperationException("Can't eval monitor-enter"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - target.emit(C.EXPRESSION, objx, gen); - gen.monitorEnter(); - NIL_EXPR.emit(context, objx, gen); - } - - static class Parser implements IParser{ - public Expr parse(C context, Object form) throws Exception{ - return new MonitorEnterExpr(analyze(C.EXPRESSION, RT.second(form))); - } - } -} - -static class MonitorExitExpr extends UntypedExpr{ - final Expr target; - - public MonitorExitExpr(Expr target){ - this.target = target; - } - - public Object eval() throws Exception{ - throw new UnsupportedOperationException("Can't eval monitor-exit"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - target.emit(C.EXPRESSION, objx, gen); - gen.monitorExit(); - NIL_EXPR.emit(context, objx, gen); - } - - static class Parser implements IParser{ - public Expr parse(C context, Object form) throws Exception{ - return new MonitorExitExpr(analyze(C.EXPRESSION, RT.second(form))); - } - } - -} - -public static class TryExpr implements Expr{ - public final Expr tryExpr; - public final Expr finallyExpr; - public final PersistentVector catchExprs; - public final int retLocal; - public final int finallyLocal; - - public static class CatchClause{ - //final String className; - public final Class c; - public final LocalBinding lb; - public final Expr handler; - Label label; - Label endLabel; - - - public CatchClause(Class c, LocalBinding lb, Expr handler){ - this.c = c; - this.lb = lb; - this.handler = handler; - } - } - - public TryExpr(Expr tryExpr, PersistentVector catchExprs, Expr finallyExpr, int retLocal, int finallyLocal){ - this.tryExpr = tryExpr; - this.catchExprs = catchExprs; - this.finallyExpr = finallyExpr; - this.retLocal = retLocal; - this.finallyLocal = finallyLocal; - } - - public Object eval() throws Exception{ - throw new UnsupportedOperationException("Can't eval try"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - Label startTry = gen.newLabel(); - Label endTry = gen.newLabel(); - Label end = gen.newLabel(); - Label ret = gen.newLabel(); - Label finallyLabel = gen.newLabel(); - for(int i = 0; i < catchExprs.count(); i++) - { - CatchClause clause = (CatchClause) catchExprs.nth(i); - clause.label = gen.newLabel(); - clause.endLabel = gen.newLabel(); - } - - gen.mark(startTry); - tryExpr.emit(context, objx, gen); - if(context != C.STATEMENT) - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), retLocal); - gen.mark(endTry); - if(finallyExpr != null) - finallyExpr.emit(C.STATEMENT, objx, gen); - gen.goTo(ret); - - for(int i = 0; i < catchExprs.count(); i++) - { - CatchClause clause = (CatchClause) catchExprs.nth(i); - gen.mark(clause.label); - //exception should be on stack - //put in clause local - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), clause.lb.idx); - clause.handler.emit(context, objx, gen); - if(context != C.STATEMENT) - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), retLocal); - gen.mark(clause.endLabel); - - if(finallyExpr != null) - finallyExpr.emit(C.STATEMENT, objx, gen); - gen.goTo(ret); - } - if(finallyExpr != null) - { - gen.mark(finallyLabel); - //exception should be on stack - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), finallyLocal); - finallyExpr.emit(C.STATEMENT, objx, gen); - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), finallyLocal); - gen.throwException(); - } - gen.mark(ret); - if(context != C.STATEMENT) - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), retLocal); - gen.mark(end); - for(int i = 0; i < catchExprs.count(); i++) - { - CatchClause clause = (CatchClause) catchExprs.nth(i); - gen.visitTryCatchBlock(startTry, endTry, clause.label, clause.c.getName().replace('.', '/')); - } - if(finallyExpr != null) - { - gen.visitTryCatchBlock(startTry, endTry, finallyLabel, null); - for(int i = 0; i < catchExprs.count(); i++) - { - CatchClause clause = (CatchClause) catchExprs.nth(i); - gen.visitTryCatchBlock(clause.label, clause.endLabel, finallyLabel, null); - } - } - for(int i = 0; i < catchExprs.count(); i++) - { - CatchClause clause = (CatchClause) catchExprs.nth(i); - gen.visitLocalVariable(clause.lb.name, "Ljava/lang/Object;", null, clause.label, clause.endLabel, - clause.lb.idx); - } - } - - public boolean hasJavaClass() throws Exception{ - return tryExpr.hasJavaClass(); - } - - public Class getJavaClass() throws Exception{ - return tryExpr.getJavaClass(); - } - - static class Parser implements IParser{ - - public Expr parse(C context, Object frm) throws Exception{ - ISeq form = (ISeq) frm; -// if(context == C.EVAL || context == C.EXPRESSION) - if(context != C.RETURN) - return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); - - //(try try-expr* catch-expr* finally-expr?) - //catch-expr: (catch class sym expr*) - //finally-expr: (finally expr*) - - PersistentVector body = PersistentVector.EMPTY; - PersistentVector catches = PersistentVector.EMPTY; - Expr bodyExpr = null; - Expr finallyExpr = null; - boolean caught = false; - - int retLocal = getAndIncLocalNum(); - int finallyLocal = getAndIncLocalNum(); - for(ISeq fs = form.next(); fs != null; fs = fs.next()) - { - Object f = fs.first(); - Object op = (f instanceof ISeq) ? ((ISeq) f).first() : null; - if(!Util.equals(op, CATCH) && !Util.equals(op, FINALLY)) - { - if(caught) - throw new Exception("Only catch or finally clause can follow catch in try expression"); - body = body.cons(f); - } - else - { - if(bodyExpr == null) - bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body)); - if(Util.equals(op, CATCH)) - { - Class c = HostExpr.maybeClass(RT.second(f), false); - if(c == null) - throw new IllegalArgumentException("Unable to resolve classname: " + RT.second(f)); - if(!(RT.third(f) instanceof Symbol)) - throw new IllegalArgumentException( - "Bad binding form, expected symbol, got: " + RT.third(f)); - Symbol sym = (Symbol) RT.third(f); - if(sym.getNamespace() != null) - throw new Exception("Can't bind qualified name:" + sym); - - IPersistentMap dynamicBindings = RT.map(LOCAL_ENV, LOCAL_ENV.deref(), - NEXT_LOCAL_NUM, NEXT_LOCAL_NUM.deref(), - IN_CATCH_FINALLY, RT.T); - try - { - Var.pushThreadBindings(dynamicBindings); - LocalBinding lb = registerLocal(sym, - (Symbol) (RT.second(f) instanceof Symbol ? RT.second(f) - : null), - null,false); - Expr handler = (new BodyExpr.Parser()).parse(context, RT.next(RT.next(RT.next(f)))); - catches = catches.cons(new CatchClause(c, lb, handler)); - } - finally - { - Var.popThreadBindings(); - } - caught = true; - } - else //finally - { - if(fs.next() != null) - throw new Exception("finally clause must be last in try expression"); - try - { - Var.pushThreadBindings(RT.map(IN_CATCH_FINALLY, RT.T)); - finallyExpr = (new BodyExpr.Parser()).parse(C.STATEMENT, RT.next(f)); - } - finally - { - Var.popThreadBindings(); - } - } - } - } - if(bodyExpr == null) - bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body)); - - return new TryExpr(bodyExpr, catches, finallyExpr, retLocal, - finallyLocal); - } - } -} - -//static class TryFinallyExpr implements Expr{ -// final Expr tryExpr; -// final Expr finallyExpr; -// -// -// public TryFinallyExpr(Expr tryExpr, Expr finallyExpr){ -// this.tryExpr = tryExpr; -// this.finallyExpr = finallyExpr; -// } -// -// public Object eval() throws Exception{ -// throw new UnsupportedOperationException("Can't eval try"); -// } -// -// public void emit(C context, FnExpr fn, GeneratorAdapter gen){ -// Label startTry = gen.newLabel(); -// Label endTry = gen.newLabel(); -// Label end = gen.newLabel(); -// Label finallyLabel = gen.newLabel(); -// gen.visitTryCatchBlock(startTry, endTry, finallyLabel, null); -// gen.mark(startTry); -// tryExpr.emit(context, fn, gen); -// gen.mark(endTry); -// finallyExpr.emit(C.STATEMENT, fn, gen); -// gen.goTo(end); -// gen.mark(finallyLabel); -// //exception should be on stack -// finallyExpr.emit(C.STATEMENT, fn, gen); -// gen.throwException(); -// gen.mark(end); -// } -// -// public boolean hasJavaClass() throws Exception{ -// return tryExpr.hasJavaClass(); -// } -// -// public Class getJavaClass() throws Exception{ -// return tryExpr.getJavaClass(); -// } -// -// static class Parser implements IParser{ -// public Expr parse(C context, Object frm) throws Exception{ -// ISeq form = (ISeq) frm; -// //(try-finally try-expr finally-expr) -// if(form.count() != 3) -// throw new IllegalArgumentException( -// "Wrong number of arguments, expecting: (try-finally try-expr finally-expr) "); -// -// if(context == C.EVAL || context == C.EXPRESSION) -// return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); -// -// return new TryFinallyExpr(analyze(context, RT.second(form)), -// analyze(C.STATEMENT, RT.third(form))); -// } -// } -//} - -static class ThrowExpr extends UntypedExpr{ - public final Expr excExpr; - - public ThrowExpr(Expr excExpr){ - this.excExpr = excExpr; - } - - - public Object eval() throws Exception{ - throw new Exception("Can't eval throw"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - excExpr.emit(C.EXPRESSION, objx, gen); - gen.checkCast(THROWABLE_TYPE); - gen.throwException(); - } - - static class Parser implements IParser{ - public Expr parse(C context, Object form) throws Exception{ - if(context == C.EVAL) - return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); - return new ThrowExpr(analyze(C.EXPRESSION, RT.second(form))); - } - } -} - - -static public boolean subsumes(Class[] c1, Class[] c2){ - //presumes matching lengths - Boolean better = false; - for(int i = 0; i < c1.length; i++) - { - if(c1[i] != c2[i])// || c2[i].isPrimitive() && c1[i] == Object.class)) - { - if(!c1[i].isPrimitive() && c2[i].isPrimitive() - //|| Number.class.isAssignableFrom(c1[i]) && c2[i].isPrimitive() - || - c2[i].isAssignableFrom(c1[i])) - better = true; - else - return false; - } - } - return better; -} - -static int getMatchingParams(String methodName, ArrayList paramlists, IPersistentVector argexprs, - List rets) - throws Exception{ - //presumes matching lengths - int matchIdx = -1; - boolean tied = false; - boolean foundExact = false; - for(int i = 0; i < paramlists.size(); i++) - { - boolean match = true; - ISeq aseq = argexprs.seq(); - int exact = 0; - for(int p = 0; match && p < argexprs.count() && aseq != null; ++p, aseq = aseq.next()) - { - Expr arg = (Expr) aseq.first(); - Class aclass = arg.hasJavaClass() ? arg.getJavaClass() : Object.class; - Class pclass = paramlists.get(i)[p]; - if(arg.hasJavaClass() && aclass == pclass) - exact++; - else - match = Reflector.paramArgTypeMatch(pclass, aclass); - } - if(exact == argexprs.count()) - { - if(!foundExact || matchIdx == -1 || rets.get(matchIdx).isAssignableFrom(rets.get(i))) - matchIdx = i; - foundExact = true; - } - else if(match && !foundExact) - { - if(matchIdx == -1) - matchIdx = i; - else - { - if(subsumes(paramlists.get(i), paramlists.get(matchIdx))) - { - matchIdx = i; - tied = false; - } - else if(Arrays.equals(paramlists.get(matchIdx), paramlists.get(i))) - { - if(rets.get(matchIdx).isAssignableFrom(rets.get(i))) - matchIdx = i; - } - else if(!(subsumes(paramlists.get(matchIdx), paramlists.get(i)))) - tied = true; - } - } - } - if(tied) - throw new IllegalArgumentException("More than one matching method found: " + methodName); - - return matchIdx; -} - -public static class NewExpr implements Expr{ - public final IPersistentVector args; - public final Constructor ctor; - public final Class c; - final static Method invokeConstructorMethod = - Method.getMethod("Object invokeConstructor(Class,Object[])"); -// final static Method forNameMethod = Method.getMethod("Class classForName(String)"); - final static Method forNameMethod = Method.getMethod("Class forName(String)"); - - - public NewExpr(Class c, IPersistentVector args, int line) throws Exception{ - this.args = args; - this.c = c; - Constructor[] allctors = c.getConstructors(); - ArrayList ctors = new ArrayList(); - ArrayList params = new ArrayList(); - ArrayList rets = new ArrayList(); - for(int i = 0; i < allctors.length; i++) - { - Constructor ctor = allctors[i]; - if(ctor.getParameterTypes().length == args.count()) - { - ctors.add(ctor); - params.add(ctor.getParameterTypes()); - rets.add(c); - } - } - if(ctors.isEmpty()) - throw new IllegalArgumentException("No matching ctor found for " + c); - - int ctoridx = 0; - if(ctors.size() > 1) - { - ctoridx = getMatchingParams(c.getName(), params, args, rets); - } - - this.ctor = ctoridx >= 0 ? (Constructor) ctors.get(ctoridx) : null; - if(ctor == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref())) - { - RT.errPrintWriter() - .format("Reflection warning, %s:%d - call to %s ctor can't be resolved.\n", - SOURCE_PATH.deref(), line, c.getName()); - } - } - - public Object eval() throws Exception{ - Object[] argvals = new Object[args.count()]; - for(int i = 0; i < args.count(); i++) - argvals[i] = ((Expr) args.nth(i)).eval(); - if(this.ctor != null) - { - return ctor.newInstance(Reflector.boxArgs(ctor.getParameterTypes(), argvals)); - } - return Reflector.invokeConstructor(c, argvals); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - if(this.ctor != null) - { - Type type = getType(c); - gen.newInstance(type); - gen.dup(); - MethodExpr.emitTypedArgs(objx, gen, ctor.getParameterTypes(), args); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } - gen.invokeConstructor(type, new Method("", Type.getConstructorDescriptor(ctor))); - } - else - { - gen.push(destubClassName(c.getName())); - gen.invokeStatic(CLASS_TYPE, forNameMethod); - MethodExpr.emitArgsAsArray(args, objx, gen); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } - gen.invokeStatic(REFLECTOR_TYPE, invokeConstructorMethod); - } - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass(){ - return true; - } - - public Class getJavaClass() throws Exception{ - return c; - } - - static class Parser implements IParser{ - public Expr parse(C context, Object frm) throws Exception{ - int line = (Integer) LINE.deref(); - ISeq form = (ISeq) frm; - //(new Classname args...) - if(form.count() < 2) - throw new Exception("wrong number of arguments, expecting: (new Classname args...)"); - Class c = HostExpr.maybeClass(RT.second(form), false); - if(c == null) - throw new IllegalArgumentException("Unable to resolve classname: " + RT.second(form)); - PersistentVector args = PersistentVector.EMPTY; - for(ISeq s = RT.next(RT.next(form)); s != null; s = s.next()) - args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first())); - return new NewExpr(c, args, line); - } - } - -} - -public static class MetaExpr implements Expr{ - public final Expr expr; - public final MapExpr meta; - final static Type IOBJ_TYPE = Type.getType(IObj.class); - final static Method withMetaMethod = Method.getMethod("clojure.lang.IObj withMeta(clojure.lang.IPersistentMap)"); - - - public MetaExpr(Expr expr, MapExpr meta){ - this.expr = expr; - this.meta = meta; - } - - public Object eval() throws Exception{ - return ((IObj) expr.eval()).withMeta((IPersistentMap) meta.eval()); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - expr.emit(C.EXPRESSION, objx, gen); - gen.checkCast(IOBJ_TYPE); - meta.emit(C.EXPRESSION, objx, gen); - gen.checkCast(IPERSISTENTMAP_TYPE); - gen.invokeInterface(IOBJ_TYPE, withMetaMethod); - if(context == C.STATEMENT) - { - gen.pop(); - } - } - - public boolean hasJavaClass() throws Exception{ - return expr.hasJavaClass(); - } - - public Class getJavaClass() throws Exception{ - return expr.getJavaClass(); - } -} - -public static class IfExpr implements Expr, MaybePrimitiveExpr{ - public final Expr testExpr; - public final Expr thenExpr; - public final Expr elseExpr; - public final int line; - - - public IfExpr(int line, Expr testExpr, Expr thenExpr, Expr elseExpr){ - this.testExpr = testExpr; - this.thenExpr = thenExpr; - this.elseExpr = elseExpr; - this.line = line; - } - - public Object eval() throws Exception{ - Object t = testExpr.eval(); - if(t != null && t != Boolean.FALSE) - return thenExpr.eval(); - return elseExpr.eval(); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - doEmit(context, objx, gen,false); - } - - public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ - doEmit(context, objx, gen, true); - } - - public void doEmit(C context, ObjExpr objx, GeneratorAdapter gen, boolean emitUnboxed){ - Label nullLabel = gen.newLabel(); - Label falseLabel = gen.newLabel(); - Label endLabel = gen.newLabel(); - - gen.visitLineNumber(line, gen.mark()); - - try - { - if(maybePrimitiveType(testExpr) == boolean.class) - { - ((MaybePrimitiveExpr) testExpr).emitUnboxed(C.EXPRESSION, objx, gen); - gen.ifZCmp(gen.EQ, falseLabel); - } - else - { - testExpr.emit(C.EXPRESSION, objx, gen); - gen.dup(); - gen.ifNull(nullLabel); - gen.getStatic(BOOLEAN_OBJECT_TYPE, "FALSE", BOOLEAN_OBJECT_TYPE); - gen.visitJumpInsn(IF_ACMPEQ, falseLabel); - } - } - catch(Exception e) - { - throw new RuntimeException(e); - } - if(emitUnboxed) - ((MaybePrimitiveExpr)thenExpr).emitUnboxed(context, objx, gen); - else - thenExpr.emit(context, objx, gen); - gen.goTo(endLabel); - gen.mark(nullLabel); - gen.pop(); - gen.mark(falseLabel); - if(emitUnboxed) - ((MaybePrimitiveExpr)elseExpr).emitUnboxed(context, objx, gen); - else - elseExpr.emit(context, objx, gen); - gen.mark(endLabel); - } - - public boolean hasJavaClass() throws Exception{ - return thenExpr.hasJavaClass() - && elseExpr.hasJavaClass() - && - (thenExpr.getJavaClass() == elseExpr.getJavaClass() - || (thenExpr.getJavaClass() == null && !elseExpr.getJavaClass().isPrimitive()) - || (elseExpr.getJavaClass() == null && !thenExpr.getJavaClass().isPrimitive())); - } - - public boolean canEmitPrimitive(){ - try - { - return thenExpr instanceof MaybePrimitiveExpr - && elseExpr instanceof MaybePrimitiveExpr - && thenExpr.getJavaClass() == elseExpr.getJavaClass() - && ((MaybePrimitiveExpr)thenExpr).canEmitPrimitive() - && ((MaybePrimitiveExpr)elseExpr).canEmitPrimitive(); - } - catch(Exception e) - { - return false; - } - } - - public Class getJavaClass() throws Exception{ - Class thenClass = thenExpr.getJavaClass(); - if(thenClass != null) - return thenClass; - return elseExpr.getJavaClass(); - } - - static class Parser implements IParser{ - public Expr parse(C context, Object frm) throws Exception{ - ISeq form = (ISeq) frm; - //(if test then) or (if test then else) - if(form.count() > 4) - throw new Exception("Too many arguments to if"); - else if(form.count() < 3) - throw new Exception("Too few arguments to if"); - PathNode branch = new PathNode(PATHTYPE.BRANCH, (PathNode) CLEAR_PATH.get()); - Expr testexpr = analyze(context == C.EVAL ? context : C.EXPRESSION, RT.second(form)); - Expr thenexpr, elseexpr; - try { - Var.pushThreadBindings( - RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch))); - thenexpr = analyze(context, RT.third(form)); - } - finally{ - Var.popThreadBindings(); - } - try { - Var.pushThreadBindings( - RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch))); - elseexpr = analyze(context, RT.fourth(form)); - } - finally{ - Var.popThreadBindings(); - } - return new IfExpr((Integer) LINE.deref(), - testexpr, - thenexpr, - elseexpr); - } - } -} - -static final public IPersistentMap CHAR_MAP = - PersistentHashMap.create('-', "_", -// '.', "_DOT_", -':', "_COLON_", -'+', "_PLUS_", -'>', "_GT_", -'<', "_LT_", -'=', "_EQ_", -'~', "_TILDE_", -'!', "_BANG_", -'@', "_CIRCA_", -'#', "_SHARP_", -'$', "_DOLLARSIGN_", -'%', "_PERCENT_", -'^', "_CARET_", -'&', "_AMPERSAND_", -'*', "_STAR_", -'|', "_BAR_", -'{', "_LBRACE_", -'}', "_RBRACE_", -'[', "_LBRACK_", -']', "_RBRACK_", -'/', "_SLASH_", -'\\', "_BSLASH_", -'?', "_QMARK_"); - -static public String munge(String name){ - StringBuilder sb = new StringBuilder(); - for(char c : name.toCharArray()) - { - String sub = (String) CHAR_MAP.valAt(c); - if(sub != null) - sb.append(sub); - else - sb.append(c); - } - return sb.toString(); -} - -public static class EmptyExpr implements Expr{ - public final Object coll; - final static Type HASHMAP_TYPE = Type.getType(PersistentArrayMap.class); - final static Type HASHSET_TYPE = Type.getType(PersistentHashSet.class); - final static Type VECTOR_TYPE = Type.getType(PersistentVector.class); - final static Type LIST_TYPE = Type.getType(PersistentList.class); - final static Type EMPTY_LIST_TYPE = Type.getType(PersistentList.EmptyList.class); - - - public EmptyExpr(Object coll){ - this.coll = coll; - } - - public Object eval() throws Exception{ - return coll; - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - if(coll instanceof IPersistentList) - gen.getStatic(LIST_TYPE, "EMPTY", EMPTY_LIST_TYPE); - else if(coll instanceof IPersistentVector) - gen.getStatic(VECTOR_TYPE, "EMPTY", VECTOR_TYPE); - else if(coll instanceof IPersistentMap) - gen.getStatic(HASHMAP_TYPE, "EMPTY", HASHMAP_TYPE); - else if(coll instanceof IPersistentSet) - gen.getStatic(HASHSET_TYPE, "EMPTY", HASHSET_TYPE); - else - throw new UnsupportedOperationException("Unknown Collection type"); - if(context == C.STATEMENT) - { - gen.pop(); - } - } - - public boolean hasJavaClass() throws Exception{ - return true; - } - - public Class getJavaClass() throws Exception{ - if(coll instanceof IPersistentList) - return IPersistentList.class; - else if(coll instanceof IPersistentVector) - return IPersistentVector.class; - else if(coll instanceof IPersistentMap) - return IPersistentMap.class; - else if(coll instanceof IPersistentSet) - return IPersistentSet.class; - else - throw new UnsupportedOperationException("Unknown Collection type"); - } -} - -public static class ListExpr implements Expr{ - public final IPersistentVector args; - final static Method arrayToListMethod = Method.getMethod("clojure.lang.ISeq arrayToList(Object[])"); - - - public ListExpr(IPersistentVector args){ - this.args = args; - } - - public Object eval() throws Exception{ - IPersistentVector ret = PersistentVector.EMPTY; - for(int i = 0; i < args.count(); i++) - ret = (IPersistentVector) ret.cons(((Expr) args.nth(i)).eval()); - return ret.seq(); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - MethodExpr.emitArgsAsArray(args, objx, gen); - gen.invokeStatic(RT_TYPE, arrayToListMethod); - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass() throws Exception{ - return true; - } - - public Class getJavaClass() throws Exception{ - return IPersistentList.class; - } - -} - -public static class MapExpr implements Expr{ - public final IPersistentVector keyvals; - final static Method mapMethod = Method.getMethod("clojure.lang.IPersistentMap map(Object[])"); - - - public MapExpr(IPersistentVector keyvals){ - this.keyvals = keyvals; - } - - public Object eval() throws Exception{ - Object[] ret = new Object[keyvals.count()]; - for(int i = 0; i < keyvals.count(); i++) - ret[i] = ((Expr) keyvals.nth(i)).eval(); - return RT.map(ret); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - MethodExpr.emitArgsAsArray(keyvals, objx, gen); - gen.invokeStatic(RT_TYPE, mapMethod); - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass() throws Exception{ - return true; - } - - public Class getJavaClass() throws Exception{ - return IPersistentMap.class; - } - - - static public Expr parse(C context, IPersistentMap form) throws Exception{ - IPersistentVector keyvals = PersistentVector.EMPTY; - for(ISeq s = RT.seq(form); s != null; s = s.next()) - { - IMapEntry e = (IMapEntry) s.first(); - keyvals = (IPersistentVector) keyvals.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, e.key())); - keyvals = (IPersistentVector) keyvals.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, e.val())); - } - Expr ret = new MapExpr(keyvals); - if(form instanceof IObj && ((IObj) form).meta() != null) - return new MetaExpr(ret, (MapExpr) MapExpr - .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta())); - else - return ret; - } -} - -public static class SetExpr implements Expr{ - public final IPersistentVector keys; - final static Method setMethod = Method.getMethod("clojure.lang.IPersistentSet set(Object[])"); - - - public SetExpr(IPersistentVector keys){ - this.keys = keys; - } - - public Object eval() throws Exception{ - Object[] ret = new Object[keys.count()]; - for(int i = 0; i < keys.count(); i++) - ret[i] = ((Expr) keys.nth(i)).eval(); - return RT.set(ret); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - MethodExpr.emitArgsAsArray(keys, objx, gen); - gen.invokeStatic(RT_TYPE, setMethod); - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass() throws Exception{ - return true; - } - - public Class getJavaClass() throws Exception{ - return IPersistentSet.class; - } - - - static public Expr parse(C context, IPersistentSet form) throws Exception{ - IPersistentVector keys = PersistentVector.EMPTY; - for(ISeq s = RT.seq(form); s != null; s = s.next()) - { - Object e = s.first(); - keys = (IPersistentVector) keys.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, e)); - } - Expr ret = new SetExpr(keys); - if(form instanceof IObj && ((IObj) form).meta() != null) - return new MetaExpr(ret, (MapExpr) MapExpr - .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta())); - else - return ret; - } -} - -public static class VectorExpr implements Expr{ - public final IPersistentVector args; - final static Method vectorMethod = Method.getMethod("clojure.lang.IPersistentVector vector(Object[])"); - - - public VectorExpr(IPersistentVector args){ - this.args = args; - } - - public Object eval() throws Exception{ - IPersistentVector ret = PersistentVector.EMPTY; - for(int i = 0; i < args.count(); i++) - ret = (IPersistentVector) ret.cons(((Expr) args.nth(i)).eval()); - return ret; - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - MethodExpr.emitArgsAsArray(args, objx, gen); - gen.invokeStatic(RT_TYPE, vectorMethod); - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass() throws Exception{ - return true; - } - - public Class getJavaClass() throws Exception{ - return IPersistentVector.class; - } - - static public Expr parse(C context, IPersistentVector form) throws Exception{ - IPersistentVector args = PersistentVector.EMPTY; - for(int i = 0; i < form.count(); i++) - args = (IPersistentVector) args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, form.nth(i))); - Expr ret = new VectorExpr(args); - if(form instanceof IObj && ((IObj) form).meta() != null) - return new MetaExpr(ret, (MapExpr) MapExpr - .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta())); - else - return ret; - } - -} - -static class KeywordInvokeExpr implements Expr{ - public final KeywordExpr kw; - public final Object tag; - public final Expr target; - public final int line; - public final int siteIndex; - public final String source; - static Type ILOOKUP_TYPE = Type.getType(ILookup.class); - - public KeywordInvokeExpr(String source, int line, Symbol tag, KeywordExpr kw, Expr target){ - this.source = source; - this.kw = kw; - this.target = target; - this.line = line; - this.tag = tag; - this.siteIndex = registerKeywordCallsite(kw.k); - } - - public Object eval() throws Exception{ - try - { - return kw.k.invoke(target.eval()); - } - catch(Throwable e) - { - if(!(e instanceof CompilerException)) - throw new CompilerException(source, line, e); - else - throw (CompilerException) e; - } - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - Label endLabel = gen.newLabel(); - Label faultLabel = gen.newLabel(); - - gen.visitLineNumber(line, gen.mark()); - gen.getStatic(objx.objtype, objx.thunkNameStatic(siteIndex),ObjExpr.ILOOKUP_THUNK_TYPE); - gen.dup(); - target.emit(C.EXPRESSION, objx, gen); - gen.dupX2(); - gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE, Method.getMethod("Object get(Object)")); - gen.dupX2(); - gen.visitJumpInsn(IF_ACMPEQ, faultLabel); - gen.pop(); - gen.goTo(endLabel); - - gen.mark(faultLabel); - gen.swap(); - gen.pop(); - gen.getStatic(objx.objtype, objx.siteNameStatic(siteIndex),ObjExpr.KEYWORD_LOOKUPSITE_TYPE); - gen.swap(); - gen.loadThis(); - gen.invokeInterface(ObjExpr.ILOOKUP_SITE_TYPE, - Method.getMethod("Object fault(Object, clojure.lang.ILookupHost)")); - - gen.mark(endLabel); - if(context == C.STATEMENT) - gen.pop(); - } - - public void emit2(C context, ObjExpr objx, GeneratorAdapter gen){ - Label endLabel = gen.newLabel(); - Label faultLabel = gen.newLabel(); - - gen.visitLineNumber(line, gen.mark()); - target.emit(C.EXPRESSION, objx, gen); - gen.dup(); - gen.getStatic(objx.objtype, objx.thunkNameStatic(siteIndex),ObjExpr.ILOOKUP_THUNK_TYPE); - gen.swap(); - gen.getStatic(objx.objtype, objx.siteNameStatic(siteIndex),ObjExpr.KEYWORD_LOOKUPSITE_TYPE); -/// gen.loadThis(); - gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE, - Method.getMethod("Object get(Object,clojure.lang.ILookupSite)")); -// gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE, -// Method.getMethod("Object get(Object,clojure.lang.ILookupSite,clojure.lang.ILookupHost)")); - gen.dup(); - gen.getStatic(objx.objtype, objx.siteNameStatic(siteIndex),ObjExpr.KEYWORD_LOOKUPSITE_TYPE); - gen.visitJumpInsn(IF_ACMPEQ, faultLabel); - gen.swap(); - gen.pop(); - gen.goTo(endLabel); - - gen.mark(faultLabel); - gen.swap(); - gen.loadThis(); - gen.invokeInterface(ObjExpr.ILOOKUP_SITE_TYPE, - Method.getMethod("Object fault(Object, clojure.lang.ILookupHost)")); - - gen.mark(endLabel); - if(context == C.STATEMENT) - gen.pop(); - } - - public void emitInstance(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitLineNumber(line, gen.mark()); - gen.loadThis(); - gen.getField(objx.objtype, objx.thunkName(siteIndex),ObjExpr.ILOOKUP_THUNK_TYPE); - target.emit(C.EXPRESSION, objx, gen); - gen.loadThis(); - gen.getField(objx.objtype, objx.siteName(siteIndex),ObjExpr.ILOOKUP_SITE_TYPE); - gen.loadThis(); - gen.checkCast(Type.getType(ILookupHost.class)); - gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE, - Method.getMethod("Object get(Object,clojure.lang.ILookupSite,clojure.lang.ILookupHost)")); - if(context == C.STATEMENT) - gen.pop(); - } - - public void emitNormal(C context, ObjExpr objx, GeneratorAdapter gen){ - Label slowLabel = gen.newLabel(); - Label endLabel = gen.newLabel(); - - gen.visitLineNumber(line, gen.mark()); - target.emit(C.EXPRESSION, objx, gen); - gen.dup(); - gen.instanceOf(ILOOKUP_TYPE); - gen.ifZCmp(GeneratorAdapter.EQ, slowLabel); - kw.emit(C.EXPRESSION, objx, gen); - gen.invokeInterface(ILOOKUP_TYPE, new Method("valAt", OBJECT_TYPE, ARG_TYPES[1])); - gen.goTo(endLabel); - - gen.mark(slowLabel); - kw.emit(C.EXPRESSION, objx, gen); - gen.invokeStatic(RT_TYPE, new Method("get", OBJECT_TYPE, ARG_TYPES[2])); - - gen.mark(endLabel); - - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass() throws Exception{ - return tag != null; - } - - public Class getJavaClass() throws Exception{ - return HostExpr.tagToClass(tag); - } - -} -//static class KeywordSiteInvokeExpr implements Expr{ -// public final Expr site; -// public final Object tag; -// public final Expr target; -// public final int line; -// public final String source; -// -// public KeywordSiteInvokeExpr(String source, int line, Symbol tag, Expr site, Expr target){ -// this.source = source; -// this.site = site; -// this.target = target; -// this.line = line; -// this.tag = tag; -// } -// -// public Object eval() throws Exception{ -// try -// { -// KeywordCallSite s = (KeywordCallSite) site.eval(); -// return s.thunk.invoke(s,target.eval()); -// } -// catch(Throwable e) -// { -// if(!(e instanceof CompilerException)) -// throw new CompilerException(source, line, e); -// else -// throw (CompilerException) e; -// } -// } -// -// public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ -// gen.visitLineNumber(line, gen.mark()); -// site.emit(C.EXPRESSION, objx, gen); -// gen.dup(); -// gen.getField(Type.getType(KeywordCallSite.class),"thunk",IFN_TYPE); -// gen.swap(); -// target.emit(C.EXPRESSION, objx, gen); -// -// gen.invokeInterface(IFN_TYPE, new Method("invoke", OBJECT_TYPE, ARG_TYPES[2])); -// if(context == C.STATEMENT) -// gen.pop(); -// } -// -// public boolean hasJavaClass() throws Exception{ -// return tag != null; -// } -// -// public Class getJavaClass() throws Exception{ -// return HostExpr.tagToClass(tag); -// } -// -//} - -public static class InstanceOfExpr implements Expr, MaybePrimitiveExpr{ - Expr expr; - Class c; - - public InstanceOfExpr(Class c, Expr expr){ - this.expr = expr; - this.c = c; - } - - public Object eval() throws Exception{ - if(c.isInstance(expr.eval())) - return RT.T; - return RT.F; - } - - public boolean canEmitPrimitive(){ - return true; - } - - public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ - expr.emit(C.EXPRESSION,objx,gen); - gen.instanceOf(Type.getType(c)); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - emitUnboxed(context,objx,gen); - HostExpr.emitBoxReturn(objx,gen,Boolean.TYPE); - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass() throws Exception{ - return true; - } - - public Class getJavaClass() throws Exception{ - return Boolean.TYPE; - } - -} - -static class InvokeExpr implements Expr{ - public final Expr fexpr; - public final Object tag; - public final IPersistentVector args; - public final int line; - public final String source; - public boolean isProtocol = false; - public boolean isDirect = false; - public int siteIndex = -1; - public Class protocolOn; - public java.lang.reflect.Method onMethod; - static Keyword onKey = Keyword.intern("on"); - static Keyword methodMapKey = Keyword.intern("method-map"); - static Keyword dynamicKey = Keyword.intern("dynamic"); - - public InvokeExpr(String source, int line, Symbol tag, Expr fexpr, IPersistentVector args) throws Exception{ - this.source = source; - this.fexpr = fexpr; - this.args = args; - this.line = line; - if(fexpr instanceof VarExpr) - { - Var fvar = ((VarExpr)fexpr).var; - Var pvar = (Var)RT.get(fvar.meta(), protocolKey); - if(pvar != null && PROTOCOL_CALLSITES.isBound()) - { - this.isProtocol = true; - this.siteIndex = registerProtocolCallsite(((VarExpr)fexpr).var); - Object pon = RT.get(pvar.get(), onKey); - this.protocolOn = HostExpr.maybeClass(pon,false); - if(this.protocolOn != null) - { - IPersistentMap mmap = (IPersistentMap) RT.get(pvar.get(), methodMapKey); - Keyword mmapVal = (Keyword) mmap.valAt(Keyword.intern(fvar.sym)); - if (mmapVal == null) { - throw new IllegalArgumentException( - "No method of interface: " + protocolOn.getName() + - " found for function: " + fvar.sym + " of protocol: " + pvar.sym + - " (The protocol method may have been defined before and removed.)"); - } - String mname = munge(mmapVal.sym.toString()); - List methods = Reflector.getMethods(protocolOn, args.count() - 1, mname, false); - if(methods.size() != 1) - throw new IllegalArgumentException( - "No single method: " + mname + " of interface: " + protocolOn.getName() + - " found for function: " + fvar.sym + " of protocol: " + pvar.sym); - this.onMethod = (java.lang.reflect.Method) methods.get(0); - } - } -// else if(pvar == null && VAR_CALLSITES.isBound() -// && fvar.ns.name.name.startsWith("clojure") -// && !RT.booleanCast(RT.get(RT.meta(fvar),dynamicKey)) -// ) -// { -// //todo - more specific criteria for binding these -// this.isDirect = true; -// this.siteIndex = registerVarCallsite(((VarExpr) fexpr).var); -// } - } - this.tag = tag != null ? tag : (fexpr instanceof VarExpr ? ((VarExpr) fexpr).tag : null); - } - - public Object eval() throws Exception{ - try - { - IFn fn = (IFn) fexpr.eval(); - PersistentVector argvs = PersistentVector.EMPTY; - for(int i = 0; i < args.count(); i++) - argvs = argvs.cons(((Expr) args.nth(i)).eval()); - return fn.applyTo(RT.seq(argvs)); - } - catch(Throwable e) - { - if(!(e instanceof CompilerException)) - throw new CompilerException(source, line, e); - else - throw (CompilerException) e; - } - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - gen.visitLineNumber(line, gen.mark()); - if(isProtocol) - { - emitProto(context,objx,gen); - } - else if(isDirect) - { - Label callLabel = gen.newLabel(); - - gen.getStatic(objx.objtype, objx.varCallsiteName(siteIndex), IFN_TYPE); - gen.dup(); - gen.ifNonNull(callLabel); - - gen.pop(); - fexpr.emit(C.EXPRESSION, objx, gen); - gen.checkCast(IFN_TYPE); -// gen.dup(); -// gen.putStatic(objx.objtype, objx.varCallsiteName(siteIndex), IFN_TYPE); - - gen.mark(callLabel); - emitArgsAndCall(0, context,objx,gen); - } - else - { - fexpr.emit(C.EXPRESSION, objx, gen); - gen.checkCast(IFN_TYPE); - emitArgsAndCall(0, context,objx,gen); - } - if(context == C.STATEMENT) - gen.pop(); - } - - public void emitProto(C context, ObjExpr objx, GeneratorAdapter gen){ - Label onLabel = gen.newLabel(); - Label callLabel = gen.newLabel(); - Label endLabel = gen.newLabel(); - - Var v = ((VarExpr)fexpr).var; - - Expr e = (Expr) args.nth(0); - e.emit(C.EXPRESSION, objx, gen); - gen.dup(); //target, target - gen.invokeStatic(UTIL_TYPE,Method.getMethod("Class classOf(Object)")); //target,class - gen.loadThis(); - gen.getField(objx.objtype, objx.cachedClassName(siteIndex),CLASS_TYPE); //target,class,cached-class - gen.visitJumpInsn(IF_ACMPEQ, callLabel); //target - if(protocolOn != null) - { - gen.dup(); //target, target - gen.instanceOf(Type.getType(protocolOn)); - gen.ifZCmp(GeneratorAdapter.NE, onLabel); - } - - gen.mark(callLabel); //target - gen.dup(); //target, target - gen.invokeStatic(UTIL_TYPE,Method.getMethod("Class classOf(Object)")); //target,class - gen.loadThis(); - gen.swap(); - gen.putField(objx.objtype, objx.cachedClassName(siteIndex),CLASS_TYPE); //target - objx.emitVar(gen, v); - gen.invokeVirtual(VAR_TYPE, Method.getMethod("Object getRawRoot()")); //target, proto-fn - gen.swap(); - emitArgsAndCall(1, context,objx,gen); - gen.goTo(endLabel); - - gen.mark(onLabel); //target - if(protocolOn != null) - { - MethodExpr.emitTypedArgs(objx, gen, onMethod.getParameterTypes(), RT.subvec(args,1,args.count())); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } - Method m = new Method(onMethod.getName(), Type.getReturnType(onMethod), Type.getArgumentTypes(onMethod)); - gen.invokeInterface(Type.getType(protocolOn), m); - HostExpr.emitBoxReturn(objx, gen, onMethod.getReturnType()); - } - gen.mark(endLabel); - } - - void emitArgsAndCall(int firstArgToEmit, C context, ObjExpr objx, GeneratorAdapter gen){ - for(int i = firstArgToEmit; i < Math.min(MAX_POSITIONAL_ARITY, args.count()); i++) - { - Expr e = (Expr) args.nth(i); - e.emit(C.EXPRESSION, objx, gen); - } - if(args.count() > MAX_POSITIONAL_ARITY) - { - PersistentVector restArgs = PersistentVector.EMPTY; - for(int i = MAX_POSITIONAL_ARITY; i < args.count(); i++) - { - restArgs = restArgs.cons(args.nth(i)); - } - MethodExpr.emitArgsAsArray(restArgs, objx, gen); - } - - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } - - gen.invokeInterface(IFN_TYPE, new Method("invoke", OBJECT_TYPE, ARG_TYPES[Math.min(MAX_POSITIONAL_ARITY + 1, - args.count())])); - } - - public boolean hasJavaClass() throws Exception{ - return tag != null; - } - - public Class getJavaClass() throws Exception{ - return HostExpr.tagToClass(tag); - } - - static public Expr parse(C context, ISeq form) throws Exception{ - if(context != C.EVAL) - context = C.EXPRESSION; - Expr fexpr = analyze(context, form.first()); - if(fexpr instanceof VarExpr && ((VarExpr)fexpr).var.equals(INSTANCE)) - { - if(RT.second(form) instanceof Symbol) - { - Class c = HostExpr.maybeClass(RT.second(form),false); - if(c != null) - return new InstanceOfExpr(c, analyze(context, RT.third(form))); - } - } - - if(fexpr instanceof KeywordExpr && RT.count(form) == 2 && KEYWORD_CALLSITES.isBound()) - { -// fexpr = new ConstantExpr(new KeywordCallSite(((KeywordExpr)fexpr).k)); - Expr target = analyze(context, RT.second(form)); - return new KeywordInvokeExpr((String) SOURCE.deref(), (Integer) LINE.deref(), tagOf(form), - (KeywordExpr) fexpr, target); - } - PersistentVector args = PersistentVector.EMPTY; - for(ISeq s = RT.seq(form.next()); s != null; s = s.next()) - { - args = args.cons(analyze(context, s.first())); - } -// if(args.count() > MAX_POSITIONAL_ARITY) -// throw new IllegalArgumentException( -// String.format("No more than %d args supported", MAX_POSITIONAL_ARITY)); - - return new InvokeExpr((String) SOURCE.deref(), (Integer) LINE.deref(), tagOf(form), fexpr, args); - } -} - -static class SourceDebugExtensionAttribute extends Attribute{ - public SourceDebugExtensionAttribute(){ - super("SourceDebugExtension"); - } - - void writeSMAP(ClassWriter cw, String smap){ - ByteVector bv = write(cw, null, -1, -1, -1); - bv.putUTF8(smap); - } -} - -static public class FnExpr extends ObjExpr{ - final static Type aFnType = Type.getType(AFunction.class); - final static Type restFnType = Type.getType(RestFn.class); - //if there is a variadic overload (there can only be one) it is stored here - FnMethod variadicMethod = null; - IPersistentCollection methods; - // String superName = null; - - public FnExpr(Object tag){ - super(tag); - } - - public boolean hasJavaClass() throws Exception{ - return true; - } - - public Class getJavaClass() throws Exception{ - return AFunction.class; - } - - protected void emitMethods(ClassVisitor cv){ - //override of invoke/doInvoke for each method - for(ISeq s = RT.seq(methods); s != null; s = s.next()) - { - ObjMethod method = (ObjMethod) s.first(); - method.emit(this, cv); - } - - if(isVariadic()) - { - GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC, - Method.getMethod("int getRequiredArity()"), - null, - null, - cv); - gen.visitCode(); - gen.push(variadicMethod.reqParms.count()); - gen.returnValue(); - gen.endMethod(); - } - } - - static Expr parse(C context, ISeq form, String name) throws Exception{ - ISeq origForm = form; - FnExpr fn = new FnExpr(tagOf(form)); - fn.src = form; - ObjMethod enclosingMethod = (ObjMethod) METHOD.deref(); - if(((IMeta) form.first()).meta() != null) - { - fn.onceOnly = RT.booleanCast(RT.get(RT.meta(form.first()), Keyword.intern(null, "once"))); -// fn.superName = (String) RT.get(RT.meta(form.first()), Keyword.intern(null, "super-name")); - } - //fn.thisName = name; - String basename = enclosingMethod != null ? - (enclosingMethod.objx.name + "$") - : //"clojure.fns." + - (munge(currentNS().name.name) + "$"); - if(RT.second(form) instanceof Symbol) - name = ((Symbol) RT.second(form)).name; - String simpleName = name != null ? - (munge(name).replace(".", "_DOT_") - + (enclosingMethod != null ? "__" + RT.nextID() : "")) - : ("fn" - + "__" + RT.nextID()); - fn.name = basename + simpleName; - fn.internalName = fn.name.replace('.', '/'); - fn.objtype = Type.getObjectType(fn.internalName); - try - { - Var.pushThreadBindings( - RT.map(CONSTANTS, PersistentVector.EMPTY, - CONSTANT_IDS, new IdentityHashMap(), - KEYWORDS, PersistentHashMap.EMPTY, - VARS, PersistentHashMap.EMPTY, - KEYWORD_CALLSITES, PersistentVector.EMPTY, - PROTOCOL_CALLSITES, PersistentVector.EMPTY, - VAR_CALLSITES, PersistentVector.EMPTY - )); - - //arglist might be preceded by symbol naming this fn - if(RT.second(form) instanceof Symbol) - { - fn.thisName = ((Symbol) RT.second(form)).name; - form = RT.cons(FN, RT.next(RT.next(form))); - } - - //now (fn [args] body...) or (fn ([args] body...) ([args2] body2...) ...) - //turn former into latter - if(RT.second(form) instanceof IPersistentVector) - form = RT.list(FN, RT.next(form)); - fn.line = (Integer) LINE.deref(); - FnMethod[] methodArray = new FnMethod[MAX_POSITIONAL_ARITY + 1]; - FnMethod variadicMethod = null; - for(ISeq s = RT.next(form); s != null; s = RT.next(s)) - { - FnMethod f = FnMethod.parse(fn, (ISeq) RT.first(s)); - if(f.isVariadic()) - { - if(variadicMethod == null) - variadicMethod = f; - else - throw new Exception("Can't have more than 1 variadic overload"); - } - else if(methodArray[f.reqParms.count()] == null) - methodArray[f.reqParms.count()] = f; - else - throw new Exception("Can't have 2 overloads with same arity"); - } - if(variadicMethod != null) - { - for(int i = variadicMethod.reqParms.count() + 1; i <= MAX_POSITIONAL_ARITY; i++) - if(methodArray[i] != null) - throw new Exception( - "Can't have fixed arity function with more params than variadic function"); - } - - IPersistentCollection methods = null; - for(int i = 0; i < methodArray.length; i++) - if(methodArray[i] != null) - methods = RT.conj(methods, methodArray[i]); - if(variadicMethod != null) - methods = RT.conj(methods, variadicMethod); - - fn.methods = methods; - fn.variadicMethod = variadicMethod; - fn.keywords = (IPersistentMap) KEYWORDS.deref(); - fn.vars = (IPersistentMap) VARS.deref(); - fn.constants = (PersistentVector) CONSTANTS.deref(); - fn.keywordCallsites = (IPersistentVector) KEYWORD_CALLSITES.deref(); - fn.protocolCallsites = (IPersistentVector) PROTOCOL_CALLSITES.deref(); - fn.varCallsites = (IPersistentVector) VAR_CALLSITES.deref(); - - fn.constantsID = RT.nextID(); -// DynamicClassLoader loader = (DynamicClassLoader) LOADER.get(); -// loader.registerConstants(fn.constantsID, fn.constants.toArray()); - } - finally - { - Var.popThreadBindings(); - } - fn.compile(fn.isVariadic() ? "clojure/lang/RestFn" : "clojure/lang/AFunction",null,fn.onceOnly); - fn.getCompiledClass(); - - if(origForm instanceof IObj && ((IObj) origForm).meta() != null) - return new MetaExpr(fn, (MapExpr) MapExpr - .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) origForm).meta())); - else - return fn; - } - - public final ObjMethod variadicMethod(){ - return variadicMethod; - } - - boolean isVariadic(){ - return variadicMethod != null; - } - - public final IPersistentCollection methods(){ - return methods; - } -} - -static public class ObjExpr implements Expr{ - static final String CONST_PREFIX = "const__"; - String name; - //String simpleName; - String internalName; - String thisName; - Type objtype; - public final Object tag; - //localbinding->itself - IPersistentMap closes = PersistentHashMap.EMPTY; - //localbndingexprs - IPersistentVector closesExprs = PersistentVector.EMPTY; - //symbols - IPersistentSet volatiles = PersistentHashSet.EMPTY; - - //symbol->lb - IPersistentMap fields = null; - - //Keyword->KeywordExpr - IPersistentMap keywords = PersistentHashMap.EMPTY; - IPersistentMap vars = PersistentHashMap.EMPTY; - Class compiledClass; - int line; - PersistentVector constants; - int constantsID; - int altCtorDrops = 0; - - IPersistentVector keywordCallsites; - IPersistentVector protocolCallsites; - IPersistentVector varCallsites; - boolean onceOnly = false; - - Object src; - - final static Method voidctor = Method.getMethod("void ()"); - protected IPersistentMap classMeta; - - public final String name(){ - return name; - } - -// public final String simpleName(){ -// return simpleName; -// } - - public final String internalName(){ - return internalName; - } - - public final String thisName(){ - return thisName; - } - - public final Type objtype(){ - return objtype; - } - - public final IPersistentMap closes(){ - return closes; - } - - public final IPersistentMap keywords(){ - return keywords; - } - - public final IPersistentMap vars(){ - return vars; - } - - public final Class compiledClass(){ - return compiledClass; - } - - public final int line(){ - return line; - } - - public final PersistentVector constants(){ - return constants; - } - - public final int constantsID(){ - return constantsID; - } - - final static Method kwintern = Method.getMethod("clojure.lang.Keyword intern(String, String)"); - final static Method symcreate = Method.getMethod("clojure.lang.Symbol create(String)"); - final static Method varintern = - Method.getMethod("clojure.lang.Var intern(clojure.lang.Symbol, clojure.lang.Symbol)"); - - final static Type DYNAMIC_CLASSLOADER_TYPE = Type.getType(DynamicClassLoader.class); - final static Method getClassMethod = Method.getMethod("Class getClass()"); - final static Method getClassLoaderMethod = Method.getMethod("ClassLoader getClassLoader()"); - final static Method getConstantsMethod = Method.getMethod("Object[] getConstants(int)"); - final static Method readStringMethod = Method.getMethod("Object readString(String)"); - - final static Type ILOOKUP_SITE_TYPE = Type.getType(ILookupSite.class); - final static Type ILOOKUP_THUNK_TYPE = Type.getType(ILookupThunk.class); - final static Type KEYWORD_LOOKUPSITE_TYPE = Type.getType(KeywordLookupSite.class); - - private DynamicClassLoader loader; - private byte[] bytecode; - - public ObjExpr(Object tag){ - this.tag = tag; - } - - static String trimGenID(String name){ - int i = name.lastIndexOf("__"); - return i==-1?name:name.substring(0,i); - } - - - - Type[] ctorTypes(){ - IPersistentVector tv = isDeftype()?PersistentVector.EMPTY:RT.vector(IPERSISTENTMAP_TYPE); - for(ISeq s = RT.keys(closes); s != null; s = s.next()) - { - LocalBinding lb = (LocalBinding) s.first(); - if(lb.getPrimitiveType() != null) - tv = tv.cons(Type.getType(lb.getPrimitiveType())); - else - tv = tv.cons(OBJECT_TYPE); - } - Type[] ret = new Type[tv.count()]; - for(int i = 0; i < tv.count(); i++) - ret[i] = (Type) tv.nth(i); - return ret; - } - - void compile(String superName, String[] interfaceNames, boolean oneTimeUse) throws Exception{ - //create bytecode for a class - //with name current_ns.defname[$letname]+ - //anonymous fns get names fn__id - //derived from AFn/RestFn - if(keywordCallsites.count() > 0) - { - if(interfaceNames == null) - interfaceNames = new String[]{"clojure/lang/ILookupHost"}; - else - { - String[] inames = new String[interfaceNames.length + 1]; - System.arraycopy(interfaceNames,0,inames,0,interfaceNames.length); - inames[interfaceNames.length] = "clojure/lang/ILookupHost"; - interfaceNames = inames; - } - } - ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS); -// ClassWriter cw = new ClassWriter(0); - ClassVisitor cv = cw; -// ClassVisitor cv = new TraceClassVisitor(new CheckClassAdapter(cw), new PrintWriter(System.out)); - //ClassVisitor cv = new TraceClassVisitor(cw, new PrintWriter(System.out)); - cv.visit(V1_5, ACC_PUBLIC + ACC_SUPER + ACC_FINAL, internalName, null,superName,interfaceNames); -// superName != null ? superName : -// (isVariadic() ? "clojure/lang/RestFn" : "clojure/lang/AFunction"), null); - String source = (String) SOURCE.deref(); - int lineBefore = (Integer) LINE_BEFORE.deref(); - int lineAfter = (Integer) LINE_AFTER.deref() + 1; - - if(source != null && SOURCE_PATH.deref() != null) - { - //cv.visitSource(source, null); - String smap = "SMAP\n" + - ((source.lastIndexOf('.') > 0) ? - source.substring(0, source.lastIndexOf('.')) - :source) - // : simpleName) - + ".java\n" + - "Clojure\n" + - "*S Clojure\n" + - "*F\n" + - "+ 1 " + source + "\n" + - (String) SOURCE_PATH.deref() + "\n" + - "*L\n" + - String.format("%d#1,%d:%d\n", lineBefore, lineAfter - lineBefore, lineBefore) + - "*E"; - cv.visitSource(source, smap); - } - addAnnotation(cv, classMeta); - //static fields for constants - for(int i = 0; i < constants.count(); i++) - { - cv.visitField(ACC_PUBLIC + ACC_FINAL - + ACC_STATIC, constantName(i), constantType(i).getDescriptor(), - null, null); - } - - //static fields for lookup sites - for(int i = 0; i < keywordCallsites.count(); i++) - { - cv.visitField(ACC_FINAL - + ACC_STATIC, siteNameStatic(i), KEYWORD_LOOKUPSITE_TYPE.getDescriptor(), - null, null); - cv.visitField(ACC_STATIC, thunkNameStatic(i), ILOOKUP_THUNK_TYPE.getDescriptor(), - null, null); - } - - for(int i=0;i ()"), - null, - null, - cv); - clinitgen.visitCode(); - clinitgen.visitLineNumber(line, clinitgen.mark()); - - if(constants.count() > 0) - { - emitConstants(clinitgen); - } - - if(keywordCallsites.count() > 0) - emitKeywordCallsites(clinitgen); - - for(int i=0;i", Type.VOID_TYPE, ctorTypes()); - GeneratorAdapter ctorgen = new GeneratorAdapter(ACC_PUBLIC, - m, - null, - null, - cv); - Label start = ctorgen.newLabel(); - Label end = ctorgen.newLabel(); - ctorgen.visitCode(); - ctorgen.visitLineNumber(line, ctorgen.mark()); - ctorgen.visitLabel(start); - ctorgen.loadThis(); -// if(superName != null) - ctorgen.invokeConstructor(Type.getObjectType(superName), voidctor); -// else if(isVariadic()) //RestFn ctor takes reqArity arg -// { -// ctorgen.push(variadicMethod.reqParms.count()); -// ctorgen.invokeConstructor(restFnType, restfnctor); -// } -// else -// ctorgen.invokeConstructor(aFnType, voidctor); - if(!isDeftype()) - { - ctorgen.loadThis(); - ctorgen.visitVarInsn(IPERSISTENTMAP_TYPE.getOpcode(Opcodes.ILOAD), 1); - ctorgen.putField(objtype, "__meta", IPERSISTENTMAP_TYPE); - } - - int a = isDeftype()?1:2; - for(ISeq s = RT.keys(closes); s != null; s = s.next(), ++a) - { - LocalBinding lb = (LocalBinding) s.first(); - ctorgen.loadThis(); - Class primc = lb.getPrimitiveType(); - if(primc != null) - { - ctorgen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ILOAD), a); - ctorgen.putField(objtype, lb.name, Type.getType(primc)); - if(primc == Long.TYPE || primc == Double.TYPE) - ++a; - } - else - { - ctorgen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), a); - ctorgen.putField(objtype, lb.name, OBJECT_TYPE); - } - closesExprs = closesExprs.cons(new LocalBindingExpr(lb, null)); - } - - - ctorgen.visitLabel(end); - - ctorgen.returnValue(); - - ctorgen.endMethod(); - - if(altCtorDrops > 0) - { - //ctor that takes closed-overs and inits base + fields - Type[] ctorTypes = ctorTypes(); - Type[] altCtorTypes = new Type[ctorTypes.length-altCtorDrops]; - for(int i=0;i", Type.VOID_TYPE, altCtorTypes); - ctorgen = new GeneratorAdapter(ACC_PUBLIC, - alt, - null, - null, - cv); - ctorgen.visitCode(); - ctorgen.loadThis(); - ctorgen.loadArgs(); - for(int i=0;i", Type.VOID_TYPE, ctorTypes)); - - ctorgen.returnValue(); - ctorgen.endMethod(); - } - - if(!isDeftype()) - { - //ctor that takes closed-overs but not meta - Type[] ctorTypes = ctorTypes(); - Type[] noMetaCtorTypes = new Type[ctorTypes.length-1]; - for(int i=1;i", Type.VOID_TYPE, noMetaCtorTypes); - ctorgen = new GeneratorAdapter(ACC_PUBLIC, - alt, - null, - null, - cv); - ctorgen.visitCode(); - ctorgen.loadThis(); - ctorgen.visitInsn(Opcodes.ACONST_NULL); //null meta - ctorgen.loadArgs(); - ctorgen.invokeConstructor(objtype, new Method("", Type.VOID_TYPE, ctorTypes)); - - ctorgen.returnValue(); - ctorgen.endMethod(); - - //meta() - Method meth = Method.getMethod("clojure.lang.IPersistentMap meta()"); - - GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC, - meth, - null, - null, - cv); - gen.visitCode(); - gen.loadThis(); - gen.getField(objtype,"__meta",IPERSISTENTMAP_TYPE); - - gen.returnValue(); - gen.endMethod(); - - //withMeta() - meth = Method.getMethod("clojure.lang.IObj withMeta(clojure.lang.IPersistentMap)"); - - gen = new GeneratorAdapter(ACC_PUBLIC, - meth, - null, - null, - cv); - gen.visitCode(); - gen.newInstance(objtype); - gen.dup(); - gen.loadArg(0); - - for(ISeq s = RT.keys(closes); s != null; s = s.next(), ++a) - { - LocalBinding lb = (LocalBinding) s.first(); - gen.loadThis(); - Class primc = lb.getPrimitiveType(); - if(primc != null) - { - gen.getField(objtype, lb.name, Type.getType(primc)); - } - else - { - gen.getField(objtype, lb.name, OBJECT_TYPE); - } - } - - gen.invokeConstructor(objtype, new Method("", Type.VOID_TYPE, ctorTypes)); - gen.returnValue(); - gen.endMethod(); - } - - emitMethods(cv); - - if(keywordCallsites.count() > 0) - { - Method meth = Method.getMethod("void swapThunk(int,clojure.lang.ILookupThunk)"); - - GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC, - meth, - null, - null, - cv); - gen.visitCode(); - Label endLabel = gen.newLabel(); - - Label[] labels = new Label[keywordCallsites.count()]; - for(int i = 0; i < keywordCallsites.count();i++) - { - labels[i] = gen.newLabel(); - } - gen.loadArg(0); - gen.visitTableSwitchInsn(0,keywordCallsites.count()-1,endLabel,labels); - - for(int i = 0; i < keywordCallsites.count();i++) - { - gen.mark(labels[i]); -// gen.loadThis(); - gen.loadArg(1); - gen.putStatic(objtype, thunkNameStatic(i),ILOOKUP_THUNK_TYPE); - gen.goTo(endLabel); - } - - gen.mark(endLabel); - - gen.returnValue(); - gen.endMethod(); - } - - //end of class - cv.visitEnd(); - - bytecode = cw.toByteArray(); - if(RT.booleanCast(COMPILE_FILES.deref())) - writeClassFile(internalName, bytecode); -// else -// getCompiledClass(); - } - - private void emitKeywordCallsites(GeneratorAdapter clinitgen){ - for(int i=0;i(int,clojure.lang.Keyword)")); - clinitgen.dup(); - clinitgen.putStatic(objtype, siteNameStatic(i), KEYWORD_LOOKUPSITE_TYPE); - clinitgen.putStatic(objtype, thunkNameStatic(i), ILOOKUP_THUNK_TYPE); - } - } - - protected void emitMethods(ClassVisitor gen){ - } - - void emitListAsObjectArray(Object value, GeneratorAdapter gen){ - gen.push(((List) value).size()); - gen.newArray(OBJECT_TYPE); - int i = 0; - for(Iterator it = ((List) value).iterator(); it.hasNext(); i++) - { - gen.dup(); - gen.push(i); - emitValue(it.next(), gen); - gen.arrayStore(OBJECT_TYPE); - } - } - - void emitValue(Object value, GeneratorAdapter gen){ - boolean partial = true; - //System.out.println(value.getClass().toString()); - - if(value instanceof String) - { - gen.push((String) value); - } - else if(value instanceof Integer) - { - gen.push(((Integer) value).intValue()); - gen.invokeStatic(Type.getType(Integer.class), Method.getMethod("Integer valueOf(int)")); - } - else if(value instanceof Double) - { - gen.push(((Double) value).doubleValue()); - gen.invokeStatic(Type.getType(Double.class), Method.getMethod("Double valueOf(double)")); - } - else if(value instanceof Character) - { - gen.push(((Character) value).charValue()); - gen.invokeStatic(Type.getType(Character.class), Method.getMethod("Character valueOf(char)")); - } - else if(value instanceof Class) - { - Class cc = (Class)value; - if(cc.isPrimitive()) - { - Type bt; - if ( cc == boolean.class ) bt = Type.getType(Boolean.class); - else if ( cc == byte.class ) bt = Type.getType(Byte.class); - else if ( cc == char.class ) bt = Type.getType(Character.class); - else if ( cc == double.class ) bt = Type.getType(Double.class); - else if ( cc == float.class ) bt = Type.getType(Float.class); - else if ( cc == int.class ) bt = Type.getType(Integer.class); - else if ( cc == long.class ) bt = Type.getType(Long.class); - else if ( cc == short.class ) bt = Type.getType(Short.class); - else throw new RuntimeException( - "Can't embed unknown primitive in code: " + value); - gen.getStatic( bt, "TYPE", Type.getType(Class.class) ); - } - else - { - gen.push(destubClassName(cc.getName())); - gen.invokeStatic(Type.getType(Class.class), Method.getMethod("Class forName(String)")); - } - } - else if(value instanceof Symbol) - { - gen.push(((Symbol) value).ns); - gen.push(((Symbol) value).name); - gen.invokeStatic(Type.getType(Symbol.class), - Method.getMethod("clojure.lang.Symbol create(String,String)")); - } - else if(value instanceof Keyword) - { - emitValue(((Keyword) value).sym, gen); - gen.invokeStatic(Type.getType(Keyword.class), - Method.getMethod("clojure.lang.Keyword intern(clojure.lang.Symbol)")); - } -// else if(value instanceof KeywordCallSite) -// { -// emitValue(((KeywordCallSite) value).k.sym, gen); -// gen.invokeStatic(Type.getType(KeywordCallSite.class), -// Method.getMethod("clojure.lang.KeywordCallSite create(clojure.lang.Symbol)")); -// } - else if(value instanceof Var) - { - Var var = (Var) value; - gen.push(var.ns.name.toString()); - gen.push(var.sym.toString()); - gen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.Var var(String,String)")); - } - else if(value instanceof IPersistentMap) - { - List entries = new ArrayList(); - for(Map.Entry entry : (Set) ((Map) value).entrySet()) - { - entries.add(entry.getKey()); - entries.add(entry.getValue()); - } - emitListAsObjectArray(entries, gen); - gen.invokeStatic(RT_TYPE, - Method.getMethod("clojure.lang.IPersistentMap map(Object[])")); - } - else if(value instanceof IPersistentVector) - { - emitListAsObjectArray(value, gen); - gen.invokeStatic(RT_TYPE, Method.getMethod( - "clojure.lang.IPersistentVector vector(Object[])")); - } - else if(value instanceof ISeq || value instanceof IPersistentList) - { - emitListAsObjectArray(value, gen); - gen.invokeStatic(Type.getType(java.util.Arrays.class), - Method.getMethod("java.util.List asList(Object[])")); - gen.invokeStatic(Type.getType(PersistentList.class), - Method.getMethod( - "clojure.lang.IPersistentList create(java.util.List)")); - } - else - { - String cs = null; - try - { - cs = RT.printString(value); - //System.out.println("WARNING SLOW CODE: " + value.getClass() + " -> " + cs); - } - catch(Exception e) - { - throw new RuntimeException( - "Can't embed object in code, maybe print-dup not defined: " + - value); - } - if(cs.length() == 0) - throw new RuntimeException( - "Can't embed unreadable object in code: " + value); - - if(cs.startsWith("#<")) - throw new RuntimeException( - "Can't embed unreadable object in code: " + cs); - - gen.push(cs); - gen.invokeStatic(RT_TYPE, readStringMethod); - partial = false; - } - - if(partial) - { - if(value instanceof IObj && RT.count(((IObj) value).meta()) > 0) - { - gen.checkCast(IOBJ_TYPE); - emitValue(((IObj) value).meta(), gen); - gen.checkCast(IPERSISTENTMAP_TYPE); - gen.invokeInterface(IOBJ_TYPE, - Method.getMethod("clojure.lang.IObj withMeta(clojure.lang.IPersistentMap)")); - } - } - } - - - void emitConstants(GeneratorAdapter clinitgen){ - try - { - Var.pushThreadBindings(RT.map(RT.PRINT_DUP, RT.T)); - - for(int i = 0; i < constants.count(); i++) - { - emitValue(constants.nth(i), clinitgen); - clinitgen.checkCast(constantType(i)); - clinitgen.putStatic(objtype, constantName(i), constantType(i)); - } - } - finally - { - Var.popThreadBindings(); - } - } - - boolean isMutable(LocalBinding lb){ - return isVolatile(lb) || - RT.booleanCast(RT.contains(fields, lb.sym)) && - RT.booleanCast(RT.get(lb.sym.meta(), Keyword.intern("unsynchronized-mutable"))); - } - - boolean isVolatile(LocalBinding lb){ - return RT.booleanCast(RT.contains(fields, lb.sym)) && - RT.booleanCast(RT.get(lb.sym.meta(), Keyword.intern("volatile-mutable"))); - } - - boolean isDeftype(){ - return fields != null; - } - - void emitClearCloses(GeneratorAdapter gen){ -// int a = 1; -// for(ISeq s = RT.keys(closes); s != null; s = s.next(), ++a) -// { -// LocalBinding lb = (LocalBinding) s.first(); -// Class primc = lb.getPrimitiveType(); -// if(primc == null) -// { -// gen.loadThis(); -// gen.visitInsn(Opcodes.ACONST_NULL); -// gen.putField(objtype, lb.name, OBJECT_TYPE); -// } -// } - } - - synchronized Class getCompiledClass(){ - if(compiledClass == null) - try - { -// if(RT.booleanCast(COMPILE_FILES.deref())) -// compiledClass = RT.classForName(name);//loader.defineClass(name, bytecode); -// else - { - loader = (DynamicClassLoader) LOADER.deref(); - compiledClass = loader.defineClass(name, bytecode, src); - } - } - catch(Exception e) - { - throw new RuntimeException(e); - } - return compiledClass; - } - - public Object eval() throws Exception{ - if(isDeftype()) - return null; - return getCompiledClass().newInstance(); - } - - public void emitLetFnInits(GeneratorAdapter gen, ObjExpr objx, IPersistentSet letFnLocals){ - //objx arg is enclosing objx, not this - gen.checkCast(objtype); - - for(ISeq s = RT.keys(closes); s != null; s = s.next()) - { - LocalBinding lb = (LocalBinding) s.first(); - if(letFnLocals.contains(lb)) - { - Class primc = lb.getPrimitiveType(); - gen.dup(); - if(primc != null) - { - objx.emitUnboxedLocal(gen, lb); - gen.putField(objtype, lb.name, Type.getType(primc)); - } - else - { - objx.emitLocal(gen, lb, false); - gen.putField(objtype, lb.name, OBJECT_TYPE); - } - } - } - gen.pop(); - - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - //emitting a Fn means constructing an instance, feeding closed-overs from enclosing scope, if any - //objx arg is enclosing objx, not this -// getCompiledClass(); - if(isDeftype()) - { - gen.visitInsn(Opcodes.ACONST_NULL); - } - else - { - gen.newInstance(objtype); - gen.dup(); - gen.visitInsn(Opcodes.ACONST_NULL); - for(ISeq s = RT.seq(closesExprs); s != null; s = s.next()) - { - LocalBindingExpr lbe = (LocalBindingExpr) s.first(); - LocalBinding lb = lbe.b; - if(lb.getPrimitiveType() != null) - objx.emitUnboxedLocal(gen, lb); - else - objx.emitLocal(gen, lb, lbe.shouldClear); - } - gen.invokeConstructor(objtype, new Method("", Type.VOID_TYPE, ctorTypes())); - } - if(context == C.STATEMENT) - gen.pop(); - } - - public boolean hasJavaClass() throws Exception{ - return true; - } - - public Class getJavaClass() throws Exception{ - return (compiledClass != null) ? compiledClass - : (tag != null) ? HostExpr.tagToClass(tag) - : IFn.class; - } - - public void emitAssignLocal(GeneratorAdapter gen, LocalBinding lb,Expr val){ - if(!isMutable(lb)) - throw new IllegalArgumentException("Cannot assign to non-mutable: " + lb.name); - Class primc = lb.getPrimitiveType(); - gen.loadThis(); - if(primc != null) - { - if(!(val instanceof MaybePrimitiveExpr && ((MaybePrimitiveExpr) val).canEmitPrimitive())) - throw new IllegalArgumentException("Must assign primitive to primitive mutable: " + lb.name); - MaybePrimitiveExpr me = (MaybePrimitiveExpr) val; - me.emitUnboxed(C.EXPRESSION, this, gen); - gen.putField(objtype, lb.name, Type.getType(primc)); - } - else - { - val.emit(C.EXPRESSION, this, gen); - gen.putField(objtype, lb.name, OBJECT_TYPE); - } - } - - private void emitLocal(GeneratorAdapter gen, LocalBinding lb, boolean clear){ - if(closes.containsKey(lb)) - { - Class primc = lb.getPrimitiveType(); - gen.loadThis(); - if(primc != null) - { - gen.getField(objtype, lb.name, Type.getType(primc)); - HostExpr.emitBoxReturn(this, gen, primc); - } - else - { - gen.getField(objtype, lb.name, OBJECT_TYPE); - if(onceOnly && clear && lb.canBeCleared) - { - gen.loadThis(); - gen.visitInsn(Opcodes.ACONST_NULL); - gen.putField(objtype, lb.name, OBJECT_TYPE); - } - } - } - else - { - Class primc = lb.getPrimitiveType(); -// String rep = lb.sym.name + " " + lb.toString().substring(lb.toString().lastIndexOf('@')); - if(lb.isArg) - { - gen.loadArg(lb.idx-1); - if(primc != null) - HostExpr.emitBoxReturn(this, gen, primc); - else - { - if(clear && lb.canBeCleared) - { -// System.out.println("clear: " + rep); - gen.visitInsn(Opcodes.ACONST_NULL); - gen.storeArg(lb.idx - 1); - } - else - { -// System.out.println("use: " + rep); - } - } - } - else - { - if(primc != null) - { - gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ILOAD), lb.idx); - HostExpr.emitBoxReturn(this, gen, primc); - } - else - { - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), lb.idx); - if(clear && lb.canBeCleared) - { -// System.out.println("clear: " + rep); - gen.visitInsn(Opcodes.ACONST_NULL); - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), lb.idx); - } - else - { -// System.out.println("use: " + rep); - } - } - } - } - } - - private void emitUnboxedLocal(GeneratorAdapter gen, LocalBinding lb){ - Class primc = lb.getPrimitiveType(); - if(closes.containsKey(lb)) - { - gen.loadThis(); - gen.getField(objtype, lb.name, Type.getType(primc)); - } - else if(lb.isArg) - gen.loadArg(lb.idx-1); - else - gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ILOAD), lb.idx); - } - - public void emitVar(GeneratorAdapter gen, Var var){ - Integer i = (Integer) vars.valAt(var); - emitConstant(gen, i); - //gen.getStatic(fntype, munge(var.sym.toString()), VAR_TYPE); - } - - public void emitKeyword(GeneratorAdapter gen, Keyword k){ - Integer i = (Integer) keywords.valAt(k); - emitConstant(gen, i); -// gen.getStatic(fntype, munge(k.sym.toString()), KEYWORD_TYPE); - } - - public void emitConstant(GeneratorAdapter gen, int id){ - gen.getStatic(objtype, constantName(id), constantType(id)); - } - - - String constantName(int id){ - return CONST_PREFIX + id; - } - - String siteName(int n){ - return "__site__" + n; - } - - String siteNameStatic(int n){ - return siteName(n) + "__"; - } - - String thunkName(int n){ - return "__thunk__" + n; - } - - String cachedClassName(int n){ - return "__cached_class__" + n; - } - - String cachedProtoFnName(int n){ - return "__cached_proto_fn__" + n; - } - - String cachedProtoImplName(int n){ - return "__cached_proto_impl__" + n; - } - - String varCallsiteName(int n){ - return "__var__callsite__" + n; - } - - String thunkNameStatic(int n){ - return thunkName(n) + "__"; - } - - Type constantType(int id){ - Object o = constants.nth(id); - Class c = o.getClass(); - if(Modifier.isPublic(c.getModifiers())) - { - //can't emit derived fn types due to visibility - if(LazySeq.class.isAssignableFrom(c)) - return Type.getType(ISeq.class); - else if(c == Keyword.class) - return Type.getType(Keyword.class); -// else if(c == KeywordCallSite.class) -// return Type.getType(KeywordCallSite.class); - else if(RestFn.class.isAssignableFrom(c)) - return Type.getType(RestFn.class); - else if(AFn.class.isAssignableFrom(c)) - return Type.getType(AFn.class); - else if(c == Var.class) - return Type.getType(Var.class); - else if(c == String.class) - return Type.getType(String.class); - -// return Type.getType(c); - } - return OBJECT_TYPE; - } - -} - -enum PATHTYPE { - PATH, BRANCH; -} - -static class PathNode{ - final PATHTYPE type; - final PathNode parent; - - PathNode(PATHTYPE type, PathNode parent) { - this.type = type; - this.parent = parent; - } -} - -static PathNode clearPathRoot(){ - return (PathNode) CLEAR_ROOT.get(); -} - -enum PSTATE{ - REQ, REST, DONE -} - -public static class FnMethod extends ObjMethod{ - //localbinding->localbinding - PersistentVector reqParms = PersistentVector.EMPTY; - LocalBinding restParm = null; - - public FnMethod(ObjExpr objx, ObjMethod parent){ - super(objx, parent); - } - - static FnMethod parse(ObjExpr objx, ISeq form) throws Exception{ - //([args] body...) - IPersistentVector parms = (IPersistentVector) RT.first(form); - ISeq body = RT.next(form); - try - { - FnMethod method = new FnMethod(objx, (ObjMethod) METHOD.deref()); - method.line = (Integer) LINE.deref(); - //register as the current method and set up a new env frame - PathNode pnode = (PathNode) CLEAR_PATH.get(); - if(pnode == null) - pnode = new PathNode(PATHTYPE.PATH,null); - Var.pushThreadBindings( - RT.map( - METHOD, method, - LOCAL_ENV, LOCAL_ENV.deref(), - LOOP_LOCALS, null, - NEXT_LOCAL_NUM, 0 - ,CLEAR_PATH, pnode - ,CLEAR_ROOT, pnode - ,CLEAR_SITES, PersistentHashMap.EMPTY - )); - - //register 'this' as local 0 - //registerLocal(THISFN, null, null); - if(objx.thisName != null) - registerLocal(Symbol.intern(objx.thisName), null, null,false); - else - getAndIncLocalNum(); - PSTATE state = PSTATE.REQ; - PersistentVector argLocals = PersistentVector.EMPTY; - for(int i = 0; i < parms.count(); i++) - { - if(!(parms.nth(i) instanceof Symbol)) - throw new IllegalArgumentException("fn params must be Symbols"); - Symbol p = (Symbol) parms.nth(i); - if(p.getNamespace() != null) - throw new Exception("Can't use qualified name as parameter: " + p); - if(p.equals(_AMP_)) - { - if(state == PSTATE.REQ) - state = PSTATE.REST; - else - throw new Exception("Invalid parameter list"); - } - - else - { - LocalBinding lb = registerLocal(p, state == PSTATE.REST ? ISEQ : tagOf(p), null,true); - argLocals = argLocals.cons(lb); - switch(state) - { - case REQ: - method.reqParms = method.reqParms.cons(lb); - break; - case REST: - method.restParm = lb; - state = PSTATE.DONE; - break; - - default: - throw new Exception("Unexpected parameter"); - } - } - } - if(method.reqParms.count() > MAX_POSITIONAL_ARITY) - throw new Exception("Can't specify more than " + MAX_POSITIONAL_ARITY + " params"); - LOOP_LOCALS.set(argLocals); - method.argLocals = argLocals; - method.body = (new BodyExpr.Parser()).parse(C.RETURN, body); - return method; - } - finally - { - Var.popThreadBindings(); - } - } - - public final PersistentVector reqParms(){ - return reqParms; - } - - public final LocalBinding restParm(){ - return restParm; - } - - boolean isVariadic(){ - return restParm != null; - } - - int numParams(){ - return reqParms.count() + (isVariadic() ? 1 : 0); - } - - String getMethodName(){ - return isVariadic()?"doInvoke":"invoke"; - } - - Type getReturnType(){ - return OBJECT_TYPE; - } - - Type[] getArgTypes(){ - if(isVariadic() && reqParms.count() == MAX_POSITIONAL_ARITY) - { - Type[] ret = new Type[MAX_POSITIONAL_ARITY + 1]; - for(int i = 0;ilocalbinding - IPersistentMap locals = null; - //num->localbinding - IPersistentMap indexlocals = null; - Expr body = null; - ObjExpr objx; - PersistentVector argLocals; - int maxLocal = 0; - int line; - PersistentHashSet localsUsedInCatchFinally = PersistentHashSet.EMPTY; - protected IPersistentMap methodMeta; - - public final IPersistentMap locals(){ - return locals; - } - - public final Expr body(){ - return body; - } - - public final ObjExpr objx(){ - return objx; - } - - public final PersistentVector argLocals(){ - return argLocals; - } - - public final int maxLocal(){ - return maxLocal; - } - - public final int line(){ - return line; - } - - public ObjMethod(ObjExpr objx, ObjMethod parent){ - this.parent = parent; - this.objx = objx; - } - - abstract int numParams(); - abstract String getMethodName(); - abstract Type getReturnType(); - abstract Type[] getArgTypes(); - - public void emit(ObjExpr fn, ClassVisitor cv){ - Method m = new Method(getMethodName(), getReturnType(), getArgTypes()); - - GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC, - m, - null, - //todo don't hardwire this - EXCEPTION_TYPES, - cv); - gen.visitCode(); - Label loopLabel = gen.mark(); - gen.visitLineNumber(line, loopLabel); - try - { - Var.pushThreadBindings(RT.map(LOOP_LABEL, loopLabel, METHOD, this)); - body.emit(C.RETURN, fn, gen); - Label end = gen.mark(); - gen.visitLocalVariable("this", "Ljava/lang/Object;", null, loopLabel, end, 0); - for(ISeq lbs = argLocals.seq(); lbs != null; lbs = lbs.next()) - { - LocalBinding lb = (LocalBinding) lbs.first(); - gen.visitLocalVariable(lb.name, "Ljava/lang/Object;", null, loopLabel, end, lb.idx); - } - } - finally - { - Var.popThreadBindings(); - } - - gen.returnValue(); - //gen.visitMaxs(1, 1); - gen.endMethod(); - } - - void emitClearLocals(GeneratorAdapter gen){ - } - - void emitClearLocalsOld(GeneratorAdapter gen){ - for(int i=0;i 0) - { -// Object dummy; - - if(sites != null) - { - for(ISeq s = sites.seq();s!=null;s = s.next()) - { - LocalBindingExpr o = (LocalBindingExpr) s.first(); - PathNode common = commonPath(clearPath,o.clearPath); - if(common != null && common.type == PATHTYPE.PATH) - o.shouldClear = false; -// else -// dummy = null; - } - } - - if(clearRoot == b.clearPathRoot) - { - this.shouldClear = true; - sites = RT.conj(sites,this); - CLEAR_SITES.set(RT.assoc(CLEAR_SITES.get(), b, sites)); - } -// else -// dummy = null; - } - } - - public Object eval() throws Exception{ - throw new UnsupportedOperationException("Can't eval locals"); - } - - public boolean canEmitPrimitive(){ - return b.getPrimitiveType() != null; - } - - public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ - objx.emitUnboxedLocal(gen, b); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - if(context != C.STATEMENT) - objx.emitLocal(gen, b, shouldClear); - } - - public Object evalAssign(Expr val) throws Exception{ - throw new UnsupportedOperationException("Can't eval locals"); - } - - public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, Expr val){ - objx.emitAssignLocal(gen, b,val); - if(context != C.STATEMENT) - objx.emitLocal(gen, b, false); - } - - public boolean hasJavaClass() throws Exception{ - return tag != null || b.hasJavaClass(); - } - - public Class getJavaClass() throws Exception{ - if(tag != null) - return HostExpr.tagToClass(tag); - return b.getJavaClass(); - } - - -} - -public static class BodyExpr implements Expr, MaybePrimitiveExpr{ - PersistentVector exprs; - - public final PersistentVector exprs(){ - return exprs; - } - - public BodyExpr(PersistentVector exprs){ - this.exprs = exprs; - } - - static class Parser implements IParser{ - public Expr parse(C context, Object frms) throws Exception{ - ISeq forms = (ISeq) frms; - if(Util.equals(RT.first(forms), DO)) - forms = RT.next(forms); - PersistentVector exprs = PersistentVector.EMPTY; - for(; forms != null; forms = forms.next()) - { - Expr e = (context != C.EVAL && - (context == C.STATEMENT || forms.next() != null)) ? - analyze(C.STATEMENT, forms.first()) - : - analyze(context, forms.first()); - exprs = exprs.cons(e); - } - if(exprs.count() == 0) - exprs = exprs.cons(NIL_EXPR); - return new BodyExpr(exprs); - } - } - - public Object eval() throws Exception{ - Object ret = null; - for(Object o : exprs) - { - Expr e = (Expr) o; - ret = e.eval(); - } - return ret; - } - - public boolean canEmitPrimitive(){ - return lastExpr() instanceof MaybePrimitiveExpr && ((MaybePrimitiveExpr)lastExpr()).canEmitPrimitive(); - } - - public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ - for(int i = 0; i < exprs.count() - 1; i++) - { - Expr e = (Expr) exprs.nth(i); - e.emit(C.STATEMENT, objx, gen); - } - MaybePrimitiveExpr last = (MaybePrimitiveExpr) exprs.nth(exprs.count() - 1); - last.emitUnboxed(context, objx, gen); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - for(int i = 0; i < exprs.count() - 1; i++) - { - Expr e = (Expr) exprs.nth(i); - e.emit(C.STATEMENT, objx, gen); - } - Expr last = (Expr) exprs.nth(exprs.count() - 1); - last.emit(context, objx, gen); - } - - public boolean hasJavaClass() throws Exception{ - return lastExpr().hasJavaClass(); - } - - public Class getJavaClass() throws Exception{ - return lastExpr().getJavaClass(); - } - - private Expr lastExpr(){ - return (Expr) exprs.nth(exprs.count() - 1); - } -} - -public static class BindingInit{ - LocalBinding binding; - Expr init; - - public final LocalBinding binding(){ - return binding; - } - - public final Expr init(){ - return init; - } - - public BindingInit(LocalBinding binding, Expr init){ - this.binding = binding; - this.init = init; - } -} - -public static class LetFnExpr implements Expr{ - public final PersistentVector bindingInits; - public final Expr body; - - public LetFnExpr(PersistentVector bindingInits, Expr body){ - this.bindingInits = bindingInits; - this.body = body; - } - - static class Parser implements IParser{ - public Expr parse(C context, Object frm) throws Exception{ - ISeq form = (ISeq) frm; - //(letfns* [var (fn [args] body) ...] body...) - if(!(RT.second(form) instanceof IPersistentVector)) - throw new IllegalArgumentException("Bad binding form, expected vector"); - - IPersistentVector bindings = (IPersistentVector) RT.second(form); - if((bindings.count() % 2) != 0) - throw new IllegalArgumentException("Bad binding form, expected matched symbol expression pairs"); - - ISeq body = RT.next(RT.next(form)); - - if(context == C.EVAL) - return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); - - IPersistentMap dynamicBindings = RT.map(LOCAL_ENV, LOCAL_ENV.deref(), - NEXT_LOCAL_NUM, NEXT_LOCAL_NUM.deref()); - - try - { - Var.pushThreadBindings(dynamicBindings); - - //pre-seed env (like Lisp labels) - PersistentVector lbs = PersistentVector.EMPTY; - for(int i = 0; i < bindings.count(); i += 2) - { - if(!(bindings.nth(i) instanceof Symbol)) - throw new IllegalArgumentException( - "Bad binding form, expected symbol, got: " + bindings.nth(i)); - Symbol sym = (Symbol) bindings.nth(i); - if(sym.getNamespace() != null) - throw new Exception("Can't let qualified name: " + sym); - LocalBinding lb = registerLocal(sym, tagOf(sym), null,false); - lb.canBeCleared = false; - lbs = lbs.cons(lb); - } - PersistentVector bindingInits = PersistentVector.EMPTY; - for(int i = 0; i < bindings.count(); i += 2) - { - Symbol sym = (Symbol) bindings.nth(i); - Expr init = analyze(C.EXPRESSION, bindings.nth(i + 1), sym.name); - LocalBinding lb = (LocalBinding) lbs.nth(i / 2); - lb.init = init; - BindingInit bi = new BindingInit(lb, init); - bindingInits = bindingInits.cons(bi); - } - return new LetFnExpr(bindingInits, (new BodyExpr.Parser()).parse(context, body)); - } - finally - { - Var.popThreadBindings(); - } - } - } - - public Object eval() throws Exception{ - throw new UnsupportedOperationException("Can't eval letfns"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - for(int i = 0; i < bindingInits.count(); i++) - { - BindingInit bi = (BindingInit) bindingInits.nth(i); - gen.visitInsn(Opcodes.ACONST_NULL); - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx); - } - - IPersistentSet lbset = PersistentHashSet.EMPTY; - - for(int i = 0; i < bindingInits.count(); i++) - { - BindingInit bi = (BindingInit) bindingInits.nth(i); - lbset = (IPersistentSet) lbset.cons(bi.binding); - bi.init.emit(C.EXPRESSION, objx, gen); - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx); - } - - for(int i = 0; i < bindingInits.count(); i++) - { - BindingInit bi = (BindingInit) bindingInits.nth(i); - ObjExpr fe = (ObjExpr) bi.init; - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), bi.binding.idx); - fe.emitLetFnInits(gen, objx, lbset); - } - - Label loopLabel = gen.mark(); - - body.emit(context, objx, gen); - - Label end = gen.mark(); -// gen.visitLocalVariable("this", "Ljava/lang/Object;", null, loopLabel, end, 0); - for(ISeq bis = bindingInits.seq(); bis != null; bis = bis.next()) - { - BindingInit bi = (BindingInit) bis.first(); - String lname = bi.binding.name; - if(lname.endsWith("__auto__")) - lname += RT.nextID(); - Class primc = maybePrimitiveType(bi.init); - if(primc != null) - gen.visitLocalVariable(lname, Type.getDescriptor(primc), null, loopLabel, end, - bi.binding.idx); - else - gen.visitLocalVariable(lname, "Ljava/lang/Object;", null, loopLabel, end, bi.binding.idx); - } - } - - public boolean hasJavaClass() throws Exception{ - return body.hasJavaClass(); - } - - public Class getJavaClass() throws Exception{ - return body.getJavaClass(); - } -} - -public static class LetExpr implements Expr, MaybePrimitiveExpr{ - public final PersistentVector bindingInits; - public final Expr body; - public final boolean isLoop; - - public LetExpr(PersistentVector bindingInits, Expr body, boolean isLoop){ - this.bindingInits = bindingInits; - this.body = body; - this.isLoop = isLoop; - } - - static class Parser implements IParser{ - public Expr parse(C context, Object frm) throws Exception{ - ISeq form = (ISeq) frm; - //(let [var val var2 val2 ...] body...) - boolean isLoop = RT.first(form).equals(LOOP); - if(!(RT.second(form) instanceof IPersistentVector)) - throw new IllegalArgumentException("Bad binding form, expected vector"); - - IPersistentVector bindings = (IPersistentVector) RT.second(form); - if((bindings.count() % 2) != 0) - throw new IllegalArgumentException("Bad binding form, expected matched symbol expression pairs"); - - ISeq body = RT.next(RT.next(form)); - - if(context == C.EVAL - || (context == C.EXPRESSION && isLoop)) - return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); - - IPersistentMap dynamicBindings = RT.map(LOCAL_ENV, LOCAL_ENV.deref(), - NEXT_LOCAL_NUM, NEXT_LOCAL_NUM.deref()); - if(isLoop) - dynamicBindings = dynamicBindings.assoc(LOOP_LOCALS, null); - - try - { - Var.pushThreadBindings(dynamicBindings); - - PersistentVector bindingInits = PersistentVector.EMPTY; - PersistentVector loopLocals = PersistentVector.EMPTY; - for(int i = 0; i < bindings.count(); i += 2) - { - if(!(bindings.nth(i) instanceof Symbol)) - throw new IllegalArgumentException( - "Bad binding form, expected symbol, got: " + bindings.nth(i)); - Symbol sym = (Symbol) bindings.nth(i); - if(sym.getNamespace() != null) - throw new Exception("Can't let qualified name: " + sym); - Expr init = analyze(C.EXPRESSION, bindings.nth(i + 1), sym.name); - //sequential enhancement of env (like Lisp let*) - LocalBinding lb = registerLocal(sym, tagOf(sym), init,false); - BindingInit bi = new BindingInit(lb, init); - bindingInits = bindingInits.cons(bi); - - if(isLoop) - loopLocals = loopLocals.cons(lb); - } - if(isLoop) - LOOP_LOCALS.set(loopLocals); - Expr bodyExpr; - try { - if(isLoop) - { - PathNode root = new PathNode(PATHTYPE.PATH, (PathNode) CLEAR_PATH.get()); - Var.pushThreadBindings( - RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,root), - CLEAR_ROOT, new PathNode(PATHTYPE.PATH,root))); - } - bodyExpr = (new BodyExpr.Parser()).parse(isLoop ? C.RETURN : context, body); - } - finally{ - if(isLoop) - Var.popThreadBindings(); - } - return new LetExpr(bindingInits, bodyExpr, - isLoop); - } - finally - { - Var.popThreadBindings(); - } - } - } - - public Object eval() throws Exception{ - throw new UnsupportedOperationException("Can't eval let/loop"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - doEmit(context, objx, gen, false); - } - - public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ - doEmit(context, objx, gen, true); - } - - - public void doEmit(C context, ObjExpr objx, GeneratorAdapter gen, boolean emitUnboxed){ - for(int i = 0; i < bindingInits.count(); i++) - { - BindingInit bi = (BindingInit) bindingInits.nth(i); - Class primc = maybePrimitiveType(bi.init); - if(primc != null) - { - ((MaybePrimitiveExpr) bi.init).emitUnboxed(C.EXPRESSION, objx, gen); - gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ISTORE), bi.binding.idx); - } - else - { - bi.init.emit(C.EXPRESSION, objx, gen); - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx); - } - } - Label loopLabel = gen.mark(); - if(isLoop) - { - try - { - Var.pushThreadBindings(RT.map(LOOP_LABEL, loopLabel)); - if(emitUnboxed) - ((MaybePrimitiveExpr)body).emitUnboxed(context, objx, gen); - else - body.emit(context, objx, gen); - } - finally - { - Var.popThreadBindings(); - } - } - else - { - if(emitUnboxed) - ((MaybePrimitiveExpr)body).emitUnboxed(context, objx, gen); - else - body.emit(context, objx, gen); - } - Label end = gen.mark(); -// gen.visitLocalVariable("this", "Ljava/lang/Object;", null, loopLabel, end, 0); - for(ISeq bis = bindingInits.seq(); bis != null; bis = bis.next()) - { - BindingInit bi = (BindingInit) bis.first(); - String lname = bi.binding.name; - if(lname.endsWith("__auto__")) - lname += RT.nextID(); - Class primc = maybePrimitiveType(bi.init); - if(primc != null) - gen.visitLocalVariable(lname, Type.getDescriptor(primc), null, loopLabel, end, - bi.binding.idx); - else - gen.visitLocalVariable(lname, "Ljava/lang/Object;", null, loopLabel, end, bi.binding.idx); - } - } - - public boolean hasJavaClass() throws Exception{ - return body.hasJavaClass(); - } - - public Class getJavaClass() throws Exception{ - return body.getJavaClass(); - } - - public boolean canEmitPrimitive(){ - return body instanceof MaybePrimitiveExpr && ((MaybePrimitiveExpr)body).canEmitPrimitive(); - } - -} - -public static class RecurExpr implements Expr{ - public final IPersistentVector args; - public final IPersistentVector loopLocals; - - public RecurExpr(IPersistentVector loopLocals, IPersistentVector args){ - this.loopLocals = loopLocals; - this.args = args; - } - - public Object eval() throws Exception{ - throw new UnsupportedOperationException("Can't eval recur"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - Label loopLabel = (Label) LOOP_LABEL.deref(); - if(loopLabel == null) - throw new IllegalStateException(); - for(int i = 0; i < loopLocals.count(); i++) - { - LocalBinding lb = (LocalBinding) loopLocals.nth(i); - Expr arg = (Expr) args.nth(i); - if(lb.getPrimitiveType() != null) - { - Class primc = lb.getPrimitiveType(); - try - { - if(!(arg instanceof MaybePrimitiveExpr && arg.hasJavaClass() && arg.getJavaClass() == primc)) - throw new IllegalArgumentException("recur arg for primitive local: " + - lb.name + " must be matching primitive"); - } - catch(Exception e) - { - throw new RuntimeException(e); - } - ((MaybePrimitiveExpr) arg).emitUnboxed(C.EXPRESSION, objx, gen); - } - else - { - arg.emit(C.EXPRESSION, objx, gen); - } - } - - for(int i = loopLocals.count() - 1; i >= 0; i--) - { - LocalBinding lb = (LocalBinding) loopLocals.nth(i); - Class primc = lb.getPrimitiveType(); - if(lb.isArg) - gen.storeArg(lb.idx-1); - else - { - if(primc != null) - gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ISTORE), lb.idx); - else - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), lb.idx); - } - } - - gen.goTo(loopLabel); - } - - public boolean hasJavaClass() throws Exception{ - return true; - } - - public Class getJavaClass() throws Exception{ - return null; - } - - static class Parser implements IParser{ - public Expr parse(C context, Object frm) throws Exception{ - ISeq form = (ISeq) frm; - IPersistentVector loopLocals = (IPersistentVector) LOOP_LOCALS.deref(); - if(context != C.RETURN || loopLocals == null) - throw new UnsupportedOperationException("Can only recur from tail position"); - if(IN_CATCH_FINALLY.deref() != null) - throw new UnsupportedOperationException("Cannot recur from catch/finally"); - PersistentVector args = PersistentVector.EMPTY; - for(ISeq s = RT.seq(form.next()); s != null; s = s.next()) - { - args = args.cons(analyze(C.EXPRESSION, s.first())); - } - if(args.count() != loopLocals.count()) - throw new IllegalArgumentException( - String.format("Mismatched argument count to recur, expected: %d args, got: %d", - loopLocals.count(), args.count())); - return new RecurExpr(loopLocals, args); - } - } -} - -private static LocalBinding registerLocal(Symbol sym, Symbol tag, Expr init, boolean isArg) throws Exception{ - int num = getAndIncLocalNum(); - LocalBinding b = new LocalBinding(num, sym, tag, init, isArg, clearPathRoot()); - IPersistentMap localsMap = (IPersistentMap) LOCAL_ENV.deref(); - LOCAL_ENV.set(RT.assoc(localsMap, b.sym, b)); - ObjMethod method = (ObjMethod) METHOD.deref(); - method.locals = (IPersistentMap) RT.assoc(method.locals, b, b); - method.indexlocals = (IPersistentMap) RT.assoc(method.indexlocals, num, b); - return b; -} - -private static int getAndIncLocalNum(){ - int num = ((Number) NEXT_LOCAL_NUM.deref()).intValue(); - ObjMethod m = (ObjMethod) METHOD.deref(); - if(num > m.maxLocal) - m.maxLocal = num; - NEXT_LOCAL_NUM.set(num + 1); - return num; -} - -public static Expr analyze(C context, Object form) throws Exception{ - return analyze(context, form, null); -} - -private static Expr analyze(C context, Object form, String name) throws Exception{ - //todo symbol macro expansion? - try - { - if(form instanceof LazySeq) - { - form = RT.seq(form); - if(form == null) - form = PersistentList.EMPTY; - } - if(form == null) - return NIL_EXPR; - else if(form == Boolean.TRUE) - return TRUE_EXPR; - else if(form == Boolean.FALSE) - return FALSE_EXPR; - Class fclass = form.getClass(); - if(fclass == Symbol.class) - return analyzeSymbol((Symbol) form); - else if(fclass == Keyword.class) - return registerKeyword((Keyword) form); -// else if(form instanceof Num) -// return new NumExpr((Num) form); - else if(fclass == String.class) - return new StringExpr(((String) form).intern()); -// else if(fclass == Character.class) -// return new CharExpr((Character) form); - else if(form instanceof IPersistentCollection && ((IPersistentCollection) form).count() == 0) - { - Expr ret = new EmptyExpr(form); - if(RT.meta(form) != null) - ret = new MetaExpr(ret, (MapExpr) MapExpr - .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta())); - return ret; - } - else if(form instanceof ISeq) - return analyzeSeq(context, (ISeq) form, name); - else if(form instanceof IPersistentVector) - return VectorExpr.parse(context, (IPersistentVector) form); - else if(form instanceof IPersistentMap) - return MapExpr.parse(context, (IPersistentMap) form); - else if(form instanceof IPersistentSet) - return SetExpr.parse(context, (IPersistentSet) form); - -// else - //throw new UnsupportedOperationException(); - return new ConstantExpr(form); - } - catch(Throwable e) - { - if(!(e instanceof CompilerException)) - throw new CompilerException((String) SOURCE.deref(), (Integer) LINE.deref(), e); - else - throw (CompilerException) e; - } -} - -static public class CompilerException extends Exception{ - - public CompilerException(String source, int line, Throwable cause){ - super(errorMsg(source, line, cause.toString()), cause); - } - - public String toString(){ - return getMessage(); - } -} - -static public Var isMacro(Object op) throws Exception{ - //no local macros for now - if(op instanceof Symbol && referenceLocal((Symbol) op) != null) - return null; - if(op instanceof Symbol || op instanceof Var) - { - Var v = (op instanceof Var) ? (Var) op : lookupVar((Symbol) op, false); - if(v != null && v.isMacro()) - { - if(v.ns != currentNS() && !v.isPublic()) - throw new IllegalStateException("var: " + v + " is not public"); - return v; - } - } - return null; -} - -static public IFn isInline(Object op, int arity) throws Exception{ - //no local inlines for now - if(op instanceof Symbol && referenceLocal((Symbol) op) != null) - return null; - if(op instanceof Symbol || op instanceof Var) - { - Var v = (op instanceof Var) ? (Var) op : lookupVar((Symbol) op, false); - if(v != null) - { - if(v.ns != currentNS() && !v.isPublic()) - throw new IllegalStateException("var: " + v + " is not public"); - IFn ret = (IFn) RT.get(v.meta(), inlineKey); - if(ret != null) - { - IFn arityPred = (IFn) RT.get(v.meta(), inlineAritiesKey); - if(arityPred == null || RT.booleanCast(arityPred.invoke(arity))) - return ret; - } - } - } - return null; -} - -public static boolean namesStaticMember(Symbol sym){ - return sym.ns != null && namespaceFor(sym) == null; -} - -public static Object preserveTag(ISeq src, Object dst) { - Symbol tag = tagOf(src); - if (tag != null && dst instanceof IObj) { - IPersistentMap meta = RT.meta(dst); - return ((IObj) dst).withMeta((IPersistentMap) RT.assoc(meta, RT.TAG_KEY, tag)); - } - return dst; -} - -public static Object macroexpand1(Object x) throws Exception{ - if(x instanceof ISeq) - { - ISeq form = (ISeq) x; - Object op = RT.first(form); - if(isSpecial(op)) - return x; - //macro expansion - Var v = isMacro(op); - if(v != null) - { - return v.applyTo(RT.cons(form,RT.cons(LOCAL_ENV.get(),form.next()))); - } - else - { - if(op instanceof Symbol) - { - Symbol sym = (Symbol) op; - String sname = sym.name; - //(.substring s 2 5) => (. s substring 2 5) - if(sym.name.charAt(0) == '.') - { - if(RT.length(form) < 2) - throw new IllegalArgumentException( - "Malformed member expression, expecting (.member target ...)"); - Symbol meth = Symbol.intern(sname.substring(1)); - Object target = RT.second(form); - if(HostExpr.maybeClass(target, false) != null) - { - target = ((IObj)RT.list(IDENTITY, target)).withMeta(RT.map(RT.TAG_KEY,CLASS)); - } - return preserveTag(form, RT.listStar(DOT, target, meth, form.next().next())); - } - else if(namesStaticMember(sym)) - { - Symbol target = Symbol.intern(sym.ns); - Class c = HostExpr.maybeClass(target, false); - if(c != null) - { - Symbol meth = Symbol.intern(sym.name); - return preserveTag(form, RT.listStar(DOT, target, meth, form.next())); - } - } - else - { - //(s.substring 2 5) => (. s substring 2 5) - //also (package.class.name ...) (. package.class name ...) - int idx = sname.lastIndexOf('.'); -// if(idx > 0 && idx < sname.length() - 1) -// { -// Symbol target = Symbol.intern(sname.substring(0, idx)); -// Symbol meth = Symbol.intern(sname.substring(idx + 1)); -// return RT.listStar(DOT, target, meth, form.rest()); -// } - //(StringBuilder. "foo") => (new StringBuilder "foo") - //else - if(idx == sname.length() - 1) - return RT.listStar(NEW, Symbol.intern(sname.substring(0, idx)), form.next()); - } - } - } - } - return x; -} - -static Object macroexpand(Object form) throws Exception{ - Object exf = macroexpand1(form); - if(exf != form) - return macroexpand(exf); - return form; -} - -private static Expr analyzeSeq(C context, ISeq form, String name) throws Exception{ - Integer line = (Integer) LINE.deref(); - if(RT.meta(form) != null && RT.meta(form).containsKey(RT.LINE_KEY)) - line = (Integer) RT.meta(form).valAt(RT.LINE_KEY); - Var.pushThreadBindings( - RT.map(LINE, line)); - try - { - Object me = macroexpand1(form); - if(me != form) - return analyze(context, me, name); - - Object op = RT.first(form); - if(op == null) - throw new IllegalArgumentException("Can't call nil"); - IFn inline = isInline(op, RT.count(RT.next(form))); - if(inline != null) - return analyze(context, preserveTag(form, inline.applyTo(RT.next(form)))); - IParser p; - if(op.equals(FN)) - return FnExpr.parse(context, form, name); - else if((p = (IParser) specials.valAt(op)) != null) - return p.parse(context, form); - else - return InvokeExpr.parse(context, form); - } - catch(Throwable e) - { - if(!(e instanceof CompilerException)) - throw new CompilerException((String) SOURCE.deref(), (Integer) LINE.deref(), e); - else - throw (CompilerException) e; - } - finally - { - Var.popThreadBindings(); - } -} - -static String errorMsg(String source, int line, String s){ - return String.format("%s (%s:%d)", s, source, line); -} - -public static Object eval(Object form) throws Exception{ - return eval(form, true); -} - -public static Object eval(Object form, boolean freshLoader) throws Exception{ - boolean createdLoader = false; - if(true)//!LOADER.isBound()) - { - Var.pushThreadBindings(RT.map(LOADER, RT.makeClassLoader())); - createdLoader = true; - } - try - { - Integer line = (Integer) LINE.deref(); - if(RT.meta(form) != null && RT.meta(form).containsKey(RT.LINE_KEY)) - line = (Integer) RT.meta(form).valAt(RT.LINE_KEY); - Var.pushThreadBindings(RT.map(LINE, line)); - try - { - form = macroexpand(form); - if(form instanceof IPersistentCollection && Util.equals(RT.first(form), DO)) - { - ISeq s = RT.next(form); - for(; RT.next(s) != null; s = RT.next(s)) - eval(RT.first(s),false); - return eval(RT.first(s),false); - } - else if(form instanceof IPersistentCollection - && !(RT.first(form) instanceof Symbol - && ((Symbol) RT.first(form)).name.startsWith("def"))) - { - ObjExpr fexpr = (ObjExpr) analyze(C.EXPRESSION, RT.list(FN, PersistentVector.EMPTY, form), - "eval" + RT.nextID()); - IFn fn = (IFn) fexpr.eval(); - return fn.invoke(); - } - else - { - Expr expr = analyze(C.EVAL, form); - return expr.eval(); - } - } - finally - { - Var.popThreadBindings(); - } - } - catch(Throwable e) - { - if(!(e instanceof CompilerException)) - throw new CompilerException((String) SOURCE.deref(), (Integer) LINE.deref(), e); - else - throw (CompilerException) e; - } - finally - { - if(createdLoader) - Var.popThreadBindings(); - } -} - -private static int registerConstant(Object o){ - if(!CONSTANTS.isBound()) - return -1; - PersistentVector v = (PersistentVector) CONSTANTS.deref(); - IdentityHashMap ids = (IdentityHashMap) CONSTANT_IDS.deref(); - Integer i = ids.get(o); - if(i != null) - return i; - CONSTANTS.set(RT.conj(v, o)); - ids.put(o, v.count()); - return v.count(); -} - -private static KeywordExpr registerKeyword(Keyword keyword){ - if(!KEYWORDS.isBound()) - return new KeywordExpr(keyword); - - IPersistentMap keywordsMap = (IPersistentMap) KEYWORDS.deref(); - Object id = RT.get(keywordsMap, keyword); - if(id == null) - { - KEYWORDS.set(RT.assoc(keywordsMap, keyword, registerConstant(keyword))); - } - return new KeywordExpr(keyword); -// KeywordExpr ke = (KeywordExpr) RT.get(keywordsMap, keyword); -// if(ke == null) -// KEYWORDS.set(RT.assoc(keywordsMap, keyword, ke = new KeywordExpr(keyword))); -// return ke; -} - -private static int registerKeywordCallsite(Keyword keyword){ - if(!KEYWORD_CALLSITES.isBound()) - throw new IllegalAccessError("KEYWORD_CALLSITES is not bound"); - - IPersistentVector keywordCallsites = (IPersistentVector) KEYWORD_CALLSITES.deref(); - - keywordCallsites = keywordCallsites.cons(keyword); - KEYWORD_CALLSITES.set(keywordCallsites); - return keywordCallsites.count()-1; -} - -private static int registerProtocolCallsite(Var v){ - if(!PROTOCOL_CALLSITES.isBound()) - throw new IllegalAccessError("PROTOCOL_CALLSITES is not bound"); - - IPersistentVector protocolCallsites = (IPersistentVector) PROTOCOL_CALLSITES.deref(); - - protocolCallsites = protocolCallsites.cons(v); - PROTOCOL_CALLSITES.set(protocolCallsites); - return protocolCallsites.count()-1; -} - -private static int registerVarCallsite(Var v){ - if(!VAR_CALLSITES.isBound()) - throw new IllegalAccessError("VAR_CALLSITES is not bound"); - - IPersistentVector varCallsites = (IPersistentVector) VAR_CALLSITES.deref(); - - varCallsites = varCallsites.cons(v); - VAR_CALLSITES.set(varCallsites); - return varCallsites.count()-1; -} - -static ISeq fwdPath(PathNode p1){ - ISeq ret = null; - for(;p1 != null;p1 = p1.parent) - ret = RT.cons(p1,ret); - return ret; -} - -static PathNode commonPath(PathNode n1, PathNode n2){ - ISeq xp = fwdPath(n1); - ISeq yp = fwdPath(n2); - if(RT.first(xp) != RT.first(yp)) - return null; - while(RT.second(xp) != null && RT.second(xp) == RT.second(yp)) - { - xp = xp.next(); - yp = yp.next(); - } - return (PathNode) RT.first(xp); -} - -static void addAnnotation(Object visitor, IPersistentMap meta){ - try{ - if(meta != null && ADD_ANNOTATIONS.isBound()) - ADD_ANNOTATIONS.invoke(visitor, meta); - } - catch (Exception e) - { - throw new RuntimeException(e); - } -} - -static void addParameterAnnotation(Object visitor, IPersistentMap meta, int i){ - try{ - if(meta != null && ADD_ANNOTATIONS.isBound()) - ADD_ANNOTATIONS.invoke(visitor, meta, i); - } - catch (Exception e) - { - throw new RuntimeException(e); - } -} - -private static Expr analyzeSymbol(Symbol sym) throws Exception{ - Symbol tag = tagOf(sym); - if(sym.ns == null) //ns-qualified syms are always Vars - { - LocalBinding b = referenceLocal(sym); - if(b != null) - { - return new LocalBindingExpr(b, tag); - } - } - else - { - if(namespaceFor(sym) == null) - { - Symbol nsSym = Symbol.create(sym.ns); - Class c = HostExpr.maybeClass(nsSym, false); - if(c != null) - { - if(Reflector.getField(c, sym.name, true) != null) - return new StaticFieldExpr((Integer) LINE.deref(), c, sym.name, tag); - throw new Exception("Unable to find static field: " + sym.name + " in " + c); - } - } - } - //Var v = lookupVar(sym, false); -// Var v = lookupVar(sym, false); -// if(v != null) -// return new VarExpr(v, tag); - Object o = resolve(sym); - if(o instanceof Var) - { - Var v = (Var) o; - if(isMacro(v) != null) - throw new Exception("Can't take value of a macro: " + v); - registerVar(v); - return new VarExpr(v, tag); - } - else if(o instanceof Class) - return new ConstantExpr(o); - else if(o instanceof Symbol) - return new UnresolvedVarExpr((Symbol) o); - - throw new Exception("Unable to resolve symbol: " + sym + " in this context"); - -} - -static String destubClassName(String className){ - //skip over prefix + '.' or '/' - if(className.startsWith(COMPILE_STUB_PREFIX)) - return className.substring(COMPILE_STUB_PREFIX.length()+1); - return className; -} - -static Type getType(Class c){ - String descriptor = Type.getType(c).getDescriptor(); - if(descriptor.startsWith("L")) - descriptor = "L" + destubClassName(descriptor.substring(1)); - return Type.getType(descriptor); -} - -static Object resolve(Symbol sym, boolean allowPrivate) throws Exception{ - return resolveIn(currentNS(), sym, allowPrivate); -} - -static Object resolve(Symbol sym) throws Exception{ - return resolveIn(currentNS(), sym, false); -} - -static Namespace namespaceFor(Symbol sym){ - return namespaceFor(currentNS(), sym); -} - -static Namespace namespaceFor(Namespace inns, Symbol sym){ - //note, presumes non-nil sym.ns - // first check against currentNS' aliases... - Symbol nsSym = Symbol.create(sym.ns); - Namespace ns = inns.lookupAlias(nsSym); - if(ns == null) - { - // ...otherwise check the Namespaces map. - ns = Namespace.find(nsSym); - } - return ns; -} - -static public Object resolveIn(Namespace n, Symbol sym, boolean allowPrivate) throws Exception{ - //note - ns-qualified vars must already exist - if(sym.ns != null) - { - Namespace ns = namespaceFor(n, sym); - if(ns == null) - throw new Exception("No such namespace: " + sym.ns); - - Var v = ns.findInternedVar(Symbol.create(sym.name)); - if(v == null) - throw new Exception("No such var: " + sym); - else if(v.ns != currentNS() && !v.isPublic() && !allowPrivate) - throw new IllegalStateException("var: " + sym + " is not public"); - return v; - } - else if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[') - { - return RT.classForName(sym.name); - } - else if(sym.equals(NS)) - return RT.NS_VAR; - else if(sym.equals(IN_NS)) - return RT.IN_NS_VAR; - else - { - if(Util.equals(sym,COMPILE_STUB_SYM.get())) - return COMPILE_STUB_CLASS.get(); - Object o = n.getMapping(sym); - if(o == null) - { - if(RT.booleanCast(RT.ALLOW_UNRESOLVED_VARS.deref())) - { - return sym; - } - else - { - throw new Exception("Unable to resolve symbol: " + sym + " in this context"); - } - } - return o; - } -} - - -static public Object maybeResolveIn(Namespace n, Symbol sym) throws Exception{ - //note - ns-qualified vars must already exist - if(sym.ns != null) - { - Namespace ns = namespaceFor(n, sym); - if(ns == null) - return null; - Var v = ns.findInternedVar(Symbol.create(sym.name)); - if(v == null) - return null; - return v; - } - else if(sym.name.indexOf('.') > 0 && !sym.name.endsWith(".") - || sym.name.charAt(0) == '[') - { - return RT.classForName(sym.name); - } - else if(sym.equals(NS)) - return RT.NS_VAR; - else if(sym.equals(IN_NS)) - return RT.IN_NS_VAR; - else - { - Object o = n.getMapping(sym); - return o; - } -} - - -static Var lookupVar(Symbol sym, boolean internNew) throws Exception{ - Var var = null; - - //note - ns-qualified vars in other namespaces must already exist - if(sym.ns != null) - { - Namespace ns = namespaceFor(sym); - if(ns == null) - return null; - //throw new Exception("No such namespace: " + sym.ns); - Symbol name = Symbol.create(sym.name); - if(internNew && ns == currentNS()) - var = currentNS().intern(name); - else - var = ns.findInternedVar(name); - } - else if(sym.equals(NS)) - var = RT.NS_VAR; - else if(sym.equals(IN_NS)) - var = RT.IN_NS_VAR; - else - { - //is it mapped? - Object o = currentNS().getMapping(sym); - if(o == null) - { - //introduce a new var in the current ns - if(internNew) - var = currentNS().intern(Symbol.create(sym.name)); - } - else if(o instanceof Var) - { - var = (Var) o; - } - else - { - throw new Exception("Expecting var, but " + sym + " is mapped to " + o); - } - } - if(var != null) - registerVar(var); - return var; -} - -private static void registerVar(Var var) throws Exception{ - if(!VARS.isBound()) - return; - IPersistentMap varsMap = (IPersistentMap) VARS.deref(); - Object id = RT.get(varsMap, var); - if(id == null) - { - VARS.set(RT.assoc(varsMap, var, registerConstant(var))); - } -// if(varsMap != null && RT.get(varsMap, var) == null) -// VARS.set(RT.assoc(varsMap, var, var)); -} - -static Namespace currentNS(){ - return (Namespace) RT.CURRENT_NS.deref(); -} - -static void closeOver(LocalBinding b, ObjMethod method){ - if(b != null && method != null) - { - if(RT.get(method.locals, b) == null) - { - method.objx.closes = (IPersistentMap) RT.assoc(method.objx.closes, b, b); - closeOver(b, method.parent); - } - else if(IN_CATCH_FINALLY.deref() != null) - { - method.localsUsedInCatchFinally = (PersistentHashSet) method.localsUsedInCatchFinally.cons(b.idx); - } - } -} - - -static LocalBinding referenceLocal(Symbol sym) throws Exception{ - if(!LOCAL_ENV.isBound()) - return null; - LocalBinding b = (LocalBinding) RT.get(LOCAL_ENV.deref(), sym); - if(b != null) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - closeOver(b, method); - } - return b; -} - -private static Symbol tagOf(Object o){ - Object tag = RT.get(RT.meta(o), RT.TAG_KEY); - if(tag instanceof Symbol) - return (Symbol) tag; - else if(tag instanceof String) - return Symbol.intern(null, (String) tag); - return null; -} - -public static Object loadFile(String file) throws Exception{ -// File fo = new File(file); -// if(!fo.exists()) -// return null; - - FileInputStream f = new FileInputStream(file); - try - { - return load(new InputStreamReader(f, RT.UTF8), new File(file).getAbsolutePath(), (new File(file)).getName()); - } - finally - { - f.close(); - } -} - -public static Object load(Reader rdr) throws Exception{ - return load(rdr, null, "NO_SOURCE_FILE"); -} - -public static Object load(Reader rdr, String sourcePath, String sourceName) throws Exception{ - Object EOF = new Object(); - Object ret = null; - LineNumberingPushbackReader pushbackReader = - (rdr instanceof LineNumberingPushbackReader) ? (LineNumberingPushbackReader) rdr : - new LineNumberingPushbackReader(rdr); - Var.pushThreadBindings( - RT.map(LOADER, RT.makeClassLoader(), - SOURCE_PATH, sourcePath, - SOURCE, sourceName, - METHOD, null, - LOCAL_ENV, null, - LOOP_LOCALS, null, - NEXT_LOCAL_NUM, 0, - RT.CURRENT_NS, RT.CURRENT_NS.deref(), - LINE_BEFORE, pushbackReader.getLineNumber(), - LINE_AFTER, pushbackReader.getLineNumber() - )); - - try - { - for(Object r = LispReader.read(pushbackReader, false, EOF, false); r != EOF; - r = LispReader.read(pushbackReader, false, EOF, false)) - { - LINE_AFTER.set(pushbackReader.getLineNumber()); - ret = eval(r,false); - LINE_BEFORE.set(pushbackReader.getLineNumber()); - } - } - catch(LispReader.ReaderException e) - { - throw new CompilerException(sourceName, e.line, e.getCause()); - } - finally - { - Var.popThreadBindings(); - } - return ret; -} - -static public void writeClassFile(String internalName, byte[] bytecode) throws Exception{ - String genPath = (String) COMPILE_PATH.deref(); - if(genPath == null) - throw new Exception("*compile-path* not set"); - String[] dirs = internalName.split("/"); - String p = genPath; - for(int i = 0; i < dirs.length - 1; i++) - { - p += File.separator + dirs[i]; - (new File(p)).mkdir(); - } - String path = genPath + File.separator + internalName + ".class"; - File cf = new File(path); - cf.createNewFile(); - FileOutputStream cfs = new FileOutputStream(cf); - try - { - cfs.write(bytecode); - cfs.flush(); - cfs.getFD().sync(); - } - finally - { - cfs.close(); - } -} - -public static void pushNS(){ - Var.pushThreadBindings(PersistentHashMap.create(Var.intern(Symbol.create("clojure.core"), - Symbol.create("*ns*")), null)); -} - -public static ILookupThunk getLookupThunk(Object target, Keyword k){ - return null; //To change body of created methods use File | Settings | File Templates. -} - -static void compile1(GeneratorAdapter gen, ObjExpr objx, Object form) throws Exception{ - Integer line = (Integer) LINE.deref(); - if(RT.meta(form) != null && RT.meta(form).containsKey(RT.LINE_KEY)) - line = (Integer) RT.meta(form).valAt(RT.LINE_KEY); - Var.pushThreadBindings( - RT.map(LINE, line - ,LOADER, RT.makeClassLoader() - )); - try - { - form = macroexpand(form); - if(form instanceof IPersistentCollection && Util.equals(RT.first(form), DO)) - { - for(ISeq s = RT.next(form); s != null; s = RT.next(s)) - { - compile1(gen, objx, RT.first(s)); - } - } - else - { - Expr expr = analyze(C.EVAL, form); - objx.keywords = (IPersistentMap) KEYWORDS.deref(); - objx.vars = (IPersistentMap) VARS.deref(); - objx.constants = (PersistentVector) CONSTANTS.deref(); - expr.emit(C.EXPRESSION, objx, gen); - expr.eval(); - } - } - finally - { - Var.popThreadBindings(); - } -} - -public static Object compile(Reader rdr, String sourcePath, String sourceName) throws Exception{ - if(COMPILE_PATH.deref() == null) - throw new Exception("*compile-path* not set"); - - Object EOF = new Object(); - Object ret = null; - LineNumberingPushbackReader pushbackReader = - (rdr instanceof LineNumberingPushbackReader) ? (LineNumberingPushbackReader) rdr : - new LineNumberingPushbackReader(rdr); - Var.pushThreadBindings( - RT.map(SOURCE_PATH, sourcePath, - SOURCE, sourceName, - METHOD, null, - LOCAL_ENV, null, - LOOP_LOCALS, null, - NEXT_LOCAL_NUM, 0, - RT.CURRENT_NS, RT.CURRENT_NS.deref(), - LINE_BEFORE, pushbackReader.getLineNumber(), - LINE_AFTER, pushbackReader.getLineNumber(), - CONSTANTS, PersistentVector.EMPTY, - CONSTANT_IDS, new IdentityHashMap(), - KEYWORDS, PersistentHashMap.EMPTY, - VARS, PersistentHashMap.EMPTY - // ,LOADER, RT.makeClassLoader() - )); - - try - { - //generate loader class - ObjExpr objx = new ObjExpr(null); - objx.internalName = sourcePath.replace(File.separator, "/").substring(0, sourcePath.lastIndexOf('.')) - + RT.LOADER_SUFFIX; - - objx.objtype = Type.getObjectType(objx.internalName); - ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS); - ClassVisitor cv = cw; - cv.visit(V1_5, ACC_PUBLIC + ACC_SUPER, objx.internalName, null, "java/lang/Object", null); - - //static load method - GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC, - Method.getMethod("void load ()"), - null, - null, - cv); - gen.visitCode(); - - for(Object r = LispReader.read(pushbackReader, false, EOF, false); r != EOF; - r = LispReader.read(pushbackReader, false, EOF, false)) - { - LINE_AFTER.set(pushbackReader.getLineNumber()); - compile1(gen, objx, r); - LINE_BEFORE.set(pushbackReader.getLineNumber()); - } - //end of load - gen.returnValue(); - gen.endMethod(); - - //static fields for constants - for(int i = 0; i < objx.constants.count(); i++) - { - cv.visitField(ACC_PUBLIC + ACC_FINAL + ACC_STATIC, objx.constantName(i), objx.constantType(i).getDescriptor(), - null, null); - } - - //static init for constants, keywords and vars - GeneratorAdapter clinitgen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC, - Method.getMethod("void ()"), - null, - null, - cv); - clinitgen.visitCode(); - Label startTry = clinitgen.newLabel(); - Label endTry = clinitgen.newLabel(); - Label end = clinitgen.newLabel(); - Label finallyLabel = clinitgen.newLabel(); - - if(objx.constants.count() > 0) - { - objx.emitConstants(clinitgen); - } - clinitgen.invokeStatic(Type.getType(Compiler.class), Method.getMethod("void pushNS()")); - clinitgen.mark(startTry); - clinitgen.invokeStatic(objx.objtype, Method.getMethod("void load()")); - clinitgen.mark(endTry); - clinitgen.invokeStatic(VAR_TYPE, Method.getMethod("void popThreadBindings()")); - clinitgen.goTo(end); - - clinitgen.mark(finallyLabel); - //exception should be on stack - clinitgen.invokeStatic(VAR_TYPE, Method.getMethod("void popThreadBindings()")); - clinitgen.throwException(); - clinitgen.mark(end); - clinitgen.visitTryCatchBlock(startTry, endTry, finallyLabel, null); - - //end of static init - clinitgen.returnValue(); - clinitgen.endMethod(); - - //end of class - cv.visitEnd(); - - writeClassFile(objx.internalName, cw.toByteArray()); - } - catch(LispReader.ReaderException e) - { - throw new CompilerException(sourceName, e.line, e.getCause()); - } - finally - { - Var.popThreadBindings(); - } - return ret; -} - - -static public class NewInstanceExpr extends ObjExpr{ - //IPersistentMap optionsMap = PersistentArrayMap.EMPTY; - IPersistentCollection methods; - - Map mmap; - Map> covariants; - - public NewInstanceExpr(Object tag){ - super(tag); - } - - static class DeftypeParser implements IParser{ - public Expr parse(C context, final Object frm) throws Exception{ - ISeq rform = (ISeq) frm; - //(deftype* tagname classname [fields] :implements [interfaces] :tag tagname methods*) - rform = RT.next(rform); - String tagname = ((Symbol) rform.first()).toString(); - rform = rform.next(); - Symbol classname = (Symbol) rform.first(); - rform = rform.next(); - IPersistentVector fields = (IPersistentVector) rform.first(); - rform = rform.next(); - IPersistentMap opts = PersistentHashMap.EMPTY; - while(rform != null && rform.first() instanceof Keyword) - { - opts = opts.assoc(rform.first(), RT.second(rform)); - rform = rform.next().next(); - } - - ObjExpr ret = build((IPersistentVector)RT.get(opts,implementsKey,PersistentVector.EMPTY),fields,null,tagname, classname, - (Symbol) RT.get(opts,RT.TAG_KEY),rform, frm); - return ret; - } - } - - static class ReifyParser implements IParser{ - public Expr parse(C context, Object frm) throws Exception{ - //(reify this-name? [interfaces] (method-name [args] body)*) - ISeq form = (ISeq) frm; - ObjMethod enclosingMethod = (ObjMethod) METHOD.deref(); - String basename = enclosingMethod != null ? - (trimGenID(enclosingMethod.objx.name) + "$") - : (munge(currentNS().name.name) + "$"); - String simpleName = "reify__" + RT.nextID(); - String classname = basename + simpleName; - - ISeq rform = RT.next(form); - - IPersistentVector interfaces = ((IPersistentVector) RT.first(rform)).cons(Symbol.intern("clojure.lang.IObj")); - - - rform = RT.next(rform); - - - ObjExpr ret = build(interfaces, null, null, classname, Symbol.intern(classname), null, rform, frm); - if(frm instanceof IObj && ((IObj) frm).meta() != null) - return new MetaExpr(ret, (MapExpr) MapExpr - .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) frm).meta())); - else - return ret; - } - } - - static ObjExpr build(IPersistentVector interfaceSyms, IPersistentVector fieldSyms, Symbol thisSym, - String tagName, Symbol className, - Symbol typeTag, ISeq methodForms, Object frm) throws Exception{ - NewInstanceExpr ret = new NewInstanceExpr(null); - - ret.src = frm; - ret.name = className.toString(); - ret.classMeta = RT.meta(className); - ret.internalName = ret.name.replace('.', '/'); - ret.objtype = Type.getObjectType(ret.internalName); - - if(thisSym != null) - ret.thisName = thisSym.name; - - if(fieldSyms != null) - { - IPersistentMap fmap = PersistentHashMap.EMPTY; - Object[] closesvec = new Object[2 * fieldSyms.count()]; - for(int i=0;i= 0 && ((Symbol)fieldSyms.nth(i)).name.startsWith("__");--i) - ret.altCtorDrops++; - } - //todo - set up volatiles -// ret.volatiles = PersistentHashSet.create(RT.seq(RT.get(ret.optionsMap, volatileKey))); - - PersistentVector interfaces = PersistentVector.EMPTY; - for(ISeq s = RT.seq(interfaceSyms);s!=null;s = s.next()) - { - Class c = (Class) resolve((Symbol) s.first()); - if(!c.isInterface()) - throw new IllegalArgumentException("only interfaces are supported, had: " + c.getName()); - interfaces = interfaces.cons(c); - } - Class superClass = Object.class; - Map[] mc = gatherMethods(superClass,RT.seq(interfaces)); - Map overrideables = mc[0]; - Map covariants = mc[1]; - ret.mmap = overrideables; - ret.covariants = covariants; - - String[] inames = interfaceNames(interfaces); - - Class stub = compileStub(slashname(superClass),ret, inames, frm); - Symbol thistag = Symbol.intern(null,stub.getName()); - - try - { - Var.pushThreadBindings( - RT.map(CONSTANTS, PersistentVector.EMPTY, - CONSTANT_IDS, new IdentityHashMap(), - KEYWORDS, PersistentHashMap.EMPTY, - VARS, PersistentHashMap.EMPTY, - KEYWORD_CALLSITES, PersistentVector.EMPTY, - PROTOCOL_CALLSITES, PersistentVector.EMPTY, - VAR_CALLSITES, PersistentVector.EMPTY - )); - if(ret.isDeftype()) - { - Var.pushThreadBindings(RT.map(METHOD, null, - LOCAL_ENV, ret.fields - , COMPILE_STUB_SYM, Symbol.intern(null, tagName) - , COMPILE_STUB_CLASS, stub)); - } - - //now (methodname [args] body)* - ret.line = (Integer) LINE.deref(); - IPersistentCollection methods = null; - for(ISeq s = methodForms; s != null; s = RT.next(s)) - { - NewInstanceMethod m = NewInstanceMethod.parse(ret, (ISeq) RT.first(s),thistag, overrideables); - methods = RT.conj(methods, m); - } - - - ret.methods = methods; - ret.keywords = (IPersistentMap) KEYWORDS.deref(); - ret.vars = (IPersistentMap) VARS.deref(); - ret.constants = (PersistentVector) CONSTANTS.deref(); - ret.constantsID = RT.nextID(); - ret.keywordCallsites = (IPersistentVector) KEYWORD_CALLSITES.deref(); - ret.protocolCallsites = (IPersistentVector) PROTOCOL_CALLSITES.deref(); - ret.varCallsites = (IPersistentVector) VAR_CALLSITES.deref(); - } - finally - { - if(ret.isDeftype()) - Var.popThreadBindings(); - Var.popThreadBindings(); - } - - ret.compile(slashname(superClass),inames,false); - ret.getCompiledClass(); - return ret; - } - - /*** - * Current host interop uses reflection, which requires pre-existing classes - * Work around this by: - * Generate a stub class that has the same interfaces and fields as the class we are generating. - * Use it as a type hint for this, and bind the simple name of the class to this stub (in resolve etc) - * Unmunge the name (using a magic prefix) on any code gen for classes - */ - static Class compileStub(String superName, NewInstanceExpr ret, String[] interfaceNames, Object frm){ - ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS); - ClassVisitor cv = cw; - cv.visit(V1_5, ACC_PUBLIC + ACC_SUPER, COMPILE_STUB_PREFIX + "/" + ret.internalName, - null,superName,interfaceNames); - - //instance fields for closed-overs - for(ISeq s = RT.keys(ret.closes); s != null; s = s.next()) - { - LocalBinding lb = (LocalBinding) s.first(); - int access = ACC_PUBLIC + (ret.isVolatile(lb) ? ACC_VOLATILE : - ret.isMutable(lb) ? 0 : - ACC_FINAL); - if(lb.getPrimitiveType() != null) - cv.visitField(access - , lb.name, Type.getType(lb.getPrimitiveType()).getDescriptor(), - null, null); - else - //todo - when closed-overs are fields, use more specific types here and in ctor and emitLocal? - cv.visitField(access - , lb.name, OBJECT_TYPE.getDescriptor(), null, null); - } - - //ctor that takes closed-overs and does nothing - Method m = new Method("", Type.VOID_TYPE, ret.ctorTypes()); - GeneratorAdapter ctorgen = new GeneratorAdapter(ACC_PUBLIC, - m, - null, - null, - cv); - ctorgen.visitCode(); - ctorgen.loadThis(); - ctorgen.invokeConstructor(Type.getObjectType(superName), voidctor); - ctorgen.returnValue(); - ctorgen.endMethod(); - - if(ret.altCtorDrops > 0) - { - Type[] ctorTypes = ret.ctorTypes(); - Type[] altCtorTypes = new Type[ctorTypes.length-ret.altCtorDrops]; - for(int i=0;i", Type.VOID_TYPE, altCtorTypes); - ctorgen = new GeneratorAdapter(ACC_PUBLIC, - alt, - null, - null, - cv); - ctorgen.visitCode(); - ctorgen.loadThis(); - ctorgen.loadArgs(); - for(int i=0;i", Type.VOID_TYPE, ctorTypes)); - - ctorgen.returnValue(); - ctorgen.endMethod(); - } - //end of class - cv.visitEnd(); - - byte[] bytecode = cw.toByteArray(); - DynamicClassLoader loader = (DynamicClassLoader) LOADER.deref(); - return loader.defineClass(COMPILE_STUB_PREFIX + "." + ret.name, bytecode, frm); - } - - static String[] interfaceNames(IPersistentVector interfaces){ - int icnt = interfaces.count(); - String[] inames = icnt > 0 ? new String[icnt] : null; - for(int i=0;i> e : covariants.entrySet()) - { - java.lang.reflect.Method m = mmap.get(e.getKey()); - Class[] params = m.getParameterTypes(); - Type[] argTypes = new Type[params.length]; - - for(int i = 0; i < params.length; i++) - { - argTypes[i] = Type.getType(params[i]); - } - - Method target = new Method(m.getName(), Type.getType(m.getReturnType()), argTypes); - - for(Class retType : e.getValue()) - { - Method meth = new Method(m.getName(), Type.getType(retType), argTypes); - - GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC + ACC_BRIDGE, - meth, - null, - //todo don't hardwire this - EXCEPTION_TYPES, - cv); - gen.visitCode(); - gen.loadThis(); - gen.loadArgs(); - gen.invokeInterface(Type.getType(m.getDeclaringClass()),target); - gen.returnValue(); - gen.endMethod(); - } - } - } - - static public IPersistentVector msig(java.lang.reflect.Method m){ - return RT.vector(m.getName(), RT.seq(m.getParameterTypes()),m.getReturnType()); - } - - static void considerMethod(java.lang.reflect.Method m, Map mm){ - IPersistentVector mk = msig(m); - int mods = m.getModifiers(); - - if(!(mm.containsKey(mk) - || !(Modifier.isPublic(mods) || Modifier.isProtected(mods)) - || Modifier.isStatic(mods) - || Modifier.isFinal(mods))) - { - mm.put(mk, m); - } - } - - static void gatherMethods(Class c, Map mm){ - for(; c != null; c = c.getSuperclass()) - { - for(java.lang.reflect.Method m : c.getDeclaredMethods()) - considerMethod(m, mm); - for(java.lang.reflect.Method m : c.getMethods()) - considerMethod(m, mm); - } - } - - static public Map[] gatherMethods(Class sc, ISeq interfaces){ - Map allm = new HashMap(); - gatherMethods(sc, allm); - for(; interfaces != null; interfaces = interfaces.next()) - gatherMethods((Class) interfaces.first(), allm); - - Map mm = new HashMap(); - Map> covariants = new HashMap>(); - for(Object o : allm.entrySet()) - { - Map.Entry e = (Map.Entry) o; - IPersistentVector mk = (IPersistentVector) e.getKey(); - mk = (IPersistentVector) mk.pop(); - java.lang.reflect.Method m = (java.lang.reflect.Method) e.getValue(); - if(mm.containsKey(mk)) //covariant return - { - Set cvs = covariants.get(mk); - if(cvs == null) - { - cvs = new HashSet(); - covariants.put(mk,cvs); - } - java.lang.reflect.Method om = mm.get(mk); - if(om.getReturnType().isAssignableFrom(m.getReturnType())) - { - cvs.add(om.getReturnType()); - mm.put(mk, m); - } - else - cvs.add(m.getReturnType()); - } - else - mm.put(mk, m); - } - return new Map[]{mm,covariants}; - } -} - -public static class NewInstanceMethod extends ObjMethod{ - String name; - Type[] argTypes; - Type retType; - Class retClass; - Class[] exclasses; - - static Symbol dummyThis = Symbol.intern(null,"dummy_this_dlskjsdfower"); - private IPersistentVector parms; - - public NewInstanceMethod(ObjExpr objx, ObjMethod parent){ - super(objx, parent); - } - - int numParams(){ - return argLocals.count(); - } - - String getMethodName(){ - return name; - } - - Type getReturnType(){ - return retType; - } - - Type[] getArgTypes(){ - return argTypes; - } - - - - static public IPersistentVector msig(String name,Class[] paramTypes){ - return RT.vector(name,RT.seq(paramTypes)); - } - - static NewInstanceMethod parse(ObjExpr objx, ISeq form, Symbol thistag, - Map overrideables) throws Exception{ - //(methodname [this-name args*] body...) - //this-name might be nil - NewInstanceMethod method = new NewInstanceMethod(objx, (ObjMethod) METHOD.deref()); - Symbol dotname = (Symbol)RT.first(form); - Symbol name = (Symbol) Symbol.intern(null,munge(dotname.name)).withMeta(RT.meta(dotname)); - IPersistentVector parms = (IPersistentVector) RT.second(form); - if(parms.count() == 0) - { - throw new IllegalArgumentException("Must supply at least one argument for 'this' in: " + dotname); - } - Symbol thisName = (Symbol) parms.nth(0); - parms = RT.subvec(parms,1,parms.count()); - ISeq body = RT.next(RT.next(form)); - try - { - method.line = (Integer) LINE.deref(); - //register as the current method and set up a new env frame - PathNode pnode = new PathNode(PATHTYPE.PATH, (PathNode) CLEAR_PATH.get()); - Var.pushThreadBindings( - RT.map( - METHOD, method, - LOCAL_ENV, LOCAL_ENV.deref(), - LOOP_LOCALS, null, - NEXT_LOCAL_NUM, 0 - ,CLEAR_PATH, pnode - ,CLEAR_ROOT, pnode - ,CLEAR_SITES, PersistentHashMap.EMPTY - )); - - //register 'this' as local 0 - if(thisName != null) - registerLocal((thisName == null) ? dummyThis:thisName,thistag, null,false); - else - getAndIncLocalNum(); - - PersistentVector argLocals = PersistentVector.EMPTY; - method.retClass = tagClass(tagOf(name)); - method.argTypes = new Type[parms.count()]; - boolean hinted = tagOf(name) != null; - Class[] pclasses = new Class[parms.count()]; - Symbol[] psyms = new Symbol[parms.count()]; - - for(int i = 0; i < parms.count(); i++) - { - if(!(parms.nth(i) instanceof Symbol)) - throw new IllegalArgumentException("params must be Symbols"); - Symbol p = (Symbol) parms.nth(i); - Object tag = tagOf(p); - if(tag != null) - hinted = true; - if(p.getNamespace() != null) - p = Symbol.create(p.name); - Class pclass = tagClass(tag); - pclasses[i] = pclass; - psyms[i] = p; - } - Map matches = findMethodsWithNameAndArity(name.name, parms.count(), overrideables); - Object mk = msig(name.name, pclasses); - java.lang.reflect.Method m = null; - if(matches.size() > 0) - { - //multiple methods - if(matches.size() > 1) - { - //must be hinted and match one method - if(!hinted) - throw new IllegalArgumentException("Must hint overloaded method: " + name.name); - m = (java.lang.reflect.Method) matches.get(mk); - if(m == null) - throw new IllegalArgumentException("Can't find matching overloaded method: " + name.name); - if(m.getReturnType() != method.retClass) - throw new IllegalArgumentException("Mismatched return type: " + name.name + - ", expected: " + m.getReturnType().getName() + ", had: " + method.retClass.getName()); - } - else //one match - { - //if hinted, validate match, - if(hinted) - { - m = (java.lang.reflect.Method) matches.get(mk); - if(m == null) - throw new IllegalArgumentException("Can't find matching method: " + name.name + - ", leave off hints for auto match."); - if(m.getReturnType() != method.retClass) - throw new IllegalArgumentException("Mismatched return type: " + name.name + - ", expected: " + m.getReturnType().getName() + ", had: " + method.retClass.getName()); - } - else //adopt found method sig - { - m = (java.lang.reflect.Method) matches.values().iterator().next(); - method.retClass = m.getReturnType(); - pclasses = m.getParameterTypes(); - } - } - } -// else if(findMethodsWithName(name.name,allmethods).size()>0) -// throw new IllegalArgumentException("Can't override/overload method: " + name.name); - else - throw new IllegalArgumentException("Can't define method not in interfaces: " + name.name); - - //else - //validate unque name+arity among additional methods - - method.retType = Type.getType(method.retClass); - method.exclasses = m.getExceptionTypes(); - - for(int i = 0; i < parms.count(); i++) - { - LocalBinding lb = registerLocal(psyms[i], null, new MethodParamExpr(pclasses[i]),true); - argLocals = argLocals.assocN(i,lb); - method.argTypes[i] = Type.getType(pclasses[i]); - } - for(int i = 0; i < parms.count(); i++) - { - if(pclasses[i] == long.class || pclasses[i] == double.class) - getAndIncLocalNum(); - } - LOOP_LOCALS.set(argLocals); - method.name = name.name; - method.methodMeta = RT.meta(name); - method.parms = parms; - method.argLocals = argLocals; - method.body = (new BodyExpr.Parser()).parse(C.RETURN, body); - return method; - } - finally - { - Var.popThreadBindings(); - } - } - - private static Map findMethodsWithNameAndArity(String name, int arity, Map mm){ - Map ret = new HashMap(); - for(Object o : mm.entrySet()) - { - Map.Entry e = (Map.Entry) o; - java.lang.reflect.Method m = (java.lang.reflect.Method) e.getValue(); - if(name.equals(m.getName()) && m.getParameterTypes().length == arity) - ret.put(e.getKey(), e.getValue()); - } - return ret; - } - - private static Map findMethodsWithName(String name, Map mm){ - Map ret = new HashMap(); - for(Object o : mm.entrySet()) - { - Map.Entry e = (Map.Entry) o; - java.lang.reflect.Method m = (java.lang.reflect.Method) e.getValue(); - if(name.equals(m.getName())) - ret.put(e.getKey(), e.getValue()); - } - return ret; - } - - public void emit(ObjExpr obj, ClassVisitor cv){ - Method m = new Method(getMethodName(), getReturnType(), getArgTypes()); - - Type[] extypes = null; - if(exclasses.length > 0) - { - extypes = new Type[exclasses.length]; - for(int i=0;i tests; - public final HashMap thens; - public final boolean allKeywords; - - public final int line; - - final static Method hashMethod = Method.getMethod("int hash(Object)"); - final static Method hashCodeMethod = Method.getMethod("int hashCode()"); - final static Method equalsMethod = Method.getMethod("boolean equals(Object, Object)"); - - - public CaseExpr(int line, LocalBindingExpr expr, int shift, int mask, int low, int high, Expr defaultExpr, - HashMap tests,HashMap thens, boolean allKeywords){ - this.expr = expr; - this.shift = shift; - this.mask = mask; - this.low = low; - this.high = high; - this.defaultExpr = defaultExpr; - this.tests = tests; - this.thens = thens; - this.line = line; - this.allKeywords = allKeywords; - } - - public Object eval() throws Exception{ - throw new UnsupportedOperationException("Can't eval case"); - } - - public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ - Label defaultLabel = gen.newLabel(); - Label endLabel = gen.newLabel(); - HashMap labels = new HashMap(); - - for(Integer i : tests.keySet()) - { - labels.put(i, gen.newLabel()); - } - - Label[] la = new Label[(high-low)+1]; - - for(int i=low;i<=high;i++) - { - la[i-low] = labels.containsKey(i) ? labels.get(i) : defaultLabel; - } - - gen.visitLineNumber(line, gen.mark()); - expr.emit(C.EXPRESSION, objx, gen); - gen.invokeStatic(UTIL_TYPE,hashMethod); - gen.push(shift); - gen.visitInsn(ISHR); - gen.push(mask); - gen.visitInsn(IAND); - gen.visitTableSwitchInsn(low, high, defaultLabel, la); - - for(Integer i : labels.keySet()) - { - gen.mark(labels.get(i)); - expr.emit(C.EXPRESSION, objx, gen); - tests.get(i).emit(C.EXPRESSION, objx, gen); - if(allKeywords) - { - gen.visitJumpInsn(IF_ACMPNE, defaultLabel); - } - else - { - gen.invokeStatic(UTIL_TYPE, equalsMethod); - gen.ifZCmp(GeneratorAdapter.EQ, defaultLabel); - } - thens.get(i).emit(C.EXPRESSION,objx,gen); - gen.goTo(endLabel); - } - - gen.mark(defaultLabel); - defaultExpr.emit(C.EXPRESSION, objx, gen); - gen.mark(endLabel); - if(context == C.STATEMENT) - gen.pop(); - } - - static class Parser implements IParser{ - //(case* expr shift mask low high default map identity?) - //prepared by case macro and presumed correct - //case macro binds actual expr in let so expr is always a local, - //no need to worry about multiple evaluation - public Expr parse(C context, Object frm) throws Exception{ - ISeq form = (ISeq) frm; - if(context == C.EVAL) - return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); - PersistentVector args = PersistentVector.create(form.next()); - HashMap tests = new HashMap(); - HashMap thens = new HashMap(); - - LocalBindingExpr testexpr = (LocalBindingExpr) analyze(C.EXPRESSION, args.nth(0)); - testexpr.shouldClear = false; - - PathNode branch = new PathNode(PATHTYPE.BRANCH, (PathNode) CLEAR_PATH.get()); - for(Object o : ((Map)args.nth(6)).entrySet()) - { - Map.Entry e = (Map.Entry) o; - Integer minhash = (Integer) e.getKey(); - MapEntry me = (MapEntry) e.getValue(); - Expr testExpr = new ConstantExpr(me.getKey()); - tests.put(minhash, testExpr); - Expr thenExpr; - try { - Var.pushThreadBindings( - RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch))); - thenExpr = analyze(context, me.getValue()); - } - finally{ - Var.popThreadBindings(); - } - thens.put(minhash, thenExpr); - } - - Expr defaultExpr; - try { - Var.pushThreadBindings( - RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch))); - defaultExpr = analyze(context, args.nth(5)); - } - finally{ - Var.popThreadBindings(); - } - - return new CaseExpr((Integer) LINE.deref(), - testexpr, - (Integer)args.nth(1), - (Integer)args.nth(2), - (Integer)args.nth(3), - (Integer)args.nth(4), - defaultExpr, - tests,thens,args.nth(7) != RT.F); - - } - } -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Cons.java --- a/src/clojure/lang/Cons.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 25, 2006 11:01:29 AM */ - -package clojure.lang; - -import java.io.Serializable; - -final public class Cons extends ASeq implements Serializable { - -private final Object _first; -private final ISeq _more; - -public Cons(Object first, ISeq _more){ - this._first = first; - this._more = _more; -} - - -public Cons(IPersistentMap meta, Object _first, ISeq _more){ - super(meta); - this._first = _first; - this._more = _more; -} - -public Object first(){ - return _first; -} - -public ISeq next(){ - return more().seq(); -} - -public ISeq more(){ - if(_more == null) - return PersistentList.EMPTY; - return _more; -} - -public int count(){ - return 1 + RT.count(_more); -} - -public Cons withMeta(IPersistentMap meta){ - return new Cons(meta, _first, _more); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Counted.java --- a/src/clojure/lang/Counted.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -package clojure.lang; - -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ - -/* A class that implements Counted promises that it is a collection - * that implement a constant-time count() */ - -public interface Counted { - int count(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Delay.java --- a/src/clojure/lang/Delay.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jun 28, 2007 */ - -package clojure.lang; - -public class Delay implements IDeref{ -Object val; -IFn fn; - -public Delay(IFn fn){ - this.fn = fn; - this.val = null; -} - -static public Object force(Object x) throws Exception{ - return (x instanceof Delay) ? - ((Delay) x).deref() - : x; -} - -synchronized public Object deref() throws Exception{ - if(fn != null) - { - val = fn.invoke(); - fn = null; - } - return val; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/DynamicClassLoader.java --- a/src/clojure/lang/DynamicClassLoader.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,73 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Aug 21, 2007 */ - -package clojure.lang; - -import java.util.HashMap; -import java.util.Map; -import java.util.concurrent.ConcurrentHashMap; -import java.net.URLClassLoader; -import java.net.URL; -import java.lang.ref.ReferenceQueue; -import java.lang.ref.SoftReference; - -public class DynamicClassLoader extends URLClassLoader{ -HashMap constantVals = new HashMap(); -static ConcurrentHashMap>classCache = - new ConcurrentHashMap >(); - -static final URL[] EMPTY_URLS = new URL[]{}; - -static final ReferenceQueue rq = new ReferenceQueue(); - -public DynamicClassLoader(){ - //pseudo test in lieu of hasContextClassLoader() - super(EMPTY_URLS,(Thread.currentThread().getContextClassLoader() == null || - Thread.currentThread().getContextClassLoader() == ClassLoader.getSystemClassLoader())? - Compiler.class.getClassLoader():Thread.currentThread().getContextClassLoader()); -} - -public DynamicClassLoader(ClassLoader parent){ - super(EMPTY_URLS,parent); -} - -public Class defineClass(String name, byte[] bytes, Object srcForm){ - Util.clearCache(rq, classCache); - Class c = defineClass(name, bytes, 0, bytes.length); - classCache.put(name, new SoftReference(c,rq)); - return c; -} - -protected Class findClass(String name) throws ClassNotFoundException{ - SoftReference cr = classCache.get(name); - if(cr != null) - { - Class c = cr.get(); - if(c != null) - return c; - } - return super.findClass(name); -} - -public void registerConstants(int id, Object[] val){ - constantVals.put(id, val); -} - -public Object[] getConstants(int id){ - return constantVals.get(id); -} - -public void addURL(URL url){ - super.addURL(url); -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/EnumerationSeq.java --- a/src/clojure/lang/EnumerationSeq.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,78 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 3, 2008 */ - -package clojure.lang; - -import java.io.IOException; -import java.io.NotSerializableException; -import java.util.Enumeration; - -public class EnumerationSeq extends ASeq{ -final Enumeration iter; -final State state; - - static class State{ - volatile Object val; - volatile Object _rest; -} - -public static EnumerationSeq create(Enumeration iter){ - if(iter.hasMoreElements()) - return new EnumerationSeq(iter); - return null; -} - -EnumerationSeq(Enumeration iter){ - this.iter = iter; - state = new State(); - this.state.val = state; - this.state._rest = state; -} - -EnumerationSeq(IPersistentMap meta, Enumeration iter, State state){ - super(meta); - this.iter = iter; - this.state = state; -} - -public Object first(){ - if(state.val == state) - synchronized(state) - { - if(state.val == state) - state.val = iter.nextElement(); - } - return state.val; -} - -public ISeq next(){ - if(state._rest == state) - synchronized(state) - { - if(state._rest == state) - { - first(); - state._rest = create(iter); - } - } - return (ISeq) state._rest; -} - -public EnumerationSeq withMeta(IPersistentMap meta){ - return new EnumerationSeq(meta, iter, state); -} - -private void writeObject (java.io.ObjectOutputStream out) throws IOException { - throw new NotSerializableException(getClass().getName()); -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Fn.java --- a/src/clojure/lang/Fn.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Nov 25, 2008 */ - -package clojure.lang; - -public interface Fn{ -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IChunk.java --- a/src/clojure/lang/IChunk.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jun 18, 2009 */ - -package clojure.lang; - -public interface IChunk extends Indexed{ - -IChunk dropFirst(); - -Object reduce(IFn f, Object start) throws Exception; -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IChunkedSeq.java --- a/src/clojure/lang/IChunkedSeq.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,23 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich May 24, 2009 */ - -package clojure.lang; - -public interface IChunkedSeq extends ISeq{ - -IChunk chunkedFirst() throws Exception; - -ISeq chunkedNext() throws Exception; - -ISeq chunkedMore() throws Exception; - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IDeref.java --- a/src/clojure/lang/IDeref.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Feb 9, 2009 */ - -package clojure.lang; - -public interface IDeref{ -Object deref() throws Exception; -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IEditableCollection.java --- a/src/clojure/lang/IEditableCollection.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jul 17, 2009 */ - -package clojure.lang; - -public interface IEditableCollection{ -ITransientCollection asTransient(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IFn.java --- a/src/clojure/lang/IFn.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,90 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 25, 2006 3:54:03 PM */ - -package clojure.lang; - -import java.util.concurrent.Callable; - -public interface IFn extends Callable, Runnable{ - -public Object invoke() throws Exception; - -public Object invoke(Object arg1) throws Exception; - -public Object invoke(Object arg1, Object arg2) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) - throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) - throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) - throws Exception; - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, - Object... args) - throws Exception; - -public Object applyTo(ISeq arglist) throws Exception; -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IKeywordLookup.java --- a/src/clojure/lang/IKeywordLookup.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Oct 31, 2009 */ - -package clojure.lang; - -public interface IKeywordLookup{ -ILookupThunk getLookupThunk(Keyword k); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ILookup.java --- a/src/clojure/lang/ILookup.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Aug 2, 2009 */ - -package clojure.lang; - -public interface ILookup{ -Object valAt(Object key); - -Object valAt(Object key, Object notFound); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ILookupHost.java --- a/src/clojure/lang/ILookupHost.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Nov 2, 2009 */ - -package clojure.lang; - -public interface ILookupHost{ - -void swapThunk(int n, ILookupThunk thunk); - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ILookupSite.java --- a/src/clojure/lang/ILookupSite.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Nov 2, 2009 */ - -package clojure.lang; - -public interface ILookupSite{ - -Object fault(Object target, ILookupHost host); - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ILookupThunk.java --- a/src/clojure/lang/ILookupThunk.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Nov 2, 2009 */ - -package clojure.lang; - -public interface ILookupThunk{ - -Object get(Object target); - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IMapEntry.java --- a/src/clojure/lang/IMapEntry.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ - -package clojure.lang; - -import java.util.Map; - -public interface IMapEntry extends Map.Entry{ -Object key(); - -Object val(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IMeta.java --- a/src/clojure/lang/IMeta.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Dec 31, 2008 */ - -package clojure.lang; - -public interface IMeta { - IPersistentMap meta(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IObj.java --- a/src/clojure/lang/IObj.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - - -public interface IObj extends IMeta { - - public IObj withMeta(IPersistentMap meta); - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IPersistentCollection.java --- a/src/clojure/lang/IPersistentCollection.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,23 +0,0 @@ -package clojure.lang; - -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ - - -public interface IPersistentCollection extends Seqable { - -int count(); - -IPersistentCollection cons(Object o); - -IPersistentCollection empty(); - -boolean equiv(Object o); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IPersistentList.java --- a/src/clojure/lang/IPersistentList.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ - -package clojure.lang; - - -public interface IPersistentList extends Sequential, IPersistentStack{ - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IPersistentMap.java --- a/src/clojure/lang/IPersistentMap.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,23 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ - -package clojure.lang; - - -public interface IPersistentMap extends Iterable, Associative, Counted{ - - -IPersistentMap assoc(Object key, Object val); - -IPersistentMap assocEx(Object key, Object val) throws Exception; - -IPersistentMap without(Object key) throws Exception; - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IPersistentSet.java --- a/src/clojure/lang/IPersistentSet.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 3, 2008 */ - -package clojure.lang; - -public interface IPersistentSet extends IPersistentCollection, Counted{ - public IPersistentSet disjoin(Object key) throws Exception; - public boolean contains(Object key); - public Object get(Object key); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IPersistentStack.java --- a/src/clojure/lang/IPersistentStack.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Sep 19, 2007 */ - -package clojure.lang; - -public interface IPersistentStack extends IPersistentCollection{ -Object peek(); - -IPersistentStack pop(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IPersistentVector.java --- a/src/clojure/lang/IPersistentVector.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -package clojure.lang; - -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ - -public interface IPersistentVector extends Associative, Sequential, IPersistentStack, Reversible, Indexed{ -int length(); - -IPersistentVector assocN(int i, Object val); - -IPersistentVector cons(Object o); - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IProxy.java --- a/src/clojure/lang/IProxy.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,21 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Feb 27, 2008 */ - -package clojure.lang; - -public interface IProxy{ - - public void __initClojureFnMappings(IPersistentMap m); - public void __updateClojureFnMappings(IPersistentMap m); - public IPersistentMap __getClojureFnMappings(); - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IReduce.java --- a/src/clojure/lang/IReduce.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jun 11, 2008 */ - -package clojure.lang; - -public interface IReduce{ -Object reduce(IFn f) throws Exception; - -Object reduce(IFn f, Object start) throws Exception; -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IRef.java --- a/src/clojure/lang/IRef.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,27 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Nov 18, 2007 */ - -package clojure.lang; - -public interface IRef extends IDeref{ - - void setValidator(IFn vf); - - IFn getValidator(); - - IPersistentMap getWatches(); - - IRef addWatch(Object key, IFn callback); - - IRef removeWatch(Object key); - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IReference.java --- a/src/clojure/lang/IReference.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Dec 31, 2008 */ - -package clojure.lang; - -public interface IReference extends IMeta { - IPersistentMap alterMeta(IFn alter, ISeq args) throws Exception; - IPersistentMap resetMeta(IPersistentMap m); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ISeq.java --- a/src/clojure/lang/ISeq.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,29 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ - -package clojure.lang; - -/** - * A persistent, functional, sequence interface - *

- * ISeqs are immutable values, i.e. neither first(), nor rest() changes - * or invalidates the ISeq - */ -public interface ISeq extends IPersistentCollection, Sequential{ - -Object first(); - -ISeq next(); - -ISeq more(); - -ISeq cons(Object o); - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ITransientAssociative.java --- a/src/clojure/lang/ITransientAssociative.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jul 17, 2009 */ - -package clojure.lang; - -public interface ITransientAssociative extends ITransientCollection, ILookup{ - -ITransientAssociative assoc(Object key, Object val); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ITransientCollection.java --- a/src/clojure/lang/ITransientCollection.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jul 17, 2009 */ - -package clojure.lang; - -public interface ITransientCollection{ - -ITransientCollection conj(Object val); - -IPersistentCollection persistent(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ITransientMap.java --- a/src/clojure/lang/ITransientMap.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jul 17, 2009 */ - -package clojure.lang; - -public interface ITransientMap extends ITransientAssociative, Counted{ - -ITransientMap assoc(Object key, Object val); - -ITransientMap without(Object key); - -IPersistentMap persistent(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ITransientSet.java --- a/src/clojure/lang/ITransientSet.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 3, 2008 */ - -package clojure.lang; - -public interface ITransientSet extends ITransientCollection, Counted{ - public ITransientSet disjoin(Object key) throws Exception; - public boolean contains(Object key); - public Object get(Object key); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ITransientVector.java --- a/src/clojure/lang/ITransientVector.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jul 17, 2009 */ - -package clojure.lang; - -public interface ITransientVector extends ITransientAssociative, Indexed{ - -ITransientVector assocN(int i, Object val); - -ITransientVector pop(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Indexed.java --- a/src/clojure/lang/Indexed.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich May 24, 2009 */ - -package clojure.lang; - -public interface Indexed extends Counted{ -Object nth(int i); - -Object nth(int i, Object notFound); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IndexedSeq.java --- a/src/clojure/lang/IndexedSeq.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ - -package clojure.lang; - -public interface IndexedSeq extends ISeq, Counted{ - -public int index(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/IteratorSeq.java --- a/src/clojure/lang/IteratorSeq.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,75 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -import java.io.IOException; -import java.io.NotSerializableException; -import java.util.Iterator; - -public class IteratorSeq extends ASeq{ -final Iterator iter; -final State state; - - static class State{ - volatile Object val; - volatile Object _rest; -} - -public static IteratorSeq create(Iterator iter){ - if(iter.hasNext()) - return new IteratorSeq(iter); - return null; -} - -IteratorSeq(Iterator iter){ - this.iter = iter; - state = new State(); - this.state.val = state; - this.state._rest = state; -} - -IteratorSeq(IPersistentMap meta, Iterator iter, State state){ - super(meta); - this.iter = iter; - this.state = state; -} - -public Object first(){ - if(state.val == state) - synchronized(state) - { - if(state.val == state) - state.val = iter.next(); - } - return state.val; -} - -public ISeq next(){ - if(state._rest == state) - synchronized(state) - { - if(state._rest == state) - { - first(); - state._rest = create(iter); - } - } - return (ISeq) state._rest; -} - -public IteratorSeq withMeta(IPersistentMap meta){ - return new IteratorSeq(meta, iter, state); -} - -private void writeObject (java.io.ObjectOutputStream out) throws IOException { - throw new NotSerializableException(getClass().getName()); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Keyword.java --- a/src/clojure/lang/Keyword.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,225 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 29, 2006 10:39:05 AM */ - -package clojure.lang; - -import java.io.ObjectStreamException; -import java.io.Serializable; -import java.util.concurrent.ConcurrentHashMap; -import java.lang.ref.ReferenceQueue; -import java.lang.ref.SoftReference; - - -public final class Keyword implements IFn, Comparable, Named, Serializable { - -private static ConcurrentHashMap> table = new ConcurrentHashMap(); -static final ReferenceQueue rq = new ReferenceQueue(); -public final Symbol sym; -final int hash; - -public static Keyword intern(Symbol sym){ - Util.clearCache(rq, table); - Keyword k = new Keyword(sym); - SoftReference existingRef = table.putIfAbsent(sym, new SoftReference(k,rq)); - if(existingRef == null) - return k; - Keyword existingk = existingRef.get(); - if(existingk != null) - return existingk; - //entry died in the interim, do over - return intern(sym); -} - -public static Keyword intern(String ns, String name){ - return intern(Symbol.intern(ns, name)); -} - -public static Keyword intern(String nsname){ - return intern(Symbol.intern(nsname)); -} - -private Keyword(Symbol sym){ - this.sym = sym; - hash = sym.hashCode() + 0x9e3779b9; -} - -public final int hashCode(){ - return hash; -} - -public String toString(){ - return ":" + sym; -} - -public Object throwArity(){ - throw new IllegalArgumentException("Wrong number of args passed to keyword: " - + toString()); -} - -public Object call() throws Exception{ - return throwArity(); -} - -public void run(){ - throw new UnsupportedOperationException(); -} - -public Object invoke() throws Exception{ - return throwArity(); -} - -public int compareTo(Object o){ - return sym.compareTo(((Keyword) o).sym); -} - - -public String getNamespace(){ - return sym.getNamespace(); -} - -public String getName(){ - return sym.getName(); -} - -private Object readResolve() throws ObjectStreamException{ - return intern(sym); -} - -/** - * Indexer implements IFn for attr access - * - * @param obj - must be IPersistentMap - * @return the value at the key or nil if not found - * @throws Exception - */ -final public Object invoke(Object obj) throws Exception{ - if(obj instanceof ILookup) - return ((ILookup)obj).valAt(this); - return RT.get(obj, this); -} - -final public Object invoke(Object obj, Object notFound) throws Exception{ - if(obj instanceof ILookup) - return ((ILookup)obj).valAt(this,notFound); - return RT.get(obj, this, notFound); -} - -public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) - throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) - throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) - throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) - throws Exception{ - return throwArity(); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, - Object... args) - throws Exception{ - return throwArity(); -} - - -public Object applyTo(ISeq arglist) throws Exception{ - return AFn.applyToHelper(this, arglist); -} - - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/KeywordLookupSite.java --- a/src/clojure/lang/KeywordLookupSite.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,65 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Nov 2, 2009 */ - -package clojure.lang; - -public final class KeywordLookupSite implements ILookupSite, ILookupThunk{ - -final int n; -final Keyword k; - -public KeywordLookupSite(int n, Keyword k){ - this.n = n; - this.k = k; -} - -public Object fault(Object target, ILookupHost host){ - if(target instanceof IKeywordLookup) - { - return install(target, host); - } - else if(target instanceof ILookup) - { - host.swapThunk(n,ilookupThunk(target.getClass())); - return ((ILookup) target).valAt(k); - } - host.swapThunk(n,this); - return RT.get(target, k); -} - -public Object get(Object target){ - if(target instanceof IKeywordLookup || target instanceof ILookup) - return this; - return RT.get(target,k); -} - -private ILookupThunk ilookupThunk(final Class c){ - return new ILookupThunk(){ - public Object get(Object target){ - if(target != null && target.getClass() == c) - return ((ILookup) target).valAt(k); - return this; - } - }; -} - -private Object install(Object target, ILookupHost host){ - ILookupThunk t = ((IKeywordLookup)target).getLookupThunk(k); - if(t != null) - { - host.swapThunk(n,t); - return t.get(target); - } - host.swapThunk(n,ilookupThunk(target.getClass())); - return ((ILookup) target).valAt(k); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/LazilyPersistentVector.java --- a/src/clojure/lang/LazilyPersistentVector.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich May 14, 2008 */ - -package clojure.lang; - -import java.util.Collection; - -public class LazilyPersistentVector{ - - -static public IPersistentVector createOwning(Object... items){ - if(items.length == 0) - return PersistentVector.EMPTY; - else if(items.length <= 32) - return new PersistentVector(items.length, 5, PersistentVector.EMPTY_NODE,items); - return PersistentVector.create(items); -} - -static public IPersistentVector create(Collection coll){ - if(!(coll instanceof ISeq) && coll.size() <= 32) - return createOwning(coll.toArray()); - return PersistentVector.create(RT.seq(coll)); -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/LazySeq.java --- a/src/clojure/lang/LazySeq.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,251 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jan 31, 2009 */ - -package clojure.lang; - -import java.util.*; - -public final class LazySeq extends Obj implements ISeq, List{ - -private IFn fn; -private Object sv; -private ISeq s; - -public LazySeq(IFn fn){ - this.fn = fn; -} - -private LazySeq(IPersistentMap meta, ISeq s){ - super(meta); - this.fn = null; - this.s = s; -} - -public Obj withMeta(IPersistentMap meta){ - return new LazySeq(meta, seq()); -} - -final synchronized Object sval(){ - if(fn != null) - { - try - { - sv = fn.invoke(); - fn = null; - } - catch(Exception e) - { - throw new RuntimeException(e); - } - } - if(sv != null) - return sv; - return s; -} - -final synchronized public ISeq seq(){ - sval(); - if(sv != null) - { - Object ls = sv; - sv = null; - while(ls instanceof LazySeq) - { - ls = ((LazySeq)ls).sval(); - } - s = RT.seq(ls); - } - return s; -} - -public int count(){ - int c = 0; - for(ISeq s = seq(); s != null; s = s.next()) - ++c; - return c; -} - -public Object first(){ - seq(); - if(s == null) - return null; - return s.first(); -} - -public ISeq next(){ - seq(); - if(s == null) - return null; - return s.next(); -} - -public ISeq more(){ - seq(); - if(s == null) - return PersistentList.EMPTY; - return s.more(); -} - -public ISeq cons(Object o){ - return RT.cons(o, seq()); -} - -public IPersistentCollection empty(){ - return PersistentList.EMPTY; -} - -public boolean equiv(Object o){ - return equals(o); -} - -public int hashCode(){ - return Util.hash(seq()); -} - -public boolean equals(Object o){ - ISeq s = seq(); - if(s != null) - return s.equiv(o); - else - return (o instanceof Sequential || o instanceof List) && RT.seq(o) == null; -} - - -// java.util.Collection implementation - -public Object[] toArray(){ - return RT.seqToArray(seq()); -} - -public boolean add(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean remove(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean addAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public void clear(){ - throw new UnsupportedOperationException(); -} - -public boolean retainAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean removeAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean containsAll(Collection c){ - for(Object o : c) - { - if(!contains(o)) - return false; - } - return true; -} - -public Object[] toArray(Object[] a){ - if(a.length >= count()) - { - ISeq s = seq(); - for(int i = 0; s != null; ++i, s = s.next()) - { - a[i] = s.first(); - } - if(a.length > count()) - a[count()] = null; - return a; - } - else - return toArray(); -} - -public int size(){ - return count(); -} - -public boolean isEmpty(){ - return seq() == null; -} - -public boolean contains(Object o){ - for(ISeq s = seq(); s != null; s = s.next()) - { - if(Util.equiv(s.first(), o)) - return true; - } - return false; -} - -public Iterator iterator(){ - return new SeqIterator(seq()); -} - -//////////// List stuff ///////////////// -private List reify(){ - return new ArrayList(this); -} - -public List subList(int fromIndex, int toIndex){ - return reify().subList(fromIndex, toIndex); -} - -public Object set(int index, Object element){ - throw new UnsupportedOperationException(); -} - -public Object remove(int index){ - throw new UnsupportedOperationException(); -} - -public int indexOf(Object o){ - ISeq s = seq(); - for(int i = 0; s != null; s = s.next(), i++) - { - if(Util.equiv(s.first(), o)) - return i; - } - return -1; -} - -public int lastIndexOf(Object o){ - return reify().lastIndexOf(o); -} - -public ListIterator listIterator(){ - return reify().listIterator(); -} - -public ListIterator listIterator(int index){ - return reify().listIterator(index); -} - -public Object get(int index){ - return RT.nth(this, index); -} - -public void add(int index, Object element){ - throw new UnsupportedOperationException(); -} - -public boolean addAll(int index, Collection c){ - throw new UnsupportedOperationException(); -} - - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/LineNumberingPushbackReader.java --- a/src/clojure/lang/LineNumberingPushbackReader.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,75 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ - -package clojure.lang; - -import java.io.PushbackReader; -import java.io.Reader; -import java.io.LineNumberReader; -import java.io.IOException; - - -public class LineNumberingPushbackReader extends PushbackReader{ - -// This class is a PushbackReader that wraps a LineNumberReader. The code -// here to handle line terminators only mentions '\n' because -// LineNumberReader collapses all occurrences of CR, LF, and CRLF into a -// single '\n'. - -private static final int newline = (int) '\n'; - -private boolean _atLineStart = true; -private boolean _prev; - -public LineNumberingPushbackReader(Reader r){ - super(new LineNumberReader(r)); -} - -public int getLineNumber(){ - return ((LineNumberReader) in).getLineNumber() + 1; -} - -public int read() throws IOException{ - int c = super.read(); - _prev = _atLineStart; - _atLineStart = (c == newline) || (c == -1); - return c; -} - -public void unread(int c) throws IOException{ - super.unread(c); - _atLineStart = _prev; -} - -public String readLine() throws IOException{ - int c = read(); - String line; - switch (c) { - case -1: - line = null; - break; - case newline: - line = ""; - break; - default: - String first = String.valueOf((char) c); - String rest = ((LineNumberReader)in).readLine(); - line = (rest == null) ? first : first + rest; - _prev = false; - _atLineStart = true; - break; - } - return line; -} - -public boolean atLineStart(){ - return _atLineStart; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/LispReader.java --- a/src/clojure/lang/LispReader.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1103 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -import java.io.*; -import java.util.regex.Pattern; -import java.util.regex.Matcher; -import java.util.ArrayList; -import java.util.List; -import java.util.Map; -import java.math.BigInteger; -import java.math.BigDecimal; -import java.lang.*; - -public class LispReader{ - -static final Symbol QUOTE = Symbol.create("quote"); -static final Symbol THE_VAR = Symbol.create("var"); -//static Symbol SYNTAX_QUOTE = Symbol.create(null, "syntax-quote"); -static Symbol UNQUOTE = Symbol.create("clojure.core", "unquote"); -static Symbol UNQUOTE_SPLICING = Symbol.create("clojure.core", "unquote-splicing"); -static Symbol CONCAT = Symbol.create("clojure.core", "concat"); -static Symbol SEQ = Symbol.create("clojure.core", "seq"); -static Symbol LIST = Symbol.create("clojure.core", "list"); -static Symbol APPLY = Symbol.create("clojure.core", "apply"); -static Symbol HASHMAP = Symbol.create("clojure.core", "hash-map"); -static Symbol HASHSET = Symbol.create("clojure.core", "hash-set"); -static Symbol VECTOR = Symbol.create("clojure.core", "vector"); -static Symbol WITH_META = Symbol.create("clojure.core", "with-meta"); -static Symbol META = Symbol.create("clojure.core", "meta"); -static Symbol DEREF = Symbol.create("clojure.core", "deref"); -//static Symbol DEREF_BANG = Symbol.create("clojure.core", "deref!"); - -static IFn[] macros = new IFn[256]; -static IFn[] dispatchMacros = new IFn[256]; -//static Pattern symbolPat = Pattern.compile("[:]?([\\D&&[^:/]][^:/]*/)?[\\D&&[^:/]][^:/]*"); -static Pattern symbolPat = Pattern.compile("[:]?([\\D&&[^/]].*/)?([\\D&&[^/]][^/]*)"); -//static Pattern varPat = Pattern.compile("([\\D&&[^:\\.]][^:\\.]*):([\\D&&[^:\\.]][^:\\.]*)"); -//static Pattern intPat = Pattern.compile("[-+]?[0-9]+\\.?"); -static Pattern intPat = - Pattern.compile( - "([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)"); -static Pattern ratioPat = Pattern.compile("([-+]?[0-9]+)/([0-9]+)"); -static Pattern floatPat = Pattern.compile("([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?"); -static final Symbol SLASH = Symbol.create("/"); -static final Symbol CLOJURE_SLASH = Symbol.create("clojure.core","/"); -//static Pattern accessorPat = Pattern.compile("\\.[a-zA-Z_]\\w*"); -//static Pattern instanceMemberPat = Pattern.compile("\\.([a-zA-Z_][\\w\\.]*)\\.([a-zA-Z_]\\w*)"); -//static Pattern staticMemberPat = Pattern.compile("([a-zA-Z_][\\w\\.]*)\\.([a-zA-Z_]\\w*)"); -//static Pattern classNamePat = Pattern.compile("([a-zA-Z_][\\w\\.]*)\\."); - -//symbol->gensymbol -static Var GENSYM_ENV = Var.create(null); -//sorted-map num->gensymbol -static Var ARG_ENV = Var.create(null); - - static - { - macros['"'] = new StringReader(); - macros[';'] = new CommentReader(); - macros['\''] = new WrappingReader(QUOTE); - macros['@'] = new WrappingReader(DEREF);//new DerefReader(); - macros['^'] = new MetaReader(); - macros['`'] = new SyntaxQuoteReader(); - macros['~'] = new UnquoteReader(); - macros['('] = new ListReader(); - macros[')'] = new UnmatchedDelimiterReader(); - macros['['] = new VectorReader(); - macros[']'] = new UnmatchedDelimiterReader(); - macros['{'] = new MapReader(); - macros['}'] = new UnmatchedDelimiterReader(); -// macros['|'] = new ArgVectorReader(); - macros['\\'] = new CharacterReader(); - macros['%'] = new ArgReader(); - macros['#'] = new DispatchReader(); - - - dispatchMacros['^'] = new MetaReader(); - dispatchMacros['\''] = new VarReader(); - dispatchMacros['"'] = new RegexReader(); - dispatchMacros['('] = new FnReader(); - dispatchMacros['{'] = new SetReader(); - dispatchMacros['='] = new EvalReader(); - dispatchMacros['!'] = new CommentReader(); - dispatchMacros['<'] = new UnreadableReader(); - dispatchMacros['_'] = new DiscardReader(); - } - -static boolean isWhitespace(int ch){ - return Character.isWhitespace(ch) || ch == ','; -} - -static void unread(PushbackReader r, int ch) throws IOException{ - if(ch != -1) - r.unread(ch); -} - -public static class ReaderException extends Exception{ - final int line; - - public ReaderException(int line, Throwable cause){ - super(cause); - this.line = line; - } -} - -static public Object read(PushbackReader r, boolean eofIsError, Object eofValue, boolean isRecursive) - throws Exception{ - - try - { - for(; ;) - { - int ch = r.read(); - - while(isWhitespace(ch)) - ch = r.read(); - - if(ch == -1) - { - if(eofIsError) - throw new Exception("EOF while reading"); - return eofValue; - } - - if(Character.isDigit(ch)) - { - Object n = readNumber(r, (char) ch); - if(RT.suppressRead()) - return null; - return n; - } - - IFn macroFn = getMacro(ch); - if(macroFn != null) - { - Object ret = macroFn.invoke(r, (char) ch); - if(RT.suppressRead()) - return null; - //no op macros return the reader - if(ret == r) - continue; - return ret; - } - - if(ch == '+' || ch == '-') - { - int ch2 = r.read(); - if(Character.isDigit(ch2)) - { - unread(r, ch2); - Object n = readNumber(r, (char) ch); - if(RT.suppressRead()) - return null; - return n; - } - unread(r, ch2); - } - - String token = readToken(r, (char) ch); - if(RT.suppressRead()) - return null; - return interpretToken(token); - } - } - catch(Exception e) - { - if(isRecursive || !(r instanceof LineNumberingPushbackReader)) - throw e; - LineNumberingPushbackReader rdr = (LineNumberingPushbackReader) r; - //throw new Exception(String.format("ReaderError:(%d,1) %s", rdr.getLineNumber(), e.getMessage()), e); - throw new ReaderException(rdr.getLineNumber(), e); - } -} - -static private String readToken(PushbackReader r, char initch) throws Exception{ - StringBuilder sb = new StringBuilder(); - sb.append(initch); - - for(; ;) - { - int ch = r.read(); - if(ch == -1 || isWhitespace(ch) || isTerminatingMacro(ch)) - { - unread(r, ch); - return sb.toString(); - } - sb.append((char) ch); - } -} - -static private Object readNumber(PushbackReader r, char initch) throws Exception{ - StringBuilder sb = new StringBuilder(); - sb.append(initch); - - for(; ;) - { - int ch = r.read(); - if(ch == -1 || isWhitespace(ch) || isMacro(ch)) - { - unread(r, ch); - break; - } - sb.append((char) ch); - } - - String s = sb.toString(); - Object n = matchNumber(s); - if(n == null) - throw new NumberFormatException("Invalid number: " + s); - return n; -} - -static private int readUnicodeChar(String token, int offset, int length, int base) throws Exception{ - if(token.length() != offset + length) - throw new IllegalArgumentException("Invalid unicode character: \\" + token); - int uc = 0; - for(int i = offset; i < offset + length; ++i) - { - int d = Character.digit(token.charAt(i), base); - if(d == -1) - throw new IllegalArgumentException("Invalid digit: " + (char) d); - uc = uc * base + d; - } - return (char) uc; -} - -static private int readUnicodeChar(PushbackReader r, int initch, int base, int length, boolean exact) throws Exception{ - int uc = Character.digit(initch, base); - if(uc == -1) - throw new IllegalArgumentException("Invalid digit: " + initch); - int i = 1; - for(; i < length; ++i) - { - int ch = r.read(); - if(ch == -1 || isWhitespace(ch) || isMacro(ch)) - { - unread(r, ch); - break; - } - int d = Character.digit(ch, base); - if(d == -1) - throw new IllegalArgumentException("Invalid digit: " + (char) ch); - uc = uc * base + d; - } - if(i != length && exact) - throw new IllegalArgumentException("Invalid character length: " + i + ", should be: " + length); - return uc; -} - -static private Object interpretToken(String s) throws Exception{ - if(s.equals("nil")) - { - return null; - } - else if(s.equals("true")) - { - return RT.T; - } - else if(s.equals("false")) - { - return RT.F; - } - else if(s.equals("/")) - { - return SLASH; - } - else if(s.equals("clojure.core//")) - { - return CLOJURE_SLASH; - } - Object ret = null; - - ret = matchSymbol(s); - if(ret != null) - return ret; - - throw new Exception("Invalid token: " + s); -} - - -private static Object matchSymbol(String s){ - Matcher m = symbolPat.matcher(s); - if(m.matches()) - { - int gc = m.groupCount(); - String ns = m.group(1); - String name = m.group(2); - if(ns != null && ns.endsWith(":/") - || name.endsWith(":") - || s.indexOf("::", 1) != -1) - return null; - if(s.startsWith("::")) - { - Symbol ks = Symbol.intern(s.substring(2)); - Namespace kns; - if(ks.ns != null) - kns = Compiler.namespaceFor(ks); - else - kns = Compiler.currentNS(); - //auto-resolving keyword - if (kns != null) - return Keyword.intern(kns.name.name,ks.name); - else - return null; - } - boolean isKeyword = s.charAt(0) == ':'; - Symbol sym = Symbol.intern(s.substring(isKeyword ? 1 : 0)); - if(isKeyword) - return Keyword.intern(sym); - return sym; - } - return null; -} - - -private static Object matchNumber(String s){ - Matcher m = intPat.matcher(s); - if(m.matches()) - { - if(m.group(2) != null) - return 0; - boolean negate = (m.group(1).equals("-")); - String n; - int radix = 10; - if((n = m.group(3)) != null) - radix = 10; - else if((n = m.group(4)) != null) - radix = 16; - else if((n = m.group(5)) != null) - radix = 8; - else if((n = m.group(7)) != null) - radix = Integer.parseInt(m.group(6)); - if(n == null) - return null; - BigInteger bn = new BigInteger(n, radix); - return Numbers.reduce(negate ? bn.negate() : bn); - } - m = floatPat.matcher(s); - if(m.matches()) - { - if(m.group(4) != null) - return new BigDecimal(m.group(1)); - return Double.parseDouble(s); - } - m = ratioPat.matcher(s); - if(m.matches()) - { - return Numbers.divide(new BigInteger(m.group(1)), new BigInteger(m.group(2))); - } - return null; -} - -static private IFn getMacro(int ch){ - if(ch < macros.length) - return macros[ch]; - return null; -} - -static private boolean isMacro(int ch){ - return (ch < macros.length && macros[ch] != null); -} - -static private boolean isTerminatingMacro(int ch){ - return (ch != '#' && ch < macros.length && macros[ch] != null); -} - -public static class RegexReader extends AFn{ - static StringReader stringrdr = new StringReader(); - - public Object invoke(Object reader, Object doublequote) throws Exception{ - StringBuilder sb = new StringBuilder(); - Reader r = (Reader) reader; - for(int ch = r.read(); ch != '"'; ch = r.read()) - { - if(ch == -1) - throw new Exception("EOF while reading regex"); - sb.append( (char) ch ); - if(ch == '\\') //escape - { - ch = r.read(); - if(ch == -1) - throw new Exception("EOF while reading regex"); - sb.append( (char) ch ) ; - } - } - return Pattern.compile(sb.toString()); - } -} - -public static class StringReader extends AFn{ - public Object invoke(Object reader, Object doublequote) throws Exception{ - StringBuilder sb = new StringBuilder(); - Reader r = (Reader) reader; - - for(int ch = r.read(); ch != '"'; ch = r.read()) - { - if(ch == -1) - throw new Exception("EOF while reading string"); - if(ch == '\\') //escape - { - ch = r.read(); - if(ch == -1) - throw new Exception("EOF while reading string"); - switch(ch) - { - case 't': - ch = '\t'; - break; - case 'r': - ch = '\r'; - break; - case 'n': - ch = '\n'; - break; - case '\\': - break; - case '"': - break; - case 'b': - ch = '\b'; - break; - case 'f': - ch = '\f'; - break; - case 'u': - { - ch = r.read(); - if (Character.digit(ch, 16) == -1) - throw new Exception("Invalid unicode escape: \\u" + (char) ch); - ch = readUnicodeChar((PushbackReader) r, ch, 16, 4, true); - break; - } - default: - { - if(Character.isDigit(ch)) - { - ch = readUnicodeChar((PushbackReader) r, ch, 8, 3, false); - if(ch > 0377) - throw new Exception("Octal escape sequence must be in range [0, 377]."); - } - else - throw new Exception("Unsupported escape character: \\" + (char) ch); - } - } - } - sb.append((char) ch); - } - return sb.toString(); - } -} - -public static class CommentReader extends AFn{ - public Object invoke(Object reader, Object semicolon) throws Exception{ - Reader r = (Reader) reader; - int ch; - do - { - ch = r.read(); - } while(ch != -1 && ch != '\n' && ch != '\r'); - return r; - } - -} - -public static class DiscardReader extends AFn{ - public Object invoke(Object reader, Object underscore) throws Exception{ - PushbackReader r = (PushbackReader) reader; - read(r, true, null, true); - return r; - } -} - -public static class WrappingReader extends AFn{ - final Symbol sym; - - public WrappingReader(Symbol sym){ - this.sym = sym; - } - - public Object invoke(Object reader, Object quote) throws Exception{ - PushbackReader r = (PushbackReader) reader; - Object o = read(r, true, null, true); - return RT.list(sym, o); - } - -} - -public static class DeprecatedWrappingReader extends AFn{ - final Symbol sym; - final String macro; - - public DeprecatedWrappingReader(Symbol sym, String macro){ - this.sym = sym; - this.macro = macro; - } - - public Object invoke(Object reader, Object quote) throws Exception{ - System.out.println("WARNING: reader macro " + macro + - " is deprecated; use " + sym.getName() + - " instead"); - PushbackReader r = (PushbackReader) reader; - Object o = read(r, true, null, true); - return RT.list(sym, o); - } - -} - -public static class VarReader extends AFn{ - public Object invoke(Object reader, Object quote) throws Exception{ - PushbackReader r = (PushbackReader) reader; - Object o = read(r, true, null, true); -// if(o instanceof Symbol) -// { -// Object v = Compiler.maybeResolveIn(Compiler.currentNS(), (Symbol) o); -// if(v instanceof Var) -// return v; -// } - return RT.list(THE_VAR, o); - } -} - -/* -static class DerefReader extends AFn{ - - public Object invoke(Object reader, Object quote) throws Exception{ - PushbackReader r = (PushbackReader) reader; - int ch = r.read(); - if(ch == -1) - throw new Exception("EOF while reading character"); - if(ch == '!') - { - Object o = read(r, true, null, true); - return RT.list(DEREF_BANG, o); - } - else - { - r.unread(ch); - Object o = read(r, true, null, true); - return RT.list(DEREF, o); - } - } - -} -*/ - -public static class DispatchReader extends AFn{ - public Object invoke(Object reader, Object hash) throws Exception{ - int ch = ((Reader) reader).read(); - if(ch == -1) - throw new Exception("EOF while reading character"); - IFn fn = dispatchMacros[ch]; - if(fn == null) - throw new Exception(String.format("No dispatch macro for: %c", (char) ch)); - return fn.invoke(reader, ch); - } -} - -static Symbol garg(int n){ - return Symbol.intern(null, (n == -1 ? "rest" : ("p" + n)) + "__" + RT.nextID() + "#"); -} - -public static class FnReader extends AFn{ - public Object invoke(Object reader, Object lparen) throws Exception{ - PushbackReader r = (PushbackReader) reader; - if(ARG_ENV.deref() != null) - throw new IllegalStateException("Nested #()s are not allowed"); - try - { - Var.pushThreadBindings( - RT.map(ARG_ENV, PersistentTreeMap.EMPTY)); - r.unread('('); - Object form = read(r, true, null, true); - - PersistentVector args = PersistentVector.EMPTY; - PersistentTreeMap argsyms = (PersistentTreeMap) ARG_ENV.deref(); - ISeq rargs = argsyms.rseq(); - if(rargs != null) - { - int higharg = (Integer) ((Map.Entry) rargs.first()).getKey(); - if(higharg > 0) - { - for(int i = 1; i <= higharg; ++i) - { - Object sym = argsyms.valAt(i); - if(sym == null) - sym = garg(i); - args = args.cons(sym); - } - } - Object restsym = argsyms.valAt(-1); - if(restsym != null) - { - args = args.cons(Compiler._AMP_); - args = args.cons(restsym); - } - } - return RT.list(Compiler.FN, args, form); - } - finally - { - Var.popThreadBindings(); - } - } -} - -static Symbol registerArg(int n){ - PersistentTreeMap argsyms = (PersistentTreeMap) ARG_ENV.deref(); - if(argsyms == null) - { - throw new IllegalStateException("arg literal not in #()"); - } - Symbol ret = (Symbol) argsyms.valAt(n); - if(ret == null) - { - ret = garg(n); - ARG_ENV.set(argsyms.assoc(n, ret)); - } - return ret; -} - -static class ArgReader extends AFn{ - public Object invoke(Object reader, Object pct) throws Exception{ - PushbackReader r = (PushbackReader) reader; - if(ARG_ENV.deref() == null) - { - return interpretToken(readToken(r, '%')); - } - int ch = r.read(); - unread(r, ch); - //% alone is first arg - if(ch == -1 || isWhitespace(ch) || isTerminatingMacro(ch)) - { - return registerArg(1); - } - Object n = read(r, true, null, true); - if(n.equals(Compiler._AMP_)) - return registerArg(-1); - if(!(n instanceof Number)) - throw new IllegalStateException("arg literal must be %, %& or %integer"); - return registerArg(((Number) n).intValue()); - } -} - -public static class MetaReader extends AFn{ - public Object invoke(Object reader, Object caret) throws Exception{ - PushbackReader r = (PushbackReader) reader; - int line = -1; - if(r instanceof LineNumberingPushbackReader) - line = ((LineNumberingPushbackReader) r).getLineNumber(); - Object meta = read(r, true, null, true); - if(meta instanceof Symbol || meta instanceof Keyword || meta instanceof String) - meta = RT.map(RT.TAG_KEY, meta); - else if(!(meta instanceof IPersistentMap)) - throw new IllegalArgumentException("Metadata must be Symbol,Keyword,String or Map"); - - Object o = read(r, true, null, true); - if(o instanceof IMeta) - { - if(line != -1 && o instanceof ISeq) - meta = ((IPersistentMap) meta).assoc(RT.LINE_KEY, line); - if(o instanceof IReference) - { - ((IReference)o).resetMeta((IPersistentMap) meta); - return o; - } - return ((IObj) o).withMeta((IPersistentMap) meta); - } - else - throw new IllegalArgumentException("Metadata can only be applied to IMetas"); - } - -} - -public static class SyntaxQuoteReader extends AFn{ - public Object invoke(Object reader, Object backquote) throws Exception{ - PushbackReader r = (PushbackReader) reader; - try - { - Var.pushThreadBindings( - RT.map(GENSYM_ENV, PersistentHashMap.EMPTY)); - - Object form = read(r, true, null, true); - return syntaxQuote(form); - } - finally - { - Var.popThreadBindings(); - } - } - - static Object syntaxQuote(Object form) throws Exception{ - Object ret; - if(Compiler.isSpecial(form)) - ret = RT.list(Compiler.QUOTE, form); - else if(form instanceof Symbol) - { - Symbol sym = (Symbol) form; - if(sym.ns == null && sym.name.endsWith("#")) - { - IPersistentMap gmap = (IPersistentMap) GENSYM_ENV.deref(); - if(gmap == null) - throw new IllegalStateException("Gensym literal not in syntax-quote"); - Symbol gs = (Symbol) gmap.valAt(sym); - if(gs == null) - GENSYM_ENV.set(gmap.assoc(sym, gs = Symbol.intern(null, - sym.name.substring(0, sym.name.length() - 1) - + "__" + RT.nextID() + "__auto__"))); - sym = gs; - } - else if(sym.ns == null && sym.name.endsWith(".")) - { - Symbol csym = Symbol.intern(null, sym.name.substring(0, sym.name.length() - 1)); - csym = Compiler.resolveSymbol(csym); - sym = Symbol.intern(null, csym.name.concat(".")); - } - else if(sym.ns == null && sym.name.startsWith(".")) - { - // Simply quote method names. - } - else - { - Object maybeClass = null; - if(sym.ns != null) - maybeClass = Compiler.currentNS().getMapping( - Symbol.intern(null, sym.ns)); - if(maybeClass instanceof Class) - { - // Classname/foo -> package.qualified.Classname/foo - sym = Symbol.intern( - ((Class)maybeClass).getName(), sym.name); - } - else - sym = Compiler.resolveSymbol(sym); - } - ret = RT.list(Compiler.QUOTE, sym); - } - else if(isUnquote(form)) - return RT.second(form); - else if(isUnquoteSplicing(form)) - throw new IllegalStateException("splice not in list"); - else if(form instanceof IPersistentCollection) - { - if(form instanceof IPersistentMap) - { - IPersistentVector keyvals = flattenMap(form); - ret = RT.list(APPLY, HASHMAP, RT.list(SEQ, RT.cons(CONCAT, sqExpandList(keyvals.seq())))); - } - else if(form instanceof IPersistentVector) - { - ret = RT.list(APPLY, VECTOR, RT.list(SEQ, RT.cons(CONCAT, sqExpandList(((IPersistentVector) form).seq())))); - } - else if(form instanceof IPersistentSet) - { - ret = RT.list(APPLY, HASHSET, RT.list(SEQ, RT.cons(CONCAT, sqExpandList(((IPersistentSet) form).seq())))); - } - else if(form instanceof ISeq || form instanceof IPersistentList) - { - ISeq seq = RT.seq(form); - if(seq == null) - ret = RT.cons(LIST,null); - else - ret = RT.list(SEQ, RT.cons(CONCAT, sqExpandList(seq))); - } - else - throw new UnsupportedOperationException("Unknown Collection type"); - } - else if(form instanceof Keyword - || form instanceof Number - || form instanceof Character - || form instanceof String) - ret = form; - else - ret = RT.list(Compiler.QUOTE, form); - - if(form instanceof IObj && RT.meta(form) != null) - { - //filter line numbers - IPersistentMap newMeta = ((IObj) form).meta().without(RT.LINE_KEY); - if(newMeta.count() > 0) - return RT.list(WITH_META, ret, syntaxQuote(((IObj) form).meta())); - } - return ret; - } - - private static ISeq sqExpandList(ISeq seq) throws Exception{ - PersistentVector ret = PersistentVector.EMPTY; - for(; seq != null; seq = seq.next()) - { - Object item = seq.first(); - if(isUnquote(item)) - ret = ret.cons(RT.list(LIST, RT.second(item))); - else if(isUnquoteSplicing(item)) - ret = ret.cons(RT.second(item)); - else - ret = ret.cons(RT.list(LIST, syntaxQuote(item))); - } - return ret.seq(); - } - - private static IPersistentVector flattenMap(Object form){ - IPersistentVector keyvals = PersistentVector.EMPTY; - for(ISeq s = RT.seq(form); s != null; s = s.next()) - { - IMapEntry e = (IMapEntry) s.first(); - keyvals = (IPersistentVector) keyvals.cons(e.key()); - keyvals = (IPersistentVector) keyvals.cons(e.val()); - } - return keyvals; - } - -} - -static boolean isUnquoteSplicing(Object form){ - return form instanceof ISeq && Util.equals(RT.first(form),UNQUOTE_SPLICING); -} - -static boolean isUnquote(Object form){ - return form instanceof ISeq && Util.equals(RT.first(form),UNQUOTE); -} - -static class UnquoteReader extends AFn{ - public Object invoke(Object reader, Object comma) throws Exception{ - PushbackReader r = (PushbackReader) reader; - int ch = r.read(); - if(ch == -1) - throw new Exception("EOF while reading character"); - if(ch == '@') - { - Object o = read(r, true, null, true); - return RT.list(UNQUOTE_SPLICING, o); - } - else - { - unread(r, ch); - Object o = read(r, true, null, true); - return RT.list(UNQUOTE, o); - } - } - -} - -public static class CharacterReader extends AFn{ - public Object invoke(Object reader, Object backslash) throws Exception{ - PushbackReader r = (PushbackReader) reader; - int ch = r.read(); - if(ch == -1) - throw new Exception("EOF while reading character"); - String token = readToken(r, (char) ch); - if(token.length() == 1) - return Character.valueOf(token.charAt(0)); - else if(token.equals("newline")) - return '\n'; - else if(token.equals("space")) - return ' '; - else if(token.equals("tab")) - return '\t'; - else if(token.equals("backspace")) - return '\b'; - else if(token.equals("formfeed")) - return '\f'; - else if(token.equals("return")) - return '\r'; - else if(token.startsWith("u")) - { - char c = (char) readUnicodeChar(token, 1, 4, 16); - if(c >= '\uD800' && c <= '\uDFFF') // surrogate code unit? - throw new Exception("Invalid character constant: \\u" + Integer.toString(c, 16)); - return c; - } - else if(token.startsWith("o")) - { - int len = token.length() - 1; - if(len > 3) - throw new Exception("Invalid octal escape sequence length: " + len); - int uc = readUnicodeChar(token, 1, len, 8); - if(uc > 0377) - throw new Exception("Octal escape sequence must be in range [0, 377]."); - return (char) uc; - } - throw new Exception("Unsupported character: \\" + token); - } - -} - -public static class ListReader extends AFn{ - public Object invoke(Object reader, Object leftparen) throws Exception{ - PushbackReader r = (PushbackReader) reader; - int line = -1; - if(r instanceof LineNumberingPushbackReader) - line = ((LineNumberingPushbackReader) r).getLineNumber(); - List list = readDelimitedList(')', r, true); - if(list.isEmpty()) - return PersistentList.EMPTY; - IObj s = (IObj) PersistentList.create(list); -// IObj s = (IObj) RT.seq(list); - if(line != -1) - return s.withMeta(RT.map(RT.LINE_KEY, line)); - else - return s; - } - -} - -static class CtorReader extends AFn{ - static final Symbol cls = Symbol.create("class"); - - public Object invoke(Object reader, Object leftangle) throws Exception{ - PushbackReader r = (PushbackReader) reader; - // # - // # - // # - List list = readDelimitedList('>', r, true); - if(list.isEmpty()) - throw new Exception("Must supply 'class', classname or classname/staticMethod"); - Symbol s = (Symbol) list.get(0); - Object[] args = list.subList(1, list.size()).toArray(); - if(s.equals(cls)) - { - return RT.classForName(args[0].toString()); - } - else if(s.ns != null) //static method - { - String classname = s.ns; - String method = s.name; - return Reflector.invokeStaticMethod(classname, method, args); - } - else - { - return Reflector.invokeConstructor(RT.classForName(s.name), args); - } - } - -} - -public static class EvalReader extends AFn{ - public Object invoke(Object reader, Object eq) throws Exception{ - if (!RT.booleanCast(RT.READEVAL.deref())) - { - throw new Exception("EvalReader not allowed when *read-eval* is false."); - } - - PushbackReader r = (PushbackReader) reader; - Object o = read(r, true, null, true); - if(o instanceof Symbol) - { - return RT.classForName(o.toString()); - } - else if(o instanceof IPersistentList) - { - Symbol fs = (Symbol) RT.first(o); - if(fs.equals(THE_VAR)) - { - Symbol vs = (Symbol) RT.second(o); - return RT.var(vs.ns, vs.name); //Compiler.resolve((Symbol) RT.second(o),true); - } - if(fs.name.endsWith(".")) - { - Object[] args = RT.toArray(RT.next(o)); - return Reflector.invokeConstructor(RT.classForName(fs.name.substring(0, fs.name.length() - 1)), args); - } - if(Compiler.namesStaticMember(fs)) - { - Object[] args = RT.toArray(RT.next(o)); - return Reflector.invokeStaticMethod(fs.ns, fs.name, args); - } - Object v = Compiler.maybeResolveIn(Compiler.currentNS(), fs); - if(v instanceof Var) - { - return ((IFn) v).applyTo(RT.next(o)); - } - throw new Exception("Can't resolve " + fs); - } - else - throw new IllegalArgumentException("Unsupported #= form"); - } -} - -//static class ArgVectorReader extends AFn{ -// public Object invoke(Object reader, Object leftparen) throws Exception{ -// PushbackReader r = (PushbackReader) reader; -// return ArgVector.create(readDelimitedList('|', r, true)); -// } -// -//} - -public static class VectorReader extends AFn{ - public Object invoke(Object reader, Object leftparen) throws Exception{ - PushbackReader r = (PushbackReader) reader; - return LazilyPersistentVector.create(readDelimitedList(']', r, true)); - } - -} - -public static class MapReader extends AFn{ - public Object invoke(Object reader, Object leftparen) throws Exception{ - PushbackReader r = (PushbackReader) reader; - return RT.map(readDelimitedList('}', r, true).toArray()); - } - -} - -public static class SetReader extends AFn{ - public Object invoke(Object reader, Object leftbracket) throws Exception{ - PushbackReader r = (PushbackReader) reader; - return PersistentHashSet.createWithCheck(readDelimitedList('}', r, true)); - } - -} - -public static class UnmatchedDelimiterReader extends AFn{ - public Object invoke(Object reader, Object rightdelim) throws Exception{ - throw new Exception("Unmatched delimiter: " + rightdelim); - } - -} - -public static class UnreadableReader extends AFn{ - public Object invoke(Object reader, Object leftangle) throws Exception{ - throw new Exception("Unreadable form"); - } -} - -public static List readDelimitedList(char delim, PushbackReader r, boolean isRecursive) throws Exception{ - ArrayList a = new ArrayList(); - - for(; ;) - { - int ch = r.read(); - - while(isWhitespace(ch)) - ch = r.read(); - - if(ch == -1) - throw new Exception("EOF while reading"); - - if(ch == delim) - break; - - IFn macroFn = getMacro(ch); - if(macroFn != null) - { - Object mret = macroFn.invoke(r, (char) ch); - //no op macros return the reader - if(mret != r) - a.add(mret); - } - else - { - unread(r, ch); - - Object o = read(r, true, null, isRecursive); - if(o != r) - a.add(o); - } - } - - - return a; -} - -/* -public static void main(String[] args) throws Exception{ - //RT.init(); - PushbackReader rdr = new PushbackReader( new java.io.StringReader( "(+ 21 21)" ) ); - Object input = LispReader.read(rdr, false, new Object(), false ); - System.out.println(Compiler.eval(input)); -} - -public static void main(String[] args){ - LineNumberingPushbackReader r = new LineNumberingPushbackReader(new InputStreamReader(System.in)); - OutputStreamWriter w = new OutputStreamWriter(System.out); - Object ret = null; - try - { - for(; ;) - { - ret = LispReader.read(r, true, null, false); - RT.print(ret, w); - w.write('\n'); - if(ret != null) - w.write(ret.getClass().toString()); - w.write('\n'); - w.flush(); - } - } - catch(Exception e) - { - e.printStackTrace(); - } -} - */ - -} - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/LockingTransaction.java --- a/src/clojure/lang/LockingTransaction.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,645 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jul 26, 2007 */ - -package clojure.lang; - -import java.util.*; -import java.util.concurrent.atomic.AtomicInteger; -import java.util.concurrent.atomic.AtomicLong; -import java.util.concurrent.Callable; -import java.util.concurrent.TimeUnit; -import java.util.concurrent.CountDownLatch; - -@SuppressWarnings({"SynchronizeOnNonFinalField"}) -public class LockingTransaction{ - -public static final int RETRY_LIMIT = 10000; -public static final int LOCK_WAIT_MSECS = 100; -public static final long BARGE_WAIT_NANOS = 10 * 1000000; -//public static int COMMUTE_RETRY_LIMIT = 10; - -static final int RUNNING = 0; -static final int COMMITTING = 1; -static final int RETRY = 2; -static final int KILLED = 3; -static final int COMMITTED = 4; - -final static ThreadLocal transaction = new ThreadLocal(); - - -static class RetryEx extends Error{ -} - -static class AbortException extends Exception{ -} - -public static class Info{ - final AtomicInteger status; - final long startPoint; - final CountDownLatch latch; - - - public Info(int status, long startPoint){ - this.status = new AtomicInteger(status); - this.startPoint = startPoint; - this.latch = new CountDownLatch(1); - } - - public boolean running(){ - int s = status.get(); - return s == RUNNING || s == COMMITTING; - } -} - -static class CFn{ - final IFn fn; - final ISeq args; - - public CFn(IFn fn, ISeq args){ - this.fn = fn; - this.args = args; - } -} -//total order on transactions -//transactions will consume a point for init, for each retry, and on commit if writing -final private static AtomicLong lastPoint = new AtomicLong(); - -void getReadPoint(){ - readPoint = lastPoint.incrementAndGet(); -} - -long getCommitPoint(){ - return lastPoint.incrementAndGet(); -} - -void stop(int status){ - if(info != null) - { - synchronized(info) - { - info.status.set(status); - info.latch.countDown(); - } - info = null; - vals.clear(); - sets.clear(); - commutes.clear(); - //actions.clear(); - } -} - - -Info info; -long readPoint; -long startPoint; -long startTime; -final RetryEx retryex = new RetryEx(); -final ArrayList actions = new ArrayList(); -final HashMap vals = new HashMap(); -final HashSet sets = new HashSet(); -final TreeMap> commutes = new TreeMap>(); - -final HashSet ensures = new HashSet(); //all hold readLock - - -void tryWriteLock(Ref ref){ - try - { - if(!ref.lock.writeLock().tryLock(LOCK_WAIT_MSECS, TimeUnit.MILLISECONDS)) - throw retryex; - } - catch(InterruptedException e) - { - throw retryex; - } -} - -//returns the most recent val -Object lock(Ref ref){ - //can't upgrade readLock, so release it - releaseIfEnsured(ref); - - boolean unlocked = true; - try - { - tryWriteLock(ref); - unlocked = false; - - if(ref.tvals != null && ref.tvals.point > readPoint) - throw retryex; - Info refinfo = ref.tinfo; - - //write lock conflict - if(refinfo != null && refinfo != info && refinfo.running()) - { - if(!barge(refinfo)) - { - ref.lock.writeLock().unlock(); - unlocked = true; - return blockAndBail(refinfo); - } - } - ref.tinfo = info; - return ref.tvals == null ? null : ref.tvals.val; - } - finally - { - if(!unlocked) - ref.lock.writeLock().unlock(); - } -} - -private Object blockAndBail(Info refinfo){ -//stop prior to blocking - stop(RETRY); - try - { - refinfo.latch.await(LOCK_WAIT_MSECS, TimeUnit.MILLISECONDS); - } - catch(InterruptedException e) - { - //ignore - } - throw retryex; -} - -private void releaseIfEnsured(Ref ref){ - if(ensures.contains(ref)) - { - ensures.remove(ref); - ref.lock.readLock().unlock(); - } -} - -void abort() throws AbortException{ - stop(KILLED); - throw new AbortException(); -} - -private boolean bargeTimeElapsed(){ - return System.nanoTime() - startTime > BARGE_WAIT_NANOS; -} - -private boolean barge(Info refinfo){ - boolean barged = false; - //if this transaction is older - // try to abort the other - if(bargeTimeElapsed() && startPoint < refinfo.startPoint) - { - barged = refinfo.status.compareAndSet(RUNNING, KILLED); - if(barged) - refinfo.latch.countDown(); - } - return barged; -} - -static LockingTransaction getEx(){ - LockingTransaction t = transaction.get(); - if(t == null || t.info == null) - throw new IllegalStateException("No transaction running"); - return t; -} - -static public boolean isRunning(){ - return getRunning() != null; -} - -static LockingTransaction getRunning(){ - LockingTransaction t = transaction.get(); - if(t == null || t.info == null) - return null; - return t; -} - -static public Object runInTransaction(Callable fn) throws Exception{ - LockingTransaction t = transaction.get(); - if(t == null) - transaction.set(t = new LockingTransaction()); - - if(t.info != null) - return fn.call(); - - return t.run(fn); -} - -static class Notify{ - final public Ref ref; - final public Object oldval; - final public Object newval; - - Notify(Ref ref, Object oldval, Object newval){ - this.ref = ref; - this.oldval = oldval; - this.newval = newval; - } -} - -Object run(Callable fn) throws Exception{ - boolean done = false; - Object ret = null; - ArrayList locked = new ArrayList(); - ArrayList notify = new ArrayList(); - - for(int i = 0; !done && i < RETRY_LIMIT; i++) - { - try - { - getReadPoint(); - if(i == 0) - { - startPoint = readPoint; - startTime = System.nanoTime(); - } - info = new Info(RUNNING, startPoint); - ret = fn.call(); - //make sure no one has killed us before this point, and can't from now on - if(info.status.compareAndSet(RUNNING, COMMITTING)) - { - for(Map.Entry> e : commutes.entrySet()) - { - Ref ref = e.getKey(); - if(sets.contains(ref)) continue; - - boolean wasEnsured = ensures.contains(ref); - //can't upgrade readLock, so release it - releaseIfEnsured(ref); - tryWriteLock(ref); - locked.add(ref); - if(wasEnsured && ref.tvals != null && ref.tvals.point > readPoint) - throw retryex; - - Info refinfo = ref.tinfo; - if(refinfo != null && refinfo != info && refinfo.running()) - { - if(!barge(refinfo)) - throw retryex; - } - Object val = ref.tvals == null ? null : ref.tvals.val; - vals.put(ref, val); - for(CFn f : e.getValue()) - { - vals.put(ref, f.fn.applyTo(RT.cons(vals.get(ref), f.args))); - } - } - for(Ref ref : sets) - { - tryWriteLock(ref); - locked.add(ref); - } - - //validate and enqueue notifications - for(Map.Entry e : vals.entrySet()) - { - Ref ref = e.getKey(); - ref.validate(ref.getValidator(), e.getValue()); - } - - //at this point, all values calced, all refs to be written locked - //no more client code to be called - long msecs = System.currentTimeMillis(); - long commitPoint = getCommitPoint(); - for(Map.Entry e : vals.entrySet()) - { - Ref ref = e.getKey(); - Object oldval = ref.tvals == null ? null : ref.tvals.val; - Object newval = e.getValue(); - int hcount = ref.histCount(); - - if(ref.tvals == null) - { - ref.tvals = new Ref.TVal(newval, commitPoint, msecs); - } - else if((ref.faults.get() > 0 && hcount < ref.maxHistory) - || hcount < ref.minHistory) - { - ref.tvals = new Ref.TVal(newval, commitPoint, msecs, ref.tvals); - ref.faults.set(0); - } - else - { - ref.tvals = ref.tvals.next; - ref.tvals.val = newval; - ref.tvals.point = commitPoint; - ref.tvals.msecs = msecs; - } - if(ref.getWatches().count() > 0) - notify.add(new Notify(ref, oldval, newval)); - } - - done = true; - info.status.set(COMMITTED); - } - } - catch(RetryEx retry) - { - //eat this so we retry rather than fall out - } - finally - { - for(int k = locked.size() - 1; k >= 0; --k) - { - locked.get(k).lock.writeLock().unlock(); - } - locked.clear(); - for(Ref r : ensures) - { - r.lock.readLock().unlock(); - } - ensures.clear(); - stop(done ? COMMITTED : RETRY); - try - { - if(done) //re-dispatch out of transaction - { - for(Notify n : notify) - { - n.ref.notifyWatches(n.oldval, n.newval); - } - for(Agent.Action action : actions) - { - Agent.dispatchAction(action); - } - } - } - finally - { - notify.clear(); - actions.clear(); - } - } - } - if(!done) - throw new Exception("Transaction failed after reaching retry limit"); - return ret; -} - -public void enqueue(Agent.Action action){ - actions.add(action); -} - -Object doGet(Ref ref){ - if(!info.running()) - throw retryex; - if(vals.containsKey(ref)) - return vals.get(ref); - try - { - ref.lock.readLock().lock(); - if(ref.tvals == null) - throw new IllegalStateException(ref.toString() + " is unbound."); - Ref.TVal ver = ref.tvals; - do - { - if(ver.point <= readPoint) - return ver.val; - } while((ver = ver.prior) != ref.tvals); - } - finally - { - ref.lock.readLock().unlock(); - } - //no version of val precedes the read point - ref.faults.incrementAndGet(); - throw retryex; - -} - -Object doSet(Ref ref, Object val){ - if(!info.running()) - throw retryex; - if(commutes.containsKey(ref)) - throw new IllegalStateException("Can't set after commute"); - if(!sets.contains(ref)) - { - sets.add(ref); - lock(ref); - } - vals.put(ref, val); - return val; -} - -void doEnsure(Ref ref){ - if(!info.running()) - throw retryex; - if(ensures.contains(ref)) - return; - ref.lock.readLock().lock(); - - //someone completed a write after our snapshot - if(ref.tvals != null && ref.tvals.point > readPoint) { - ref.lock.readLock().unlock(); - throw retryex; - } - - Info refinfo = ref.tinfo; - - //writer exists - if(refinfo != null && refinfo.running()) - { - ref.lock.readLock().unlock(); - - if(refinfo != info) //not us, ensure is doomed - { - blockAndBail(refinfo); - } - } - else - ensures.add(ref); -} - -Object doCommute(Ref ref, IFn fn, ISeq args) throws Exception{ - if(!info.running()) - throw retryex; - if(!vals.containsKey(ref)) - { - Object val = null; - try - { - ref.lock.readLock().lock(); - val = ref.tvals == null ? null : ref.tvals.val; - } - finally - { - ref.lock.readLock().unlock(); - } - vals.put(ref, val); - } - ArrayList fns = commutes.get(ref); - if(fns == null) - commutes.put(ref, fns = new ArrayList()); - fns.add(new CFn(fn, args)); - Object ret = fn.applyTo(RT.cons(vals.get(ref), args)); - vals.put(ref, ret); - return ret; -} - -/* -//for test -static CyclicBarrier barrier; -static ArrayList items; - -public static void main(String[] args){ - try - { - if(args.length != 4) - System.err.println("Usage: LockingTransaction nthreads nitems niters ninstances"); - int nthreads = Integer.parseInt(args[0]); - int nitems = Integer.parseInt(args[1]); - int niters = Integer.parseInt(args[2]); - int ninstances = Integer.parseInt(args[3]); - - if(items == null) - { - ArrayList temp = new ArrayList(nitems); - for(int i = 0; i < nitems; i++) - temp.add(new Ref(0)); - items = temp; - } - - class Incr extends AFn{ - public Object invoke(Object arg1) throws Exception{ - Integer i = (Integer) arg1; - return i + 1; - } - - public Obj withMeta(IPersistentMap meta){ - throw new UnsupportedOperationException(); - - } - } - - class Commuter extends AFn implements Callable{ - int niters; - List items; - Incr incr; - - - public Commuter(int niters, List items){ - this.niters = niters; - this.items = items; - this.incr = new Incr(); - } - - public Object call() throws Exception{ - long nanos = 0; - for(int i = 0; i < niters; i++) - { - long start = System.nanoTime(); - LockingTransaction.runInTransaction(this); - nanos += System.nanoTime() - start; - } - return nanos; - } - - public Object invoke() throws Exception{ - for(Ref tref : items) - { - LockingTransaction.getEx().doCommute(tref, incr); - } - return null; - } - - public Obj withMeta(IPersistentMap meta){ - throw new UnsupportedOperationException(); - - } - } - - class Incrementer extends AFn implements Callable{ - int niters; - List items; - - - public Incrementer(int niters, List items){ - this.niters = niters; - this.items = items; - } - - public Object call() throws Exception{ - long nanos = 0; - for(int i = 0; i < niters; i++) - { - long start = System.nanoTime(); - LockingTransaction.runInTransaction(this); - nanos += System.nanoTime() - start; - } - return nanos; - } - - public Object invoke() throws Exception{ - for(Ref tref : items) - { - //Transaction.get().doTouch(tref); -// LockingTransaction t = LockingTransaction.getEx(); -// int val = (Integer) t.doGet(tref); -// t.doSet(tref, val + 1); - int val = (Integer) tref.get(); - tref.set(val + 1); - } - return null; - } - - public Obj withMeta(IPersistentMap meta){ - throw new UnsupportedOperationException(); - - } - } - - ArrayList> tasks = new ArrayList(nthreads); - for(int i = 0; i < nthreads; i++) - { - ArrayList si; - synchronized(items) - { - si = (ArrayList) items.clone(); - } - Collections.shuffle(si); - tasks.add(new Incrementer(niters, si)); - //tasks.add(new Commuter(niters, si)); - } - ExecutorService e = Executors.newFixedThreadPool(nthreads); - - if(barrier == null) - barrier = new CyclicBarrier(ninstances); - System.out.println("waiting for other instances..."); - barrier.await(); - System.out.println("starting"); - long start = System.nanoTime(); - List> results = e.invokeAll(tasks); - long estimatedTime = System.nanoTime() - start; - System.out.printf("nthreads: %d, nitems: %d, niters: %d, time: %d%n", nthreads, nitems, niters, - estimatedTime / 1000000); - e.shutdown(); - for(Future result : results) - { - System.out.printf("%d, ", result.get() / 1000000); - } - System.out.println(); - System.out.println("waiting for other instances..."); - barrier.await(); - synchronized(items) - { - for(Ref item : items) - { - System.out.printf("%d, ", (Integer) item.currentVal()); - } - } - System.out.println("\ndone"); - System.out.flush(); - } - catch(Exception ex) - { - ex.printStackTrace(); - } -} -*/ -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/MapEntry.java --- a/src/clojure/lang/MapEntry.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -import java.util.Iterator; - -public class MapEntry extends AMapEntry{ -final Object _key; -final Object _val; - -public MapEntry(Object key, Object val){ - this._key = key; - this._val = val; -} - -public Object key(){ - return _key; -} - -public Object val(){ - return _val; -} - -public Object getKey(){ - return key(); -} - -public Object getValue(){ - return val(); -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/MapEquivalence.java --- a/src/clojure/lang/MapEquivalence.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Aug 4, 2010 */ - -package clojure.lang; - -//marker interface -public interface MapEquivalence{ -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/MethodImplCache.java --- a/src/clojure/lang/MethodImplCache.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Nov 8, 2009 */ - -package clojure.lang; - -public final class MethodImplCache{ - -static public class Entry{ - final public Class c; - final public IFn fn; - - public Entry(Class c, IFn fn){ - this.c = c; - this.fn = fn; - } -} - -public final IPersistentMap protocol; -public final Keyword methodk; -public final int shift; -public final int mask; -public final Object[] table; //[class, entry. class, entry ...] - -volatile Entry mre = null; - -public MethodImplCache(IPersistentMap protocol, Keyword methodk){ - this(protocol, methodk, 0, 0, RT.EMPTY_ARRAY); -} - -public MethodImplCache(IPersistentMap protocol, Keyword methodk, int shift, int mask, Object[] table){ - this.protocol = protocol; - this.methodk = methodk; - this.shift = shift; - this.mask = mask; - this.table = table; -} - -public IFn fnFor(Class c){ - Entry last = mre; - if(last != null && last.c == c) - return last.fn; - return findFnFor(c); -} - -IFn findFnFor(Class c){ - int idx = ((Util.hash(c) >> shift) & mask) << 1; - if(idx < table.length && table[idx] == c) - { - Entry e = ((Entry) table[idx + 1]); - mre = e; - return e != null ? e.fn : null; - } - return null; -} - - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/MultiFn.java --- a/src/clojure/lang/MultiFn.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,314 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Sep 13, 2007 */ - -package clojure.lang; - -import java.util.Map; - -public class MultiFn extends AFn{ -final public IFn dispatchFn; -final public Object defaultDispatchVal; -final public IRef hierarchy; -final String name; -IPersistentMap methodTable; -IPersistentMap preferTable; -IPersistentMap methodCache; -Object cachedHierarchy; - -static final Var assoc = RT.var("clojure.core", "assoc"); -static final Var dissoc = RT.var("clojure.core", "dissoc"); -static final Var isa = RT.var("clojure.core", "isa?"); -static final Var parents = RT.var("clojure.core", "parents"); - -public MultiFn(String name, IFn dispatchFn, Object defaultDispatchVal, IRef hierarchy) throws Exception{ - this.name = name; - this.dispatchFn = dispatchFn; - this.defaultDispatchVal = defaultDispatchVal; - this.methodTable = PersistentHashMap.EMPTY; - this.methodCache = getMethodTable(); - this.preferTable = PersistentHashMap.EMPTY; - this.hierarchy = hierarchy; - cachedHierarchy = null; -} - -synchronized public MultiFn reset(){ - methodTable = methodCache = preferTable = PersistentHashMap.EMPTY; - cachedHierarchy = null; - return this; -} - -synchronized public MultiFn addMethod(Object dispatchVal, IFn method) throws Exception{ - methodTable = getMethodTable().assoc(dispatchVal, method); - resetCache(); - return this; -} - -synchronized public MultiFn removeMethod(Object dispatchVal) throws Exception{ - methodTable = getMethodTable().without(dispatchVal); - resetCache(); - return this; -} - -synchronized public MultiFn preferMethod(Object dispatchValX, Object dispatchValY) throws Exception{ - if(prefers(dispatchValY, dispatchValX)) - throw new IllegalStateException( - String.format("Preference conflict in multimethod '%s': %s is already preferred to %s", - name, dispatchValY, dispatchValX)); - preferTable = getPreferTable().assoc(dispatchValX, RT.conj((IPersistentCollection) RT.get(getPreferTable(), - dispatchValX, - PersistentHashSet.EMPTY), - dispatchValY)); - resetCache(); - return this; -} - -private boolean prefers(Object x, Object y) throws Exception{ - IPersistentSet xprefs = (IPersistentSet) getPreferTable().valAt(x); - if(xprefs != null && xprefs.contains(y)) - return true; - for(ISeq ps = RT.seq(parents.invoke(y)); ps != null; ps = ps.next()) - { - if(prefers(x, ps.first())) - return true; - } - for(ISeq ps = RT.seq(parents.invoke(x)); ps != null; ps = ps.next()) - { - if(prefers(ps.first(), y)) - return true; - } - return false; -} - -private boolean isA(Object x, Object y) throws Exception{ - return RT.booleanCast(isa.invoke(hierarchy.deref(), x, y)); -} - -private boolean dominates(Object x, Object y) throws Exception{ - return prefers(x, y) || isA(x, y); -} - -private IPersistentMap resetCache() throws Exception{ - methodCache = getMethodTable(); - cachedHierarchy = hierarchy.deref(); - return methodCache; -} - -synchronized public IFn getMethod(Object dispatchVal) throws Exception{ - if(cachedHierarchy != hierarchy.deref()) - resetCache(); - IFn targetFn = (IFn) methodCache.valAt(dispatchVal); - if(targetFn != null) - return targetFn; - targetFn = findAndCacheBestMethod(dispatchVal); - if(targetFn != null) - return targetFn; - targetFn = (IFn) getMethodTable().valAt(defaultDispatchVal); - return targetFn; -} - -private IFn getFn(Object dispatchVal) throws Exception{ - IFn targetFn = getMethod(dispatchVal); - if(targetFn == null) - throw new IllegalArgumentException(String.format("No method in multimethod '%s' for dispatch value: %s", - name, dispatchVal)); - return targetFn; -} - -private IFn findAndCacheBestMethod(Object dispatchVal) throws Exception{ - Map.Entry bestEntry = null; - for(Object o : getMethodTable()) - { - Map.Entry e = (Map.Entry) o; - if(isA(dispatchVal, e.getKey())) - { - if(bestEntry == null || dominates(e.getKey(), bestEntry.getKey())) - bestEntry = e; - if(!dominates(bestEntry.getKey(), e.getKey())) - throw new IllegalArgumentException( - String.format( - "Multiple methods in multimethod '%s' match dispatch value: %s -> %s and %s, and neither is preferred", - name, dispatchVal, e.getKey(), bestEntry.getKey())); - } - } - if(bestEntry == null) - return null; - //ensure basis has stayed stable throughout, else redo - if(cachedHierarchy == hierarchy.deref()) - { - //place in cache - methodCache = methodCache.assoc(dispatchVal, bestEntry.getValue()); - return (IFn) bestEntry.getValue(); - } - else - { - resetCache(); - return findAndCacheBestMethod(dispatchVal); - } -} - -public Object invoke() throws Exception{ - return getFn(dispatchFn.invoke()).invoke(); -} - -public Object invoke(Object arg1) throws Exception{ - return getFn(dispatchFn.invoke(arg1)).invoke(arg1); -} - -public Object invoke(Object arg1, Object arg2) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2)).invoke(arg1, arg2); -} - -public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3)).invoke(arg1, arg2, arg3); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4)).invoke(arg1, arg2, arg3, arg4); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5)).invoke(arg1, arg2, arg3, arg4, arg5); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6)).invoke(arg1, arg2, arg3, arg4, arg5, arg6); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) - throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7)) - .invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception{ - return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) - throws Exception{ - return getFn( - dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15) throws Exception{ - return getFn( - dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15)) - .invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16) throws Exception{ - return getFn( - dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16)) - .invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17) throws Exception{ - return getFn( - dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17)) - .invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ - return getFn( - dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ - return getFn( - dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) - throws Exception{ - return getFn( - dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19, arg20)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19, arg20); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args) - throws Exception{ - return getFn( - dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19, arg20, args)). - invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19, arg20, args); -} - - public IPersistentMap getMethodTable() { - return methodTable; - } - - public IPersistentMap getPreferTable() { - return preferTable; - } -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Named.java --- a/src/clojure/lang/Named.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Sep 20, 2007 */ - -package clojure.lang; - -public interface Named{ -String getNamespace(); - -String getName(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Namespace.java --- a/src/clojure/lang/Namespace.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,243 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jan 23, 2008 */ - -package clojure.lang; - -import java.io.ObjectStreamException; -import java.io.Serializable; -import java.util.concurrent.ConcurrentHashMap; -import java.util.concurrent.atomic.AtomicReference; - -public class Namespace extends AReference implements Serializable { -final public Symbol name; -transient final AtomicReference mappings = new AtomicReference(); -transient final AtomicReference aliases = new AtomicReference(); - -final static ConcurrentHashMap namespaces = new ConcurrentHashMap(); - -public String toString(){ - return name.toString(); -} - -Namespace(Symbol name){ - super(name.meta()); - this.name = name; - mappings.set(RT.DEFAULT_IMPORTS); - aliases.set(RT.map()); -} - -public static ISeq all(){ - return RT.seq(namespaces.values()); -} - -public Symbol getName(){ - return name; -} - -public IPersistentMap getMappings(){ - return mappings.get(); -} - -public Var intern(Symbol sym){ - if(sym.ns != null) - { - throw new IllegalArgumentException("Can't intern namespace-qualified symbol"); - } - IPersistentMap map = getMappings(); - Object o; - Var v = null; - while((o = map.valAt(sym)) == null) - { - if(v == null) - v = new Var(this, sym); - IPersistentMap newMap = map.assoc(sym, v); - mappings.compareAndSet(map, newMap); - map = getMappings(); - } - if(o instanceof Var && ((Var) o).ns == this) - return (Var) o; - - if(v == null) - v = new Var(this, sym); - - warnOrFailOnReplace(sym, o, v); - - - while(!mappings.compareAndSet(map, map.assoc(sym, v))) - map = getMappings(); - - return v; -} - -private void warnOrFailOnReplace(Symbol sym, Object o, Object v){ - if (o instanceof Var) - { - Namespace ns = ((Var)o).ns; - if (ns == this) - return; - if (ns != RT.CLOJURE_NS) - throw new IllegalStateException(sym + " already refers to: " + o + " in namespace: " + name); - } - RT.errPrintWriter().println("WARNING: " + sym + " already refers to: " + o + " in namespace: " + name - + ", being replaced by: " + v); -} - -Object reference(Symbol sym, Object val){ - if(sym.ns != null) - { - throw new IllegalArgumentException("Can't intern namespace-qualified symbol"); - } - IPersistentMap map = getMappings(); - Object o; - while((o = map.valAt(sym)) == null) - { - IPersistentMap newMap = map.assoc(sym, val); - mappings.compareAndSet(map, newMap); - map = getMappings(); - } - if(o == val) - return o; - - warnOrFailOnReplace(sym, o, val); - - while(!mappings.compareAndSet(map, map.assoc(sym, val))) - map = getMappings(); - - return val; - -} - -public static boolean areDifferentInstancesOfSameClassName(Class cls1, Class cls2) { - return (cls1 != cls2) && (cls1.getName().equals(cls2.getName())); -} - -Class referenceClass(Symbol sym, Class val){ - if(sym.ns != null) - { - throw new IllegalArgumentException("Can't intern namespace-qualified symbol"); - } - IPersistentMap map = getMappings(); - Class c = (Class) map.valAt(sym); - while((c == null) || (areDifferentInstancesOfSameClassName(c, val))) - { - IPersistentMap newMap = map.assoc(sym, val); - mappings.compareAndSet(map, newMap); - map = getMappings(); - c = (Class) map.valAt(sym); - } - if(c == val) - return c; - - throw new IllegalStateException(sym + " already refers to: " + c + " in namespace: " + name); -} - -public void unmap(Symbol sym) throws Exception{ - if(sym.ns != null) - { - throw new IllegalArgumentException("Can't unintern namespace-qualified symbol"); - } - IPersistentMap map = getMappings(); - while(map.containsKey(sym)) - { - IPersistentMap newMap = map.without(sym); - mappings.compareAndSet(map, newMap); - map = getMappings(); - } -} - -public Class importClass(Symbol sym, Class c){ - return referenceClass(sym, c); - -} - -public Class importClass(Class c){ - String n = c.getName(); - return importClass(Symbol.intern(n.substring(n.lastIndexOf('.') + 1)), c); -} - -public Var refer(Symbol sym, Var var){ - return (Var) reference(sym, var); - -} - -public static Namespace findOrCreate(Symbol name){ - Namespace ns = namespaces.get(name); - if(ns != null) - return ns; - Namespace newns = new Namespace(name); - ns = namespaces.putIfAbsent(name, newns); - return ns == null ? newns : ns; -} - -public static Namespace remove(Symbol name){ - if(name.equals(RT.CLOJURE_NS.name)) - throw new IllegalArgumentException("Cannot remove clojure namespace"); - return namespaces.remove(name); -} - -public static Namespace find(Symbol name){ - return namespaces.get(name); -} - -public Object getMapping(Symbol name){ - return mappings.get().valAt(name); -} - -public Var findInternedVar(Symbol symbol){ - Object o = mappings.get().valAt(symbol); - if(o != null && o instanceof Var && ((Var) o).ns == this) - return (Var) o; - return null; -} - - -public IPersistentMap getAliases(){ - return aliases.get(); -} - -public Namespace lookupAlias(Symbol alias){ - IPersistentMap map = getAliases(); - return (Namespace) map.valAt(alias); -} - -public void addAlias(Symbol alias, Namespace ns){ - if (alias == null || ns == null) - throw new NullPointerException("Expecting Symbol + Namespace"); - IPersistentMap map = getAliases(); - while(!map.containsKey(alias)) - { - IPersistentMap newMap = map.assoc(alias, ns); - aliases.compareAndSet(map, newMap); - map = getAliases(); - } - // you can rebind an alias, but only to the initially-aliased namespace. - if(!map.valAt(alias).equals(ns)) - throw new IllegalStateException("Alias " + alias + " already exists in namespace " - + name + ", aliasing " + map.valAt(alias)); -} - -public void removeAlias(Symbol alias) throws Exception{ - IPersistentMap map = getAliases(); - while(map.containsKey(alias)) - { - IPersistentMap newMap = map.without(alias); - aliases.compareAndSet(map, newMap); - map = getAliases(); - } -} - -private Object readResolve() throws ObjectStreamException { - // ensures that serialized namespaces are "deserialized" to the - // namespace in the present runtime - return findOrCreate(name); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Numbers.java --- a/src/clojure/lang/Numbers.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4527 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 31, 2008 */ - -package clojure.lang; - -import java.math.BigInteger; -import java.math.BigDecimal; -import java.math.MathContext; - -public class Numbers{ - -static interface Ops{ - Ops combine(Ops y); - - Ops opsWith(IntegerOps x); - - Ops opsWith(LongOps x); - - Ops opsWith(FloatOps x); - - Ops opsWith(DoubleOps x); - - Ops opsWith(RatioOps x); - - Ops opsWith(BigIntegerOps x); - - Ops opsWith(BigDecimalOps x); - - public boolean isZero(Number x); - - public boolean isPos(Number x); - - public boolean isNeg(Number x); - - public Number add(Number x, Number y); - - public Number multiply(Number x, Number y); - - public Number divide(Number x, Number y); - - public Number quotient(Number x, Number y); - - public Number remainder(Number x, Number y); - - public boolean equiv(Number x, Number y); - - public boolean lt(Number x, Number y); - - public Number negate(Number x); - - public Number inc(Number x); - - public Number dec(Number x); -} - -static interface BitOps{ - BitOps combine(BitOps y); - - BitOps bitOpsWith(IntegerBitOps x); - - BitOps bitOpsWith(LongBitOps x); - - BitOps bitOpsWith(BigIntegerBitOps x); - - public Number not(Number x); - - public Number and(Number x, Number y); - - public Number or(Number x, Number y); - - public Number xor(Number x, Number y); - - public Number andNot(Number x, Number y); - - public Number clearBit(Number x, int n); - - public Number setBit(Number x, int n); - - public Number flipBit(Number x, int n); - - public boolean testBit(Number x, int n); - - public Number shiftLeft(Number x, int n); - - public Number shiftRight(Number x, int n); -} - - -static public boolean isZero(Object x){ - return ops(x).isZero((Number)x); -} - -static public boolean isPos(Object x){ - return ops(x).isPos((Number)x); -} - -static public boolean isNeg(Object x){ - return ops(x).isNeg((Number)x); -} - -static public Number minus(Object x){ - return ops(x).negate((Number)x); -} - -static public Number inc(Object x){ - return ops(x).inc((Number)x); -} - -static public Number dec(Object x){ - return ops(x).dec((Number)x); -} - -static public Number add(Object x, Object y){ - return ops(x).combine(ops(y)).add((Number)x, (Number)y); -} - -static public Number minus(Object x, Object y){ - Ops yops = ops(y); - return ops(x).combine(yops).add((Number)x, yops.negate((Number)y)); -} - -static public Number multiply(Object x, Object y){ - return ops(x).combine(ops(y)).multiply((Number)x, (Number)y); -} - -static public Number divide(Object x, Object y){ - Ops yops = ops(y); - if(yops.isZero((Number)y)) - throw new ArithmeticException("Divide by zero"); - return ops(x).combine(yops).divide((Number)x, (Number)y); -} - -static public Number quotient(Number x, Number y){ - Ops yops = ops(y); - if(yops.isZero(y)) - throw new ArithmeticException("Divide by zero"); - return reduce(ops(x).combine(yops).quotient(x, y)); -} - -static public Number remainder(Number x, Number y){ - Ops yops = ops(y); - if(yops.isZero(y)) - throw new ArithmeticException("Divide by zero"); - return reduce(ops(x).combine(yops).remainder(x, y)); -} - -static Number quotient(double n, double d){ - double q = n / d; - if(q <= Integer.MAX_VALUE && q >= Integer.MIN_VALUE) - { - return (int) q; - } - else - { //bigint quotient - return reduce(new BigDecimal(q).toBigInteger()); - } -} - -static Number remainder(double n, double d){ - double q = n / d; - if(q <= Integer.MAX_VALUE && q >= Integer.MIN_VALUE) - { - return (n - ((int) q) * d); - } - else - { //bigint quotient - Number bq = reduce(new BigDecimal(q).toBigInteger()); - return (n - bq.doubleValue() * d); - } -} - -static public boolean equiv(Object x, Object y){ - return equiv((Number) x, (Number) y); -} - -static public boolean equiv(Number x, Number y){ - return ops(x).combine(ops(y)).equiv(x, y); -} - -static public boolean lt(Object x, Object y){ - return ops(x).combine(ops(y)).lt((Number)x, (Number)y); -} - -static public boolean lte(Object x, Object y){ - return !ops(x).combine(ops(y)).lt((Number)y, (Number)x); -} - -static public boolean gt(Object x, Object y){ - return ops(x).combine(ops(y)).lt((Number)y, (Number)x); -} - -static public boolean gte(Object x, Object y){ - return !ops(x).combine(ops(y)).lt((Number)x, (Number)y); -} - -static public int compare(Number x, Number y){ - Ops ops = ops(x).combine(ops(y)); - if(ops.lt(x, y)) - return -1; - else if(ops.lt(y, x)) - return 1; - return 0; -} - -static BigInteger toBigInteger(Object x){ - if(x instanceof BigInteger) - return (BigInteger) x; - else - return BigInteger.valueOf(((Number) x).longValue()); -} - -static BigDecimal toBigDecimal(Object x){ - if(x instanceof BigDecimal) - return (BigDecimal) x; - else if(x instanceof BigInteger) - return new BigDecimal((BigInteger) x); - else - return BigDecimal.valueOf(((Number) x).longValue()); -} - -static Ratio toRatio(Object x){ - if(x instanceof Ratio) - return (Ratio) x; - else if(x instanceof BigDecimal) - { - BigDecimal bx = (BigDecimal) x; - BigInteger bv = bx.unscaledValue(); - int scale = bx.scale(); - if(scale < 0) - return new Ratio(bv.multiply(BigInteger.TEN.pow(-scale)), BigInteger.ONE); - else - return new Ratio(bv, BigInteger.TEN.pow(scale)); - } - return new Ratio(toBigInteger(x), BigInteger.ONE); -} - -static public Number rationalize(Number x){ - if(x instanceof Float || x instanceof Double) - return rationalize(BigDecimal.valueOf(x.doubleValue())); - else if(x instanceof BigDecimal) - { - BigDecimal bx = (BigDecimal) x; - BigInteger bv = bx.unscaledValue(); - int scale = bx.scale(); - if(scale < 0) - return bv.multiply(BigInteger.TEN.pow(-scale)); - else - return divide(bv, BigInteger.TEN.pow(scale)); - } - return x; -} - -static public Number reduce(Number val){ - if(val instanceof Long) - return reduce(val.longValue()); - else if (val instanceof BigInteger) - return reduce((BigInteger) val); - return val; -} - -static public Number reduce(BigInteger val){ - int bitLength = val.bitLength(); - if(bitLength < 32) - return val.intValue(); - else if(bitLength < 64) - return val.longValue(); - else - return val; -} - -static public Number reduce(long val){ - if(val >= Integer.MIN_VALUE && val <= Integer.MAX_VALUE) - return (int) val; - else - return val; -} - -static public Number divide(BigInteger n, BigInteger d){ - if(d.equals(BigInteger.ZERO)) - throw new ArithmeticException("Divide by zero"); - BigInteger gcd = n.gcd(d); - if(gcd.equals(BigInteger.ZERO)) - return 0; - n = n.divide(gcd); - d = d.divide(gcd); - if(d.equals(BigInteger.ONE)) - return reduce(n); - else if(d.equals(BigInteger.ONE.negate())) - return reduce(n.negate()); - return new Ratio((d.signum() < 0 ? n.negate() : n), - (d.signum() < 0 ? d.negate() : d)); -} - -static public Number not(Object x){ - return bitOps(x).not((Number)x); -} - - -static public Number and(Object x, Object y){ - return bitOps(x).combine(bitOps(y)).and((Number)x, (Number)y); -} - -static public Number or(Object x, Object y){ - return bitOps(x).combine(bitOps(y)).or((Number)x, (Number)y); -} - -static public Number xor(Object x, Object y){ - return bitOps(x).combine(bitOps(y)).xor((Number)x, (Number)y); -} - -static public Number andNot(Number x, Number y){ - return bitOps(x).combine(bitOps(y)).andNot(x, y); -} - -static public Number clearBit(Number x, int n){ - if(n < 0) - throw new ArithmeticException("Negative bit index"); - return bitOps(x).clearBit(x, n); -} - -static public Number setBit(Number x, int n){ - if(n < 0) - throw new ArithmeticException("Negative bit index"); - return bitOps(x).setBit(x, n); -} - -static public Number flipBit(Number x, int n){ - if(n < 0) - throw new ArithmeticException("Negative bit index"); - return bitOps(x).flipBit(x, n); -} - -static public boolean testBit(Number x, int n){ - if(n < 0) - throw new ArithmeticException("Negative bit index"); - return bitOps(x).testBit(x, n); -} - -static public Number shiftLeft(Object x, Object n){ - return bitOps(x).shiftLeft((Number)x, ((Number)n).intValue()); -} - -static public int shiftLeft(int x, int n){ - return x << n; -} - -static public Number shiftRight(Object x, Object n){ - return bitOps(x).shiftRight((Number)x, ((Number)n).intValue()); -} - -static public int shiftRight(int x, int n){ - return x >> n; -} - -final static class IntegerOps implements Ops{ - public Ops combine(Ops y){ - return y.opsWith(this); - } - - final public Ops opsWith(IntegerOps x){ - return this; - } - - final public Ops opsWith(LongOps x){ - return LONG_OPS; - } - - final public Ops opsWith(FloatOps x){ - return FLOAT_OPS; - } - - final public Ops opsWith(DoubleOps x){ - return DOUBLE_OPS; - } - - final public Ops opsWith(RatioOps x){ - return RATIO_OPS; - } - - final public Ops opsWith(BigIntegerOps x){ - return BIGINTEGER_OPS; - } - - final public Ops opsWith(BigDecimalOps x){ - return BIGDECIMAL_OPS; - } - - public boolean isZero(Number x){ - return x.intValue() == 0; - } - - public boolean isPos(Number x){ - return x.intValue() > 0; - } - - public boolean isNeg(Number x){ - return x.intValue() < 0; - } - - final public Number add(Number x, Number y){ - long ret = x.longValue() + y.longValue(); - if(ret <= Integer.MAX_VALUE && ret >= Integer.MIN_VALUE) - return (int) ret; - return ret; - } - - final public Number multiply(Number x, Number y){ - long ret = x.longValue() * y.longValue(); - if(ret <= Integer.MAX_VALUE && ret >= Integer.MIN_VALUE) - return (int) ret; - return ret; - } - - static int gcd(int u, int v){ - while(v != 0) - { - int r = u % v; - u = v; - v = r; - } - return u; - } - - public Number divide(Number x, Number y){ - int n = x.intValue(); - int val = y.intValue(); - int gcd = gcd(n, val); - if(gcd == 0) - return 0; - - n = n / gcd; - int d = val / gcd; - if(d == 1) - return n; - if(d < 0) - { - n = -n; - d = -d; - } - return new Ratio(BigInteger.valueOf(n), BigInteger.valueOf(d)); - } - - public Number quotient(Number x, Number y){ - return x.intValue() / y.intValue(); - } - - public Number remainder(Number x, Number y){ - return x.intValue() % y.intValue(); - } - - public boolean equiv(Number x, Number y){ - return x.intValue() == y.intValue(); - } - - public boolean lt(Number x, Number y){ - return x.intValue() < y.intValue(); - } - - //public Number subtract(Number x, Number y); - final public Number negate(Number x){ - int val = x.intValue(); - if(val > Integer.MIN_VALUE) - return -val; - return -((long) val); - } - - public Number inc(Number x){ - int val = x.intValue(); - if(val < Integer.MAX_VALUE) - return val + 1; - return (long) val + 1; - } - - public Number dec(Number x){ - int val = x.intValue(); - if(val > Integer.MIN_VALUE) - return val - 1; - return (long) val - 1; - } -} - -final static class LongOps implements Ops{ - public Ops combine(Ops y){ - return y.opsWith(this); - } - - final public Ops opsWith(IntegerOps x){ - return this; - } - - final public Ops opsWith(LongOps x){ - return this; - } - - final public Ops opsWith(FloatOps x){ - return FLOAT_OPS; - } - - final public Ops opsWith(DoubleOps x){ - return DOUBLE_OPS; - } - - final public Ops opsWith(RatioOps x){ - return RATIO_OPS; - } - - final public Ops opsWith(BigIntegerOps x){ - return BIGINTEGER_OPS; - } - - final public Ops opsWith(BigDecimalOps x){ - return BIGDECIMAL_OPS; - } - - public boolean isZero(Number x){ - return x.longValue() == 0; - } - - public boolean isPos(Number x){ - return x.longValue() > 0; - } - - public boolean isNeg(Number x){ - return x.longValue() < 0; - } - - final public Number add(Number x, Number y){ - long lx = x.longValue(), ly = y.longValue(); - long ret = lx + ly; - if ((ret ^ lx) < 0 && (ret ^ ly) < 0) - return BIGINTEGER_OPS.add(x, y); - return ret; - } - - final public Number multiply(Number x, Number y){ - long lx = x.longValue(), ly = y.longValue(); - long ret = lx * ly; - if (ly != 0 && ret/ly != lx) - return BIGINTEGER_OPS.multiply(x, y); - return ret; - } - - static long gcd(long u, long v){ - while(v != 0) - { - long r = u % v; - u = v; - v = r; - } - return u; - } - - public Number divide(Number x, Number y){ - long n = x.longValue(); - long val = y.longValue(); - long gcd = gcd(n, val); - if(gcd == 0) - return 0; - - n = n / gcd; - long d = val / gcd; - if(d == 1) - return n; - if(d < 0) - { - n = -n; - d = -d; - } - return new Ratio(BigInteger.valueOf(n), BigInteger.valueOf(d)); - } - - public Number quotient(Number x, Number y){ - return x.longValue() / y.longValue(); - } - - public Number remainder(Number x, Number y){ - return x.longValue() % y.longValue(); - } - - public boolean equiv(Number x, Number y){ - return x.longValue() == y.longValue(); - } - - public boolean lt(Number x, Number y){ - return x.longValue() < y.longValue(); - } - - //public Number subtract(Number x, Number y); - final public Number negate(Number x){ - long val = x.longValue(); - if(val > Long.MIN_VALUE) - return -val; - return BigInteger.valueOf(val).negate(); - } - - public Number inc(Number x){ - long val = x.longValue(); - if(val < Long.MAX_VALUE) - return val + 1; - return BIGINTEGER_OPS.inc(x); - } - - public Number dec(Number x){ - long val = x.longValue(); - if(val > Long.MIN_VALUE) - return val - 1; - return BIGINTEGER_OPS.dec(x); - } -} - -final static class FloatOps implements Ops{ - public Ops combine(Ops y){ - return y.opsWith(this); - } - - final public Ops opsWith(IntegerOps x){ - return this; - } - - final public Ops opsWith(LongOps x){ - return this; - } - - final public Ops opsWith(FloatOps x){ - return this; - } - - final public Ops opsWith(DoubleOps x){ - return DOUBLE_OPS; - } - - final public Ops opsWith(RatioOps x){ - return this; - } - - final public Ops opsWith(BigIntegerOps x){ - return this; - } - - final public Ops opsWith(BigDecimalOps x){ - return this; - } - - public boolean isZero(Number x){ - return x.floatValue() == 0; - } - - public boolean isPos(Number x){ - return x.floatValue() > 0; - } - - public boolean isNeg(Number x){ - return x.floatValue() < 0; - } - - final public Number add(Number x, Number y){ - return x.floatValue() + y.floatValue(); - } - - final public Number multiply(Number x, Number y){ - return x.floatValue() * y.floatValue(); - } - - public Number divide(Number x, Number y){ - return x.floatValue() / y.floatValue(); - } - - public Number quotient(Number x, Number y){ - return Numbers.quotient(x.doubleValue(), y.doubleValue()); - } - - public Number remainder(Number x, Number y){ - return Numbers.remainder(x.doubleValue(), y.doubleValue()); - } - - public boolean equiv(Number x, Number y){ - return x.floatValue() == y.floatValue(); - } - - public boolean lt(Number x, Number y){ - return x.floatValue() < y.floatValue(); - } - - //public Number subtract(Number x, Number y); - final public Number negate(Number x){ - return -x.floatValue(); - } - - public Number inc(Number x){ - return x.floatValue() + 1; - } - - public Number dec(Number x){ - return x.floatValue() - 1; - } -} - -final static class DoubleOps implements Ops{ - public Ops combine(Ops y){ - return y.opsWith(this); - } - - final public Ops opsWith(IntegerOps x){ - return this; - } - - final public Ops opsWith(LongOps x){ - return this; - } - - final public Ops opsWith(FloatOps x){ - return this; - } - - final public Ops opsWith(DoubleOps x){ - return this; - } - - final public Ops opsWith(RatioOps x){ - return this; - } - - final public Ops opsWith(BigIntegerOps x){ - return this; - } - - final public Ops opsWith(BigDecimalOps x){ - return this; - } - - public boolean isZero(Number x){ - return x.doubleValue() == 0; - } - - public boolean isPos(Number x){ - return x.doubleValue() > 0; - } - - public boolean isNeg(Number x){ - return x.doubleValue() < 0; - } - - final public Number add(Number x, Number y){ - return x.doubleValue() + y.doubleValue(); - } - - final public Number multiply(Number x, Number y){ - return x.doubleValue() * y.doubleValue(); - } - - public Number divide(Number x, Number y){ - return x.doubleValue() / y.doubleValue(); - } - - public Number quotient(Number x, Number y){ - return Numbers.quotient(x.doubleValue(), y.doubleValue()); - } - - public Number remainder(Number x, Number y){ - return Numbers.remainder(x.doubleValue(), y.doubleValue()); - } - - public boolean equiv(Number x, Number y){ - return x.doubleValue() == y.doubleValue(); - } - - public boolean lt(Number x, Number y){ - return x.doubleValue() < y.doubleValue(); - } - - //public Number subtract(Number x, Number y); - final public Number negate(Number x){ - return -x.doubleValue(); - } - - public Number inc(Number x){ - return x.doubleValue() + 1; - } - - public Number dec(Number x){ - return x.doubleValue() - 1; - } -} - -final static class RatioOps implements Ops{ - public Ops combine(Ops y){ - return y.opsWith(this); - } - - final public Ops opsWith(IntegerOps x){ - return this; - } - - final public Ops opsWith(LongOps x){ - return this; - } - - final public Ops opsWith(FloatOps x){ - return FLOAT_OPS; - } - - final public Ops opsWith(DoubleOps x){ - return DOUBLE_OPS; - } - - final public Ops opsWith(RatioOps x){ - return this; - } - - final public Ops opsWith(BigIntegerOps x){ - return this; - } - - final public Ops opsWith(BigDecimalOps x){ - return this; - } - - public boolean isZero(Number x){ - Ratio r = (Ratio) x; - return r.numerator.signum() == 0; - } - - public boolean isPos(Number x){ - Ratio r = (Ratio) x; - return r.numerator.signum() > 0; - } - - public boolean isNeg(Number x){ - Ratio r = (Ratio) x; - return r.numerator.signum() < 0; - } - - final public Number add(Number x, Number y){ - Ratio rx = toRatio(x); - Ratio ry = toRatio(y); - return divide(ry.numerator.multiply(rx.denominator) - .add(rx.numerator.multiply(ry.denominator)) - , ry.denominator.multiply(rx.denominator)); - } - - final public Number multiply(Number x, Number y){ - Ratio rx = toRatio(x); - Ratio ry = toRatio(y); - return Numbers.divide(ry.numerator.multiply(rx.numerator) - , ry.denominator.multiply(rx.denominator)); - } - - public Number divide(Number x, Number y){ - Ratio rx = toRatio(x); - Ratio ry = toRatio(y); - return Numbers.divide(ry.denominator.multiply(rx.numerator) - , ry.numerator.multiply(rx.denominator)); - } - - public Number quotient(Number x, Number y){ - Ratio rx = toRatio(x); - Ratio ry = toRatio(y); - BigInteger q = rx.numerator.multiply(ry.denominator).divide( - rx.denominator.multiply(ry.numerator)); - return reduce(q); - } - - public Number remainder(Number x, Number y){ - Ratio rx = toRatio(x); - Ratio ry = toRatio(y); - BigInteger q = rx.numerator.multiply(ry.denominator).divide( - rx.denominator.multiply(ry.numerator)); - return Numbers.minus(x, Numbers.multiply(q, y)); - } - - public boolean equiv(Number x, Number y){ - Ratio rx = toRatio(x); - Ratio ry = toRatio(y); - return rx.numerator.equals(ry.numerator) - && rx.denominator.equals(ry.denominator); - } - - public boolean lt(Number x, Number y){ - Ratio rx = toRatio(x); - Ratio ry = toRatio(y); - return Numbers.lt(rx.numerator.multiply(ry.denominator), ry.numerator.multiply(rx.denominator)); - } - - //public Number subtract(Number x, Number y); - final public Number negate(Number x){ - Ratio r = (Ratio) x; - return new Ratio(r.numerator.negate(), r.denominator); - } - - public Number inc(Number x){ - return Numbers.add(x, 1); - } - - public Number dec(Number x){ - return Numbers.add(x, -1); - } - -} - -final static class BigIntegerOps implements Ops{ - public Ops combine(Ops y){ - return y.opsWith(this); - } - - final public Ops opsWith(IntegerOps x){ - return this; - } - - final public Ops opsWith(LongOps x){ - return this; - } - - final public Ops opsWith(FloatOps x){ - return FLOAT_OPS; - } - - final public Ops opsWith(DoubleOps x){ - return DOUBLE_OPS; - } - - final public Ops opsWith(RatioOps x){ - return RATIO_OPS; - } - - final public Ops opsWith(BigIntegerOps x){ - return this; - } - - final public Ops opsWith(BigDecimalOps x){ - return BIGDECIMAL_OPS; - } - - public boolean isZero(Number x){ - BigInteger bx = toBigInteger(x); - return bx.signum() == 0; - } - - public boolean isPos(Number x){ - BigInteger bx = toBigInteger(x); - return bx.signum() > 0; - } - - public boolean isNeg(Number x){ - BigInteger bx = toBigInteger(x); - return bx.signum() < 0; - } - - final public Number add(Number x, Number y){ - return reduce(toBigInteger(x).add(toBigInteger(y))); - } - - final public Number multiply(Number x, Number y){ - return reduce(toBigInteger(x).multiply(toBigInteger(y))); - } - - public Number divide(Number x, Number y){ - return Numbers.divide(toBigInteger(x), toBigInteger(y)); - } - - public Number quotient(Number x, Number y){ - return toBigInteger(x).divide(toBigInteger(y)); - } - - public Number remainder(Number x, Number y){ - return toBigInteger(x).remainder(toBigInteger(y)); - } - - public boolean equiv(Number x, Number y){ - return toBigInteger(x).equals(toBigInteger(y)); - } - - public boolean lt(Number x, Number y){ - return toBigInteger(x).compareTo(toBigInteger(y)) < 0; - } - - //public Number subtract(Number x, Number y); - final public Number negate(Number x){ - return toBigInteger(x).negate(); - } - - public Number inc(Number x){ - BigInteger bx = toBigInteger(x); - return reduce(bx.add(BigInteger.ONE)); - } - - public Number dec(Number x){ - BigInteger bx = toBigInteger(x); - return reduce(bx.subtract(BigInteger.ONE)); - } -} - -final static class BigDecimalOps implements Ops{ - final static Var MATH_CONTEXT = RT.MATH_CONTEXT; - - public Ops combine(Ops y){ - return y.opsWith(this); - } - - final public Ops opsWith(IntegerOps x){ - return this; - } - - final public Ops opsWith(LongOps x){ - return this; - } - - final public Ops opsWith(FloatOps x){ - return FLOAT_OPS; - } - - final public Ops opsWith(DoubleOps x){ - return DOUBLE_OPS; - } - - final public Ops opsWith(RatioOps x){ - return RATIO_OPS; - } - - final public Ops opsWith(BigIntegerOps x){ - return this; - } - - final public Ops opsWith(BigDecimalOps x){ - return this; - } - - public boolean isZero(Number x){ - BigDecimal bx = (BigDecimal) x; - return bx.signum() == 0; - } - - public boolean isPos(Number x){ - BigDecimal bx = (BigDecimal) x; - return bx.signum() > 0; - } - - public boolean isNeg(Number x){ - BigDecimal bx = (BigDecimal) x; - return bx.signum() < 0; - } - - final public Number add(Number x, Number y){ - MathContext mc = (MathContext) MATH_CONTEXT.deref(); - return mc == null - ? toBigDecimal(x).add(toBigDecimal(y)) - : toBigDecimal(x).add(toBigDecimal(y), mc); - } - - final public Number multiply(Number x, Number y){ - MathContext mc = (MathContext) MATH_CONTEXT.deref(); - return mc == null - ? toBigDecimal(x).multiply(toBigDecimal(y)) - : toBigDecimal(x).multiply(toBigDecimal(y), mc); - } - - public Number divide(Number x, Number y){ - MathContext mc = (MathContext) MATH_CONTEXT.deref(); - return mc == null - ? toBigDecimal(x).divide(toBigDecimal(y)) - : toBigDecimal(x).divide(toBigDecimal(y), mc); - } - - public Number quotient(Number x, Number y){ - MathContext mc = (MathContext) MATH_CONTEXT.deref(); - return mc == null - ? toBigDecimal(x).divideToIntegralValue(toBigDecimal(y)) - : toBigDecimal(x).divideToIntegralValue(toBigDecimal(y), mc); - } - - public Number remainder(Number x, Number y){ - MathContext mc = (MathContext) MATH_CONTEXT.deref(); - return mc == null - ? toBigDecimal(x).remainder(toBigDecimal(y)) - : toBigDecimal(x).remainder(toBigDecimal(y), mc); - } - - public boolean equiv(Number x, Number y){ - return toBigDecimal(x).equals(toBigDecimal(y)); - } - - public boolean lt(Number x, Number y){ - return toBigDecimal(x).compareTo(toBigDecimal(y)) < 0; - } - - //public Number subtract(Number x, Number y); - final public Number negate(Number x){ - MathContext mc = (MathContext) MATH_CONTEXT.deref(); - return mc == null - ? ((BigDecimal) x).negate() - : ((BigDecimal) x).negate(mc); - } - - public Number inc(Number x){ - MathContext mc = (MathContext) MATH_CONTEXT.deref(); - BigDecimal bx = (BigDecimal) x; - return mc == null - ? bx.add(BigDecimal.ONE) - : bx.add(BigDecimal.ONE, mc); - } - - public Number dec(Number x){ - MathContext mc = (MathContext) MATH_CONTEXT.deref(); - BigDecimal bx = (BigDecimal) x; - return mc == null - ? bx.subtract(BigDecimal.ONE) - : bx.subtract(BigDecimal.ONE, mc); - } -} - -final static class IntegerBitOps implements BitOps{ - public BitOps combine(BitOps y){ - return y.bitOpsWith(this); - } - - final public BitOps bitOpsWith(IntegerBitOps x){ - return this; - } - - final public BitOps bitOpsWith(LongBitOps x){ - return LONG_BITOPS; - } - - final public BitOps bitOpsWith(BigIntegerBitOps x){ - return BIGINTEGER_BITOPS; - } - - - public Number not(Number x){ - return ~x.intValue(); - } - - public Number and(Number x, Number y){ - return x.intValue() & y.intValue(); - } - - public Number or(Number x, Number y){ - return x.intValue() | y.intValue(); - } - - public Number xor(Number x, Number y){ - return x.intValue() ^ y.intValue(); - } - - public Number andNot(Number x, Number y){ - return x.intValue() & ~y.intValue(); - } - - public Number clearBit(Number x, int n){ - if(n < 31) - return x.intValue() & ~(1 << n); - else if(n < 63) - return x.longValue() & ~(1L << n); - else - return toBigInteger(x).clearBit(n); - } - - public Number setBit(Number x, int n){ - if(n < 31) - return x.intValue() | (1 << n); - else if(n < 63) - return x.longValue() | (1L << n); - else - return toBigInteger(x).setBit(n); - } - - public Number flipBit(Number x, int n){ - if(n < 31) - return x.intValue() ^ (1 << n); - else if(n < 63) - return x.longValue() ^ (1L << n); - else - return toBigInteger(x).flipBit(n); - } - - public boolean testBit(Number x, int n){ - if(n < 32) - return (x.intValue() & (1 << n)) != 0; - else if(n < 64) - return (x.longValue() & (1L << n)) != 0; - else - return toBigInteger(x).testBit(n); - } - - public Number shiftLeft(Number x, int n){ - if(n < 32) - { - if(n < 0) - return shiftRight(x, -n); - return reduce(x.longValue() << n); - } - else - return reduce(toBigInteger(x).shiftLeft(n)); - } - - public Number shiftRight(Number x, int n){ - if(n < 0) - return shiftLeft(x, -n); - return x.intValue() >> n; - } -} - -final static class LongBitOps implements BitOps{ - public BitOps combine(BitOps y){ - return y.bitOpsWith(this); - } - - final public BitOps bitOpsWith(IntegerBitOps x){ - return this; - } - - final public BitOps bitOpsWith(LongBitOps x){ - return this; - } - - final public BitOps bitOpsWith(BigIntegerBitOps x){ - return BIGINTEGER_BITOPS; - } - - public Number not(Number x){ - return ~x.longValue(); - } - - public Number and(Number x, Number y){ - return x.longValue() & y.longValue(); - } - - public Number or(Number x, Number y){ - return x.longValue() | y.longValue(); - } - - public Number xor(Number x, Number y){ - return x.longValue() ^ y.longValue(); - } - - public Number andNot(Number x, Number y){ - return x.longValue() & ~y.longValue(); - } - - public Number clearBit(Number x, int n){ - if(n < 63) - return x.longValue() & ~(1L << n); - else - return toBigInteger(x).clearBit(n); - } - - public Number setBit(Number x, int n){ - if(n < 63) - return x.longValue() | (1L << n); - else - return toBigInteger(x).setBit(n); - } - - public Number flipBit(Number x, int n){ - if(n < 63) - return x.longValue() ^ (1L << n); - else - return toBigInteger(x).flipBit(n); - } - - public boolean testBit(Number x, int n){ - if(n < 64) - return (x.longValue() & (1L << n)) != 0; - else - return toBigInteger(x).testBit(n); - } - - public Number shiftLeft(Number x, int n){ - if(n < 0) - return shiftRight(x, -n); - return reduce(toBigInteger(x).shiftLeft(n)); - } - - public Number shiftRight(Number x, int n){ - if(n < 0) - return shiftLeft(x, -n); - return x.longValue() >> n; - } -} - -final static class BigIntegerBitOps implements BitOps{ - public BitOps combine(BitOps y){ - return y.bitOpsWith(this); - } - - final public BitOps bitOpsWith(IntegerBitOps x){ - return this; - } - - final public BitOps bitOpsWith(LongBitOps x){ - return this; - } - - final public BitOps bitOpsWith(BigIntegerBitOps x){ - return this; - } - - public Number not(Number x){ - return toBigInteger(x).not(); - } - - public Number and(Number x, Number y){ - return toBigInteger(x).and(toBigInteger(y)); - } - - public Number or(Number x, Number y){ - return toBigInteger(x).or(toBigInteger(y)); - } - - public Number xor(Number x, Number y){ - return toBigInteger(x).xor(toBigInteger(y)); - } - - public Number andNot(Number x, Number y){ - return toBigInteger(x).andNot(toBigInteger(y)); - } - - public Number clearBit(Number x, int n){ - return toBigInteger(x).clearBit(n); - } - - public Number setBit(Number x, int n){ - return toBigInteger(x).setBit(n); - } - - public Number flipBit(Number x, int n){ - return toBigInteger(x).flipBit(n); - } - - public boolean testBit(Number x, int n){ - return toBigInteger(x).testBit(n); - } - - public Number shiftLeft(Number x, int n){ - return toBigInteger(x).shiftLeft(n); - } - - public Number shiftRight(Number x, int n){ - return toBigInteger(x).shiftRight(n); - } -} - -static final IntegerOps INTEGER_OPS = new IntegerOps(); -static final LongOps LONG_OPS = new LongOps(); -static final FloatOps FLOAT_OPS = new FloatOps(); -static final DoubleOps DOUBLE_OPS = new DoubleOps(); -static final RatioOps RATIO_OPS = new RatioOps(); -static final BigIntegerOps BIGINTEGER_OPS = new BigIntegerOps(); -static final BigDecimalOps BIGDECIMAL_OPS = new BigDecimalOps(); - -static final IntegerBitOps INTEGER_BITOPS = new IntegerBitOps(); -static final LongBitOps LONG_BITOPS = new LongBitOps(); -static final BigIntegerBitOps BIGINTEGER_BITOPS = new BigIntegerBitOps(); - -static Ops ops(Object x){ - Class xc = x.getClass(); - - if(xc == Integer.class) - return INTEGER_OPS; - else if(xc == Double.class) - return DOUBLE_OPS; - else if(xc == Float.class) - return FLOAT_OPS; - else if(xc == BigInteger.class) - return BIGINTEGER_OPS; - else if(xc == Long.class) - return LONG_OPS; - else if(xc == Ratio.class) - return RATIO_OPS; - else if(xc == BigDecimal.class) - return BIGDECIMAL_OPS; - else - return INTEGER_OPS; -} - -static BitOps bitOps(Object x){ - Class xc = x.getClass(); - - if(xc == Integer.class) - return INTEGER_BITOPS; - else if(xc == Long.class) - return LONG_BITOPS; - else if(xc == BigInteger.class) - return BIGINTEGER_BITOPS; - else if(xc == Double.class || xc == Float.class || xc == BigDecimalOps.class || xc == Ratio.class) - throw new ArithmeticException("bit operation on non integer type: " + xc); - else - return INTEGER_BITOPS; -} - -//final static ExecutorService executor = Executors.newCachedThreadPool(); -//static public int minChunk = 100; -//static int chunkSize(int alength){ -// return Math.max(alength / Runtime.getRuntime().availableProcessors(), minChunk); -//} - -// } -// else -// { -// LinkedList> ops = new LinkedList>(); -// for(int offset = 0;offset < xs.length;offset+=chunk) -// { -// final int start = offset; -// final int end = Math.min(xs.length, start + chunk); -// ops.add(new Callable(){ -// public Float call() throws Exception{ -// for(int i=start;i y; -} - -static public boolean gte(float x, float y){ - return x >= y; -} - -static public boolean isPos(float x){ - return x > 0; -} - -static public boolean isNeg(float x){ - return x < 0; -} - -static public boolean isZero(float x){ - return x == 0; -} - -static public Number num(double x){ - return x; -} - -static public double add(double x, double y){ - return x + y; -} - -static public double minus(double x, double y){ - return x - y; -} - -static public double minus(double x){ - return -x; -} - -static public double inc(double x){ - return x + 1; -} - -static public double dec(double x){ - return x - 1; -} - -static public double multiply(double x, double y){ - return x * y; -} - -static public double divide(double x, double y){ - return x / y; -} - -static public boolean equiv(double x, double y){ - return x == y; -} - -static public boolean lt(double x, double y){ - return x < y; -} - -static public boolean lte(double x, double y){ - return x <= y; -} - -static public boolean gt(double x, double y){ - return x > y; -} - -static public boolean gte(double x, double y){ - return x >= y; -} - -static public boolean isPos(double x){ - return x > 0; -} - -static public boolean isNeg(double x){ - return x < 0; -} - -static public boolean isZero(double x){ - return x == 0; -} - -static int throwIntOverflow(){ - throw new ArithmeticException("integer overflow"); -} - -static public Number num(int x){ - return x; -} - -static public int unchecked_add(int x, int y){ - return x + y; -} - -static public int unchecked_subtract(int x, int y){ - return x - y; -} - -static public int unchecked_negate(int x){ - return -x; -} - -static public int unchecked_inc(int x){ - return x + 1; -} - -static public int unchecked_dec(int x){ - return x - 1; -} - -static public int unchecked_multiply(int x, int y){ - return x * y; -} - -static public int add(int x, int y){ - int ret = x + y; - if ((ret ^ x) < 0 && (ret ^ y) < 0) - return throwIntOverflow(); - return ret; -} - -static public int not(int x){ - return ~x; -} - -static public int and(int x, int y){ - return x & y; -} - -static public int or(int x, int y){ - return x | y; -} - -static public int xor(int x, int y){ - return x ^ y; -} - -static public int minus(int x, int y){ - int ret = x - y; - if (((ret ^ x) < 0 && (ret ^ ~y) < 0)) - return throwIntOverflow(); - return ret; -} - -static public int minus(int x){ - if(x == Integer.MIN_VALUE) - return throwIntOverflow(); - return -x; -} - -static public int inc(int x){ - if(x == Integer.MAX_VALUE) - return throwIntOverflow(); - return x + 1; -} - -static public int dec(int x){ - if(x == Integer.MIN_VALUE) - return throwIntOverflow(); - return x - 1; -} - -static public int multiply(int x, int y){ - int ret = x * y; - if (y != 0 && ret/y != x) - return throwIntOverflow(); - return ret; -} - -static public int unchecked_divide(int x, int y){ - return x / y; -} - -static public int unchecked_remainder(int x, int y){ - return x % y; -} - -static public boolean equiv(int x, int y){ - return x == y; -} - -static public boolean lt(int x, int y){ - return x < y; -} - -static public boolean lte(int x, int y){ - return x <= y; -} - -static public boolean gt(int x, int y){ - return x > y; -} - -static public boolean gte(int x, int y){ - return x >= y; -} - -static public boolean isPos(int x){ - return x > 0; -} - -static public boolean isNeg(int x){ - return x < 0; -} - -static public boolean isZero(int x){ - return x == 0; -} - -static public Number num(long x){ - return x; -} - -static public long unchecked_add(long x, long y){ - return x + y; -} - -static public long unchecked_subtract(long x, long y){ - return x - y; -} - -static public long unchecked_negate(long x){ - return -x; -} - -static public long unchecked_inc(long x){ - return x + 1; -} - -static public long unchecked_dec(long x){ - return x - 1; -} - -static public long unchecked_multiply(long x, long y){ - return x * y; -} - -static public long add(long x, long y){ - long ret = x + y; - if ((ret ^ x) < 0 && (ret ^ y) < 0) - return throwIntOverflow(); - return ret; -} - -static public long minus(long x, long y){ - long ret = x - y; - if (((ret ^ x) < 0 && (ret ^ ~y) < 0)) - return throwIntOverflow(); - return ret; -} - -static public long minus(long x){ - if(x == Long.MIN_VALUE) - return throwIntOverflow(); - return -x; -} - -static public long inc(long x){ - if(x == Long.MAX_VALUE) - return throwIntOverflow(); - return x + 1; -} - -static public long dec(long x){ - if(x == Long.MIN_VALUE) - return throwIntOverflow(); - return x - 1; -} - -static public long multiply(long x, long y){ - long ret = x * y; - if (y != 0 && ret/y != x) - return throwIntOverflow(); - return ret; -} - -static public long unchecked_divide(long x, long y){ - return x / y; -} - -static public long unchecked_remainder(long x, long y){ - return x % y; -} - -static public boolean equiv(long x, long y){ - return x == y; -} - -static public boolean lt(long x, long y){ - return x < y; -} - -static public boolean lte(long x, long y){ - return x <= y; -} - -static public boolean gt(long x, long y){ - return x > y; -} - -static public boolean gte(long x, long y){ - return x >= y; -} - -static public boolean isPos(long x){ - return x > 0; -} - -static public boolean isNeg(long x){ - return x < 0; -} - -static public boolean isZero(long x){ - return x == 0; -} - -/* -static public class F{ - static public float add(float x, float y){ - return x + y; - } - - static public float subtract(float x, float y){ - return x - y; - } - - static public float negate(float x){ - return -x; - } - - static public float inc(float x){ - return x + 1; - } - - static public float dec(float x){ - return x - 1; - } - - static public float multiply(float x, float y){ - return x * y; - } - - static public float divide(float x, float y){ - return x / y; - } - - static public boolean equiv(float x, float y){ - return x == y; - } - - static public boolean lt(float x, float y){ - return x < y; - } - - static public boolean lte(float x, float y){ - return x <= y; - } - - static public boolean gt(float x, float y){ - return x > y; - } - - static public boolean gte(float x, float y){ - return x >= y; - } - - static public boolean pos(float x){ - return x > 0; - } - - static public boolean neg(float x){ - return x < 0; - } - - static public boolean zero(float x){ - return x == 0; - } - - static public float aget(float[] xs, int i){ - return xs[i]; - } - - static public float aset(float[] xs, int i, float v){ - xs[i] = v; - return v; - } - - static public int alength(float[] xs){ - return xs.length; - } - - static public float[] aclone(float[] xs){ - return xs.clone(); - } - - static public float[] vec(int size, Object init){ - float[] ret = new float[size]; - if(init instanceof Number) - { - float f = ((Number) init).floatValue(); - for(int i = 0; i < ret.length; i++) - ret[i] = f; - } - else - { - ISeq s = RT.seq(init); - for(int i = 0; i < size && s != null; i++, s = s.rest()) - ret[i] = ((Number) s.first()).floatValue(); - } - return ret; - } - - static public float[] vec(Object sizeOrSeq){ - if(sizeOrSeq instanceof Number) - return new float[((Number) sizeOrSeq).intValue()]; - else - { - ISeq s = RT.seq(sizeOrSeq); - int size = s.count(); - float[] ret = new float[size]; - for(int i = 0; i < size && s != null; i++, s = s.rest()) - ret[i] = ((Number) s.first()).intValue(); - return ret; - } - } - - - static public float[] vsadd(float[] x, float y){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] += y; - return xs; - } - - static public float[] vssub(float[] x, float y){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] -= y; - return xs; - } - - static public float[] vsdiv(float[] x, float y){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] /= y; - return xs; - } - - static public float[] vsmul(float[] x, float y){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= y; - return xs; - } - - static public float[] svdiv(float y, float[] x){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = y / xs[i]; - return xs; - } - - static public float[] vsmuladd(float[] x, float y, float[] zs){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y + zs[i]; - return xs; - } - - static public float[] vsmulsub(float[] x, float y, float[] zs){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y - zs[i]; - return xs; - } - - static public float[] vsmulsadd(float[] x, float y, float z){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y + z; - return xs; - } - - static public float[] vsmulssub(float[] x, float y, float z){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y - z; - return xs; - } - - static public float[] vabs(float[] x){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.abs(xs[i]); - return xs; - } - - static public float[] vnegabs(float[] x){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = -Math.abs(xs[i]); - return xs; - } - - static public float[] vneg(float[] x){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = -xs[i]; - return xs; - } - - static public float[] vsqr(float[] x){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= xs[i]; - return xs; - } - - static public float[] vsignedsqr(float[] x){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= Math.abs(xs[i]); - return xs; - } - - static public float[] vclip(float[] x, float low, float high){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < low) - xs[i] = low; - else if(xs[i] > high) - xs[i] = high; - } - return xs; - } - - static public IPersistentVector vclipcounts(float[] x, float low, float high){ - final float[] xs = x.clone(); - int lowc = 0; - int highc = 0; - - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < low) - { - ++lowc; - xs[i] = low; - } - else if(xs[i] > high) - { - ++highc; - xs[i] = high; - } - } - return RT.vector(xs, lowc, highc); - } - - static public float[] vthresh(float[] x, float thresh, float otherwise){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < thresh) - xs[i] = otherwise; - } - return xs; - } - - static public float[] vreverse(float[] x){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[xs.length - i - 1]; - return xs; - } - - static public float[] vrunningsum(float[] x){ - final float[] xs = x.clone(); - for(int i = 1; i < xs.length; i++) - xs[i] = xs[i - 1] + xs[i]; - return xs; - } - - static public float[] vsort(float[] x){ - final float[] xs = x.clone(); - Arrays.sort(xs); - return xs; - } - - static public float vdot(float[] xs, float[] ys){ - float ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i] * ys[i]; - return ret; - } - - static public float vmax(float[] xs){ - if(xs.length == 0) - return 0; - float ret = xs[0]; - for(int i = 0; i < xs.length; i++) - ret = Math.max(ret, xs[i]); - return ret; - } - - static public float vmin(float[] xs){ - if(xs.length == 0) - return 0; - float ret = xs[0]; - for(int i = 0; i < xs.length; i++) - ret = Math.min(ret, xs[i]); - return ret; - } - - static public float vmean(float[] xs){ - if(xs.length == 0) - return 0; - return vsum(xs) / xs.length; - } - - static public double vrms(float[] xs){ - if(xs.length == 0) - return 0; - float ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i] * xs[i]; - return Math.sqrt(ret / xs.length); - } - - static public float vsum(float[] xs){ - float ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i]; - return ret; - } - - static public boolean vequiv(float[] xs, float[] ys){ - return Arrays.equals(xs, ys); - } - - static public float[] vadd(float[] x, float[] ys){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] += ys[i]; - return xs; - } - - static public float[] vsub(float[] x, float[] ys){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] -= ys[i]; - return xs; - } - - static public float[] vaddmul(float[] x, float[] ys, float[] zs){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] + ys[i]) * zs[i]; - return xs; - } - - static public float[] vsubmul(float[] x, float[] ys, float[] zs){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] - ys[i]) * zs[i]; - return xs; - } - - static public float[] vaddsmul(float[] x, float[] ys, float z){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] + ys[i]) * z; - return xs; - } - - static public float[] vsubsmul(float[] x, float[] ys, float z){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] - ys[i]) * z; - return xs; - } - - static public float[] vmulsadd(float[] x, float[] ys, float z){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) + z; - return xs; - } - - static public float[] vdiv(float[] x, float[] ys){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] /= ys[i]; - return xs; - } - - static public float[] vmul(float[] x, float[] ys){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= ys[i]; - return xs; - } - - static public float[] vmuladd(float[] x, float[] ys, float[] zs){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) + zs[i]; - return xs; - } - - static public float[] vmulsub(float[] x, float[] ys, float[] zs){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) - zs[i]; - return xs; - } - - static public float[] vmax(float[] x, float[] ys){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.max(xs[i], ys[i]); - return xs; - } - - static public float[] vmin(float[] x, float[] ys){ - final float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.min(xs[i], ys[i]); - return xs; - } - - static public float[] vmap(IFn fn, float[] x) throws Exception{ - float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = ((Number) fn.invoke(xs[i])).floatValue(); - return xs; - } - - static public float[] vmap(IFn fn, float[] x, float[] ys) throws Exception{ - float[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = ((Number) fn.invoke(xs[i], ys[i])).floatValue(); - return xs; - } - -} - -static public class D{ - static public double add(double x, double y){ - return x + y; - } - - static public double subtract(double x, double y){ - return x - y; - } - - static public double negate(double x){ - return -x; - } - - static public double inc(double x){ - return x + 1; - } - - static public double dec(double x){ - return x - 1; - } - - static public double multiply(double x, double y){ - return x * y; - } - - static public double divide(double x, double y){ - return x / y; - } - - static public boolean equiv(double x, double y){ - return x == y; - } - - static public boolean lt(double x, double y){ - return x < y; - } - - static public boolean lte(double x, double y){ - return x <= y; - } - - static public boolean gt(double x, double y){ - return x > y; - } - - static public boolean gte(double x, double y){ - return x >= y; - } - - static public boolean pos(double x){ - return x > 0; - } - - static public boolean neg(double x){ - return x < 0; - } - - static public boolean zero(double x){ - return x == 0; - } - - static public double aget(double[] xs, int i){ - return xs[i]; - } - - static public double aset(double[] xs, int i, double v){ - xs[i] = v; - return v; - } - - static public int alength(double[] xs){ - return xs.length; - } - - static public double[] aclone(double[] xs){ - return xs.clone(); - } - - static public double[] vec(int size, Object init){ - double[] ret = new double[size]; - if(init instanceof Number) - { - double f = ((Number) init).doubleValue(); - for(int i = 0; i < ret.length; i++) - ret[i] = f; - } - else - { - ISeq s = RT.seq(init); - for(int i = 0; i < size && s != null; i++, s = s.rest()) - ret[i] = ((Number) s.first()).doubleValue(); - } - return ret; - } - - static public double[] vec(Object sizeOrSeq){ - if(sizeOrSeq instanceof Number) - return new double[((Number) sizeOrSeq).intValue()]; - else - { - ISeq s = RT.seq(sizeOrSeq); - int size = s.count(); - double[] ret = new double[size]; - for(int i = 0; i < size && s != null; i++, s = s.rest()) - ret[i] = ((Number) s.first()).intValue(); - return ret; - } - } - - static public double[] vsadd(double[] x, double y){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] += y; - return xs; - } - - static public double[] vssub(double[] x, double y){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] -= y; - return xs; - } - - static public double[] vsdiv(double[] x, double y){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] /= y; - return xs; - } - - static public double[] vsmul(double[] x, double y){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= y; - return xs; - } - - static public double[] svdiv(double y, double[] x){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = y / xs[i]; - return xs; - } - - static public double[] vsmuladd(double[] x, double y, double[] zs){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y + zs[i]; - return xs; - } - - static public double[] vsmulsub(double[] x, double y, double[] zs){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y - zs[i]; - return xs; - } - - static public double[] vsmulsadd(double[] x, double y, double z){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y + z; - return xs; - } - - static public double[] vsmulssub(double[] x, double y, double z){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y - z; - return xs; - } - - static public double[] vabs(double[] x){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.abs(xs[i]); - return xs; - } - - static public double[] vnegabs(double[] x){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = -Math.abs(xs[i]); - return xs; - } - - static public double[] vneg(double[] x){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = -xs[i]; - return xs; - } - - static public double[] vsqr(double[] x){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= xs[i]; - return xs; - } - - static public double[] vsignedsqr(double[] x){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= Math.abs(xs[i]); - return xs; - } - - static public double[] vclip(double[] x, double low, double high){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < low) - xs[i] = low; - else if(xs[i] > high) - xs[i] = high; - } - return xs; - } - - static public IPersistentVector vclipcounts(double[] x, double low, double high){ - final double[] xs = x.clone(); - int lowc = 0; - int highc = 0; - - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < low) - { - ++lowc; - xs[i] = low; - } - else if(xs[i] > high) - { - ++highc; - xs[i] = high; - } - } - return RT.vector(xs, lowc, highc); - } - - static public double[] vthresh(double[] x, double thresh, double otherwise){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < thresh) - xs[i] = otherwise; - } - return xs; - } - - static public double[] vreverse(double[] x){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[xs.length - i - 1]; - return xs; - } - - static public double[] vrunningsum(double[] x){ - final double[] xs = x.clone(); - for(int i = 1; i < xs.length; i++) - xs[i] = xs[i - 1] + xs[i]; - return xs; - } - - static public double[] vsort(double[] x){ - final double[] xs = x.clone(); - Arrays.sort(xs); - return xs; - } - - static public double vdot(double[] xs, double[] ys){ - double ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i] * ys[i]; - return ret; - } - - static public double vmax(double[] xs){ - if(xs.length == 0) - return 0; - double ret = xs[0]; - for(int i = 0; i < xs.length; i++) - ret = Math.max(ret, xs[i]); - return ret; - } - - static public double vmin(double[] xs){ - if(xs.length == 0) - return 0; - double ret = xs[0]; - for(int i = 0; i < xs.length; i++) - ret = Math.min(ret, xs[i]); - return ret; - } - - static public double vmean(double[] xs){ - if(xs.length == 0) - return 0; - return vsum(xs) / xs.length; - } - - static public double vrms(double[] xs){ - if(xs.length == 0) - return 0; - double ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i] * xs[i]; - return Math.sqrt(ret / xs.length); - } - - static public double vsum(double[] xs){ - double ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i]; - return ret; - } - - static public boolean vequiv(double[] xs, double[] ys){ - return Arrays.equals(xs, ys); - } - - static public double[] vadd(double[] x, double[] ys){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] += ys[i]; - return xs; - } - - static public double[] vsub(double[] x, double[] ys){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] -= ys[i]; - return xs; - } - - static public double[] vaddmul(double[] x, double[] ys, double[] zs){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] + ys[i]) * zs[i]; - return xs; - } - - static public double[] vsubmul(double[] x, double[] ys, double[] zs){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] - ys[i]) * zs[i]; - return xs; - } - - static public double[] vaddsmul(double[] x, double[] ys, double z){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] + ys[i]) * z; - return xs; - } - - static public double[] vsubsmul(double[] x, double[] ys, double z){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] - ys[i]) * z; - return xs; - } - - static public double[] vmulsadd(double[] x, double[] ys, double z){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) + z; - return xs; - } - - static public double[] vdiv(double[] x, double[] ys){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] /= ys[i]; - return xs; - } - - static public double[] vmul(double[] x, double[] ys){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= ys[i]; - return xs; - } - - static public double[] vmuladd(double[] x, double[] ys, double[] zs){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) + zs[i]; - return xs; - } - - static public double[] vmulsub(double[] x, double[] ys, double[] zs){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) - zs[i]; - return xs; - } - - static public double[] vmax(double[] x, double[] ys){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.max(xs[i], ys[i]); - return xs; - } - - static public double[] vmin(double[] x, double[] ys){ - final double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.min(xs[i], ys[i]); - return xs; - } - - static public double[] vmap(IFn fn, double[] x) throws Exception{ - double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = ((Number) fn.invoke(xs[i])).doubleValue(); - return xs; - } - - static public double[] vmap(IFn fn, double[] x, double[] ys) throws Exception{ - double[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = ((Number) fn.invoke(xs[i], ys[i])).doubleValue(); - return xs; - } -} - -static public class I{ - static public int add(int x, int y){ - return x + y; - } - - static public int subtract(int x, int y){ - return x - y; - } - - static public int negate(int x){ - return -x; - } - - static public int inc(int x){ - return x + 1; - } - - static public int dec(int x){ - return x - 1; - } - - static public int multiply(int x, int y){ - return x * y; - } - - static public int divide(int x, int y){ - return x / y; - } - - static public boolean equiv(int x, int y){ - return x == y; - } - - static public boolean lt(int x, int y){ - return x < y; - } - - static public boolean lte(int x, int y){ - return x <= y; - } - - static public boolean gt(int x, int y){ - return x > y; - } - - static public boolean gte(int x, int y){ - return x >= y; - } - - static public boolean pos(int x){ - return x > 0; - } - - static public boolean neg(int x){ - return x < 0; - } - - static public boolean zero(int x){ - return x == 0; - } - - static public int aget(int[] xs, int i){ - return xs[i]; - } - - static public int aset(int[] xs, int i, int v){ - xs[i] = v; - return v; - } - - static public int alength(int[] xs){ - return xs.length; - } - - static public int[] aclone(int[] xs){ - return xs.clone(); - } - - static public int[] vec(int size, Object init){ - int[] ret = new int[size]; - if(init instanceof Number) - { - int f = ((Number) init).intValue(); - for(int i = 0; i < ret.length; i++) - ret[i] = f; - } - else - { - ISeq s = RT.seq(init); - for(int i = 0; i < size && s != null; i++, s = s.rest()) - ret[i] = ((Number) s.first()).intValue(); - } - return ret; - } - - static public int[] vec(Object sizeOrSeq){ - if(sizeOrSeq instanceof Number) - return new int[((Number) sizeOrSeq).intValue()]; - else - { - ISeq s = RT.seq(sizeOrSeq); - int size = s.count(); - int[] ret = new int[size]; - for(int i = 0; i < size && s != null; i++, s = s.rest()) - ret[i] = ((Number) s.first()).intValue(); - return ret; - } - } - - static public int[] vsadd(int[] x, int y){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] += y; - return xs; - } - - static public int[] vssub(int[] x, int y){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] -= y; - return xs; - } - - static public int[] vsdiv(int[] x, int y){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] /= y; - return xs; - } - - static public int[] vsmul(int[] x, int y){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= y; - return xs; - } - - static public int[] svdiv(int y, int[] x){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = y / xs[i]; - return xs; - } - - static public int[] vsmuladd(int[] x, int y, int[] zs){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y + zs[i]; - return xs; - } - - static public int[] vsmulsub(int[] x, int y, int[] zs){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y - zs[i]; - return xs; - } - - static public int[] vsmulsadd(int[] x, int y, int z){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y + z; - return xs; - } - - static public int[] vsmulssub(int[] x, int y, int z){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y - z; - return xs; - } - - static public int[] vabs(int[] x){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.abs(xs[i]); - return xs; - } - - static public int[] vnegabs(int[] x){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = -Math.abs(xs[i]); - return xs; - } - - static public int[] vneg(int[] x){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = -xs[i]; - return xs; - } - - static public int[] vsqr(int[] x){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= xs[i]; - return xs; - } - - static public int[] vsignedsqr(int[] x){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= Math.abs(xs[i]); - return xs; - } - - static public int[] vclip(int[] x, int low, int high){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < low) - xs[i] = low; - else if(xs[i] > high) - xs[i] = high; - } - return xs; - } - - static public IPersistentVector vclipcounts(int[] x, int low, int high){ - final int[] xs = x.clone(); - int lowc = 0; - int highc = 0; - - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < low) - { - ++lowc; - xs[i] = low; - } - else if(xs[i] > high) - { - ++highc; - xs[i] = high; - } - } - return RT.vector(xs, lowc, highc); - } - - static public int[] vthresh(int[] x, int thresh, int otherwise){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < thresh) - xs[i] = otherwise; - } - return xs; - } - - static public int[] vreverse(int[] x){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[xs.length - i - 1]; - return xs; - } - - static public int[] vrunningsum(int[] x){ - final int[] xs = x.clone(); - for(int i = 1; i < xs.length; i++) - xs[i] = xs[i - 1] + xs[i]; - return xs; - } - - static public int[] vsort(int[] x){ - final int[] xs = x.clone(); - Arrays.sort(xs); - return xs; - } - - static public int vdot(int[] xs, int[] ys){ - int ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i] * ys[i]; - return ret; - } - - static public int vmax(int[] xs){ - if(xs.length == 0) - return 0; - int ret = xs[0]; - for(int i = 0; i < xs.length; i++) - ret = Math.max(ret, xs[i]); - return ret; - } - - static public int vmin(int[] xs){ - if(xs.length == 0) - return 0; - int ret = xs[0]; - for(int i = 0; i < xs.length; i++) - ret = Math.min(ret, xs[i]); - return ret; - } - - static public double vmean(int[] xs){ - if(xs.length == 0) - return 0; - return vsum(xs) / (double) xs.length; - } - - static public double vrms(int[] xs){ - if(xs.length == 0) - return 0; - int ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i] * xs[i]; - return Math.sqrt(ret / (double) xs.length); - } - - static public int vsum(int[] xs){ - int ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i]; - return ret; - } - - static public boolean vequiv(int[] xs, int[] ys){ - return Arrays.equals(xs, ys); - } - - static public int[] vadd(int[] x, int[] ys){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] += ys[i]; - return xs; - } - - static public int[] vsub(int[] x, int[] ys){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] -= ys[i]; - return xs; - } - - static public int[] vaddmul(int[] x, int[] ys, int[] zs){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] + ys[i]) * zs[i]; - return xs; - } - - static public int[] vsubmul(int[] x, int[] ys, int[] zs){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] - ys[i]) * zs[i]; - return xs; - } - - static public int[] vaddsmul(int[] x, int[] ys, int z){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] + ys[i]) * z; - return xs; - } - - static public int[] vsubsmul(int[] x, int[] ys, int z){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] - ys[i]) * z; - return xs; - } - - static public int[] vmulsadd(int[] x, int[] ys, int z){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) + z; - return xs; - } - - static public int[] vdiv(int[] x, int[] ys){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] /= ys[i]; - return xs; - } - - static public int[] vmul(int[] x, int[] ys){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= ys[i]; - return xs; - } - - static public int[] vmuladd(int[] x, int[] ys, int[] zs){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) + zs[i]; - return xs; - } - - static public int[] vmulsub(int[] x, int[] ys, int[] zs){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) - zs[i]; - return xs; - } - - static public int[] vmax(int[] x, int[] ys){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.max(xs[i], ys[i]); - return xs; - } - - static public int[] vmin(int[] x, int[] ys){ - final int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.min(xs[i], ys[i]); - return xs; - } - - static public int[] vmap(IFn fn, int[] x) throws Exception{ - int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = ((Number) fn.invoke(xs[i])).intValue(); - return xs; - } - - static public int[] vmap(IFn fn, int[] x, int[] ys) throws Exception{ - int[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = ((Number) fn.invoke(xs[i], ys[i])).intValue(); - return xs; - } - -} - -static public class L{ - static public long add(long x, long y){ - return x + y; - } - - static public long subtract(long x, long y){ - return x - y; - } - - static public long negate(long x){ - return -x; - } - - static public long inc(long x){ - return x + 1; - } - - static public long dec(long x){ - return x - 1; - } - - static public long multiply(long x, long y){ - return x * y; - } - - static public long divide(long x, long y){ - return x / y; - } - - static public boolean equiv(long x, long y){ - return x == y; - } - - static public boolean lt(long x, long y){ - return x < y; - } - - static public boolean lte(long x, long y){ - return x <= y; - } - - static public boolean gt(long x, long y){ - return x > y; - } - - static public boolean gte(long x, long y){ - return x >= y; - } - - static public boolean pos(long x){ - return x > 0; - } - - static public boolean neg(long x){ - return x < 0; - } - - static public boolean zero(long x){ - return x == 0; - } - - static public long aget(long[] xs, int i){ - return xs[i]; - } - - static public long aset(long[] xs, int i, long v){ - xs[i] = v; - return v; - } - - static public int alength(long[] xs){ - return xs.length; - } - - static public long[] aclone(long[] xs){ - return xs.clone(); - } - - static public long[] vec(int size, Object init){ - long[] ret = new long[size]; - if(init instanceof Number) - { - long f = ((Number) init).longValue(); - for(int i = 0; i < ret.length; i++) - ret[i] = f; - } - else - { - ISeq s = RT.seq(init); - for(int i = 0; i < size && s != null; i++, s = s.rest()) - ret[i] = ((Number) s.first()).longValue(); - } - return ret; - } - - static public long[] vec(Object sizeOrSeq){ - if(sizeOrSeq instanceof Number) - return new long[((Number) sizeOrSeq).intValue()]; - else - { - ISeq s = RT.seq(sizeOrSeq); - int size = s.count(); - long[] ret = new long[size]; - for(int i = 0; i < size && s != null; i++, s = s.rest()) - ret[i] = ((Number) s.first()).intValue(); - return ret; - } - } - - - static public long[] vsadd(long[] x, long y){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] += y; - return xs; - } - - static public long[] vssub(long[] x, long y){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] -= y; - return xs; - } - - static public long[] vsdiv(long[] x, long y){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] /= y; - return xs; - } - - static public long[] vsmul(long[] x, long y){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= y; - return xs; - } - - static public long[] svdiv(long y, long[] x){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = y / xs[i]; - return xs; - } - - static public long[] vsmuladd(long[] x, long y, long[] zs){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y + zs[i]; - return xs; - } - - static public long[] vsmulsub(long[] x, long y, long[] zs){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y - zs[i]; - return xs; - } - - static public long[] vsmulsadd(long[] x, long y, long z){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y + z; - return xs; - } - - static public long[] vsmulssub(long[] x, long y, long z){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[i] * y - z; - return xs; - } - - static public long[] vabs(long[] x){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.abs(xs[i]); - return xs; - } - - static public long[] vnegabs(long[] x){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = -Math.abs(xs[i]); - return xs; - } - - static public long[] vneg(long[] x){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = -xs[i]; - return xs; - } - - static public long[] vsqr(long[] x){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= xs[i]; - return xs; - } - - static public long[] vsignedsqr(long[] x){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= Math.abs(xs[i]); - return xs; - } - - static public long[] vclip(long[] x, long low, long high){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < low) - xs[i] = low; - else if(xs[i] > high) - xs[i] = high; - } - return xs; - } - - static public IPersistentVector vclipcounts(long[] x, long low, long high){ - final long[] xs = x.clone(); - int lowc = 0; - int highc = 0; - - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < low) - { - ++lowc; - xs[i] = low; - } - else if(xs[i] > high) - { - ++highc; - xs[i] = high; - } - } - return RT.vector(xs, lowc, highc); - } - - static public long[] vthresh(long[] x, long thresh, long otherwise){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - { - if(xs[i] < thresh) - xs[i] = otherwise; - } - return xs; - } - - static public long[] vreverse(long[] x){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = xs[xs.length - i - 1]; - return xs; - } - - static public long[] vrunningsum(long[] x){ - final long[] xs = x.clone(); - for(int i = 1; i < xs.length; i++) - xs[i] = xs[i - 1] + xs[i]; - return xs; - } - - static public long[] vsort(long[] x){ - final long[] xs = x.clone(); - Arrays.sort(xs); - return xs; - } - - static public long vdot(long[] xs, long[] ys){ - long ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i] * ys[i]; - return ret; - } - - static public long vmax(long[] xs){ - if(xs.length == 0) - return 0; - long ret = xs[0]; - for(int i = 0; i < xs.length; i++) - ret = Math.max(ret, xs[i]); - return ret; - } - - static public long vmin(long[] xs){ - if(xs.length == 0) - return 0; - long ret = xs[0]; - for(int i = 0; i < xs.length; i++) - ret = Math.min(ret, xs[i]); - return ret; - } - - static public double vmean(long[] xs){ - if(xs.length == 0) - return 0; - return vsum(xs) / (double) xs.length; - } - - static public double vrms(long[] xs){ - if(xs.length == 0) - return 0; - long ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i] * xs[i]; - return Math.sqrt(ret / (double) xs.length); - } - - static public long vsum(long[] xs){ - long ret = 0; - for(int i = 0; i < xs.length; i++) - ret += xs[i]; - return ret; - } - - static public boolean vequiv(long[] xs, long[] ys){ - return Arrays.equals(xs, ys); - } - - static public long[] vadd(long[] x, long[] ys){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] += ys[i]; - return xs; - } - - static public long[] vsub(long[] x, long[] ys){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] -= ys[i]; - return xs; - } - - static public long[] vaddmul(long[] x, long[] ys, long[] zs){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] + ys[i]) * zs[i]; - return xs; - } - - static public long[] vsubmul(long[] x, long[] ys, long[] zs){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] - ys[i]) * zs[i]; - return xs; - } - - static public long[] vaddsmul(long[] x, long[] ys, long z){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] + ys[i]) * z; - return xs; - } - - static public long[] vsubsmul(long[] x, long[] ys, long z){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] - ys[i]) * z; - return xs; - } - - static public long[] vmulsadd(long[] x, long[] ys, long z){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) + z; - return xs; - } - - static public long[] vdiv(long[] x, long[] ys){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] /= ys[i]; - return xs; - } - - static public long[] vmul(long[] x, long[] ys){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] *= ys[i]; - return xs; - } - - static public long[] vmuladd(long[] x, long[] ys, long[] zs){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) + zs[i]; - return xs; - } - - static public long[] vmulsub(long[] x, long[] ys, long[] zs){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = (xs[i] * ys[i]) - zs[i]; - return xs; - } - - static public long[] vmax(long[] x, long[] ys){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.max(xs[i], ys[i]); - return xs; - } - - static public long[] vmin(long[] x, long[] ys){ - final long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = Math.min(xs[i], ys[i]); - return xs; - } - - static public long[] vmap(IFn fn, long[] x) throws Exception{ - long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = ((Number) fn.invoke(xs[i])).longValue(); - return xs; - } - - static public long[] vmap(IFn fn, long[] x, long[] ys) throws Exception{ - long[] xs = x.clone(); - for(int i = 0; i < xs.length; i++) - xs[i] = ((Number) fn.invoke(xs[i], ys[i])).longValue(); - return xs; - } - -} -*/ - - -//overload resolution - -static public Number add(int x, Object y){ - return add((Object)x,y); -} - -static public Number add(Object x, int y){ - return add(x,(Object)y); -} - -static public Number and(int x, Object y){ - return and((Object)x,y); -} - -static public Number and(Object x, int y){ - return and(x,(Object)y); -} - -static public Number or(int x, Object y){ - return or((Object)x,y); -} - -static public Number or(Object x, int y){ - return or(x,(Object)y); -} - -static public Number xor(int x, Object y){ - return xor((Object)x,y); -} - -static public Number xor(Object x, int y){ - return xor(x,(Object)y); -} - -static public Number add(float x, Object y){ - return add((Object)x,y); -} - -static public Number add(Object x, float y){ - return add(x,(Object)y); -} - -static public Number add(long x, Object y){ - return add((Object)x,y); -} - -static public Number add(Object x, long y){ - return add(x,(Object)y); -} - -static public Number add(double x, Object y){ - return add((Object)x,y); -} - -static public Number add(Object x, double y){ - return add(x,(Object)y); -} - -static public Number minus(int x, Object y){ - return minus((Object)x,y); -} - -static public Number minus(Object x, int y){ - return minus(x,(Object)y); -} - -static public Number minus(float x, Object y){ - return minus((Object)x,y); -} - -static public Number minus(Object x, float y){ - return minus(x,(Object)y); -} - -static public Number minus(long x, Object y){ - return minus((Object)x,y); -} - -static public Number minus(Object x, long y){ - return minus(x,(Object)y); -} - -static public Number minus(double x, Object y){ - return minus((Object)x,y); -} - -static public Number minus(Object x, double y){ - return minus(x,(Object)y); -} - -static public Number multiply(int x, Object y){ - return multiply((Object)x,y); -} - -static public Number multiply(Object x, int y){ - return multiply(x,(Object)y); -} - -static public Number multiply(float x, Object y){ - return multiply((Object)x,y); -} - -static public Number multiply(Object x, float y){ - return multiply(x,(Object)y); -} - -static public Number multiply(long x, Object y){ - return multiply((Object)x,y); -} - -static public Number multiply(Object x, long y){ - return multiply(x,(Object)y); -} - -static public Number multiply(double x, Object y){ - return multiply((Object)x,y); -} - -static public Number multiply(Object x, double y){ - return multiply(x,(Object)y); -} - -static public Number divide(int x, Object y){ - return divide((Object)x,y); -} - -static public Number divide(Object x, int y){ - return divide(x,(Object)y); -} - -static public Number divide(float x, Object y){ - return divide((Object)x,y); -} - -static public Number divide(Object x, float y){ - return divide(x,(Object)y); -} - -static public Number divide(long x, Object y){ - return divide((Object)x,y); -} - -static public Number divide(Object x, long y){ - return divide(x,(Object)y); -} - -static public Number divide(double x, Object y){ - return divide((Object)x,y); -} - -static public Number divide(Object x, double y){ - return divide(x,(Object)y); -} - -static public boolean lt(int x, Object y){ - return lt((Object)x,y); -} - -static public boolean lt(Object x, int y){ - return lt(x,(Object)y); -} - -static public boolean lt(float x, Object y){ - return lt((Object)x,y); -} - -static public boolean lt(Object x, float y){ - return lt(x,(Object)y); -} - -static public boolean lt(long x, Object y){ - return lt((Object)x,y); -} - -static public boolean lt(Object x, long y){ - return lt(x,(Object)y); -} - -static public boolean lt(double x, Object y){ - return lt((Object)x,y); -} - -static public boolean lt(Object x, double y){ - return lt(x,(Object)y); -} - -static public boolean lte(int x, Object y){ - return lte((Object)x,y); -} - -static public boolean lte(Object x, int y){ - return lte(x,(Object)y); -} - -static public boolean lte(float x, Object y){ - return lte((Object)x,y); -} - -static public boolean lte(Object x, float y){ - return lte(x,(Object)y); -} - -static public boolean lte(long x, Object y){ - return lte((Object)x,y); -} - -static public boolean lte(Object x, long y){ - return lte(x,(Object)y); -} - -static public boolean lte(double x, Object y){ - return lte((Object)x,y); -} - -static public boolean lte(Object x, double y){ - return lte(x,(Object)y); -} - -static public boolean gt(int x, Object y){ - return gt((Object)x,y); -} - -static public boolean gt(Object x, int y){ - return gt(x,(Object)y); -} - -static public boolean gt(float x, Object y){ - return gt((Object)x,y); -} - -static public boolean gt(Object x, float y){ - return gt(x,(Object)y); -} - -static public boolean gt(long x, Object y){ - return gt((Object)x,y); -} - -static public boolean gt(Object x, long y){ - return gt(x,(Object)y); -} - -static public boolean gt(double x, Object y){ - return gt((Object)x,y); -} - -static public boolean gt(Object x, double y){ - return gt(x,(Object)y); -} - -static public boolean gte(int x, Object y){ - return gte((Object)x,y); -} - -static public boolean gte(Object x, int y){ - return gte(x,(Object)y); -} - -static public boolean gte(float x, Object y){ - return gte((Object)x,y); -} - -static public boolean gte(Object x, float y){ - return gte(x,(Object)y); -} - -static public boolean gte(long x, Object y){ - return gte((Object)x,y); -} - -static public boolean gte(Object x, long y){ - return gte(x,(Object)y); -} - -static public boolean gte(double x, Object y){ - return gte((Object)x,y); -} - -static public boolean gte(Object x, double y){ - return gte(x,(Object)y); -} - - -static public boolean equiv(int x, Object y){ - return equiv((Object)x,y); -} - -static public boolean equiv(Object x, int y){ - return equiv(x,(Object)y); -} - -static public boolean equiv(float x, Object y){ - return equiv((Object)x,y); -} - -static public boolean equiv(Object x, float y){ - return equiv(x,(Object)y); -} - -static public boolean equiv(long x, Object y){ - return equiv((Object)x,y); -} - -static public boolean equiv(Object x, long y){ - return equiv(x,(Object)y); -} - -static public boolean equiv(double x, Object y){ - return equiv((Object)x,y); -} - -static public boolean equiv(Object x, double y){ - return equiv(x,(Object)y); -} - - -static public float add(int x, float y){ - return add((float)x,y); -} - -static public float add(float x, int y){ - return add(x,(float)y); -} - -static public double add(int x, double y){ - return add((double)x,y); -} - -static public double add(double x, int y){ - return add(x,(double)y); -} - -static public long add(int x, long y){ - return add((long)x,y); -} - -static public long add(long x, int y){ - return add(x,(long)y); -} - -static public float add(long x, float y){ - return add((float)x,y); -} - -static public float add(float x, long y){ - return add(x,(float)y); -} - -static public double add(long x, double y){ - return add((double)x,y); -} - -static public double add(double x, long y){ - return add(x,(double)y); -} - -static public double add(float x, double y){ - return add((double)x,y); -} - -static public double add(double x, float y){ - return add(x,(double)y); -} - -static public float minus(int x, float y){ - return minus((float)x,y); -} - -static public float minus(float x, int y){ - return minus(x,(float)y); -} - -static public double minus(int x, double y){ - return minus((double)x,y); -} - -static public double minus(double x, int y){ - return minus(x,(double)y); -} - -static public long minus(int x, long y){ - return minus((long)x,y); -} - -static public long minus(long x, int y){ - return minus(x,(long)y); -} - -static public float minus(long x, float y){ - return minus((float)x,y); -} - -static public float minus(float x, long y){ - return minus(x,(float)y); -} - -static public double minus(long x, double y){ - return minus((double)x,y); -} - -static public double minus(double x, long y){ - return minus(x,(double)y); -} - -static public double minus(float x, double y){ - return minus((double)x,y); -} - -static public double minus(double x, float y){ - return minus(x,(double)y); -} - -static public float multiply(int x, float y){ - return multiply((float)x,y); -} - -static public float multiply(float x, int y){ - return multiply(x,(float)y); -} - -static public double multiply(int x, double y){ - return multiply((double)x,y); -} - -static public double multiply(double x, int y){ - return multiply(x,(double)y); -} - -static public long multiply(int x, long y){ - return multiply((long)x,y); -} - -static public long multiply(long x, int y){ - return multiply(x,(long)y); -} - -static public float multiply(long x, float y){ - return multiply((float)x,y); -} - -static public float multiply(float x, long y){ - return multiply(x,(float)y); -} - -static public double multiply(long x, double y){ - return multiply((double)x,y); -} - -static public double multiply(double x, long y){ - return multiply(x,(double)y); -} - -static public double multiply(float x, double y){ - return multiply((double)x,y); -} - -static public double multiply(double x, float y){ - return multiply(x,(double)y); -} - -static public float divide(int x, float y){ - return divide((float)x,y); -} - -static public float divide(float x, int y){ - return divide(x,(float)y); -} - -static public double divide(int x, double y){ - return divide((double)x,y); -} - -static public double divide(double x, int y){ - return divide(x,(double)y); -} - -static public float divide(long x, float y){ - return divide((float)x,y); -} - -static public float divide(float x, long y){ - return divide(x,(float)y); -} - -static public double divide(long x, double y){ - return divide((double)x,y); -} - -static public double divide(double x, long y){ - return divide(x,(double)y); -} - -static public double divide(float x, double y){ - return divide((double)x,y); -} - -static public double divide(double x, float y){ - return divide(x,(double)y); -} - -static public boolean lt(int x, float y){ - return lt((float)x,y); -} - -static public boolean lt(float x, int y){ - return lt(x,(float)y); -} - -static public boolean lt(int x, double y){ - return lt((double)x,y); -} - -static public boolean lt(double x, int y){ - return lt(x,(double)y); -} - -static public boolean lt(int x, long y){ - return lt((long)x,y); -} - -static public boolean lt(long x, int y){ - return lt(x,(long)y); -} - -static public boolean lt(long x, float y){ - return lt((float)x,y); -} - -static public boolean lt(float x, long y){ - return lt(x,(float)y); -} - -static public boolean lt(long x, double y){ - return lt((double)x,y); -} - -static public boolean lt(double x, long y){ - return lt(x,(double)y); -} - -static public boolean lt(float x, double y){ - return lt((double)x,y); -} - -static public boolean lt(double x, float y){ - return lt(x,(double)y); -} - - -static public boolean lte(int x, float y){ - return lte((float)x,y); -} - -static public boolean lte(float x, int y){ - return lte(x,(float)y); -} - -static public boolean lte(int x, double y){ - return lte((double)x,y); -} - -static public boolean lte(double x, int y){ - return lte(x,(double)y); -} - -static public boolean lte(int x, long y){ - return lte((long)x,y); -} - -static public boolean lte(long x, int y){ - return lte(x,(long)y); -} - -static public boolean lte(long x, float y){ - return lte((float)x,y); -} - -static public boolean lte(float x, long y){ - return lte(x,(float)y); -} - -static public boolean lte(long x, double y){ - return lte((double)x,y); -} - -static public boolean lte(double x, long y){ - return lte(x,(double)y); -} - -static public boolean lte(float x, double y){ - return lte((double)x,y); -} - -static public boolean lte(double x, float y){ - return lte(x,(double)y); -} - -static public boolean gt(int x, float y){ - return gt((float)x,y); -} - -static public boolean gt(float x, int y){ - return gt(x,(float)y); -} - -static public boolean gt(int x, double y){ - return gt((double)x,y); -} - -static public boolean gt(double x, int y){ - return gt(x,(double)y); -} - -static public boolean gt(int x, long y){ - return gt((long)x,y); -} - -static public boolean gt(long x, int y){ - return gt(x,(long)y); -} - -static public boolean gt(long x, float y){ - return gt((float)x,y); -} - -static public boolean gt(float x, long y){ - return gt(x,(float)y); -} - -static public boolean gt(long x, double y){ - return gt((double)x,y); -} - -static public boolean gt(double x, long y){ - return gt(x,(double)y); -} - -static public boolean gt(float x, double y){ - return gt((double)x,y); -} - -static public boolean gt(double x, float y){ - return gt(x,(double)y); -} - -static public boolean gte(int x, float y){ - return gte((float)x,y); -} - -static public boolean gte(float x, int y){ - return gte(x,(float)y); -} - -static public boolean gte(int x, double y){ - return gte((double)x,y); -} - -static public boolean gte(double x, int y){ - return gte(x,(double)y); -} - -static public boolean gte(int x, long y){ - return gte((long)x,y); -} - -static public boolean gte(long x, int y){ - return gte(x,(long)y); -} - -static public boolean gte(long x, float y){ - return gte((float)x,y); -} - -static public boolean gte(float x, long y){ - return gte(x,(float)y); -} - -static public boolean gte(long x, double y){ - return gte((double)x,y); -} - -static public boolean gte(double x, long y){ - return gte(x,(double)y); -} - -static public boolean gte(float x, double y){ - return gte((double)x,y); -} - -static public boolean gte(double x, float y){ - return gte(x,(double)y); -} - -static public boolean equiv(int x, float y){ - return equiv((float)x,y); -} - -static public boolean equiv(float x, int y){ - return equiv(x,(float)y); -} - -static public boolean equiv(int x, double y){ - return equiv((double)x,y); -} - -static public boolean equiv(double x, int y){ - return equiv(x,(double)y); -} - -static public boolean equiv(int x, long y){ - return equiv((long)x,y); -} - -static public boolean equiv(long x, int y){ - return equiv(x,(long)y); -} - -static public boolean equiv(long x, float y){ - return equiv((float)x,y); -} - -static public boolean equiv(float x, long y){ - return equiv(x,(float)y); -} - -static public boolean equiv(long x, double y){ - return equiv((double)x,y); -} - -static public boolean equiv(double x, long y){ - return equiv(x,(double)y); -} - -static public boolean equiv(float x, double y){ - return equiv((double)x,y); -} - -static public boolean equiv(double x, float y){ - return equiv(x,(double)y); -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Obj.java --- a/src/clojure/lang/Obj.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 25, 2006 3:44:58 PM */ - -package clojure.lang; - -import java.io.Serializable; - -public abstract class Obj implements IObj, Serializable { - -final IPersistentMap _meta; - -public Obj(IPersistentMap meta){ - this._meta = meta; -} - -public Obj(){ - _meta = null; -} - -final public IPersistentMap meta(){ - return _meta; -} - -abstract public Obj withMeta(IPersistentMap meta); - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/PersistentArrayMap.java --- a/src/clojure/lang/PersistentArrayMap.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,367 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -import java.io.Serializable; -import java.util.Arrays; -import java.util.Iterator; -import java.util.Map; - -/** - * Simple implementation of persistent map on an array - *

- * Note that instances of this class are constant values - * i.e. add/remove etc return new values - *

- * Copies array on every change, so only appropriate for _very_small_ maps - *

- * null keys and values are ok, but you won't be able to distinguish a null value via valAt - use contains/entryAt - */ - -public class PersistentArrayMap extends APersistentMap implements IObj, IEditableCollection { - -final Object[] array; -static final int HASHTABLE_THRESHOLD = 16; - -public static final PersistentArrayMap EMPTY = new PersistentArrayMap(); -private final IPersistentMap _meta; - -static public IPersistentMap create(Map other){ - ITransientMap ret = EMPTY.asTransient(); - for(Object o : other.entrySet()) - { - Map.Entry e = (Entry) o; - ret = ret.assoc(e.getKey(), e.getValue()); - } - return ret.persistent(); -} - -protected PersistentArrayMap(){ - this.array = new Object[]{}; - this._meta = null; -} - -public PersistentArrayMap withMeta(IPersistentMap meta){ - return new PersistentArrayMap(meta, array); -} - -PersistentArrayMap create(Object... init){ - return new PersistentArrayMap(meta(), init); -} - -IPersistentMap createHT(Object[] init){ - return PersistentHashMap.create(meta(), init); -} - -static public PersistentArrayMap createWithCheck(Object[] init){ - for(int i=0;i< init.length;i += 2) - { - for(int j=i+2;j= 0; -} - -public IMapEntry entryAt(Object key){ - int i = indexOf(key); - if(i >= 0) - return new MapEntry(array[i],array[i+1]); - return null; -} - -public IPersistentMap assocEx(Object key, Object val) throws Exception{ - int i = indexOf(key); - Object[] newArray; - if(i >= 0) - { - throw new Exception("Key already present"); - } - else //didn't have key, grow - { - if(array.length > HASHTABLE_THRESHOLD) - return createHT(array).assocEx(key, val); - newArray = new Object[array.length + 2]; - if(array.length > 0) - System.arraycopy(array, 0, newArray, 2, array.length); - newArray[0] = key; - newArray[1] = val; - } - return create(newArray); -} - -public IPersistentMap assoc(Object key, Object val){ - int i = indexOf(key); - Object[] newArray; - if(i >= 0) //already have key, same-sized replacement - { - if(array[i + 1] == val) //no change, no op - return this; - newArray = array.clone(); - newArray[i + 1] = val; - } - else //didn't have key, grow - { - if(array.length > HASHTABLE_THRESHOLD) - return createHT(array).assoc(key, val); - newArray = new Object[array.length + 2]; - if(array.length > 0) - System.arraycopy(array, 0, newArray, 2, array.length); - newArray[0] = key; - newArray[1] = val; - } - return create(newArray); -} - -public IPersistentMap without(Object key){ - int i = indexOf(key); - if(i >= 0) //have key, will remove - { - int newlen = array.length - 2; - if(newlen == 0) - return empty(); - Object[] newArray = new Object[newlen]; - for(int s = 0, d = 0; s < array.length; s += 2) - { - if(!equalKey(array[s], key)) //skip removal key - { - newArray[d] = array[s]; - newArray[d + 1] = array[s + 1]; - d += 2; - } - } - return create(newArray); - } - //don't have key, no op - return this; -} - -public IPersistentMap empty(){ - return (IPersistentMap) EMPTY.withMeta(meta()); -} - -final public Object valAt(Object key, Object notFound){ - int i = indexOf(key); - if(i >= 0) - return array[i + 1]; - return notFound; -} - -public Object valAt(Object key){ - return valAt(key, null); -} - -public int capacity(){ - return count(); -} - -private int indexOf(Object key){ - for(int i = 0; i < array.length; i += 2) - { - if(equalKey(array[i], key)) - return i; - } - return -1; -} - -static boolean equalKey(Object k1, Object k2){ - if(k1 == null) - return k2 == null; - return k1.equals(k2); -} - -public Iterator iterator(){ - return new Iter(array); -} - -public ISeq seq(){ - if(array.length > 0) - return new Seq(array, 0); - return null; -} - -public IPersistentMap meta(){ - return _meta; -} - -static class Seq extends ASeq implements Counted{ - final Object[] array; - final int i; - - Seq(Object[] array, int i){ - this.array = array; - this.i = i; - } - - public Seq(IPersistentMap meta, Object[] array, int i){ - super(meta); - this.array = array; - this.i = i; - } - - public Object first(){ - return new MapEntry(array[i],array[i+1]); - } - - public ISeq next(){ - if(i + 2 < array.length) - return new Seq(array, i + 2); - return null; - } - - public int count(){ - return (array.length - i) / 2; - } - - public Obj withMeta(IPersistentMap meta){ - return new Seq(meta, array, i); - } -} - -static class Iter implements Iterator{ - Object[] array; - int i; - - //for iterator - Iter(Object[] array){ - this(array, -2); - } - - //for entryAt - Iter(Object[] array, int i){ - this.array = array; - this.i = i; - } - - public boolean hasNext(){ - return i < array.length - 2; - } - - public Object next(){ - i += 2; - return new MapEntry(array[i],array[i+1]); - } - - public void remove(){ - throw new UnsupportedOperationException(); - } - -} - -public ITransientMap asTransient(){ - return new TransientArrayMap(array); -} - -static final class TransientArrayMap extends ATransientMap { - int len; - final Object[] array; - Thread owner; - - public TransientArrayMap(Object[] array){ - this.owner = Thread.currentThread(); - this.array = new Object[Math.max(HASHTABLE_THRESHOLD, array.length)]; - System.arraycopy(array, 0, this.array, 0, array.length); - this.len = array.length; - } - - private int indexOf(Object key){ - for(int i = 0; i < len; i += 2) - { - if(equalKey(array[i], key)) - return i; - } - return -1; - } - - ITransientMap doAssoc(Object key, Object val){ - int i = indexOf(key); - if(i >= 0) //already have key, - { - if(array[i + 1] != val) //no change, no op - array[i + 1] = val; - } - else //didn't have key, grow - { - if(len >= array.length) - return PersistentHashMap.create(array).asTransient().assoc(key, val); - array[len++] = key; - array[len++] = val; - } - return this; - } - - ITransientMap doWithout(Object key) { - int i = indexOf(key); - if(i >= 0) //have key, will remove - { - if (len >= 2) - { - array[i] = array[len - 2]; - array[i + 1] = array[len - 1]; - } - len -= 2; - } - return this; - } - - Object doValAt(Object key, Object notFound) { - int i = indexOf(key); - if (i >= 0) - return array[i + 1]; - return notFound; - } - - int doCount() { - return len / 2; - } - - IPersistentMap doPersistent(){ - ensureEditable(); - owner = null; - Object[] a = new Object[len]; - System.arraycopy(array,0,a,0,len); - return new PersistentArrayMap(a); - } - - void ensureEditable(){ - if(owner == Thread.currentThread()) - return; - if(owner != null) - throw new IllegalAccessError("Transient used by non-owner thread"); - throw new IllegalAccessError("Transient used after persistent! call"); - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/PersistentHashMap.java --- a/src/clojure/lang/PersistentHashMap.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1054 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -import java.io.Serializable; -import java.util.Iterator; -import java.util.List; -import java.util.Map; -import java.util.concurrent.atomic.AtomicReference; - -/* - A persistent rendition of Phil Bagwell's Hash Array Mapped Trie - - Uses path copying for persistence - HashCollision leaves vs. extended hashing - Node polymorphism vs. conditionals - No sub-tree pools or root-resizing - Any errors are my own - */ - -public class PersistentHashMap extends APersistentMap implements IEditableCollection, IObj { - -final int count; -final INode root; -final boolean hasNull; -final Object nullValue; -final IPersistentMap _meta; - -final public static PersistentHashMap EMPTY = new PersistentHashMap(0, null, false, null); -final private static Object NOT_FOUND = new Object(); - -static public IPersistentMap create(Map other){ - ITransientMap ret = EMPTY.asTransient(); - for(Object o : other.entrySet()) - { - Map.Entry e = (Entry) o; - ret = ret.assoc(e.getKey(), e.getValue()); - } - return ret.persistent(); -} - -/* - * @param init {key1,val1,key2,val2,...} - */ -public static PersistentHashMap create(Object... init){ - ITransientMap ret = EMPTY.asTransient(); - for(int i = 0; i < init.length; i += 2) - { - ret = ret.assoc(init[i], init[i + 1]); - } - return (PersistentHashMap) ret.persistent(); -} - -public static PersistentHashMap createWithCheck(Object... init){ - ITransientMap ret = EMPTY.asTransient(); - for(int i = 0; i < init.length; i += 2) - { - ret = ret.assoc(init[i], init[i + 1]); - if(ret.count() != i/2 + 1) - throw new IllegalArgumentException("Duplicate key: " + init[i]); - } - return (PersistentHashMap) ret.persistent(); -} - -static public PersistentHashMap create(ISeq items){ - ITransientMap ret = EMPTY.asTransient(); - for(; items != null; items = items.next().next()) - { - if(items.next() == null) - throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first())); - ret = ret.assoc(items.first(), RT.second(items)); - } - return (PersistentHashMap) ret.persistent(); -} - -static public PersistentHashMap createWithCheck(ISeq items){ - ITransientMap ret = EMPTY.asTransient(); - for(int i=0; items != null; items = items.next().next(), ++i) - { - if(items.next() == null) - throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first())); - ret = ret.assoc(items.first(), RT.second(items)); - if(ret.count() != i + 1) - throw new IllegalArgumentException("Duplicate key: " + items.first()); - } - return (PersistentHashMap) ret.persistent(); -} - -/* - * @param init {key1,val1,key2,val2,...} - */ -public static PersistentHashMap create(IPersistentMap meta, Object... init){ - return create(init).withMeta(meta); -} - -PersistentHashMap(int count, INode root, boolean hasNull, Object nullValue){ - this.count = count; - this.root = root; - this.hasNull = hasNull; - this.nullValue = nullValue; - this._meta = null; -} - -public PersistentHashMap(IPersistentMap meta, int count, INode root, boolean hasNull, Object nullValue){ - this._meta = meta; - this.count = count; - this.root = root; - this.hasNull = hasNull; - this.nullValue = nullValue; -} - -public boolean containsKey(Object key){ - if(key == null) - return hasNull; - return (root != null) ? root.find(0, Util.hash(key), key, NOT_FOUND) != NOT_FOUND : false; -} - -public IMapEntry entryAt(Object key){ - if(key == null) - return hasNull ? new MapEntry(null, nullValue) : null; - return (root != null) ? root.find(0, Util.hash(key), key) : null; -} - -public IPersistentMap assoc(Object key, Object val){ - if(key == null) { - if(hasNull && val == nullValue) - return this; - return new PersistentHashMap(meta(), hasNull ? count : count + 1, root, true, val); - } - Box addedLeaf = new Box(null); - INode newroot = (root == null ? BitmapIndexedNode.EMPTY : root) - .assoc(0, Util.hash(key), key, val, addedLeaf); - if(newroot == root) - return this; - return new PersistentHashMap(meta(), addedLeaf.val == null ? count : count + 1, newroot, hasNull, nullValue); -} - -public Object valAt(Object key, Object notFound){ - if(key == null) - return hasNull ? nullValue : notFound; - return root != null ? root.find(0, Util.hash(key), key, notFound) : notFound; -} - -public Object valAt(Object key){ - return valAt(key, null); -} - -public IPersistentMap assocEx(Object key, Object val) throws Exception{ - if(containsKey(key)) - throw new Exception("Key already present"); - return assoc(key, val); -} - -public IPersistentMap without(Object key){ - if(key == null) - return hasNull ? new PersistentHashMap(meta(), count - 1, root, false, null) : this; - if(root == null) - return this; - INode newroot = root.without(0, Util.hash(key), key); - if(newroot == root) - return this; - return new PersistentHashMap(meta(), count - 1, newroot, hasNull, nullValue); -} - -public Iterator iterator(){ - return new SeqIterator(seq()); -} - -public int count(){ - return count; -} - -public ISeq seq(){ - ISeq s = root != null ? root.nodeSeq() : null; - return hasNull ? new Cons(new MapEntry(null, nullValue), s) : s; -} - -public IPersistentCollection empty(){ - return EMPTY.withMeta(meta()); -} - -static int mask(int hash, int shift){ - //return ((hash << shift) >>> 27);// & 0x01f; - return (hash >>> shift) & 0x01f; -} - -public PersistentHashMap withMeta(IPersistentMap meta){ - return new PersistentHashMap(meta, count, root, hasNull, nullValue); -} - -public TransientHashMap asTransient() { - return new TransientHashMap(this); -} - -public IPersistentMap meta(){ - return _meta; -} - -static final class TransientHashMap extends ATransientMap { - AtomicReference edit; - INode root; - int count; - boolean hasNull; - Object nullValue; - final Box leafFlag = new Box(null); - - - TransientHashMap(PersistentHashMap m) { - this(new AtomicReference(Thread.currentThread()), m.root, m.count, m.hasNull, m.nullValue); - } - - TransientHashMap(AtomicReference edit, INode root, int count, boolean hasNull, Object nullValue) { - this.edit = edit; - this.root = root; - this.count = count; - this.hasNull = hasNull; - this.nullValue = nullValue; - } - - ITransientMap doAssoc(Object key, Object val) { - if (key == null) { - if (this.nullValue != val) - this.nullValue = val; - if (!hasNull) { - this.count++; - this.hasNull = true; - } - return this; - } -// Box leafFlag = new Box(null); - leafFlag.val = null; - INode n = (root == null ? BitmapIndexedNode.EMPTY : root) - .assoc(edit, 0, Util.hash(key), key, val, leafFlag); - if (n != this.root) - this.root = n; - if(leafFlag.val != null) this.count++; - return this; - } - - ITransientMap doWithout(Object key) { - if (key == null) { - if (!hasNull) return this; - hasNull = false; - nullValue = null; - this.count--; - return this; - } - if (root == null) return this; -// Box leafFlag = new Box(null); - leafFlag.val = null; - INode n = root.without(edit, 0, Util.hash(key), key, leafFlag); - if (n != root) - this.root = n; - if(leafFlag.val != null) this.count--; - return this; - } - - IPersistentMap doPersistent() { - edit.set(null); - return new PersistentHashMap(count, root, hasNull, nullValue); - } - - Object doValAt(Object key, Object notFound) { - if (key == null) - if (hasNull) - return nullValue; - else - return notFound; - if (root == null) - return null; - return root.find(0, Util.hash(key), key, notFound); - } - - int doCount() { - return count; - } - - void ensureEditable(){ - Thread owner = edit.get(); - if(owner == Thread.currentThread()) - return; - if(owner != null) - throw new IllegalAccessError("Transient used by non-owner thread"); - throw new IllegalAccessError("Transient used after persistent! call"); - } -} - -static interface INode extends Serializable { - INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf); - - INode without(int shift, int hash, Object key); - - IMapEntry find(int shift, int hash, Object key); - - Object find(int shift, int hash, Object key, Object notFound); - - ISeq nodeSeq(); - - INode assoc(AtomicReference edit, int shift, int hash, Object key, Object val, Box addedLeaf); - - INode without(AtomicReference edit, int shift, int hash, Object key, Box removedLeaf); -} - -final static class ArrayNode implements INode{ - int count; - final INode[] array; - final AtomicReference edit; - - ArrayNode(AtomicReference edit, int count, INode[] array){ - this.array = array; - this.edit = edit; - this.count = count; - } - - public INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf){ - int idx = mask(hash, shift); - INode node = array[idx]; - if(node == null) - return new ArrayNode(null, count + 1, cloneAndSet(array, idx, BitmapIndexedNode.EMPTY.assoc(shift + 5, hash, key, val, addedLeaf))); - INode n = node.assoc(shift + 5, hash, key, val, addedLeaf); - if(n == node) - return this; - return new ArrayNode(null, count, cloneAndSet(array, idx, n)); - } - - public INode without(int shift, int hash, Object key){ - int idx = mask(hash, shift); - INode node = array[idx]; - if(node == null) - return this; - INode n = node.without(shift + 5, hash, key); - if(n == node) - return this; - if (n == null) { - if (count <= 8) // shrink - return pack(null, idx); - return new ArrayNode(null, count - 1, cloneAndSet(array, idx, n)); - } else - return new ArrayNode(null, count, cloneAndSet(array, idx, n)); - } - - public IMapEntry find(int shift, int hash, Object key){ - int idx = mask(hash, shift); - INode node = array[idx]; - if(node == null) - return null; - return node.find(shift + 5, hash, key); - } - - public Object find(int shift, int hash, Object key, Object notFound){ - int idx = mask(hash, shift); - INode node = array[idx]; - if(node == null) - return notFound; - return node.find(shift + 5, hash, key, notFound); - } - - public ISeq nodeSeq(){ - return Seq.create(array); - } - - private ArrayNode ensureEditable(AtomicReference edit){ - if(this.edit == edit) - return this; - return new ArrayNode(edit, count, this.array.clone()); - } - - private ArrayNode editAndSet(AtomicReference edit, int i, INode n){ - ArrayNode editable = ensureEditable(edit); - editable.array[i] = n; - return editable; - } - - - private INode pack(AtomicReference edit, int idx) { - Object[] newArray = new Object[2*(count - 1)]; - int j = 1; - int bitmap = 0; - for(int i = 0; i < idx; i++) - if (array[i] != null) { - newArray[j] = array[i]; - bitmap |= 1 << i; - j += 2; - } - for(int i = idx + 1; i < array.length; i++) - if (array[i] != null) { - newArray[j] = array[i]; - bitmap |= 1 << i; - j += 2; - } - return new BitmapIndexedNode(edit, bitmap, newArray); - } - - public INode assoc(AtomicReference edit, int shift, int hash, Object key, Object val, Box addedLeaf){ - int idx = mask(hash, shift); - INode node = array[idx]; - if(node == null) { - ArrayNode editable = editAndSet(edit, idx, BitmapIndexedNode.EMPTY.assoc(edit, shift + 5, hash, key, val, addedLeaf)); - editable.count++; - return editable; - } - INode n = node.assoc(edit, shift + 5, hash, key, val, addedLeaf); - if(n == node) - return this; - return editAndSet(edit, idx, n); - } - - public INode without(AtomicReference edit, int shift, int hash, Object key, Box removedLeaf){ - int idx = mask(hash, shift); - INode node = array[idx]; - if(node == null) - return this; - INode n = node.without(edit, shift + 5, hash, key, removedLeaf); - if(n == node) - return this; - if(n == null) { - if (count <= 8) // shrink - return pack(edit, idx); - ArrayNode editable = editAndSet(edit, idx, n); - editable.count--; - return editable; - } - return editAndSet(edit, idx, n); - } - - static class Seq extends ASeq { - final INode[] nodes; - final int i; - final ISeq s; - - static ISeq create(INode[] nodes) { - return create(null, nodes, 0, null); - } - - private static ISeq create(IPersistentMap meta, INode[] nodes, int i, ISeq s) { - if (s != null) - return new Seq(meta, nodes, i, s); - for(int j = i; j < nodes.length; j++) - if (nodes[j] != null) { - ISeq ns = nodes[j].nodeSeq(); - if (ns != null) - return new Seq(meta, nodes, j + 1, ns); - } - return null; - } - - private Seq(IPersistentMap meta, INode[] nodes, int i, ISeq s) { - super(meta); - this.nodes = nodes; - this.i = i; - this.s = s; - } - - public Obj withMeta(IPersistentMap meta) { - return new Seq(meta, nodes, i, s); - } - - public Object first() { - return s.first(); - } - - public ISeq next() { - return create(null, nodes, i, s.next()); - } - - } -} - -final static class BitmapIndexedNode implements INode{ - static final BitmapIndexedNode EMPTY = new BitmapIndexedNode(null, 0, new Object[0]); - - int bitmap; - Object[] array; - final AtomicReference edit; - - final int index(int bit){ - return Integer.bitCount(bitmap & (bit - 1)); - } - - BitmapIndexedNode(AtomicReference edit, int bitmap, Object[] array){ - this.bitmap = bitmap; - this.array = array; - this.edit = edit; - } - - public INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf){ - int bit = bitpos(hash, shift); - int idx = index(bit); - if((bitmap & bit) != 0) { - Object keyOrNull = array[2*idx]; - Object valOrNode = array[2*idx+1]; - if(keyOrNull == null) { - INode n = ((INode) valOrNode).assoc(shift + 5, hash, key, val, addedLeaf); - if(n == valOrNode) - return this; - return new BitmapIndexedNode(null, bitmap, cloneAndSet(array, 2*idx+1, n)); - } - if(Util.equals(key, keyOrNull)) { - if(val == valOrNode) - return this; - return new BitmapIndexedNode(null, bitmap, cloneAndSet(array, 2*idx+1, val)); - } - addedLeaf.val = addedLeaf; - return new BitmapIndexedNode(null, bitmap, - cloneAndSet(array, - 2*idx, null, - 2*idx+1, createNode(shift + 5, keyOrNull, valOrNode, hash, key, val))); - } else { - int n = Integer.bitCount(bitmap); - if(n >= 16) { - INode[] nodes = new INode[32]; - int jdx = mask(hash, shift); - nodes[jdx] = EMPTY.assoc(shift + 5, hash, key, val, addedLeaf); - int j = 0; - for(int i = 0; i < 32; i++) - if(((bitmap >>> i) & 1) != 0) { - if (array[j] == null) - nodes[i] = (INode) array[j+1]; - else - nodes[i] = EMPTY.assoc(shift + 5, Util.hash(array[j]), array[j], array[j+1], addedLeaf); - j += 2; - } - return new ArrayNode(null, n + 1, nodes); - } else { - Object[] newArray = new Object[2*(n+1)]; - System.arraycopy(array, 0, newArray, 0, 2*idx); - newArray[2*idx] = key; - addedLeaf.val = addedLeaf; - newArray[2*idx+1] = val; - System.arraycopy(array, 2*idx, newArray, 2*(idx+1), 2*(n-idx)); - return new BitmapIndexedNode(null, bitmap | bit, newArray); - } - } - } - - public INode without(int shift, int hash, Object key){ - int bit = bitpos(hash, shift); - if((bitmap & bit) == 0) - return this; - int idx = index(bit); - Object keyOrNull = array[2*idx]; - Object valOrNode = array[2*idx+1]; - if(keyOrNull == null) { - INode n = ((INode) valOrNode).without(shift + 5, hash, key); - if (n == valOrNode) - return this; - if (n != null) - return new BitmapIndexedNode(null, bitmap, cloneAndSet(array, 2*idx+1, n)); - if (bitmap == bit) - return null; - return new BitmapIndexedNode(null, bitmap ^ bit, removePair(array, idx)); - } - if(Util.equals(key, keyOrNull)) - // TODO: collapse - return new BitmapIndexedNode(null, bitmap ^ bit, removePair(array, idx)); - return this; - } - - public IMapEntry find(int shift, int hash, Object key){ - int bit = bitpos(hash, shift); - if((bitmap & bit) == 0) - return null; - int idx = index(bit); - Object keyOrNull = array[2*idx]; - Object valOrNode = array[2*idx+1]; - if(keyOrNull == null) - return ((INode) valOrNode).find(shift + 5, hash, key); - if(Util.equals(key, keyOrNull)) - return new MapEntry(keyOrNull, valOrNode); - return null; - } - - public Object find(int shift, int hash, Object key, Object notFound){ - int bit = bitpos(hash, shift); - if((bitmap & bit) == 0) - return notFound; - int idx = index(bit); - Object keyOrNull = array[2*idx]; - Object valOrNode = array[2*idx+1]; - if(keyOrNull == null) - return ((INode) valOrNode).find(shift + 5, hash, key, notFound); - if(Util.equals(key, keyOrNull)) - return valOrNode; - return notFound; - } - - public ISeq nodeSeq(){ - return NodeSeq.create(array); - } - - private BitmapIndexedNode ensureEditable(AtomicReference edit){ - if(this.edit == edit) - return this; - int n = Integer.bitCount(bitmap); - Object[] newArray = new Object[n >= 0 ? 2*(n+1) : 4]; // make room for next assoc - System.arraycopy(array, 0, newArray, 0, 2*n); - return new BitmapIndexedNode(edit, bitmap, newArray); - } - - private BitmapIndexedNode editAndSet(AtomicReference edit, int i, Object a) { - BitmapIndexedNode editable = ensureEditable(edit); - editable.array[i] = a; - return editable; - } - - private BitmapIndexedNode editAndSet(AtomicReference edit, int i, Object a, int j, Object b) { - BitmapIndexedNode editable = ensureEditable(edit); - editable.array[i] = a; - editable.array[j] = b; - return editable; - } - - private BitmapIndexedNode editAndRemovePair(AtomicReference edit, int bit, int i) { - if (bitmap == bit) - return null; - BitmapIndexedNode editable = ensureEditable(edit); - editable.bitmap ^= bit; - System.arraycopy(editable.array, 2*(i+1), editable.array, 2*i, editable.array.length - 2*(i+1)); - editable.array[editable.array.length - 2] = null; - editable.array[editable.array.length - 1] = null; - return editable; - } - - public INode assoc(AtomicReference edit, int shift, int hash, Object key, Object val, Box addedLeaf){ - int bit = bitpos(hash, shift); - int idx = index(bit); - if((bitmap & bit) != 0) { - Object keyOrNull = array[2*idx]; - Object valOrNode = array[2*idx+1]; - if(keyOrNull == null) { - INode n = ((INode) valOrNode).assoc(edit, shift + 5, hash, key, val, addedLeaf); - if(n == valOrNode) - return this; - return editAndSet(edit, 2*idx+1, n); - } - if(Util.equals(key, keyOrNull)) { - if(val == valOrNode) - return this; - return editAndSet(edit, 2*idx+1, val); - } - addedLeaf.val = addedLeaf; - return editAndSet(edit, 2*idx, null, 2*idx+1, - createNode(edit, shift + 5, keyOrNull, valOrNode, hash, key, val)); - } else { - int n = Integer.bitCount(bitmap); - if(n*2 < array.length) { - addedLeaf.val = addedLeaf; - BitmapIndexedNode editable = ensureEditable(edit); - System.arraycopy(editable.array, 2*idx, editable.array, 2*(idx+1), 2*(n-idx)); - editable.array[2*idx] = key; - editable.array[2*idx+1] = val; - editable.bitmap |= bit; - return editable; - } - if(n >= 16) { - INode[] nodes = new INode[32]; - int jdx = mask(hash, shift); - nodes[jdx] = EMPTY.assoc(edit, shift + 5, hash, key, val, addedLeaf); - int j = 0; - for(int i = 0; i < 32; i++) - if(((bitmap >>> i) & 1) != 0) { - if (array[j] == null) - nodes[i] = (INode) array[j+1]; - else - nodes[i] = EMPTY.assoc(edit, shift + 5, Util.hash(array[j]), array[j], array[j+1], addedLeaf); - j += 2; - } - return new ArrayNode(edit, n + 1, nodes); - } else { - Object[] newArray = new Object[2*(n+4)]; - System.arraycopy(array, 0, newArray, 0, 2*idx); - newArray[2*idx] = key; - addedLeaf.val = addedLeaf; - newArray[2*idx+1] = val; - System.arraycopy(array, 2*idx, newArray, 2*(idx+1), 2*(n-idx)); - BitmapIndexedNode editable = ensureEditable(edit); - editable.array = newArray; - editable.bitmap |= bit; - return editable; - } - } - } - - public INode without(AtomicReference edit, int shift, int hash, Object key, Box removedLeaf){ - int bit = bitpos(hash, shift); - if((bitmap & bit) == 0) - return this; - int idx = index(bit); - Object keyOrNull = array[2*idx]; - Object valOrNode = array[2*idx+1]; - if(keyOrNull == null) { - INode n = ((INode) valOrNode).without(edit, shift + 5, hash, key, removedLeaf); - if (n == valOrNode) - return this; - if (n != null) - return editAndSet(edit, 2*idx+1, n); - if (bitmap == bit) - return null; - removedLeaf.val = removedLeaf; - return editAndRemovePair(edit, bit, idx); - } - if(Util.equals(key, keyOrNull)) { - removedLeaf.val = removedLeaf; - // TODO: collapse - return editAndRemovePair(edit, bit, idx); - } - return this; - } -} - -final static class HashCollisionNode implements INode{ - - final int hash; - int count; - Object[] array; - final AtomicReference edit; - - HashCollisionNode(AtomicReference edit, int hash, int count, Object... array){ - this.edit = edit; - this.hash = hash; - this.count = count; - this.array = array; - } - - public INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf){ - if(hash == this.hash) { - int idx = findIndex(key); - if(idx != -1) { - if(array[idx + 1] == val) - return this; - return new HashCollisionNode(null, hash, count, cloneAndSet(array, idx + 1, val)); - } - Object[] newArray = new Object[array.length + 2]; - System.arraycopy(array, 0, newArray, 0, array.length); - newArray[array.length] = key; - newArray[array.length + 1] = val; - addedLeaf.val = addedLeaf; - return new HashCollisionNode(edit, hash, count + 1, newArray); - } - // nest it in a bitmap node - return new BitmapIndexedNode(null, bitpos(this.hash, shift), new Object[] {null, this}) - .assoc(shift, hash, key, val, addedLeaf); - } - - public INode without(int shift, int hash, Object key){ - int idx = findIndex(key); - if(idx == -1) - return this; - if(count == 1) - return null; - return new HashCollisionNode(null, hash, count - 1, removePair(array, idx/2)); - } - - public IMapEntry find(int shift, int hash, Object key){ - int idx = findIndex(key); - if(idx < 0) - return null; - if(Util.equals(key, array[idx])) - return new MapEntry(array[idx], array[idx+1]); - return null; - } - - public Object find(int shift, int hash, Object key, Object notFound){ - int idx = findIndex(key); - if(idx < 0) - return notFound; - if(Util.equals(key, array[idx])) - return array[idx+1]; - return notFound; - } - - public ISeq nodeSeq(){ - return NodeSeq.create(array); - } - - public int findIndex(Object key){ - for(int i = 0; i < 2*count; i+=2) - { - if(Util.equals(key, array[i])) - return i; - } - return -1; - } - - private HashCollisionNode ensureEditable(AtomicReference edit){ - if(this.edit == edit) - return this; - return new HashCollisionNode(edit, hash, count, array); - } - - private HashCollisionNode ensureEditable(AtomicReference edit, int count, Object[] array){ - if(this.edit == edit) { - this.array = array; - this.count = count; - return this; - } - return new HashCollisionNode(edit, hash, count, array); - } - - private HashCollisionNode editAndSet(AtomicReference edit, int i, Object a) { - HashCollisionNode editable = ensureEditable(edit); - editable.array[i] = a; - return editable; - } - - private HashCollisionNode editAndSet(AtomicReference edit, int i, Object a, int j, Object b) { - HashCollisionNode editable = ensureEditable(edit); - editable.array[i] = a; - editable.array[j] = b; - return editable; - } - - - public INode assoc(AtomicReference edit, int shift, int hash, Object key, Object val, Box addedLeaf){ - if(hash == this.hash) { - int idx = findIndex(key); - if(idx != -1) { - if(array[idx + 1] == val) - return this; - return editAndSet(edit, idx+1, val); - } - if (array.length > 2*count) { - addedLeaf.val = addedLeaf; - HashCollisionNode editable = editAndSet(edit, 2*count, key, 2*count+1, val); - editable.count++; - return editable; - } - Object[] newArray = new Object[array.length + 2]; - System.arraycopy(array, 0, newArray, 0, array.length); - newArray[array.length] = key; - newArray[array.length + 1] = val; - addedLeaf.val = addedLeaf; - return ensureEditable(edit, count + 1, newArray); - } - // nest it in a bitmap node - return new BitmapIndexedNode(edit, bitpos(this.hash, shift), new Object[] {null, this, null, null}) - .assoc(edit, shift, hash, key, val, addedLeaf); - } - - public INode without(AtomicReference edit, int shift, int hash, Object key, Box removedLeaf){ - int idx = findIndex(key); - if(idx == -1) - return this; - if(count == 1) - return null; - HashCollisionNode editable = ensureEditable(edit); - editable.array[idx] = editable.array[2*count-2]; - editable.array[idx+1] = editable.array[2*count-1]; - editable.array[2*count-2] = editable.array[2*count-1] = null; - editable.count--; - return editable; - } -} - -/* -public static void main(String[] args){ - try - { - ArrayList words = new ArrayList(); - Scanner s = new Scanner(new File(args[0])); - s.useDelimiter(Pattern.compile("\\W")); - while(s.hasNext()) - { - String word = s.next(); - words.add(word); - } - System.out.println("words: " + words.size()); - IPersistentMap map = PersistentHashMap.EMPTY; - //IPersistentMap map = new PersistentTreeMap(); - //Map ht = new Hashtable(); - Map ht = new HashMap(); - Random rand; - - System.out.println("Building map"); - long startTime = System.nanoTime(); - for(Object word5 : words) - { - map = map.assoc(word5, word5); - } - rand = new Random(42); - IPersistentMap snapshotMap = map; - for(int i = 0; i < words.size() / 200; i++) - { - map = map.without(words.get(rand.nextInt(words.size() / 2))); - } - long estimatedTime = System.nanoTime() - startTime; - System.out.println("count = " + map.count() + ", time: " + estimatedTime / 1000000); - - System.out.println("Building ht"); - startTime = System.nanoTime(); - for(Object word1 : words) - { - ht.put(word1, word1); - } - rand = new Random(42); - for(int i = 0; i < words.size() / 200; i++) - { - ht.remove(words.get(rand.nextInt(words.size() / 2))); - } - estimatedTime = System.nanoTime() - startTime; - System.out.println("count = " + ht.size() + ", time: " + estimatedTime / 1000000); - - System.out.println("map lookup"); - startTime = System.nanoTime(); - int c = 0; - for(Object word2 : words) - { - if(!map.contains(word2)) - ++c; - } - estimatedTime = System.nanoTime() - startTime; - System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000); - System.out.println("ht lookup"); - startTime = System.nanoTime(); - c = 0; - for(Object word3 : words) - { - if(!ht.containsKey(word3)) - ++c; - } - estimatedTime = System.nanoTime() - startTime; - System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000); - System.out.println("snapshotMap lookup"); - startTime = System.nanoTime(); - c = 0; - for(Object word4 : words) - { - if(!snapshotMap.contains(word4)) - ++c; - } - estimatedTime = System.nanoTime() - startTime; - System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000); - } - catch(FileNotFoundException e) - { - e.printStackTrace(); - } - -} -*/ - -private static INode[] cloneAndSet(INode[] array, int i, INode a) { - INode[] clone = array.clone(); - clone[i] = a; - return clone; -} - -private static Object[] cloneAndSet(Object[] array, int i, Object a) { - Object[] clone = array.clone(); - clone[i] = a; - return clone; -} - -private static Object[] cloneAndSet(Object[] array, int i, Object a, int j, Object b) { - Object[] clone = array.clone(); - clone[i] = a; - clone[j] = b; - return clone; -} - -private static Object[] removePair(Object[] array, int i) { - Object[] newArray = new Object[array.length - 2]; - System.arraycopy(array, 0, newArray, 0, 2*i); - System.arraycopy(array, 2*(i+1), newArray, 2*i, newArray.length - 2*i); - return newArray; -} - -private static INode createNode(int shift, Object key1, Object val1, int key2hash, Object key2, Object val2) { - int key1hash = Util.hash(key1); - if(key1hash == key2hash) - return new HashCollisionNode(null, key1hash, 2, new Object[] {key1, val1, key2, val2}); - Box _ = new Box(null); - AtomicReference edit = new AtomicReference(); - return BitmapIndexedNode.EMPTY - .assoc(edit, shift, key1hash, key1, val1, _) - .assoc(edit, shift, key2hash, key2, val2, _); -} - -private static INode createNode(AtomicReference edit, int shift, Object key1, Object val1, int key2hash, Object key2, Object val2) { - int key1hash = Util.hash(key1); - if(key1hash == key2hash) - return new HashCollisionNode(null, key1hash, 2, new Object[] {key1, val1, key2, val2}); - Box _ = new Box(null); - return BitmapIndexedNode.EMPTY - .assoc(edit, shift, key1hash, key1, val1, _) - .assoc(edit, shift, key2hash, key2, val2, _); -} - -private static int bitpos(int hash, int shift){ - return 1 << mask(hash, shift); -} - -static final class NodeSeq extends ASeq { - final Object[] array; - final int i; - final ISeq s; - - NodeSeq(Object[] array, int i) { - this(null, array, i, null); - } - - static ISeq create(Object[] array) { - return create(array, 0, null); - } - - private static ISeq create(Object[] array, int i, ISeq s) { - if(s != null) - return new NodeSeq(null, array, i, s); - for(int j = i; j < array.length; j+=2) { - if(array[j] != null) - return new NodeSeq(null, array, j, null); - INode node = (INode) array[j+1]; - if (node != null) { - ISeq nodeSeq = node.nodeSeq(); - if(nodeSeq != null) - return new NodeSeq(null, array, j + 2, nodeSeq); - } - } - return null; - } - - NodeSeq(IPersistentMap meta, Object[] array, int i, ISeq s) { - super(meta); - this.array = array; - this.i = i; - this.s = s; - } - - public Obj withMeta(IPersistentMap meta) { - return new NodeSeq(meta, array, i, s); - } - - public Object first() { - if(s != null) - return s.first(); - return new MapEntry(array[i], array[i+1]); - } - - public ISeq next() { - if(s != null) - return create(array, i, s.next()); - return create(array, i + 2, null); - } -} - -} \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/PersistentHashSet.java --- a/src/clojure/lang/PersistentHashSet.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,128 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 3, 2008 */ - -package clojure.lang; - -import java.util.List; - -public class PersistentHashSet extends APersistentSet implements IObj, IEditableCollection { - -static public final PersistentHashSet EMPTY = new PersistentHashSet(null, PersistentHashMap.EMPTY); - -final IPersistentMap _meta; - -public static PersistentHashSet create(Object... init){ - PersistentHashSet ret = EMPTY; - for(int i = 0; i < init.length; i++) - { - ret = (PersistentHashSet) ret.cons(init[i]); - } - return ret; -} - -public static PersistentHashSet create(List init){ - PersistentHashSet ret = EMPTY; - for(Object key : init) - { - ret = (PersistentHashSet) ret.cons(key); - } - return ret; -} - -static public PersistentHashSet create(ISeq items){ - PersistentHashSet ret = EMPTY; - for(; items != null; items = items.next()) - { - ret = (PersistentHashSet) ret.cons(items.first()); - } - return ret; -} - -public static PersistentHashSet createWithCheck(Object... init){ - PersistentHashSet ret = EMPTY; - for(int i = 0; i < init.length; i++) - { - ret = (PersistentHashSet) ret.cons(init[i]); - if(ret.count() != i + 1) - throw new IllegalArgumentException("Duplicate key: " + init[i]); - } - return ret; -} - -public static PersistentHashSet createWithCheck(List init){ - PersistentHashSet ret = EMPTY; - int i=0; - for(Object key : init) - { - ret = (PersistentHashSet) ret.cons(key); - if(ret.count() != i + 1) - throw new IllegalArgumentException("Duplicate key: " + key); - ++i; - } - return ret; -} - -static public PersistentHashSet createWithCheck(ISeq items){ - PersistentHashSet ret = EMPTY; - for(int i=0; items != null; items = items.next(), ++i) - { - ret = (PersistentHashSet) ret.cons(items.first()); - if(ret.count() != i + 1) - throw new IllegalArgumentException("Duplicate key: " + items.first()); - } - return ret; -} - -PersistentHashSet(IPersistentMap meta, IPersistentMap impl){ - super(impl); - this._meta = meta; -} - -public IPersistentSet disjoin(Object key) throws Exception{ - if(contains(key)) - return new PersistentHashSet(meta(),impl.without(key)); - return this; -} - -public IPersistentSet cons(Object o){ - if(contains(o)) - return this; - return new PersistentHashSet(meta(),impl.assoc(o,o)); -} - -public IPersistentCollection empty(){ - return EMPTY.withMeta(meta()); -} - -public PersistentHashSet withMeta(IPersistentMap meta){ - return new PersistentHashSet(meta, impl); -} - -public ITransientCollection asTransient() { - return new TransientHashSet(((PersistentHashMap) impl).asTransient()); -} - -public IPersistentMap meta(){ - return _meta; -} - -static final class TransientHashSet extends ATransientSet { - TransientHashSet(ITransientMap impl) { - super(impl); - } - - public IPersistentCollection persistent() { - return new PersistentHashSet(null, impl.persistent()); - } -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/PersistentList.java --- a/src/clojure/lang/PersistentList.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,311 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -import java.io.Serializable; -import java.util.*; - -public class PersistentList extends ASeq implements IPersistentList, IReduce, List, Counted { - -private final Object _first; -private final IPersistentList _rest; -private final int _count; - -public static IFn creator = new RestFn(){ - final public int getRequiredArity(){ - return 0; - } - - final protected Object doInvoke(Object args) throws Exception{ - if(args instanceof ArraySeq) - { - Object[] argsarray = (Object[]) ((ArraySeq) args).array; - IPersistentList ret = EMPTY; - for(int i = argsarray.length - 1; i >= 0; --i) - ret = (IPersistentList) ret.cons(argsarray[i]); - return ret; - } - LinkedList list = new LinkedList(); - for(ISeq s = RT.seq(args); s != null; s = s.next()) - list.add(s.first()); - return create(list); - } - - public IObj withMeta(IPersistentMap meta){ - throw new UnsupportedOperationException(); - } - - public IPersistentMap meta(){ - return null; - } -}; - -final public static EmptyList EMPTY = new EmptyList(null); - -public PersistentList(Object first){ - this._first = first; - this._rest = null; - - this._count = 1; -} - -PersistentList(IPersistentMap meta, Object _first, IPersistentList _rest, int _count){ - super(meta); - this._first = _first; - this._rest = _rest; - this._count = _count; -} - -public static IPersistentList create(List init){ - IPersistentList ret = EMPTY; - for(ListIterator i = init.listIterator(init.size()); i.hasPrevious();) - { - ret = (IPersistentList) ret.cons(i.previous()); - } - return ret; -} - -public Object first(){ - return _first; -} - -public ISeq next(){ - if(_count == 1) - return null; - return (ISeq) _rest; -} - -public Object peek(){ - return first(); -} - -public IPersistentList pop(){ - if(_rest == null) - return EMPTY.withMeta(_meta); - return _rest; -} - -public int count(){ - return _count; -} - -public PersistentList cons(Object o){ - return new PersistentList(meta(), o, this, _count + 1); -} - -public IPersistentCollection empty(){ - return EMPTY.withMeta(meta()); -} - -public PersistentList withMeta(IPersistentMap meta){ - if(meta != _meta) - return new PersistentList(meta, _first, _rest, _count); - return this; -} - -public Object reduce(IFn f) throws Exception{ - Object ret = first(); - for(ISeq s = next(); s != null; s = s.next()) - ret = f.invoke(ret, s.first()); - return ret; -} - -public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start, first()); - for(ISeq s = next(); s != null; s = s.next()) - ret = f.invoke(ret, s.first()); - return ret; -} - - - static class EmptyList extends Obj implements IPersistentList, List, ISeq, Counted{ - - public int hashCode(){ - return 1; - } - - public boolean equals(Object o) { - return (o instanceof Sequential || o instanceof List) && RT.seq(o) == null; - } - - public boolean equiv(Object o){ - return equals(o); - } - - EmptyList(IPersistentMap meta){ - super(meta); - } - - public Object first() { - return null; - } - - public ISeq next() { - return null; - } - - public ISeq more() { - return this; - } - - public PersistentList cons(Object o){ - return new PersistentList(meta(), o, null, 1); - } - - public IPersistentCollection empty(){ - return this; - } - - public EmptyList withMeta(IPersistentMap meta){ - if(meta != meta()) - return new EmptyList(meta); - return this; - } - - public Object peek(){ - return null; - } - - public IPersistentList pop(){ - throw new IllegalStateException("Can't pop empty list"); - } - - public int count(){ - return 0; - } - - public ISeq seq(){ - return null; - } - - - public int size(){ - return 0; - } - - public boolean isEmpty(){ - return true; - } - - public boolean contains(Object o){ - return false; - } - - public Iterator iterator(){ - return new Iterator(){ - - public boolean hasNext(){ - return false; - } - - public Object next(){ - throw new NoSuchElementException(); - } - - public void remove(){ - throw new UnsupportedOperationException(); - } - }; - } - - public Object[] toArray(){ - return RT.EMPTY_ARRAY; - } - - public boolean add(Object o){ - throw new UnsupportedOperationException(); - } - - public boolean remove(Object o){ - throw new UnsupportedOperationException(); - } - - public boolean addAll(Collection collection){ - throw new UnsupportedOperationException(); - } - - public void clear(){ - throw new UnsupportedOperationException(); - } - - public boolean retainAll(Collection collection){ - throw new UnsupportedOperationException(); - } - - public boolean removeAll(Collection collection){ - throw new UnsupportedOperationException(); - } - - public boolean containsAll(Collection collection){ - return collection.isEmpty(); - } - - public Object[] toArray(Object[] objects){ - if(objects.length > 0) - objects[0] = null; - return objects; - } - - //////////// List stuff ///////////////// - private List reify(){ - return Collections.unmodifiableList(new ArrayList(this)); - } - - public List subList(int fromIndex, int toIndex){ - return reify().subList(fromIndex, toIndex); - } - - public Object set(int index, Object element){ - throw new UnsupportedOperationException(); - } - - public Object remove(int index){ - throw new UnsupportedOperationException(); - } - - public int indexOf(Object o){ - ISeq s = seq(); - for(int i = 0; s != null; s = s.next(), i++) - { - if(Util.equiv(s.first(), o)) - return i; - } - return -1; - } - - public int lastIndexOf(Object o){ - return reify().lastIndexOf(o); - } - - public ListIterator listIterator(){ - return reify().listIterator(); - } - - public ListIterator listIterator(int index){ - return reify().listIterator(index); - } - - public Object get(int index){ - return RT.nth(this, index); - } - - public void add(int index, Object element){ - throw new UnsupportedOperationException(); - } - - public boolean addAll(int index, Collection c){ - throw new UnsupportedOperationException(); - } - - -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/PersistentQueue.java --- a/src/clojure/lang/PersistentQueue.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,304 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure.lang; - -import java.util.Collection; -import java.util.Iterator; -//import java.util.concurrent.ConcurrentLinkedQueue; - -/** - * conses onto rear, peeks/pops from front - * See Okasaki's Batched Queues - * This differs in that it uses a PersistentArrayList as the rear, which is in-order, - * so no reversing or suspensions required for persistent use - */ - -public class PersistentQueue extends Obj implements IPersistentList, Collection{ - -final public static PersistentQueue EMPTY = new PersistentQueue(null, null, null); - -//* -final ISeq f; -final PersistentVector r; -//static final int INITIAL_REAR_SIZE = 4; -int _hash = -1; - -PersistentQueue(IPersistentMap meta, ISeq f, PersistentVector r){ - super(meta); - this.f = f; - this.r = r; -} - -public boolean equiv(Object obj){ - - if(!(obj instanceof Sequential)) - return false; - ISeq ms = RT.seq(obj); - for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next()) - { - if(ms == null || !Util.equiv(s.first(), ms.first())) - return false; - } - return ms == null; - -} - -public boolean equals(Object obj){ - - if(!(obj instanceof Sequential)) - return false; - ISeq ms = RT.seq(obj); - for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next()) - { - if(ms == null || !Util.equals(s.first(), ms.first())) - return false; - } - return ms == null; - -} - -public int hashCode(){ - if(_hash == -1) - { - int hash = 0; - for(ISeq s = seq(); s != null; s = s.next()) - { - hash = Util.hashCombine(hash, Util.hash(s.first())); - } - this._hash = hash; - } - return _hash; -} - -public Object peek(){ - return RT.first(f); -} - -public PersistentQueue pop(){ - if(f == null) //hmmm... pop of empty queue -> empty queue? - return this; - //throw new IllegalStateException("popping empty queue"); - ISeq f1 = f.next(); - PersistentVector r1 = r; - if(f1 == null) - { - f1 = RT.seq(r); - r1 = null; - } - return new PersistentQueue(meta(), f1, r1); -} - -public int count(){ - return RT.count(f) + RT.count(r); -} - -public ISeq seq(){ - if(f == null) - return null; - return new Seq(f, RT.seq(r)); -} - -public PersistentQueue cons(Object o){ - if(f == null) //empty - return new PersistentQueue(meta(), RT.list(o), null); - else - return new PersistentQueue(meta(), f, (r != null ? r : PersistentVector.EMPTY).cons(o)); -} - -public IPersistentCollection empty(){ - return EMPTY.withMeta(meta()); -} - -public PersistentQueue withMeta(IPersistentMap meta){ - return new PersistentQueue(meta, f, r); -} - -static class Seq extends ASeq{ - final ISeq f; - final ISeq rseq; - - Seq(ISeq f, ISeq rseq){ - this.f = f; - this.rseq = rseq; - } - - Seq(IPersistentMap meta, ISeq f, ISeq rseq){ - super(meta); - this.f = f; - this.rseq = rseq; - } - - public Object first(){ - return f.first(); - } - - public ISeq next(){ - ISeq f1 = f.next(); - ISeq r1 = rseq; - if(f1 == null) - { - if(rseq == null) - return null; - f1 = rseq; - r1 = null; - } - return new Seq(f1, r1); - } - - public int count(){ - return RT.count(f) + RT.count(rseq); - } - - public Seq withMeta(IPersistentMap meta){ - return new Seq(meta, f, rseq); - } -} - -// java.util.Collection implementation - -public Object[] toArray(){ - return RT.seqToArray(seq()); -} - -public boolean add(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean remove(Object o){ - throw new UnsupportedOperationException(); -} - -public boolean addAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public void clear(){ - throw new UnsupportedOperationException(); -} - -public boolean retainAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean removeAll(Collection c){ - throw new UnsupportedOperationException(); -} - -public boolean containsAll(Collection c){ - for(Object o : c) - { - if(contains(o)) - return true; - } - return false; -} - -public Object[] toArray(Object[] a){ - if(a.length >= count()) - { - ISeq s = seq(); - for(int i = 0; s != null; ++i, s = s.next()) - { - a[i] = s.first(); - } - if(a.length >= count()) - a[count()] = null; - return a; - } - else - return toArray(); -} - -public int size(){ - return count(); -} - -public boolean isEmpty(){ - return count() == 0; -} - -public boolean contains(Object o){ - for(ISeq s = seq(); s != null; s = s.next()) - { - if(Util.equiv(s.first(), o)) - return true; - } - return false; -} - -public Iterator iterator(){ - return new SeqIterator(seq()); -} - -/* -public static void main(String[] args){ - if(args.length != 1) - { - System.err.println("Usage: PersistentQueue n"); - return; - } - int n = Integer.parseInt(args[0]); - - - long startTime, estimatedTime; - - Queue list = new LinkedList(); - //Queue list = new ConcurrentLinkedQueue(); - System.out.println("Queue"); - startTime = System.nanoTime(); - for(int i = 0; i < n; i++) - { - list.add(i); - list.add(i); - list.remove(); - } - for(int i = 0; i < n - 10; i++) - { - list.remove(); - } - estimatedTime = System.nanoTime() - startTime; - System.out.println("time: " + estimatedTime / 1000000); - System.out.println("peek: " + list.peek()); - - - PersistentQueue q = PersistentQueue.EMPTY; - System.out.println("PersistentQueue"); - startTime = System.nanoTime(); - for(int i = 0; i < n; i++) - { - q = q.cons(i); - q = q.cons(i); - q = q.pop(); - } -// IPersistentList lastq = null; -// IPersistentList lastq2; - for(int i = 0; i < n - 10; i++) - { - //lastq2 = lastq; - //lastq = q; - q = q.pop(); - } - estimatedTime = System.nanoTime() - startTime; - System.out.println("time: " + estimatedTime / 1000000); - System.out.println("peek: " + q.peek()); - - IPersistentList q2 = q; - for(int i = 0; i < 10; i++) - { - q2 = (IPersistentList) q2.cons(i); - } -// for(ISeq s = q.seq();s != null;s = s.rest()) -// System.out.println("q: " + s.first().toString()); -// for(ISeq s = q2.seq();s != null;s = s.rest()) -// System.out.println("q2: " + s.first().toString()); -} -*/ -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/PersistentStructMap.java --- a/src/clojure/lang/PersistentStructMap.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,233 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Dec 16, 2007 */ - -package clojure.lang; - -import java.util.Iterator; -import java.util.Map; -import java.io.Serializable; - -public class PersistentStructMap extends APersistentMap implements IObj{ - -public static class Def implements Serializable{ - final ISeq keys; - final IPersistentMap keyslots; - - Def(ISeq keys, IPersistentMap keyslots){ - this.keys = keys; - this.keyslots = keyslots; - } -} - -final Def def; -final Object[] vals; -final IPersistentMap ext; -final IPersistentMap _meta; - - -static public Def createSlotMap(ISeq keys){ - if(keys == null) - throw new IllegalArgumentException("Must supply keys"); - int c = RT.count(keys); - Object[] v = new Object[2*c]; - int i = 0; - for(ISeq s = keys; s != null; s = s.next(), i++) - { - v[2*i] = s.first(); - v[2*i+1] = i; - } - return new Def(keys, RT.map(v)); -} - -static public PersistentStructMap create(Def def, ISeq keyvals){ - Object[] vals = new Object[def.keyslots.count()]; - IPersistentMap ext = PersistentHashMap.EMPTY; - for(; keyvals != null; keyvals = keyvals.next().next()) - { - if(keyvals.next() == null) - throw new IllegalArgumentException(String.format("No value supplied for key: %s", keyvals.first())); - Object k = keyvals.first(); - Object v = RT.second(keyvals); - Map.Entry e = def.keyslots.entryAt(k); - if(e != null) - vals[(Integer) e.getValue()] = v; - else - ext = ext.assoc(k, v); - } - return new PersistentStructMap(null, def, vals, ext); -} - -static public PersistentStructMap construct(Def def, ISeq valseq){ - Object[] vals = new Object[def.keyslots.count()]; - IPersistentMap ext = PersistentHashMap.EMPTY; - for(int i = 0; i < vals.length && valseq != null; valseq = valseq.next(), i++) - { - vals[i] = valseq.first(); - } - if(valseq != null) - throw new IllegalArgumentException("Too many arguments to struct constructor"); - return new PersistentStructMap(null, def, vals, ext); -} - -static public IFn getAccessor(final Def def, Object key){ - Map.Entry e = def.keyslots.entryAt(key); - if(e != null) - { - final int i = (Integer) e.getValue(); - return new AFn(){ - public Object invoke(Object arg1) throws Exception{ - PersistentStructMap m = (PersistentStructMap) arg1; - if(m.def != def) - throw new Exception("Accessor/struct mismatch"); - return m.vals[i]; - } - }; - } - throw new IllegalArgumentException("Not a key of struct"); -} - -protected PersistentStructMap(IPersistentMap meta, Def def, Object[] vals, IPersistentMap ext){ - this._meta = meta; - this.ext = ext; - this.def = def; - this.vals = vals; -} - -/** - * Returns a new instance of PersistentStructMap using the given parameters. - * This function is used instead of the PersistentStructMap constructor by - * all methods that return a new PersistentStructMap. This is done so as to - * allow subclasses to return instances of their class from all - * PersistentStructMap methods. - */ -protected PersistentStructMap makeNew(IPersistentMap meta, Def def, Object[] vals, IPersistentMap ext){ - return new PersistentStructMap(meta, def, vals, ext); -} - -public IObj withMeta(IPersistentMap meta){ - if(meta == _meta) - return this; - return makeNew(meta, def, vals, ext); -} - -public IPersistentMap meta(){ - return _meta; -} - -public boolean containsKey(Object key){ - return def.keyslots.containsKey(key) || ext.containsKey(key); -} - -public IMapEntry entryAt(Object key){ - Map.Entry e = def.keyslots.entryAt(key); - if(e != null) - { - return new MapEntry(e.getKey(), vals[(Integer) e.getValue()]); - } - return ext.entryAt(key); -} - -public IPersistentMap assoc(Object key, Object val){ - Map.Entry e = def.keyslots.entryAt(key); - if(e != null) - { - int i = (Integer) e.getValue(); - Object[] newVals = vals.clone(); - newVals[i] = val; - return makeNew(_meta, def, newVals, ext); - } - return makeNew(_meta, def, vals, ext.assoc(key, val)); -} - -public Object valAt(Object key){ - Integer i = (Integer) def.keyslots.valAt(key); - if(i != null) - { - return vals[i]; - } - return ext.valAt(key); -} - -public Object valAt(Object key, Object notFound){ - Integer i = (Integer) def.keyslots.valAt(key); - if(i != null) - { - return vals[i]; - } - return ext.valAt(key, notFound); -} - -public IPersistentMap assocEx(Object key, Object val) throws Exception{ - if(containsKey(key)) - throw new Exception("Key already present"); - return assoc(key, val); -} - -public IPersistentMap without(Object key) throws Exception{ - Map.Entry e = def.keyslots.entryAt(key); - if(e != null) - throw new Exception("Can't remove struct key"); - IPersistentMap newExt = ext.without(key); - if(newExt == ext) - return this; - return makeNew(_meta, def, vals, newExt); -} - -public Iterator iterator(){ - return new SeqIterator(seq()); -} - - -public int count(){ - return vals.length + RT.count(ext); -} - -public ISeq seq(){ - return new Seq(null, def.keys, vals, 0, ext); -} - -public IPersistentCollection empty(){ - return construct(def, null); -} - -static class Seq extends ASeq{ - final int i; - final ISeq keys; - final Object[] vals; - final IPersistentMap ext; - - - public Seq(IPersistentMap meta, ISeq keys, Object[] vals, int i, IPersistentMap ext){ - super(meta); - this.i = i; - this.keys = keys; - this.vals = vals; - this.ext = ext; - } - - public Obj withMeta(IPersistentMap meta){ - if(meta != _meta) - return new Seq(meta, keys, vals, i, ext); - return this; - } - - public Object first(){ - return new MapEntry(keys.first(), vals[i]); - } - - public ISeq next(){ - if(i + 1 < vals.length) - return new Seq(_meta, keys.next(), vals, i + 1, ext); - return ext.seq(); - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/PersistentTreeMap.java --- a/src/clojure/lang/PersistentTreeMap.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1003 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich May 20, 2006 */ - -package clojure.lang; - -import java.util.*; - -/** - * Persistent Red Black Tree - * Note that instances of this class are constant values - * i.e. add/remove etc return new values - *

- * See Okasaki, Kahrs, Larsen et al - */ - -public class PersistentTreeMap extends APersistentMap implements IObj, Reversible, Sorted{ - -public final Comparator comp; -public final Node tree; -public final int _count; -final IPersistentMap _meta; - -final static public PersistentTreeMap EMPTY = new PersistentTreeMap(); - -static public IPersistentMap create(Map other){ - IPersistentMap ret = EMPTY; - for(Object o : other.entrySet()) - { - Map.Entry e = (Entry) o; - ret = ret.assoc(e.getKey(), e.getValue()); - } - return ret; -} - -public PersistentTreeMap(){ - this(RT.DEFAULT_COMPARATOR); -} - -public PersistentTreeMap withMeta(IPersistentMap meta){ - return new PersistentTreeMap(meta, comp, tree, _count); -} - -private PersistentTreeMap(Comparator comp){ - this(null, comp); -} - - -public PersistentTreeMap(IPersistentMap meta, Comparator comp){ - this.comp = comp; - this._meta = meta; - tree = null; - _count = 0; -} - -PersistentTreeMap(IPersistentMap meta, Comparator comp, Node tree, int _count){ - this._meta = meta; - this.comp = comp; - this.tree = tree; - this._count = _count; -} - -static public PersistentTreeMap create(ISeq items){ - IPersistentMap ret = EMPTY; - for(; items != null; items = items.next().next()) - { - if(items.next() == null) - throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first())); - ret = ret.assoc(items.first(), RT.second(items)); - } - return (PersistentTreeMap) ret; -} - -static public PersistentTreeMap create(Comparator comp, ISeq items){ - IPersistentMap ret = new PersistentTreeMap(comp); - for(; items != null; items = items.next().next()) - { - if(items.next() == null) - throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first())); - ret = ret.assoc(items.first(), RT.second(items)); - } - return (PersistentTreeMap) ret; -} - -public boolean containsKey(Object key){ - return entryAt(key) != null; -} - -public PersistentTreeMap assocEx(Object key, Object val) throws Exception{ - Box found = new Box(null); - Node t = add(tree, key, val, found); - if(t == null) //null == already contains key - { - throw new Exception("Key already present"); - } - return new PersistentTreeMap(comp, t.blacken(), _count + 1, meta()); -} - -public PersistentTreeMap assoc(Object key, Object val){ - Box found = new Box(null); - Node t = add(tree, key, val, found); - if(t == null) //null == already contains key - { - Node foundNode = (Node) found.val; - if(foundNode.val() == val) //note only get same collection on identity of val, not equals() - return this; - return new PersistentTreeMap(comp, replace(tree, key, val), _count, meta()); - } - return new PersistentTreeMap(comp, t.blacken(), _count + 1, meta()); -} - - -public PersistentTreeMap without(Object key){ - Box found = new Box(null); - Node t = remove(tree, key, found); - if(t == null) - { - if(found.val == null)//null == doesn't contain key - return this; - //empty - return new PersistentTreeMap(meta(), comp); - } - return new PersistentTreeMap(comp, t.blacken(), _count - 1, meta()); -} - -public ISeq seq(){ - if(_count > 0) - return Seq.create(tree, true, _count); - return null; -} - -public IPersistentCollection empty(){ - return new PersistentTreeMap(meta(), comp); -} - -public ISeq rseq() throws Exception{ - if(_count > 0) - return Seq.create(tree, false, _count); - return null; -} - -public Comparator comparator(){ - return comp; -} - -public Object entryKey(Object entry){ - return ((IMapEntry) entry).key(); -} - -public ISeq seq(boolean ascending){ - if(_count > 0) - return Seq.create(tree, ascending, _count); - return null; -} - -public ISeq seqFrom(Object key, boolean ascending){ - if(_count > 0) - { - ISeq stack = null; - Node t = tree; - while(t != null) - { - int c = doCompare(key, t.key); - if(c == 0) - { - stack = RT.cons(t, stack); - return new Seq(stack, ascending); - } - else if(ascending) - { - if(c < 0) - { - stack = RT.cons(t, stack); - t = t.left(); - } - else - t = t.right(); - } - else - { - if(c > 0) - { - stack = RT.cons(t, stack); - t = t.right(); - } - else - t = t.left(); - } - } - if(stack != null) - return new Seq(stack, ascending); - } - return null; -} - -public NodeIterator iterator(){ - return new NodeIterator(tree, true); -} - -public NodeIterator reverseIterator(){ - return new NodeIterator(tree, false); -} - -public Iterator keys(){ - return keys(iterator()); -} - -public Iterator vals(){ - return vals(iterator()); -} - -public Iterator keys(NodeIterator it){ - return new KeyIterator(it); -} - -public Iterator vals(NodeIterator it){ - return new ValIterator(it); -} - -public Object minKey(){ - Node t = min(); - return t != null ? t.key : null; -} - -public Node min(){ - Node t = tree; - if(t != null) - { - while(t.left() != null) - t = t.left(); - } - return t; -} - -public Object maxKey(){ - Node t = max(); - return t != null ? t.key : null; -} - -public Node max(){ - Node t = tree; - if(t != null) - { - while(t.right() != null) - t = t.right(); - } - return t; -} - -public int depth(){ - return depth(tree); -} - -int depth(Node t){ - if(t == null) - return 0; - return 1 + Math.max(depth(t.left()), depth(t.right())); -} - -public Object valAt(Object key, Object notFound){ - Node n = entryAt(key); - return (n != null) ? n.val() : notFound; -} - -public Object valAt(Object key){ - return valAt(key, null); -} - -public int capacity(){ - return _count; -} - -public int count(){ - return _count; -} - -public Node entryAt(Object key){ - Node t = tree; - while(t != null) - { - int c = doCompare(key, t.key); - if(c == 0) - return t; - else if(c < 0) - t = t.left(); - else - t = t.right(); - } - return t; -} - -public int doCompare(Object k1, Object k2){ -// if(comp != null) - return comp.compare(k1, k2); -// return ((Comparable) k1).compareTo(k2); -} - -Node add(Node t, Object key, Object val, Box found){ - if(t == null) - { - if(val == null) - return new Red(key); - return new RedVal(key, val); - } - int c = doCompare(key, t.key); - if(c == 0) - { - found.val = t; - return null; - } - Node ins = c < 0 ? add(t.left(), key, val, found) : add(t.right(), key, val, found); - if(ins == null) //found below - return null; - if(c < 0) - return t.addLeft(ins); - return t.addRight(ins); -} - -Node remove(Node t, Object key, Box found){ - if(t == null) - return null; //not found indicator - int c = doCompare(key, t.key); - if(c == 0) - { - found.val = t; - return append(t.left(), t.right()); - } - Node del = c < 0 ? remove(t.left(), key, found) : remove(t.right(), key, found); - if(del == null && found.val == null) //not found below - return null; - if(c < 0) - { - if(t.left() instanceof Black) - return balanceLeftDel(t.key, t.val(), del, t.right()); - else - return red(t.key, t.val(), del, t.right()); - } - if(t.right() instanceof Black) - return balanceRightDel(t.key, t.val(), t.left(), del); - return red(t.key, t.val(), t.left(), del); -// return t.removeLeft(del); -// return t.removeRight(del); -} - -static Node append(Node left, Node right){ - if(left == null) - return right; - else if(right == null) - return left; - else if(left instanceof Red) - { - if(right instanceof Red) - { - Node app = append(left.right(), right.left()); - if(app instanceof Red) - return red(app.key, app.val(), - red(left.key, left.val(), left.left(), app.left()), - red(right.key, right.val(), app.right(), right.right())); - else - return red(left.key, left.val(), left.left(), red(right.key, right.val(), app, right.right())); - } - else - return red(left.key, left.val(), left.left(), append(left.right(), right)); - } - else if(right instanceof Red) - return red(right.key, right.val(), append(left, right.left()), right.right()); - else //black/black - { - Node app = append(left.right(), right.left()); - if(app instanceof Red) - return red(app.key, app.val(), - black(left.key, left.val(), left.left(), app.left()), - black(right.key, right.val(), app.right(), right.right())); - else - return balanceLeftDel(left.key, left.val(), left.left(), black(right.key, right.val(), app, right.right())); - } -} - -static Node balanceLeftDel(Object key, Object val, Node del, Node right){ - if(del instanceof Red) - return red(key, val, del.blacken(), right); - else if(right instanceof Black) - return rightBalance(key, val, del, right.redden()); - else if(right instanceof Red && right.left() instanceof Black) - return red(right.left().key, right.left().val(), - black(key, val, del, right.left().left()), - rightBalance(right.key, right.val(), right.left().right(), right.right().redden())); - else - throw new UnsupportedOperationException("Invariant violation"); -} - -static Node balanceRightDel(Object key, Object val, Node left, Node del){ - if(del instanceof Red) - return red(key, val, left, del.blacken()); - else if(left instanceof Black) - return leftBalance(key, val, left.redden(), del); - else if(left instanceof Red && left.right() instanceof Black) - return red(left.right().key, left.right().val(), - leftBalance(left.key, left.val(), left.left().redden(), left.right().left()), - black(key, val, left.right().right(), del)); - else - throw new UnsupportedOperationException("Invariant violation"); -} - -static Node leftBalance(Object key, Object val, Node ins, Node right){ - if(ins instanceof Red && ins.left() instanceof Red) - return red(ins.key, ins.val(), ins.left().blacken(), black(key, val, ins.right(), right)); - else if(ins instanceof Red && ins.right() instanceof Red) - return red(ins.right().key, ins.right().val(), - black(ins.key, ins.val(), ins.left(), ins.right().left()), - black(key, val, ins.right().right(), right)); - else - return black(key, val, ins, right); -} - - -static Node rightBalance(Object key, Object val, Node left, Node ins){ - if(ins instanceof Red && ins.right() instanceof Red) - return red(ins.key, ins.val(), black(key, val, left, ins.left()), ins.right().blacken()); - else if(ins instanceof Red && ins.left() instanceof Red) - return red(ins.left().key, ins.left().val(), - black(key, val, left, ins.left().left()), - black(ins.key, ins.val(), ins.left().right(), ins.right())); - else - return black(key, val, left, ins); -} - -Node replace(Node t, Object key, Object val){ - int c = doCompare(key, t.key); - return t.replace(t.key, - c == 0 ? val : t.val(), - c < 0 ? replace(t.left(), key, val) : t.left(), - c > 0 ? replace(t.right(), key, val) : t.right()); -} - -PersistentTreeMap(Comparator comp, Node tree, int count, IPersistentMap meta){ - this._meta = meta; - this.comp = comp; - this.tree = tree; - this._count = count; -} - -static Red red(Object key, Object val, Node left, Node right){ - if(left == null && right == null) - { - if(val == null) - return new Red(key); - return new RedVal(key, val); - } - if(val == null) - return new RedBranch(key, left, right); - return new RedBranchVal(key, val, left, right); -} - -static Black black(Object key, Object val, Node left, Node right){ - if(left == null && right == null) - { - if(val == null) - return new Black(key); - return new BlackVal(key, val); - } - if(val == null) - return new BlackBranch(key, left, right); - return new BlackBranchVal(key, val, left, right); -} - -public IPersistentMap meta(){ - return _meta; -} - -static abstract class Node extends AMapEntry{ - final Object key; - - Node(Object key){ - this.key = key; - } - - public Object key(){ - return key; - } - - public Object val(){ - return null; - } - - public Object getKey(){ - return key(); - } - - public Object getValue(){ - return val(); - } - - Node left(){ - return null; - } - - Node right(){ - return null; - } - - abstract Node addLeft(Node ins); - - abstract Node addRight(Node ins); - - abstract Node removeLeft(Node del); - - abstract Node removeRight(Node del); - - abstract Node blacken(); - - abstract Node redden(); - - Node balanceLeft(Node parent){ - return black(parent.key, parent.val(), this, parent.right()); - } - - Node balanceRight(Node parent){ - return black(parent.key, parent.val(), parent.left(), this); - } - - abstract Node replace(Object key, Object val, Node left, Node right); - -} - -static class Black extends Node{ - public Black(Object key){ - super(key); - } - - Node addLeft(Node ins){ - return ins.balanceLeft(this); - } - - Node addRight(Node ins){ - return ins.balanceRight(this); - } - - Node removeLeft(Node del){ - return balanceLeftDel(key, val(), del, right()); - } - - Node removeRight(Node del){ - return balanceRightDel(key, val(), left(), del); - } - - Node blacken(){ - return this; - } - - Node redden(){ - return new Red(key); - } - - Node replace(Object key, Object val, Node left, Node right){ - return black(key, val, left, right); - } - -} - -static class BlackVal extends Black{ - final Object val; - - public BlackVal(Object key, Object val){ - super(key); - this.val = val; - } - - public Object val(){ - return val; - } - - Node redden(){ - return new RedVal(key, val); - } - -} - -static class BlackBranch extends Black{ - final Node left; - - final Node right; - - public BlackBranch(Object key, Node left, Node right){ - super(key); - this.left = left; - this.right = right; - } - - public Node left(){ - return left; - } - - public Node right(){ - return right; - } - - Node redden(){ - return new RedBranch(key, left, right); - } - -} - -static class BlackBranchVal extends BlackBranch{ - final Object val; - - public BlackBranchVal(Object key, Object val, Node left, Node right){ - super(key, left, right); - this.val = val; - } - - public Object val(){ - return val; - } - - Node redden(){ - return new RedBranchVal(key, val, left, right); - } - -} - -static class Red extends Node{ - public Red(Object key){ - super(key); - } - - Node addLeft(Node ins){ - return red(key, val(), ins, right()); - } - - Node addRight(Node ins){ - return red(key, val(), left(), ins); - } - - Node removeLeft(Node del){ - return red(key, val(), del, right()); - } - - Node removeRight(Node del){ - return red(key, val(), left(), del); - } - - Node blacken(){ - return new Black(key); - } - - Node redden(){ - throw new UnsupportedOperationException("Invariant violation"); - } - - Node replace(Object key, Object val, Node left, Node right){ - return red(key, val, left, right); - } - -} - -static class RedVal extends Red{ - final Object val; - - public RedVal(Object key, Object val){ - super(key); - this.val = val; - } - - public Object val(){ - return val; - } - - Node blacken(){ - return new BlackVal(key, val); - } - -} - -static class RedBranch extends Red{ - final Node left; - - final Node right; - - public RedBranch(Object key, Node left, Node right){ - super(key); - this.left = left; - this.right = right; - } - - public Node left(){ - return left; - } - - public Node right(){ - return right; - } - - Node balanceLeft(Node parent){ - if(left instanceof Red) - return red(key, val(), left.blacken(), black(parent.key, parent.val(), right, parent.right())); - else if(right instanceof Red) - return red(right.key, right.val(), black(key, val(), left, right.left()), - black(parent.key, parent.val(), right.right(), parent.right())); - else - return super.balanceLeft(parent); - - } - - Node balanceRight(Node parent){ - if(right instanceof Red) - return red(key, val(), black(parent.key, parent.val(), parent.left(), left), right.blacken()); - else if(left instanceof Red) - return red(left.key, left.val(), black(parent.key, parent.val(), parent.left(), left.left()), - black(key, val(), left.right(), right)); - else - return super.balanceRight(parent); - } - - Node blacken(){ - return new BlackBranch(key, left, right); - } - -} - - -static class RedBranchVal extends RedBranch{ - final Object val; - - public RedBranchVal(Object key, Object val, Node left, Node right){ - super(key, left, right); - this.val = val; - } - - public Object val(){ - return val; - } - - Node blacken(){ - return new BlackBranchVal(key, val, left, right); - } -} - - -static public class Seq extends ASeq{ - final ISeq stack; - final boolean asc; - final int cnt; - - public Seq(ISeq stack, boolean asc){ - this.stack = stack; - this.asc = asc; - this.cnt = -1; - } - - public Seq(ISeq stack, boolean asc, int cnt){ - this.stack = stack; - this.asc = asc; - this.cnt = cnt; - } - - Seq(IPersistentMap meta, ISeq stack, boolean asc, int cnt){ - super(meta); - this.stack = stack; - this.asc = asc; - this.cnt = cnt; - } - - static Seq create(Node t, boolean asc, int cnt){ - return new Seq(push(t, null, asc), asc, cnt); - } - - static ISeq push(Node t, ISeq stack, boolean asc){ - while(t != null) - { - stack = RT.cons(t, stack); - t = asc ? t.left() : t.right(); - } - return stack; - } - - public Object first(){ - return stack.first(); - } - - public ISeq next(){ - Node t = (Node) stack.first(); - ISeq nextstack = push(asc ? t.right() : t.left(), stack.next(), asc); - if(nextstack != null) - { - return new Seq(nextstack, asc, cnt - 1); - } - return null; - } - - public int count(){ - if(cnt < 0) - return super.count(); - return cnt; - } - - public Obj withMeta(IPersistentMap meta){ - return new Seq(meta, stack, asc, cnt); - } -} - -static public class NodeIterator implements Iterator{ - Stack stack = new Stack(); - boolean asc; - - NodeIterator(Node t, boolean asc){ - this.asc = asc; - push(t); - } - - void push(Node t){ - while(t != null) - { - stack.push(t); - t = asc ? t.left() : t.right(); - } - } - - public boolean hasNext(){ - return !stack.isEmpty(); - } - - public Object next(){ - Node t = (Node) stack.pop(); - push(asc ? t.right() : t.left()); - return t; - } - - public void remove(){ - throw new UnsupportedOperationException(); - } -} - -static class KeyIterator implements Iterator{ - NodeIterator it; - - KeyIterator(NodeIterator it){ - this.it = it; - } - - public boolean hasNext(){ - return it.hasNext(); - } - - public Object next(){ - return ((Node) it.next()).key; - } - - public void remove(){ - throw new UnsupportedOperationException(); - } -} - -static class ValIterator implements Iterator{ - NodeIterator it; - - ValIterator(NodeIterator it){ - this.it = it; - } - - public boolean hasNext(){ - return it.hasNext(); - } - - public Object next(){ - return ((Node) it.next()).val(); - } - - public void remove(){ - throw new UnsupportedOperationException(); - } -} -/* -static public void main(String args[]){ - if(args.length != 1) - System.err.println("Usage: RBTree n"); - int n = Integer.parseInt(args[0]); - Integer[] ints = new Integer[n]; - for(int i = 0; i < ints.length; i++) - { - ints[i] = i; - } - Collections.shuffle(Arrays.asList(ints)); - //force the ListMap class loading now -// try -// { -// -// //PersistentListMap.EMPTY.assocEx(1, null).assocEx(2,null).assocEx(3,null); -// } -// catch(Exception e) -// { -// e.printStackTrace(); //To change body of catch statement use File | Settings | File Templates. -// } - System.out.println("Building set"); - //IPersistentMap set = new PersistentArrayMap(); - //IPersistentMap set = new PersistentHashtableMap(1001); - IPersistentMap set = PersistentHashMap.EMPTY; - //IPersistentMap set = new ListMap(); - //IPersistentMap set = new ArrayMap(); - //IPersistentMap set = new PersistentTreeMap(); -// for(int i = 0; i < ints.length; i++) -// { -// Integer anInt = ints[i]; -// set = set.add(anInt); -// } - long startTime = System.nanoTime(); - for(Integer anInt : ints) - { - set = set.assoc(anInt, anInt); - } - //System.out.println("_count = " + set.count()); - -// System.out.println("_count = " + set._count + ", min: " + set.minKey() + ", max: " + set.maxKey() -// + ", depth: " + set.depth()); - for(Object aSet : set) - { - IMapEntry o = (IMapEntry) aSet; - if(!set.contains(o.key())) - System.err.println("Can't find: " + o.key()); - //else if(n < 2000) - // System.out.print(o.key().toString() + ","); - } - - Random rand = new Random(42); - for(int i = 0; i < ints.length / 2; i++) - { - Integer anInt = ints[rand.nextInt(n)]; - set = set.without(anInt); - } - - long estimatedTime = System.nanoTime() - startTime; - System.out.println(); - - System.out.println("_count = " + set.count() + ", time: " + estimatedTime / 1000000); - - System.out.println("Building ht"); - Hashtable ht = new Hashtable(1001); - startTime = System.nanoTime(); -// for(int i = 0; i < ints.length; i++) -// { -// Integer anInt = ints[i]; -// ht.put(anInt,null); -// } - for(Integer anInt : ints) - { - ht.put(anInt, anInt); - } - //System.out.println("size = " + ht.size()); - //Iterator it = ht.entrySet().iterator(); - for(Object o1 : ht.entrySet()) - { - Map.Entry o = (Map.Entry) o1; - if(!ht.containsKey(o.getKey())) - System.err.println("Can't find: " + o); - //else if(n < 2000) - // System.out.print(o.toString() + ","); - } - - rand = new Random(42); - for(int i = 0; i < ints.length / 2; i++) - { - Integer anInt = ints[rand.nextInt(n)]; - ht.remove(anInt); - } - estimatedTime = System.nanoTime() - startTime; - System.out.println(); - System.out.println("size = " + ht.size() + ", time: " + estimatedTime / 1000000); - - System.out.println("set lookup"); - startTime = System.nanoTime(); - int c = 0; - for(Integer anInt : ints) - { - if(!set.contains(anInt)) - ++c; - } - estimatedTime = System.nanoTime() - startTime; - System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000); - - System.out.println("ht lookup"); - startTime = System.nanoTime(); - c = 0; - for(Integer anInt : ints) - { - if(!ht.containsKey(anInt)) - ++c; - } - estimatedTime = System.nanoTime() - startTime; - System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000); - -// System.out.println("_count = " + set._count + ", min: " + set.minKey() + ", max: " + set.maxKey() -// + ", depth: " + set.depth()); -} -*/ -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/PersistentTreeSet.java --- a/src/clojure/lang/PersistentTreeSet.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,90 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 3, 2008 */ - -package clojure.lang; - -import java.util.Comparator; - -public class PersistentTreeSet extends APersistentSet implements IObj, Reversible, Sorted{ -static public final PersistentTreeSet EMPTY = new PersistentTreeSet(null, PersistentTreeMap.EMPTY); -final IPersistentMap _meta; - - -static public PersistentTreeSet create(ISeq items){ - PersistentTreeSet ret = EMPTY; - for(; items != null; items = items.next()) - { - ret = (PersistentTreeSet) ret.cons(items.first()); - } - return ret; -} - -static public PersistentTreeSet create(Comparator comp, ISeq items){ - PersistentTreeSet ret = new PersistentTreeSet(null, new PersistentTreeMap(null, comp)); - for(; items != null; items = items.next()) - { - ret = (PersistentTreeSet) ret.cons(items.first()); - } - return ret; -} - -PersistentTreeSet(IPersistentMap meta, IPersistentMap impl){ - super(impl); - this._meta = meta; -} - -public IPersistentSet disjoin(Object key) throws Exception{ - if(contains(key)) - return new PersistentTreeSet(meta(),impl.without(key)); - return this; -} - -public IPersistentSet cons(Object o){ - if(contains(o)) - return this; - return new PersistentTreeSet(meta(),impl.assoc(o,o)); -} - -public IPersistentCollection empty(){ - return new PersistentTreeSet(meta(),(PersistentTreeMap)impl.empty()); -} - -public ISeq rseq() throws Exception{ - return APersistentMap.KeySeq.create(((Reversible) impl).rseq()); -} - -public PersistentTreeSet withMeta(IPersistentMap meta){ - return new PersistentTreeSet(meta, impl); -} - -public Comparator comparator(){ - return ((Sorted)impl).comparator(); -} - -public Object entryKey(Object entry){ - return entry; -} - -public ISeq seq(boolean ascending){ - PersistentTreeMap m = (PersistentTreeMap) impl; - return RT.keys(m.seq(ascending)); -} - -public ISeq seqFrom(Object key, boolean ascending){ - PersistentTreeMap m = (PersistentTreeMap) impl; - return RT.keys(m.seqFrom(key,ascending)); -} - -public IPersistentMap meta(){ - return _meta; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/PersistentVector.java --- a/src/clojure/lang/PersistentVector.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,748 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jul 5, 2007 */ - -package clojure.lang; - -import java.io.Serializable; -import java.util.List; -import java.util.concurrent.atomic.AtomicReference; - -public class PersistentVector extends APersistentVector implements IObj, IEditableCollection{ - -static class Node implements Serializable { - transient final AtomicReference edit; - final Object[] array; - - Node(AtomicReference edit, Object[] array){ - this.edit = edit; - this.array = array; - } - - Node(AtomicReference edit){ - this.edit = edit; - this.array = new Object[32]; - } -} - -final static AtomicReference NOEDIT = new AtomicReference(null); -final static Node EMPTY_NODE = new Node(NOEDIT, new Object[32]); - -final int cnt; -final int shift; -final Node root; -final Object[] tail; -final IPersistentMap _meta; - - -public final static PersistentVector EMPTY = new PersistentVector(0, 5, EMPTY_NODE, new Object[]{}); - -static public PersistentVector create(ISeq items){ - TransientVector ret = EMPTY.asTransient(); - for(; items != null; items = items.next()) - ret = ret.conj(items.first()); - return ret.persistent(); -} - -static public PersistentVector create(List items){ - TransientVector ret = EMPTY.asTransient(); - for(Object item : items) - ret = ret.conj(item); - return ret.persistent(); -} - -static public PersistentVector create(Object... items){ - TransientVector ret = EMPTY.asTransient(); - for(Object item : items) - ret = ret.conj(item); - return ret.persistent(); -} - -PersistentVector(int cnt, int shift, Node root, Object[] tail){ - this._meta = null; - this.cnt = cnt; - this.shift = shift; - this.root = root; - this.tail = tail; -} - - -PersistentVector(IPersistentMap meta, int cnt, int shift, Node root, Object[] tail){ - this._meta = meta; - this.cnt = cnt; - this.shift = shift; - this.root = root; - this.tail = tail; -} - -public TransientVector asTransient(){ - return new TransientVector(this); -} - -final int tailoff(){ - if(cnt < 32) - return 0; - return ((cnt - 1) >>> 5) << 5; -} - -public Object[] arrayFor(int i){ - if(i >= 0 && i < cnt) - { - if(i >= tailoff()) - return tail; - Node node = root; - for(int level = shift; level > 0; level -= 5) - node = (Node) node.array[(i >>> level) & 0x01f]; - return node.array; - } - throw new IndexOutOfBoundsException(); -} - -public Object nth(int i){ - Object[] node = arrayFor(i); - return node[i & 0x01f]; -} - -public Object nth(int i, Object notFound){ - if(i >= 0 && i < cnt) - return nth(i); - return notFound; -} - -public PersistentVector assocN(int i, Object val){ - if(i >= 0 && i < cnt) - { - if(i >= tailoff()) - { - Object[] newTail = new Object[tail.length]; - System.arraycopy(tail, 0, newTail, 0, tail.length); - newTail[i & 0x01f] = val; - - return new PersistentVector(meta(), cnt, shift, root, newTail); - } - - return new PersistentVector(meta(), cnt, shift, doAssoc(shift, root, i, val), tail); - } - if(i == cnt) - return cons(val); - throw new IndexOutOfBoundsException(); -} - -private static Node doAssoc(int level, Node node, int i, Object val){ - Node ret = new Node(node.edit,node.array.clone()); - if(level == 0) - { - ret.array[i & 0x01f] = val; - } - else - { - int subidx = (i >>> level) & 0x01f; - ret.array[subidx] = doAssoc(level - 5, (Node) node.array[subidx], i, val); - } - return ret; -} - -public int count(){ - return cnt; -} - -public PersistentVector withMeta(IPersistentMap meta){ - return new PersistentVector(meta, cnt, shift, root, tail); -} - -public IPersistentMap meta(){ - return _meta; -} - - -public PersistentVector cons(Object val){ - int i = cnt; - //room in tail? -// if(tail.length < 32) - if(cnt - tailoff() < 32) - { - Object[] newTail = new Object[tail.length + 1]; - System.arraycopy(tail, 0, newTail, 0, tail.length); - newTail[tail.length] = val; - return new PersistentVector(meta(), cnt + 1, shift, root, newTail); - } - //full tail, push into tree - Node newroot; - Node tailnode = new Node(root.edit,tail); - int newshift = shift; - //overflow root? - if((cnt >>> 5) > (1 << shift)) - { - newroot = new Node(root.edit); - newroot.array[0] = root; - newroot.array[1] = newPath(root.edit,shift, tailnode); - newshift += 5; - } - else - newroot = pushTail(shift, root, tailnode); - return new PersistentVector(meta(), cnt + 1, newshift, newroot, new Object[]{val}); -} - -private Node pushTail(int level, Node parent, Node tailnode){ - //if parent is leaf, insert node, - // else does it map to an existing child? -> nodeToInsert = pushNode one more level - // else alloc new path - //return nodeToInsert placed in copy of parent - int subidx = ((cnt - 1) >>> level) & 0x01f; - Node ret = new Node(parent.edit, parent.array.clone()); - Node nodeToInsert; - if(level == 5) - { - nodeToInsert = tailnode; - } - else - { - Node child = (Node) parent.array[subidx]; - nodeToInsert = (child != null)? - pushTail(level-5,child, tailnode) - :newPath(root.edit,level-5, tailnode); - } - ret.array[subidx] = nodeToInsert; - return ret; -} - -private static Node newPath(AtomicReference edit,int level, Node node){ - if(level == 0) - return node; - Node ret = new Node(edit); - ret.array[0] = newPath(edit, level - 5, node); - return ret; -} - -public IChunkedSeq chunkedSeq(){ - if(count() == 0) - return null; - return new ChunkedSeq(this,0,0); -} - -public ISeq seq(){ - return chunkedSeq(); -} - -static public final class ChunkedSeq extends ASeq implements IChunkedSeq{ - - public final PersistentVector vec; - final Object[] node; - final int i; - public final int offset; - - public ChunkedSeq(PersistentVector vec, int i, int offset){ - this.vec = vec; - this.i = i; - this.offset = offset; - this.node = vec.arrayFor(i); - } - - ChunkedSeq(IPersistentMap meta, PersistentVector vec, Object[] node, int i, int offset){ - super(meta); - this.vec = vec; - this.node = node; - this.i = i; - this.offset = offset; - } - - ChunkedSeq(PersistentVector vec, Object[] node, int i, int offset){ - this.vec = vec; - this.node = node; - this.i = i; - this.offset = offset; - } - - public IChunk chunkedFirst() throws Exception{ - return new ArrayChunk(node, offset); - } - - public ISeq chunkedNext(){ - if(i + node.length < vec.cnt) - return new ChunkedSeq(vec,i+ node.length,0); - return null; - } - - public ISeq chunkedMore(){ - ISeq s = chunkedNext(); - if(s == null) - return PersistentList.EMPTY; - return s; - } - - public Obj withMeta(IPersistentMap meta){ - if(meta == this._meta) - return this; - return new ChunkedSeq(meta, vec, node, i, offset); - } - - public Object first(){ - return node[offset]; - } - - public ISeq next(){ - if(offset + 1 < node.length) - return new ChunkedSeq(vec, node, i, offset + 1); - return chunkedNext(); - } -} - -public IPersistentCollection empty(){ - return EMPTY.withMeta(meta()); -} - -//private Node pushTail(int level, Node node, Object[] tailNode, Box expansion){ -// Object newchild; -// if(level == 0) -// { -// newchild = tailNode; -// } -// else -// { -// newchild = pushTail(level - 5, (Object[]) arr[arr.length - 1], tailNode, expansion); -// if(expansion.val == null) -// { -// Object[] ret = arr.clone(); -// ret[arr.length - 1] = newchild; -// return ret; -// } -// else -// newchild = expansion.val; -// } -// //expansion -// if(arr.length == 32) -// { -// expansion.val = new Object[]{newchild}; -// return arr; -// } -// Object[] ret = new Object[arr.length + 1]; -// System.arraycopy(arr, 0, ret, 0, arr.length); -// ret[arr.length] = newchild; -// expansion.val = null; -// return ret; -//} - -public PersistentVector pop(){ - if(cnt == 0) - throw new IllegalStateException("Can't pop empty vector"); - if(cnt == 1) - return EMPTY.withMeta(meta()); - //if(tail.length > 1) - if(cnt-tailoff() > 1) - { - Object[] newTail = new Object[tail.length - 1]; - System.arraycopy(tail, 0, newTail, 0, newTail.length); - return new PersistentVector(meta(), cnt - 1, shift, root, newTail); - } - Object[] newtail = arrayFor(cnt - 2); - - Node newroot = popTail(shift, root); - int newshift = shift; - if(newroot == null) - { - newroot = EMPTY_NODE; - } - if(shift > 5 && newroot.array[1] == null) - { - newroot = (Node) newroot.array[0]; - newshift -= 5; - } - return new PersistentVector(meta(), cnt - 1, newshift, newroot, newtail); -} - -private Node popTail(int level, Node node){ - int subidx = ((cnt-2) >>> level) & 0x01f; - if(level > 5) - { - Node newchild = popTail(level - 5, (Node) node.array[subidx]); - if(newchild == null && subidx == 0) - return null; - else - { - Node ret = new Node(root.edit, node.array.clone()); - ret.array[subidx] = newchild; - return ret; - } - } - else if(subidx == 0) - return null; - else - { - Node ret = new Node(root.edit, node.array.clone()); - ret.array[subidx] = null; - return ret; - } -} - -static final class TransientVector extends AFn implements ITransientVector, Counted{ - int cnt; - int shift; - Node root; - Object[] tail; - - TransientVector(int cnt, int shift, Node root, Object[] tail){ - this.cnt = cnt; - this.shift = shift; - this.root = root; - this.tail = tail; - } - - TransientVector(PersistentVector v){ - this(v.cnt, v.shift, editableRoot(v.root), editableTail(v.tail)); - } - - public int count(){ - ensureEditable(); - return cnt; - } - - Node ensureEditable(Node node){ - if(node.edit == root.edit) - return node; - return new Node(root.edit, node.array.clone()); - } - - void ensureEditable(){ - Thread owner = root.edit.get(); - if(owner == Thread.currentThread()) - return; - if(owner != null) - throw new IllegalAccessError("Transient used by non-owner thread"); - throw new IllegalAccessError("Transient used after persistent! call"); - -// root = editableRoot(root); -// tail = editableTail(tail); - } - - static Node editableRoot(Node node){ - return new Node(new AtomicReference(Thread.currentThread()), node.array.clone()); - } - - public PersistentVector persistent(){ - ensureEditable(); -// Thread owner = root.edit.get(); -// if(owner != null && owner != Thread.currentThread()) -// { -// throw new IllegalAccessError("Mutation release by non-owner thread"); -// } - root.edit.set(null); - Object[] trimmedTail = new Object[cnt-tailoff()]; - System.arraycopy(tail,0,trimmedTail,0,trimmedTail.length); - return new PersistentVector(cnt, shift, root, trimmedTail); - } - - static Object[] editableTail(Object[] tl){ - Object[] ret = new Object[32]; - System.arraycopy(tl,0,ret,0,tl.length); - return ret; - } - - public TransientVector conj(Object val){ - ensureEditable(); - int i = cnt; - //room in tail? - if(i - tailoff() < 32) - { - tail[i & 0x01f] = val; - ++cnt; - return this; - } - //full tail, push into tree - Node newroot; - Node tailnode = new Node(root.edit, tail); - tail = new Object[32]; - tail[0] = val; - int newshift = shift; - //overflow root? - if((cnt >>> 5) > (1 << shift)) - { - newroot = new Node(root.edit); - newroot.array[0] = root; - newroot.array[1] = newPath(root.edit,shift, tailnode); - newshift += 5; - } - else - newroot = pushTail(shift, root, tailnode); - root = newroot; - shift = newshift; - ++cnt; - return this; - } - - private Node pushTail(int level, Node parent, Node tailnode){ - //if parent is leaf, insert node, - // else does it map to an existing child? -> nodeToInsert = pushNode one more level - // else alloc new path - //return nodeToInsert placed in parent - parent = ensureEditable(parent); - int subidx = ((cnt - 1) >>> level) & 0x01f; - Node ret = parent; - Node nodeToInsert; - if(level == 5) - { - nodeToInsert = tailnode; - } - else - { - Node child = (Node) parent.array[subidx]; - nodeToInsert = (child != null) ? - pushTail(level - 5, child, tailnode) - : newPath(root.edit, level - 5, tailnode); - } - ret.array[subidx] = nodeToInsert; - return ret; - } - - final private int tailoff(){ - if(cnt < 32) - return 0; - return ((cnt-1) >>> 5) << 5; - } - - private Object[] arrayFor(int i){ - if(i >= 0 && i < cnt) - { - if(i >= tailoff()) - return tail; - Node node = root; - for(int level = shift; level > 0; level -= 5) - node = (Node) node.array[(i >>> level) & 0x01f]; - return node.array; - } - throw new IndexOutOfBoundsException(); - } - - public Object valAt(Object key){ - //note - relies on ensureEditable in 2-arg valAt - return valAt(key, null); - } - - public Object valAt(Object key, Object notFound){ - ensureEditable(); - if(Util.isInteger(key)) - { - int i = ((Number) key).intValue(); - if(i >= 0 && i < cnt) - return nth(i); - } - return notFound; - } - - public Object invoke(Object arg1) throws Exception{ - //note - relies on ensureEditable in nth - if(Util.isInteger(arg1)) - return nth(((Number) arg1).intValue()); - throw new IllegalArgumentException("Key must be integer"); - } - - public Object nth(int i){ - ensureEditable(); - Object[] node = arrayFor(i); - return node[i & 0x01f]; - } - - public Object nth(int i, Object notFound){ - if(i >= 0 && i < count()) - return nth(i); - return notFound; - } - - public TransientVector assocN(int i, Object val){ - ensureEditable(); - if(i >= 0 && i < cnt) - { - if(i >= tailoff()) - { - tail[i & 0x01f] = val; - return this; - } - - root = doAssoc(shift, root, i, val); - return this; - } - if(i == cnt) - return conj(val); - throw new IndexOutOfBoundsException(); - } - - public TransientVector assoc(Object key, Object val){ - //note - relies on ensureEditable in assocN - if(Util.isInteger(key)) - { - int i = ((Number) key).intValue(); - return assocN(i, val); - } - throw new IllegalArgumentException("Key must be integer"); - } - - private Node doAssoc(int level, Node node, int i, Object val){ - node = ensureEditable(node); - Node ret = node; - if(level == 0) - { - ret.array[i & 0x01f] = val; - } - else - { - int subidx = (i >>> level) & 0x01f; - ret.array[subidx] = doAssoc(level - 5, (Node) node.array[subidx], i, val); - } - return ret; - } - - public TransientVector pop(){ - ensureEditable(); - if(cnt == 0) - throw new IllegalStateException("Can't pop empty vector"); - if(cnt == 1) - { - cnt = 0; - return this; - } - int i = cnt - 1; - //pop in tail? - if((i & 0x01f) > 0) - { - --cnt; - return this; - } - - Object[] newtail = arrayFor(cnt - 2); - - Node newroot = popTail(shift, root); - int newshift = shift; - if(newroot == null) - { - newroot = new Node(root.edit); - } - if(shift > 5 && newroot.array[1] == null) - { - newroot = ensureEditable((Node) newroot.array[0]); - newshift -= 5; - } - root = newroot; - shift = newshift; - --cnt; - tail = newtail; - return this; - } - - private Node popTail(int level, Node node){ - node = ensureEditable(node); - int subidx = ((cnt - 2) >>> level) & 0x01f; - if(level > 5) - { - Node newchild = popTail(level - 5, (Node) node.array[subidx]); - if(newchild == null && subidx == 0) - return null; - else - { - Node ret = node; - ret.array[subidx] = newchild; - return ret; - } - } - else if(subidx == 0) - return null; - else - { - Node ret = node; - ret.array[subidx] = null; - return ret; - } - } -} -/* -static public void main(String[] args){ - if(args.length != 3) - { - System.err.println("Usage: PersistentVector size writes reads"); - return; - } - int size = Integer.parseInt(args[0]); - int writes = Integer.parseInt(args[1]); - int reads = Integer.parseInt(args[2]); -// Vector v = new Vector(size); - ArrayList v = new ArrayList(size); -// v.setSize(size); - //PersistentArray p = new PersistentArray(size); - PersistentVector p = PersistentVector.EMPTY; -// MutableVector mp = p.mutable(); - - for(int i = 0; i < size; i++) - { - v.add(i); -// v.set(i, i); - //p = p.set(i, 0); - p = p.cons(i); -// mp = mp.conj(i); - } - - Random rand; - - rand = new Random(42); - long tv = 0; - System.out.println("ArrayList"); - long startTime = System.nanoTime(); - for(int i = 0; i < writes; i++) - { - v.set(rand.nextInt(size), i); - } - for(int i = 0; i < reads; i++) - { - tv += (Integer) v.get(rand.nextInt(size)); - } - long estimatedTime = System.nanoTime() - startTime; - System.out.println("time: " + estimatedTime / 1000000); - System.out.println("PersistentVector"); - rand = new Random(42); - startTime = System.nanoTime(); - long tp = 0; - -// PersistentVector oldp = p; - //Random rand2 = new Random(42); - - MutableVector mp = p.mutable(); - for(int i = 0; i < writes; i++) - { -// p = p.assocN(rand.nextInt(size), i); - mp = mp.assocN(rand.nextInt(size), i); -// mp = mp.assoc(rand.nextInt(size), i); - //dummy set to force perverse branching - //oldp = oldp.assocN(rand2.nextInt(size), i); - } - for(int i = 0; i < reads; i++) - { -// tp += (Integer) p.nth(rand.nextInt(size)); - tp += (Integer) mp.nth(rand.nextInt(size)); - } -// p = mp.immutable(); - //mp.cons(42); - estimatedTime = System.nanoTime() - startTime; - System.out.println("time: " + estimatedTime / 1000000); - for(int i = 0; i < size / 2; i++) - { - mp = mp.pop(); -// p = p.pop(); - v.remove(v.size() - 1); - } - p = (PersistentVector) mp.immutable(); - //mp.pop(); //should fail - for(int i = 0; i < size / 2; i++) - { - tp += (Integer) p.nth(i); - tv += (Integer) v.get(i); - } - System.out.println("Done: " + tv + ", " + tp); - -} -// */ -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/ProxyHandler.java --- a/src/clojure/lang/ProxyHandler.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,72 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Oct 4, 2007 */ - -package clojure.lang; - -import java.lang.reflect.InvocationHandler; -import java.lang.reflect.Method; - -public class ProxyHandler implements InvocationHandler{ -//method-name-string->fn -final IPersistentMap fns; - - -public ProxyHandler(IPersistentMap fns){ - this.fns = fns; -} - -public Object invoke(Object proxy, Method method, Object[] args) throws Throwable{ - Class rt = method.getReturnType(); - IFn fn = (IFn) fns.valAt(method.getName()); - if(fn == null) - { - if(rt == Void.TYPE) - return null; - else if(method.getName().equals("equals")) - { - return proxy == args[0]; - } - else if(method.getName().equals("hashCode")) - { - return System.identityHashCode(proxy); - } - else if(method.getName().equals("toString")) - { - return "Proxy: " + System.identityHashCode(proxy); - } - throw new UnsupportedOperationException(); - } - Object ret = fn.applyTo(ArraySeq.create(args)); - if(rt == Void.TYPE) - return null; - else if(rt.isPrimitive()) - { - if(rt == Character.TYPE) - return ret; - else if(rt == Integer.TYPE) - return ((Number) ret).intValue(); - else if(rt == Long.TYPE) - return ((Number) ret).longValue(); - else if(rt == Float.TYPE) - return ((Number) ret).floatValue(); - else if(rt == Double.TYPE) - return ((Number) ret).doubleValue(); - else if(rt == Boolean.TYPE && !(ret instanceof Boolean)) - return ret == null ? Boolean.FALSE : Boolean.TRUE; - else if(rt == Byte.TYPE) - return (byte) ((Number) ret).intValue(); - else if(rt == Short.TYPE) - return (short) ((Number) ret).intValue(); - } - return ret; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/RT.java --- a/src/clojure/lang/RT.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1735 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 25, 2006 4:28:27 PM */ - -package clojure.lang; - -import java.util.concurrent.atomic.AtomicInteger; -import java.util.concurrent.Callable; -import java.util.*; -import java.util.regex.Matcher; -import java.util.regex.Pattern; -import java.io.*; -import java.lang.reflect.Array; -import java.math.BigDecimal; -import java.math.BigInteger; -import java.security.AccessController; -import java.security.PrivilegedAction; -import java.net.URL; -import java.net.JarURLConnection; -import java.nio.charset.Charset; - -public class RT{ - -static final public Boolean T = Boolean.TRUE;//Keyword.intern(Symbol.create(null, "t")); -static final public Boolean F = Boolean.FALSE;//Keyword.intern(Symbol.create(null, "t")); -static final public String LOADER_SUFFIX = "__init"; - -//simple-symbol->class -final static IPersistentMap DEFAULT_IMPORTS = map( -// Symbol.create("RT"), "clojure.lang.RT", -// Symbol.create("Num"), "clojure.lang.Num", -// Symbol.create("Symbol"), "clojure.lang.Symbol", -// Symbol.create("Keyword"), "clojure.lang.Keyword", -// Symbol.create("Var"), "clojure.lang.Var", -// Symbol.create("Ref"), "clojure.lang.Ref", -// Symbol.create("IFn"), "clojure.lang.IFn", -// Symbol.create("IObj"), "clojure.lang.IObj", -// Symbol.create("ISeq"), "clojure.lang.ISeq", -// Symbol.create("IPersistentCollection"), -// "clojure.lang.IPersistentCollection", -// Symbol.create("IPersistentMap"), "clojure.lang.IPersistentMap", -// Symbol.create("IPersistentList"), "clojure.lang.IPersistentList", -// Symbol.create("IPersistentVector"), "clojure.lang.IPersistentVector", -Symbol.create("Boolean"), Boolean.class, -Symbol.create("Byte"), Byte.class, -Symbol.create("Character"), Character.class, -Symbol.create("Class"), Class.class, -Symbol.create("ClassLoader"), ClassLoader.class, -Symbol.create("Compiler"), Compiler.class, -Symbol.create("Double"), Double.class, -Symbol.create("Enum"), Enum.class, -Symbol.create("Float"), Float.class, -Symbol.create("InheritableThreadLocal"), InheritableThreadLocal.class, -Symbol.create("Integer"), Integer.class, -Symbol.create("Long"), Long.class, -Symbol.create("Math"), Math.class, -Symbol.create("Number"), Number.class, -Symbol.create("Object"), Object.class, -Symbol.create("Package"), Package.class, -Symbol.create("Process"), Process.class, -Symbol.create("ProcessBuilder"), ProcessBuilder.class, -Symbol.create("Runtime"), Runtime.class, -Symbol.create("RuntimePermission"), RuntimePermission.class, -Symbol.create("SecurityManager"), SecurityManager.class, -Symbol.create("Short"), Short.class, -Symbol.create("StackTraceElement"), StackTraceElement.class, -Symbol.create("StrictMath"), StrictMath.class, -Symbol.create("String"), String.class, -Symbol.create("StringBuffer"), StringBuffer.class, -Symbol.create("StringBuilder"), StringBuilder.class, -Symbol.create("System"), System.class, -Symbol.create("Thread"), Thread.class, -Symbol.create("ThreadGroup"), ThreadGroup.class, -Symbol.create("ThreadLocal"), ThreadLocal.class, -Symbol.create("Throwable"), Throwable.class, -Symbol.create("Void"), Void.class, -Symbol.create("Appendable"), Appendable.class, -Symbol.create("CharSequence"), CharSequence.class, -Symbol.create("Cloneable"), Cloneable.class, -Symbol.create("Comparable"), Comparable.class, -Symbol.create("Iterable"), Iterable.class, -Symbol.create("Readable"), Readable.class, -Symbol.create("Runnable"), Runnable.class, -Symbol.create("Callable"), Callable.class, -Symbol.create("BigInteger"), BigInteger.class, -Symbol.create("BigDecimal"), BigDecimal.class, -Symbol.create("ArithmeticException"), ArithmeticException.class, -Symbol.create("ArrayIndexOutOfBoundsException"), ArrayIndexOutOfBoundsException.class, -Symbol.create("ArrayStoreException"), ArrayStoreException.class, -Symbol.create("ClassCastException"), ClassCastException.class, -Symbol.create("ClassNotFoundException"), ClassNotFoundException.class, -Symbol.create("CloneNotSupportedException"), CloneNotSupportedException.class, -Symbol.create("EnumConstantNotPresentException"), EnumConstantNotPresentException.class, -Symbol.create("Exception"), Exception.class, -Symbol.create("IllegalAccessException"), IllegalAccessException.class, -Symbol.create("IllegalArgumentException"), IllegalArgumentException.class, -Symbol.create("IllegalMonitorStateException"), IllegalMonitorStateException.class, -Symbol.create("IllegalStateException"), IllegalStateException.class, -Symbol.create("IllegalThreadStateException"), IllegalThreadStateException.class, -Symbol.create("IndexOutOfBoundsException"), IndexOutOfBoundsException.class, -Symbol.create("InstantiationException"), InstantiationException.class, -Symbol.create("InterruptedException"), InterruptedException.class, -Symbol.create("NegativeArraySizeException"), NegativeArraySizeException.class, -Symbol.create("NoSuchFieldException"), NoSuchFieldException.class, -Symbol.create("NoSuchMethodException"), NoSuchMethodException.class, -Symbol.create("NullPointerException"), NullPointerException.class, -Symbol.create("NumberFormatException"), NumberFormatException.class, -Symbol.create("RuntimeException"), RuntimeException.class, -Symbol.create("SecurityException"), SecurityException.class, -Symbol.create("StringIndexOutOfBoundsException"), StringIndexOutOfBoundsException.class, -Symbol.create("TypeNotPresentException"), TypeNotPresentException.class, -Symbol.create("UnsupportedOperationException"), UnsupportedOperationException.class, -Symbol.create("AbstractMethodError"), AbstractMethodError.class, -Symbol.create("AssertionError"), AssertionError.class, -Symbol.create("ClassCircularityError"), ClassCircularityError.class, -Symbol.create("ClassFormatError"), ClassFormatError.class, -Symbol.create("Error"), Error.class, -Symbol.create("ExceptionInInitializerError"), ExceptionInInitializerError.class, -Symbol.create("IllegalAccessError"), IllegalAccessError.class, -Symbol.create("IncompatibleClassChangeError"), IncompatibleClassChangeError.class, -Symbol.create("InstantiationError"), InstantiationError.class, -Symbol.create("InternalError"), InternalError.class, -Symbol.create("LinkageError"), LinkageError.class, -Symbol.create("NoClassDefFoundError"), NoClassDefFoundError.class, -Symbol.create("NoSuchFieldError"), NoSuchFieldError.class, -Symbol.create("NoSuchMethodError"), NoSuchMethodError.class, -Symbol.create("OutOfMemoryError"), OutOfMemoryError.class, -Symbol.create("StackOverflowError"), StackOverflowError.class, -Symbol.create("ThreadDeath"), ThreadDeath.class, -Symbol.create("UnknownError"), UnknownError.class, -Symbol.create("UnsatisfiedLinkError"), UnsatisfiedLinkError.class, -Symbol.create("UnsupportedClassVersionError"), UnsupportedClassVersionError.class, -Symbol.create("VerifyError"), VerifyError.class, -Symbol.create("VirtualMachineError"), VirtualMachineError.class, -Symbol.create("Thread$UncaughtExceptionHandler"), Thread.UncaughtExceptionHandler.class, -Symbol.create("Thread$State"), Thread.State.class, -Symbol.create("Deprecated"), Deprecated.class, -Symbol.create("Override"), Override.class, -Symbol.create("SuppressWarnings"), SuppressWarnings.class - -// Symbol.create("Collection"), "java.util.Collection", -// Symbol.create("Comparator"), "java.util.Comparator", -// Symbol.create("Enumeration"), "java.util.Enumeration", -// Symbol.create("EventListener"), "java.util.EventListener", -// Symbol.create("Formattable"), "java.util.Formattable", -// Symbol.create("Iterator"), "java.util.Iterator", -// Symbol.create("List"), "java.util.List", -// Symbol.create("ListIterator"), "java.util.ListIterator", -// Symbol.create("Map"), "java.util.Map", -// Symbol.create("Map$Entry"), "java.util.Map$Entry", -// Symbol.create("Observer"), "java.util.Observer", -// Symbol.create("Queue"), "java.util.Queue", -// Symbol.create("RandomAccess"), "java.util.RandomAccess", -// Symbol.create("Set"), "java.util.Set", -// Symbol.create("SortedMap"), "java.util.SortedMap", -// Symbol.create("SortedSet"), "java.util.SortedSet" -); - -// single instance of UTF-8 Charset, so as to avoid catching UnsupportedCharsetExceptions everywhere -static public Charset UTF8 = Charset.forName("UTF-8"); - -static public final Namespace CLOJURE_NS = Namespace.findOrCreate(Symbol.create("clojure.core")); -//static final Namespace USER_NS = Namespace.findOrCreate(Symbol.create("user")); -final static public Var OUT = - Var.intern(CLOJURE_NS, Symbol.create("*out*"), new OutputStreamWriter(System.out)); -final static public Var IN = - Var.intern(CLOJURE_NS, Symbol.create("*in*"), - new LineNumberingPushbackReader(new InputStreamReader(System.in))); -final static public Var ERR = - Var.intern(CLOJURE_NS, Symbol.create("*err*"), - new PrintWriter(new OutputStreamWriter(System.err), true)); -final static Keyword TAG_KEY = Keyword.intern(null, "tag"); -final static public Var AGENT = Var.intern(CLOJURE_NS, Symbol.create("*agent*"), null); -final static public Var READEVAL = Var.intern(CLOJURE_NS, Symbol.create("*read-eval*"), T); -final static public Var ASSERT = Var.intern(CLOJURE_NS, Symbol.create("*assert*"), T); -final static public Var MATH_CONTEXT = Var.intern(CLOJURE_NS, Symbol.create("*math-context*"), null); -static Keyword LINE_KEY = Keyword.intern(null, "line"); -static Keyword FILE_KEY = Keyword.intern(null, "file"); -static Keyword DECLARED_KEY = Keyword.intern(null, "declared"); -final static public Var USE_CONTEXT_CLASSLOADER = - Var.intern(CLOJURE_NS, Symbol.create("*use-context-classloader*"), T); -//final static public Var CURRENT_MODULE = Var.intern(Symbol.create("clojure.core", "current-module"), -// Module.findOrCreateModule("clojure/user")); - -final static Symbol LOAD_FILE = Symbol.create("load-file"); -final static Symbol IN_NAMESPACE = Symbol.create("in-ns"); -final static Symbol NAMESPACE = Symbol.create("ns"); -static final Symbol IDENTICAL = Symbol.create("identical?"); -final static Var CMD_LINE_ARGS = Var.intern(CLOJURE_NS, Symbol.create("*command-line-args*"), null); -//symbol -final public static Var CURRENT_NS = Var.intern(CLOJURE_NS, Symbol.create("*ns*"), - CLOJURE_NS); - -final static Var FLUSH_ON_NEWLINE = Var.intern(CLOJURE_NS, Symbol.create("*flush-on-newline*"), T); -final static Var PRINT_META = Var.intern(CLOJURE_NS, Symbol.create("*print-meta*"), F); -final static Var PRINT_READABLY = Var.intern(CLOJURE_NS, Symbol.create("*print-readably*"), T); -final static Var PRINT_DUP = Var.intern(CLOJURE_NS, Symbol.create("*print-dup*"), F); -final static Var WARN_ON_REFLECTION = Var.intern(CLOJURE_NS, Symbol.create("*warn-on-reflection*"), F); -final static Var ALLOW_UNRESOLVED_VARS = Var.intern(CLOJURE_NS, Symbol.create("*allow-unresolved-vars*"), F); - -final static Var IN_NS_VAR = Var.intern(CLOJURE_NS, Symbol.create("in-ns"), F); -final static Var NS_VAR = Var.intern(CLOJURE_NS, Symbol.create("ns"), F); -static final Var PRINT_INITIALIZED = Var.intern(CLOJURE_NS, Symbol.create("print-initialized")); -static final Var PR_ON = Var.intern(CLOJURE_NS, Symbol.create("pr-on")); -//final static Var IMPORTS = Var.intern(CLOJURE_NS, Symbol.create("*imports*"), DEFAULT_IMPORTS); -final static IFn inNamespace = new AFn(){ - public Object invoke(Object arg1) throws Exception{ - Symbol nsname = (Symbol) arg1; - Namespace ns = Namespace.findOrCreate(nsname); - CURRENT_NS.set(ns); - return ns; - } -}; - -final static IFn bootNamespace = new AFn(){ - public Object invoke(Object __form, Object __env,Object arg1) throws Exception{ - Symbol nsname = (Symbol) arg1; - Namespace ns = Namespace.findOrCreate(nsname); - CURRENT_NS.set(ns); - return ns; - } -}; - -public static List processCommandLine(String[] args){ - List arglist = Arrays.asList(args); - int split = arglist.indexOf("--"); - if(split >= 0) { - CMD_LINE_ARGS.bindRoot(RT.seq(arglist.subList(split + 1, args.length))); - return arglist.subList(0, split); - } - return arglist; -} - -// duck typing stderr plays nice with e.g. swank -public static PrintWriter errPrintWriter(){ - Writer w = (Writer) ERR.deref(); - if (w instanceof PrintWriter) { - return (PrintWriter) w; - } else { - return new PrintWriter(w); - } -} - -static public final Object[] EMPTY_ARRAY = new Object[]{}; -static public final Comparator DEFAULT_COMPARATOR = new DefaultComparator(); - -private static final class DefaultComparator implements Comparator, Serializable { - public int compare(Object o1, Object o2){ - return Util.compare(o1, o2); - } - - private Object readResolve() throws ObjectStreamException { - // ensures that we aren't hanging onto a new default comparator for every - // sorted set, etc., we deserialize - return DEFAULT_COMPARATOR; - } -} - -static AtomicInteger id = new AtomicInteger(1); - -static public void addURL(Object url) throws Exception{ - URL u = (url instanceof String) ? (new URL((String) url)) : (URL) url; - ClassLoader ccl = Thread.currentThread().getContextClassLoader(); - if(ccl instanceof DynamicClassLoader) - ((DynamicClassLoader)ccl).addURL(u); - else - throw new IllegalAccessError("Context classloader is not a DynamicClassLoader"); -} - -static{ - Keyword dockw = Keyword.intern(null, "doc"); - Keyword arglistskw = Keyword.intern(null, "arglists"); - Symbol namesym = Symbol.create("name"); - OUT.setTag(Symbol.create("java.io.Writer")); - CURRENT_NS.setTag(Symbol.create("clojure.lang.Namespace")); - AGENT.setMeta(map(dockw, "The agent currently running an action on this thread, else nil")); - AGENT.setTag(Symbol.create("clojure.lang.Agent")); - MATH_CONTEXT.setTag(Symbol.create("java.math.MathContext")); - Var nv = Var.intern(CLOJURE_NS, NAMESPACE, bootNamespace); - nv.setMacro(); - Var v; - v = Var.intern(CLOJURE_NS, IN_NAMESPACE, inNamespace); - v.setMeta(map(dockw, "Sets *ns* to the namespace named by the symbol, creating it if needed.", - arglistskw, list(vector(namesym)))); - v = Var.intern(CLOJURE_NS, LOAD_FILE, - new AFn(){ - public Object invoke(Object arg1) throws Exception{ - return Compiler.loadFile((String) arg1); - } - }); - v.setMeta(map(dockw, "Sequentially read and evaluate the set of forms contained in the file.", - arglistskw, list(vector(namesym)))); - try { - doInit(); - } - catch(Exception e) { - throw new RuntimeException(e); - } -} - - -static public Var var(String ns, String name){ - return Var.intern(Namespace.findOrCreate(Symbol.intern(null, ns)), Symbol.intern(null, name)); -} - -static public Var var(String ns, String name, Object init){ - return Var.intern(Namespace.findOrCreate(Symbol.intern(null, ns)), Symbol.intern(null, name), init); -} - -public static void loadResourceScript(String name) throws Exception{ - loadResourceScript(name, true); -} - -public static void maybeLoadResourceScript(String name) throws Exception{ - loadResourceScript(name, false); -} - -public static void loadResourceScript(String name, boolean failIfNotFound) throws Exception{ - loadResourceScript(RT.class, name, failIfNotFound); -} - -public static void loadResourceScript(Class c, String name) throws Exception{ - loadResourceScript(c, name, true); -} - -public static void loadResourceScript(Class c, String name, boolean failIfNotFound) throws Exception{ - int slash = name.lastIndexOf('/'); - String file = slash >= 0 ? name.substring(slash + 1) : name; - InputStream ins = baseLoader().getResourceAsStream(name); - if(ins != null) { - try { - Compiler.load(new InputStreamReader(ins, UTF8), name, file); - } - finally { - ins.close(); - } - } - else if(failIfNotFound) { - throw new FileNotFoundException("Could not locate Clojure resource on classpath: " + name); - } -} - -static public void init() throws Exception{ - RT.errPrintWriter().println("No need to call RT.init() anymore"); -} - -static public long lastModified(URL url, String libfile) throws Exception{ - if(url.getProtocol().equals("jar")) { - return ((JarURLConnection) url.openConnection()).getJarFile().getEntry(libfile).getTime(); - } - else { - return url.openConnection().getLastModified(); - } -} - -static void compile(String cljfile) throws Exception{ - InputStream ins = baseLoader().getResourceAsStream(cljfile); - if(ins != null) { - try { - Compiler.compile(new InputStreamReader(ins, UTF8), cljfile, - cljfile.substring(1 + cljfile.lastIndexOf("/"))); - } - finally { - ins.close(); - } - - } - else - throw new FileNotFoundException("Could not locate Clojure resource on classpath: " + cljfile); -} - -static public void load(String scriptbase) throws Exception{ - load(scriptbase, true); -} - -static public void load(String scriptbase, boolean failIfNotFound) throws Exception{ - String classfile = scriptbase + LOADER_SUFFIX + ".class"; - String cljfile = scriptbase + ".clj"; - URL classURL = baseLoader().getResource(classfile); - URL cljURL = baseLoader().getResource(cljfile); - boolean loaded = false; - - if((classURL != null && - (cljURL == null - || lastModified(classURL, classfile) > lastModified(cljURL, cljfile))) - || classURL == null) { - try { - Var.pushThreadBindings( - RT.map(CURRENT_NS, CURRENT_NS.deref(), - WARN_ON_REFLECTION, WARN_ON_REFLECTION.deref())); - loaded = (loadClassForName(scriptbase.replace('/', '.') + LOADER_SUFFIX) != null); - } - finally { - Var.popThreadBindings(); - } - } - if(!loaded && cljURL != null) { - if(booleanCast(Compiler.COMPILE_FILES.deref())) - compile(cljfile); - else - loadResourceScript(RT.class, cljfile); - } - else if(!loaded && failIfNotFound) - throw new FileNotFoundException(String.format("Could not locate %s or %s on classpath: ", classfile, cljfile)); -} - -static void doInit() throws Exception{ - load("clojure/core"); - load("clojure/zip", false); - load("clojure/xml", false); - load("clojure/set", false); - - Var.pushThreadBindings( - RT.map(CURRENT_NS, CURRENT_NS.deref(), - WARN_ON_REFLECTION, WARN_ON_REFLECTION.deref())); - try { - Symbol USER = Symbol.create("user"); - Symbol CLOJURE = Symbol.create("clojure.core"); - - Var in_ns = var("clojure.core", "in-ns"); - Var refer = var("clojure.core", "refer"); - in_ns.invoke(USER); - refer.invoke(CLOJURE); - maybeLoadResourceScript("user.clj"); - } - finally { - Var.popThreadBindings(); - } -} - -static public int nextID(){ - return id.getAndIncrement(); -} - - -////////////// Collections support ///////////////////////////////// - -static public ISeq seq(Object coll){ - if(coll instanceof ASeq) - return (ASeq) coll; - else if(coll instanceof LazySeq) - return ((LazySeq) coll).seq(); - else - return seqFrom(coll); -} - -static ISeq seqFrom(Object coll){ - if(coll instanceof Seqable) - return ((Seqable) coll).seq(); - else if(coll == null) - return null; - else if(coll instanceof Iterable) - return IteratorSeq.create(((Iterable) coll).iterator()); - else if(coll.getClass().isArray()) - return ArraySeq.createFromObject(coll); - else if(coll instanceof CharSequence) - return StringSeq.create((CharSequence) coll); - else if(coll instanceof Map) - return seq(((Map) coll).entrySet()); - else { - Class c = coll.getClass(); - Class sc = c.getSuperclass(); - throw new IllegalArgumentException("Don't know how to create ISeq from: " + c.getName()); - } -} - -static public ISeq keys(Object coll){ - return APersistentMap.KeySeq.create(seq(coll)); -} - -static public ISeq vals(Object coll){ - return APersistentMap.ValSeq.create(seq(coll)); -} - -static public IPersistentMap meta(Object x){ - if(x instanceof IMeta) - return ((IMeta) x).meta(); - return null; -} - -public static int count(Object o){ - if(o instanceof Counted) - return ((Counted) o).count(); - return countFrom(Util.ret1(o, o = null)); -} - -static int countFrom(Object o){ - if(o == null) - return 0; - else if(o instanceof IPersistentCollection) { - ISeq s = seq(o); - o = null; - int i = 0; - for(; s != null; s = s.next()) { - if(s instanceof Counted) - return i + s.count(); - i++; - } - return i; - } - else if(o instanceof CharSequence) - return ((CharSequence) o).length(); - else if(o instanceof Collection) - return ((Collection) o).size(); - else if(o instanceof Map) - return ((Map) o).size(); - else if(o.getClass().isArray()) - return Array.getLength(o); - - throw new UnsupportedOperationException("count not supported on this type: " + o.getClass().getSimpleName()); -} - -static public IPersistentCollection conj(IPersistentCollection coll, Object x){ - if(coll == null) - return new PersistentList(x); - return coll.cons(x); -} - -static public ISeq cons(Object x, Object coll){ - //ISeq y = seq(coll); - if(coll == null) - return new PersistentList(x); - else if(coll instanceof ISeq) - return new Cons(x, (ISeq) coll); - else - return new Cons(x, seq(coll)); -} - -static public Object first(Object x){ - if(x instanceof ISeq) - return ((ISeq) x).first(); - ISeq seq = seq(x); - if(seq == null) - return null; - return seq.first(); -} - -static public Object second(Object x){ - return first(next(x)); -} - -static public Object third(Object x){ - return first(next(next(x))); -} - -static public Object fourth(Object x){ - return first(next(next(next(x)))); -} - -static public ISeq next(Object x){ - if(x instanceof ISeq) - return ((ISeq) x).next(); - ISeq seq = seq(x); - if(seq == null) - return null; - return seq.next(); -} - -static public ISeq more(Object x){ - if(x instanceof ISeq) - return ((ISeq) x).more(); - ISeq seq = seq(x); - if(seq == null) - return PersistentList.EMPTY; - return seq.more(); -} - -//static public Seqable more(Object x){ -// Seqable ret = null; -// if(x instanceof ISeq) -// ret = ((ISeq) x).more(); -// else -// { -// ISeq seq = seq(x); -// if(seq == null) -// ret = PersistentList.EMPTY; -// else -// ret = seq.more(); -// } -// if(ret == null) -// ret = PersistentList.EMPTY; -// return ret; -//} - -static public Object peek(Object x){ - if(x == null) - return null; - return ((IPersistentStack) x).peek(); -} - -static public Object pop(Object x){ - if(x == null) - return null; - return ((IPersistentStack) x).pop(); -} - -static public Object get(Object coll, Object key){ - if(coll instanceof ILookup) - return ((ILookup) coll).valAt(key); - return getFrom(coll, key); -} - -static Object getFrom(Object coll, Object key){ - if(coll == null) - return null; - else if(coll instanceof Map) { - Map m = (Map) coll; - return m.get(key); - } - else if(coll instanceof IPersistentSet) { - IPersistentSet set = (IPersistentSet) coll; - return set.get(key); - } - else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) { - int n = ((Number) key).intValue(); - if(n >= 0 && n < count(coll)) - return nth(coll, n); - return null; - } - - return null; -} - -static public Object get(Object coll, Object key, Object notFound){ - if(coll instanceof ILookup) - return ((ILookup) coll).valAt(key, notFound); - return getFrom(coll, key, notFound); -} - -static Object getFrom(Object coll, Object key, Object notFound){ - if(coll == null) - return notFound; - else if(coll instanceof Map) { - Map m = (Map) coll; - if(m.containsKey(key)) - return m.get(key); - return notFound; - } - else if(coll instanceof IPersistentSet) { - IPersistentSet set = (IPersistentSet) coll; - if(set.contains(key)) - return set.get(key); - return notFound; - } - else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) { - int n = ((Number) key).intValue(); - return n >= 0 && n < count(coll) ? nth(coll, n) : notFound; - } - return notFound; - -} - -static public Associative assoc(Object coll, Object key, Object val){ - if(coll == null) - return new PersistentArrayMap(new Object[]{key, val}); - return ((Associative) coll).assoc(key, val); -} - -static public Object contains(Object coll, Object key){ - if(coll == null) - return F; - else if(coll instanceof Associative) - return ((Associative) coll).containsKey(key) ? T : F; - else if(coll instanceof IPersistentSet) - return ((IPersistentSet) coll).contains(key) ? T : F; - else if(coll instanceof Map) { - Map m = (Map) coll; - return m.containsKey(key) ? T : F; - } - else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) { - int n = ((Number) key).intValue(); - return n >= 0 && n < count(coll); - } - return F; -} - -static public Object find(Object coll, Object key){ - if(coll == null) - return null; - else if(coll instanceof Associative) - return ((Associative) coll).entryAt(key); - else { - Map m = (Map) coll; - if(m.containsKey(key)) - return new MapEntry(key, m.get(key)); - return null; - } -} - -//takes a seq of key,val,key,val - -//returns tail starting at val of matching key if found, else null -static public ISeq findKey(Keyword key, ISeq keyvals) throws Exception{ - while(keyvals != null) { - ISeq r = keyvals.next(); - if(r == null) - throw new Exception("Malformed keyword argslist"); - if(keyvals.first() == key) - return r; - keyvals = r.next(); - } - return null; -} - -static public Object dissoc(Object coll, Object key) throws Exception{ - if(coll == null) - return null; - return ((IPersistentMap) coll).without(key); -} - -static public Object nth(Object coll, int n){ - if(coll instanceof Indexed) - return ((Indexed) coll).nth(n); - return nthFrom(Util.ret1(coll, coll = null), n); -} - -static Object nthFrom(Object coll, int n){ - if(coll == null) - return null; - else if(coll instanceof CharSequence) - return Character.valueOf(((CharSequence) coll).charAt(n)); - else if(coll.getClass().isArray()) - return Reflector.prepRet(Array.get(coll, n)); - else if(coll instanceof RandomAccess) - return ((List) coll).get(n); - else if(coll instanceof Matcher) - return ((Matcher) coll).group(n); - - else if(coll instanceof Map.Entry) { - Map.Entry e = (Map.Entry) coll; - if(n == 0) - return e.getKey(); - else if(n == 1) - return e.getValue(); - throw new IndexOutOfBoundsException(); - } - - else if(coll instanceof Sequential) { - ISeq seq = RT.seq(coll); - coll = null; - for(int i = 0; i <= n && seq != null; ++i, seq = seq.next()) { - if(i == n) - return seq.first(); - } - throw new IndexOutOfBoundsException(); - } - else - throw new UnsupportedOperationException( - "nth not supported on this type: " + coll.getClass().getSimpleName()); -} - -static public Object nth(Object coll, int n, Object notFound){ - if(coll instanceof Indexed) { - Indexed v = (Indexed) coll; - return v.nth(n, notFound); - } - return nthFrom(coll, n, notFound); -} - -static Object nthFrom(Object coll, int n, Object notFound){ - if(coll == null) - return notFound; - else if(n < 0) - return notFound; - - else if(coll instanceof CharSequence) { - CharSequence s = (CharSequence) coll; - if(n < s.length()) - return Character.valueOf(s.charAt(n)); - return notFound; - } - else if(coll.getClass().isArray()) { - if(n < Array.getLength(coll)) - return Reflector.prepRet(Array.get(coll, n)); - return notFound; - } - else if(coll instanceof RandomAccess) { - List list = (List) coll; - if(n < list.size()) - return list.get(n); - return notFound; - } - else if(coll instanceof Matcher) { - Matcher m = (Matcher) coll; - if(n < m.groupCount()) - return m.group(n); - return notFound; - } - else if(coll instanceof Map.Entry) { - Map.Entry e = (Map.Entry) coll; - if(n == 0) - return e.getKey(); - else if(n == 1) - return e.getValue(); - return notFound; - } - else if(coll instanceof Sequential) { - ISeq seq = RT.seq(coll); - coll = null; - for(int i = 0; i <= n && seq != null; ++i, seq = seq.next()) { - if(i == n) - return seq.first(); - } - return notFound; - } - else - throw new UnsupportedOperationException( - "nth not supported on this type: " + coll.getClass().getSimpleName()); -} - -static public Object assocN(int n, Object val, Object coll){ - if(coll == null) - return null; - else if(coll instanceof IPersistentVector) - return ((IPersistentVector) coll).assocN(n, val); - else if(coll instanceof Object[]) { - //hmm... this is not persistent - Object[] array = ((Object[]) coll); - array[n] = val; - return array; - } - else - return null; -} - -static boolean hasTag(Object o, Object tag){ - return Util.equals(tag, RT.get(RT.meta(o), TAG_KEY)); -} - -/** - * ********************* Boxing/casts ****************************** - */ -static public Object box(Object x){ - return x; -} - -static public Character box(char x){ - return Character.valueOf(x); -} - -static public Object box(boolean x){ - return x ? T : F; -} - -static public Object box(Boolean x){ - return x;// ? T : null; -} - -static public Number box(byte x){ - return x;//Num.from(x); -} - -static public Number box(short x){ - return x;//Num.from(x); -} - -static public Number box(int x){ - return x;//Num.from(x); -} - -static public Number box(long x){ - return x;//Num.from(x); -} - -static public Number box(float x){ - return x;//Num.from(x); -} - -static public Number box(double x){ - return x;//Num.from(x); -} - -static public char charCast(Object x){ - if(x instanceof Character) - return ((Character) x).charValue(); - - long n = ((Number) x).longValue(); - if(n < Character.MIN_VALUE || n > Character.MAX_VALUE) - throw new IllegalArgumentException("Value out of range for char: " + x); - - return (char) n; -} - -static public boolean booleanCast(Object x){ - if(x instanceof Boolean) - return ((Boolean) x).booleanValue(); - return x != null; -} - -static public boolean booleanCast(boolean x){ - return x; -} - -static public byte byteCast(Object x){ - long n = ((Number) x).longValue(); - if(n < Byte.MIN_VALUE || n > Byte.MAX_VALUE) - throw new IllegalArgumentException("Value out of range for byte: " + x); - - return (byte) n; -} - -static public short shortCast(Object x){ - long n = ((Number) x).longValue(); - if(n < Short.MIN_VALUE || n > Short.MAX_VALUE) - throw new IllegalArgumentException("Value out of range for short: " + x); - - return (short) n; -} - -static public int intCast(Object x){ - if(x instanceof Integer) - return ((Integer)x).intValue(); - if(x instanceof Number) - return intCast(((Number) x).longValue()); - return ((Character) x).charValue(); -} - -static public int intCast(char x){ - return x; -} - -static public int intCast(byte x){ - return x; -} - -static public int intCast(short x){ - return x; -} - -static public int intCast(int x){ - return x; -} - -static public int intCast(float x){ - if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE) - throw new IllegalArgumentException("Value out of range for int: " + x); - return (int) x; -} - -static public int intCast(long x){ - if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE) - throw new IllegalArgumentException("Value out of range for int: " + x); - return (int) x; -} - -static public int intCast(double x){ - if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE) - throw new IllegalArgumentException("Value out of range for int: " + x); - return (int) x; -} - -static public long longCast(Object x){ - return ((Number) x).longValue(); -} - -static public long longCast(int x){ - return x; -} - -static public long longCast(float x){ - if(x < Long.MIN_VALUE || x > Long.MAX_VALUE) - throw new IllegalArgumentException("Value out of range for long: " + x); - return (long) x; -} - -static public long longCast(long x){ - return x; -} - -static public long longCast(double x){ - if(x < Long.MIN_VALUE || x > Long.MAX_VALUE) - throw new IllegalArgumentException("Value out of range for long: " + x); - return (long) x; -} - -static public float floatCast(Object x){ - if(x instanceof Float) - return ((Float) x).floatValue(); - - double n = ((Number) x).doubleValue(); - if(n < -Float.MAX_VALUE || n > Float.MAX_VALUE) - throw new IllegalArgumentException("Value out of range for float: " + x); - - return (float) n; - -} - -static public float floatCast(int x){ - return x; -} - -static public float floatCast(float x){ - return x; -} - -static public float floatCast(long x){ - return x; -} - -static public float floatCast(double x){ - if(x < -Float.MAX_VALUE || x > Float.MAX_VALUE) - throw new IllegalArgumentException("Value out of range for float: " + x); - - return (float) x; -} - -static public double doubleCast(Object x){ - return ((Number) x).doubleValue(); -} - -static public double doubleCast(int x){ - return x; -} - -static public double doubleCast(float x){ - return x; -} - -static public double doubleCast(long x){ - return x; -} - -static public double doubleCast(double x){ - return x; -} - -static public IPersistentMap map(Object... init){ - if(init == null) - return PersistentArrayMap.EMPTY; - else if(init.length <= PersistentArrayMap.HASHTABLE_THRESHOLD) - return PersistentArrayMap.createWithCheck(init); - return PersistentHashMap.createWithCheck(init); -} - -static public IPersistentSet set(Object... init){ - return PersistentHashSet.createWithCheck(init); -} - -static public IPersistentVector vector(Object... init){ - return LazilyPersistentVector.createOwning(init); -} - -static public IPersistentVector subvec(IPersistentVector v, int start, int end){ - if(end < start || start < 0 || end > v.count()) - throw new IndexOutOfBoundsException(); - if(start == end) - return PersistentVector.EMPTY; - return new APersistentVector.SubVector(null, v, start, end); -} - -/** - * **************************************** list support ******************************* - */ - - -static public ISeq list(){ - return null; -} - -static public ISeq list(Object arg1){ - return new PersistentList(arg1); -} - -static public ISeq list(Object arg1, Object arg2){ - return listStar(arg1, arg2, null); -} - -static public ISeq list(Object arg1, Object arg2, Object arg3){ - return listStar(arg1, arg2, arg3, null); -} - -static public ISeq list(Object arg1, Object arg2, Object arg3, Object arg4){ - return listStar(arg1, arg2, arg3, arg4, null); -} - -static public ISeq list(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5){ - return listStar(arg1, arg2, arg3, arg4, arg5, null); -} - -static public ISeq listStar(Object arg1, ISeq rest){ - return (ISeq) cons(arg1, rest); -} - -static public ISeq listStar(Object arg1, Object arg2, ISeq rest){ - return (ISeq) cons(arg1, cons(arg2, rest)); -} - -static public ISeq listStar(Object arg1, Object arg2, Object arg3, ISeq rest){ - return (ISeq) cons(arg1, cons(arg2, cons(arg3, rest))); -} - -static public ISeq listStar(Object arg1, Object arg2, Object arg3, Object arg4, ISeq rest){ - return (ISeq) cons(arg1, cons(arg2, cons(arg3, cons(arg4, rest)))); -} - -static public ISeq listStar(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, ISeq rest){ - return (ISeq) cons(arg1, cons(arg2, cons(arg3, cons(arg4, cons(arg5, rest))))); -} - -static public ISeq arrayToList(Object[] a) throws Exception{ - ISeq ret = null; - for(int i = a.length - 1; i >= 0; --i) - ret = (ISeq) cons(a[i], ret); - return ret; -} - -static public Object[] object_array(Object sizeOrSeq){ - if(sizeOrSeq instanceof Number) - return new Object[((Number) sizeOrSeq).intValue()]; - else - { - ISeq s = RT.seq(sizeOrSeq); - int size = RT.count(s); - Object[] ret = new Object[size]; - for(int i = 0; i < size && s != null; i++, s = s.next()) - ret[i] = s.first(); - return ret; - } -} - -static public Object[] toArray(Object coll) throws Exception{ - if(coll == null) - return EMPTY_ARRAY; - else if(coll instanceof Object[]) - return (Object[]) coll; - else if(coll instanceof Collection) - return ((Collection) coll).toArray(); - else if(coll instanceof Map) - return ((Map) coll).entrySet().toArray(); - else if(coll instanceof String) { - char[] chars = ((String) coll).toCharArray(); - Object[] ret = new Object[chars.length]; - for(int i = 0; i < chars.length; i++) - ret[i] = chars[i]; - return ret; - } - else if(coll.getClass().isArray()) { - ISeq s = (seq(coll)); - Object[] ret = new Object[count(s)]; - for(int i = 0; i < ret.length; i++, s = s.next()) - ret[i] = s.first(); - return ret; - } - else - throw new Exception("Unable to convert: " + coll.getClass() + " to Object[]"); -} - -static public Object[] seqToArray(ISeq seq){ - int len = length(seq); - Object[] ret = new Object[len]; - for(int i = 0; seq != null; ++i, seq = seq.next()) - ret[i] = seq.first(); - return ret; -} - -static public Object seqToTypedArray(ISeq seq) throws Exception{ - Class type = (seq != null) ? seq.first().getClass() : Object.class; - return seqToTypedArray(type, seq); -} - -static public Object seqToTypedArray(Class type, ISeq seq) throws Exception{ - Object ret = Array.newInstance(type, length(seq)); - for(int i = 0; seq != null; ++i, seq = seq.next()) - Array.set(ret, i, seq.first()); - return ret; -} - -static public int length(ISeq list){ - int i = 0; - for(ISeq c = list; c != null; c = c.next()) { - i++; - } - return i; -} - -static public int boundedLength(ISeq list, int limit) throws Exception{ - int i = 0; - for(ISeq c = list; c != null && i <= limit; c = c.next()) { - i++; - } - return i; -} - -///////////////////////////////// reader support //////////////////////////////// - -static Character readRet(int ret){ - if(ret == -1) - return null; - return box((char) ret); -} - -static public Character readChar(Reader r) throws Exception{ - int ret = r.read(); - return readRet(ret); -} - -static public Character peekChar(Reader r) throws Exception{ - int ret; - if(r instanceof PushbackReader) { - ret = r.read(); - ((PushbackReader) r).unread(ret); - } - else { - r.mark(1); - ret = r.read(); - r.reset(); - } - - return readRet(ret); -} - -static public int getLineNumber(Reader r){ - if(r instanceof LineNumberingPushbackReader) - return ((LineNumberingPushbackReader) r).getLineNumber(); - return 0; -} - -static public LineNumberingPushbackReader getLineNumberingReader(Reader r){ - if(isLineNumberingReader(r)) - return (LineNumberingPushbackReader) r; - return new LineNumberingPushbackReader(r); -} - -static public boolean isLineNumberingReader(Reader r){ - return r instanceof LineNumberingPushbackReader; -} - -static public String resolveClassNameInContext(String className){ - //todo - look up in context var - return className; -} - -static public boolean suppressRead(){ - //todo - look up in suppress-read var - return false; -} - -static public String printString(Object x){ - try { - StringWriter sw = new StringWriter(); - print(x, sw); - return sw.toString(); - } - catch(Exception e) { - throw new RuntimeException(e); - } -} - -static public Object readString(String s){ - PushbackReader r = new PushbackReader(new StringReader(s)); - try { - return LispReader.read(r, true, null, false); - } - catch(Exception e) { - throw new RuntimeException(e); - } -} - -static public void print(Object x, Writer w) throws Exception{ - //call multimethod - if(PRINT_INITIALIZED.isBound() && RT.booleanCast(PRINT_INITIALIZED.deref())) - PR_ON.invoke(x, w); -//* - else { - boolean readably = booleanCast(PRINT_READABLY.deref()); - if(x instanceof Obj) { - Obj o = (Obj) x; - if(RT.count(o.meta()) > 0 && - ((readably && booleanCast(PRINT_META.deref())) - || booleanCast(PRINT_DUP.deref()))) { - IPersistentMap meta = o.meta(); - w.write("#^"); - if(meta.count() == 1 && meta.containsKey(TAG_KEY)) - print(meta.valAt(TAG_KEY), w); - else - print(meta, w); - w.write(' '); - } - } - if(x == null) - w.write("nil"); - else if(x instanceof ISeq || x instanceof IPersistentList) { - w.write('('); - printInnerSeq(seq(x), w); - w.write(')'); - } - else if(x instanceof String) { - String s = (String) x; - if(!readably) - w.write(s); - else { - w.write('"'); - //w.write(x.toString()); - for(int i = 0; i < s.length(); i++) { - char c = s.charAt(i); - switch(c) { - case '\n': - w.write("\\n"); - break; - case '\t': - w.write("\\t"); - break; - case '\r': - w.write("\\r"); - break; - case '"': - w.write("\\\""); - break; - case '\\': - w.write("\\\\"); - break; - case '\f': - w.write("\\f"); - break; - case '\b': - w.write("\\b"); - break; - default: - w.write(c); - } - } - w.write('"'); - } - } - else if(x instanceof IPersistentMap) { - w.write('{'); - for(ISeq s = seq(x); s != null; s = s.next()) { - IMapEntry e = (IMapEntry) s.first(); - print(e.key(), w); - w.write(' '); - print(e.val(), w); - if(s.next() != null) - w.write(", "); - } - w.write('}'); - } - else if(x instanceof IPersistentVector) { - IPersistentVector a = (IPersistentVector) x; - w.write('['); - for(int i = 0; i < a.count(); i++) { - print(a.nth(i), w); - if(i < a.count() - 1) - w.write(' '); - } - w.write(']'); - } - else if(x instanceof IPersistentSet) { - w.write("#{"); - for(ISeq s = seq(x); s != null; s = s.next()) { - print(s.first(), w); - if(s.next() != null) - w.write(" "); - } - w.write('}'); - } - else if(x instanceof Character) { - char c = ((Character) x).charValue(); - if(!readably) - w.write(c); - else { - w.write('\\'); - switch(c) { - case '\n': - w.write("newline"); - break; - case '\t': - w.write("tab"); - break; - case ' ': - w.write("space"); - break; - case '\b': - w.write("backspace"); - break; - case '\f': - w.write("formfeed"); - break; - case '\r': - w.write("return"); - break; - default: - w.write(c); - } - } - } - else if(x instanceof Class) { - w.write("#="); - w.write(((Class) x).getName()); - } - else if(x instanceof BigDecimal && readably) { - w.write(x.toString()); - w.write('M'); - } - else if(x instanceof Var) { - Var v = (Var) x; - w.write("#=(var " + v.ns.name + "/" + v.sym + ")"); - } - else if(x instanceof Pattern) { - Pattern p = (Pattern) x; - w.write("#\"" + p.pattern() + "\""); - } - else w.write(x.toString()); - } - //*/ -} - -private static void printInnerSeq(ISeq x, Writer w) throws Exception{ - for(ISeq s = x; s != null; s = s.next()) { - print(s.first(), w); - if(s.next() != null) - w.write(' '); - } -} - -static public void formatAesthetic(Writer w, Object obj) throws IOException{ - if(obj == null) - w.write("null"); - else - w.write(obj.toString()); -} - -static public void formatStandard(Writer w, Object obj) throws IOException{ - if(obj == null) - w.write("null"); - else if(obj instanceof String) { - w.write('"'); - w.write((String) obj); - w.write('"'); - } - else if(obj instanceof Character) { - w.write('\\'); - char c = ((Character) obj).charValue(); - switch(c) { - case '\n': - w.write("newline"); - break; - case '\t': - w.write("tab"); - break; - case ' ': - w.write("space"); - break; - case '\b': - w.write("backspace"); - break; - case '\f': - w.write("formfeed"); - break; - default: - w.write(c); - } - } - else - w.write(obj.toString()); -} - -static public Object format(Object o, String s, Object... args) throws Exception{ - Writer w; - if(o == null) - w = new StringWriter(); - else if(Util.equals(o, T)) - w = (Writer) OUT.deref(); - else - w = (Writer) o; - doFormat(w, s, ArraySeq.create(args)); - if(o == null) - return w.toString(); - return null; -} - -static public ISeq doFormat(Writer w, String s, ISeq args) throws Exception{ - for(int i = 0; i < s.length();) { - char c = s.charAt(i++); - switch(Character.toLowerCase(c)) { - case '~': - char d = s.charAt(i++); - switch(Character.toLowerCase(d)) { - case '%': - w.write('\n'); - break; - case 't': - w.write('\t'); - break; - case 'a': - if(args == null) - throw new IllegalArgumentException("Missing argument"); - RT.formatAesthetic(w, RT.first(args)); - args = RT.next(args); - break; - case 's': - if(args == null) - throw new IllegalArgumentException("Missing argument"); - RT.formatStandard(w, RT.first(args)); - args = RT.next(args); - break; - case '{': - int j = s.indexOf("~}", i); //note - does not nest - if(j == -1) - throw new IllegalArgumentException("Missing ~}"); - String subs = s.substring(i, j); - for(ISeq sargs = RT.seq(RT.first(args)); sargs != null;) - sargs = doFormat(w, subs, sargs); - args = RT.next(args); - i = j + 2; //skip ~} - break; - case '^': - if(args == null) - return null; - break; - case '~': - w.write('~'); - break; - default: - throw new IllegalArgumentException("Unsupported ~ directive: " + d); - } - break; - default: - w.write(c); - } - } - return args; -} -///////////////////////////////// values ////////////////////////// - -static public Object[] setValues(Object... vals){ - //ThreadLocalData.setValues(vals); - if(vals.length > 0) - return vals;//[0]; - return null; -} - - -static public ClassLoader makeClassLoader(){ - return (ClassLoader) AccessController.doPrivileged(new PrivilegedAction(){ - public Object run(){ - try{ - Var.pushThreadBindings(RT.map(USE_CONTEXT_CLASSLOADER, RT.T)); -// getRootClassLoader(); - return new DynamicClassLoader(baseLoader()); - } - finally{ - Var.popThreadBindings(); - } - } - }); -} - -static public ClassLoader baseLoader(){ - if(Compiler.LOADER.isBound()) - return (ClassLoader) Compiler.LOADER.deref(); - else if(booleanCast(USE_CONTEXT_CLASSLOADER.deref())) - return Thread.currentThread().getContextClassLoader(); - return Compiler.class.getClassLoader(); -} - -static public Class classForName(String name) throws ClassNotFoundException{ - - return Class.forName(name, true, baseLoader()); -} - -static public Class loadClassForName(String name) throws ClassNotFoundException{ - try - { - Class.forName(name, false, baseLoader()); - } - catch(ClassNotFoundException e) - { - return null; - } - return Class.forName(name, true, baseLoader()); -} - -static public float aget(float[] xs, int i){ - return xs[i]; -} - -static public float aset(float[] xs, int i, float v){ - xs[i] = v; - return v; -} - -static public int alength(float[] xs){ - return xs.length; -} - -static public float[] aclone(float[] xs){ - return xs.clone(); -} - -static public double aget(double[] xs, int i){ - return xs[i]; -} - -static public double aset(double[] xs, int i, double v){ - xs[i] = v; - return v; -} - -static public int alength(double[] xs){ - return xs.length; -} - -static public double[] aclone(double[] xs){ - return xs.clone(); -} - -static public int aget(int[] xs, int i){ - return xs[i]; -} - -static public int aset(int[] xs, int i, int v){ - xs[i] = v; - return v; -} - -static public int alength(int[] xs){ - return xs.length; -} - -static public int[] aclone(int[] xs){ - return xs.clone(); -} - -static public long aget(long[] xs, int i){ - return xs[i]; -} - -static public long aset(long[] xs, int i, long v){ - xs[i] = v; - return v; -} - -static public int alength(long[] xs){ - return xs.length; -} - -static public long[] aclone(long[] xs){ - return xs.clone(); -} - -static public char aget(char[] xs, int i){ - return xs[i]; -} - -static public char aset(char[] xs, int i, char v){ - xs[i] = v; - return v; -} - -static public int alength(char[] xs){ - return xs.length; -} - -static public char[] aclone(char[] xs){ - return xs.clone(); -} - -static public byte aget(byte[] xs, int i){ - return xs[i]; -} - -static public byte aset(byte[] xs, int i, byte v){ - xs[i] = v; - return v; -} - -static public int alength(byte[] xs){ - return xs.length; -} - -static public byte[] aclone(byte[] xs){ - return xs.clone(); -} - -static public short aget(short[] xs, int i){ - return xs[i]; -} - -static public short aset(short[] xs, int i, short v){ - xs[i] = v; - return v; -} - -static public int alength(short[] xs){ - return xs.length; -} - -static public short[] aclone(short[] xs){ - return xs.clone(); -} - -static public boolean aget(boolean[] xs, int i){ - return xs[i]; -} - -static public boolean aset(boolean[] xs, int i, boolean v){ - xs[i] = v; - return v; -} - -static public int alength(boolean[] xs){ - return xs.length; -} - -static public boolean[] aclone(boolean[] xs){ - return xs.clone(); -} - -static public Object aget(Object[] xs, int i){ - return xs[i]; -} - -static public Object aset(Object[] xs, int i, Object v){ - xs[i] = v; - return v; -} - -static public int alength(Object[] xs){ - return xs.length; -} - -static public Object[] aclone(Object[] xs){ - return xs.clone(); -} - - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Range.java --- a/src/clojure/lang/Range.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Apr 1, 2008 */ - -package clojure.lang; - -public class Range extends ASeq implements IReduce, Counted{ -final int end; -final int n; - -public Range(int start, int end){ - this.end = end; - this.n = start; -} - -public Range(IPersistentMap meta, int start, int end){ - super(meta); - this.end = end; - this.n = start; -} - -public Obj withMeta(IPersistentMap meta){ - if(meta == meta()) - return this; - return new Range(meta(), end, n); -} - -public Object first(){ - return n; -} - -public ISeq next(){ - if(n < end-1) - return new Range(_meta, n + 1, end); - return null; -} - -public Object reduce(IFn f) throws Exception{ - Object ret = n; - for(int x = n+1;x < end;x++) - ret = f.invoke(ret, x); - return ret; -} - -public Object reduce(IFn f, Object start) throws Exception{ - Object ret = f.invoke(start,n); - for(int x = n+1;x < end;x++) - ret = f.invoke(ret, x); - return ret; -} - -public int count() { - return end - n; - } - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Ratio.java --- a/src/clojure/lang/Ratio.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,78 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 31, 2008 */ - -package clojure.lang; - -import java.math.BigInteger; -import java.math.BigDecimal; -import java.math.MathContext; - -public class Ratio extends Number implements Comparable{ -final public BigInteger numerator; -final public BigInteger denominator; - -public Ratio(BigInteger numerator, BigInteger denominator){ - this.numerator = numerator; - this.denominator = denominator; -} - -public boolean equals(Object arg0){ - return arg0 != null - && arg0 instanceof Ratio - && ((Ratio) arg0).numerator.equals(numerator) - && ((Ratio) arg0).denominator.equals(denominator); -} - -public int hashCode(){ - return numerator.hashCode() ^ denominator.hashCode(); -} - -public String toString(){ - return numerator.toString() + "/" + denominator.toString(); -} - -public int intValue(){ - return (int) doubleValue(); -} - -public long longValue(){ - return bigIntegerValue().longValue(); -} - -public float floatValue(){ - return (float)doubleValue(); -} - -public double doubleValue(){ - return decimalValue(MathContext.DECIMAL64).doubleValue(); -} - -public BigDecimal decimalValue(){ - return decimalValue(MathContext.UNLIMITED); -} - -public BigDecimal decimalValue(MathContext mc){ - BigDecimal numerator = new BigDecimal(this.numerator); - BigDecimal denominator = new BigDecimal(this.denominator); - - return numerator.divide(denominator, mc); -} - -public BigInteger bigIntegerValue(){ - return numerator.divide(denominator); -} - -public int compareTo(Object o){ - Number other = (Number)o; - return Numbers.compare(this, other); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Ref.java --- a/src/clojure/lang/Ref.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,379 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jul 25, 2007 */ - -package clojure.lang; - -import java.util.concurrent.atomic.AtomicInteger; -import java.util.concurrent.atomic.AtomicLong; -import java.util.concurrent.locks.ReentrantReadWriteLock; - -public class Ref extends ARef implements IFn, Comparable, IRef{ - public int compareTo(Ref ref) { - if(this.id == ref.id) - return 0; - else if(this.id < ref.id) - return -1; - else - return 1; - } - -public int getMinHistory(){ - return minHistory; -} - -public Ref setMinHistory(int minHistory){ - this.minHistory = minHistory; - return this; -} - -public int getMaxHistory(){ - return maxHistory; -} - -public Ref setMaxHistory(int maxHistory){ - this.maxHistory = maxHistory; - return this; -} - -public static class TVal{ - Object val; - long point; - long msecs; - TVal prior; - TVal next; - - TVal(Object val, long point, long msecs, TVal prior){ - this.val = val; - this.point = point; - this.msecs = msecs; - this.prior = prior; - this.next = prior.next; - this.prior.next = this; - this.next.prior = this; - } - - TVal(Object val, long point, long msecs){ - this.val = val; - this.point = point; - this.msecs = msecs; - this.next = this; - this.prior = this; - } - -} - -TVal tvals; -final AtomicInteger faults; -final ReentrantReadWriteLock lock; -LockingTransaction.Info tinfo; -//IFn validator; -final long id; - -volatile int minHistory = 0; -volatile int maxHistory = 10; - -static final AtomicLong ids = new AtomicLong(); - -public Ref(Object initVal) throws Exception{ - this(initVal, null); -} - -public Ref(Object initVal,IPersistentMap meta) throws Exception{ - super(meta); - this.id = ids.getAndIncrement(); - this.faults = new AtomicInteger(); - this.lock = new ReentrantReadWriteLock(); - tvals = new TVal(initVal, 0, System.currentTimeMillis()); -} - -//the latest val - -// ok out of transaction -Object currentVal(){ - try - { - lock.readLock().lock(); - if(tvals != null) - return tvals.val; - throw new IllegalStateException(this.toString() + " is unbound."); - } - finally - { - lock.readLock().unlock(); - } -} - -//* - -public Object deref(){ - LockingTransaction t = LockingTransaction.getRunning(); - if(t == null) - return currentVal(); - return t.doGet(this); -} - -//void validate(IFn vf, Object val){ -// try{ -// if(vf != null && !RT.booleanCast(vf.invoke(val))) -// throw new IllegalStateException("Invalid ref state"); -// } -// catch(RuntimeException re) -// { -// throw re; -// } -// catch(Exception e) -// { -// throw new IllegalStateException("Invalid ref state", e); -// } -//} -// -//public void setValidator(IFn vf){ -// try -// { -// lock.writeLock().lock(); -// validate(vf,currentVal()); -// validator = vf; -// } -// finally -// { -// lock.writeLock().unlock(); -// } -//} -// -//public IFn getValidator(){ -// try -// { -// lock.readLock().lock(); -// return validator; -// } -// finally -// { -// lock.readLock().unlock(); -// } -//} - -public Object set(Object val){ - return LockingTransaction.getEx().doSet(this, val); -} - -public Object commute(IFn fn, ISeq args) throws Exception{ - return LockingTransaction.getEx().doCommute(this, fn, args); -} - -public Object alter(IFn fn, ISeq args) throws Exception{ - LockingTransaction t = LockingTransaction.getEx(); - return t.doSet(this, fn.applyTo(RT.cons(t.doGet(this), args))); -} - -public void touch(){ - LockingTransaction.getEx().doEnsure(this); -} - -//*/ -boolean isBound(){ - try - { - lock.readLock().lock(); - return tvals != null; - } - finally - { - lock.readLock().unlock(); - } -} - - -public void trimHistory(){ - try - { - lock.writeLock().lock(); - if(tvals != null) - { - tvals.next = tvals; - tvals.prior = tvals; - } - } - finally - { - lock.writeLock().unlock(); - } -} - -public int getHistoryCount(){ - try - { - lock.writeLock().lock(); - return histCount(); - } - finally - { - lock.writeLock().unlock(); - } -} - -int histCount(){ - if(tvals == null) - return 0; - else - { - int count = 0; - for(TVal tv = tvals.next;tv != tvals;tv = tv.next) - count++; - return count; - } -} - -final public IFn fn(){ - return (IFn) deref(); -} - -public Object call() throws Exception{ - return invoke(); -} - -public void run(){ - try - { - invoke(); - } - catch(Exception e) - { - throw new RuntimeException(e); - } -} - -public Object invoke() throws Exception{ - return fn().invoke(); -} - -public Object invoke(Object arg1) throws Exception{ - return fn().invoke(arg1); -} - -public Object invoke(Object arg1, Object arg2) throws Exception{ - return fn().invoke(arg1, arg2); -} - -public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ - return fn().invoke(arg1, arg2, arg3); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) - throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) - throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) - throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16, arg17); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16, arg17, arg18); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16, arg17, arg18, arg19); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) - throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16, arg17, arg18, arg19, arg20); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, - Object... args) - throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16, arg17, arg18, arg19, arg20, args); -} - -public Object applyTo(ISeq arglist) throws Exception{ - return AFn.applyToHelper(this, arglist); -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Reflector.java --- a/src/clojure/lang/Reflector.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,451 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Apr 19, 2006 */ - -package clojure.lang; - -import java.lang.reflect.*; -import java.util.ArrayList; -import java.util.Iterator; -import java.util.List; -import java.util.Arrays; - -public class Reflector{ - -public static Object invokeInstanceMethod(Object target, String methodName, Object[] args) throws Exception{ - try - { - Class c = target.getClass(); - List methods = getMethods(c, args.length, methodName, false); - return invokeMatchingMethod(methodName, methods, target, args); - } - catch(InvocationTargetException e) - { - if(e.getCause() instanceof Exception) - throw (Exception) e.getCause(); - else if(e.getCause() instanceof Error) - throw (Error) e.getCause(); - throw e; - } -} - -private static String noMethodReport(String methodName, Object target){ - return "No matching method found: " + methodName - + (target==null?"":" for " + target.getClass()); -} -static Object invokeMatchingMethod(String methodName, List methods, Object target, Object[] args) - throws Exception{ - Method m = null; - Object[] boxedArgs = null; - if(methods.isEmpty()) - { - throw new IllegalArgumentException(noMethodReport(methodName,target)); - } - else if(methods.size() == 1) - { - m = (Method) methods.get(0); - boxedArgs = boxArgs(m.getParameterTypes(), args); - } - else //overloaded w/same arity - { - Method foundm = null; - for(Iterator i = methods.iterator(); i.hasNext();) - { - m = (Method) i.next(); - - Class[] params = m.getParameterTypes(); - if(isCongruent(params, args)) - { - if(foundm == null || Compiler.subsumes(params, foundm.getParameterTypes())) - { - foundm = m; - boxedArgs = boxArgs(params, args); - } - } - } - m = foundm; - } - if(m == null) - throw new IllegalArgumentException(noMethodReport(methodName,target)); - - if(!Modifier.isPublic(m.getDeclaringClass().getModifiers())) - { - //public method of non-public class, try to find it in hierarchy - Method oldm = m; - m = getAsMethodOfPublicBase(m.getDeclaringClass(), m); - if(m == null) - throw new IllegalArgumentException("Can't call public method of non-public class: " + - oldm.toString()); - } - try - { - return prepRet(m.invoke(target, boxedArgs)); - } - catch(InvocationTargetException e) - { - if(e.getCause() instanceof Exception) - throw (Exception) e.getCause(); - else if(e.getCause() instanceof Error) - throw (Error) e.getCause(); - throw e; - } - -} - -public static Method getAsMethodOfPublicBase(Class c, Method m){ - for(Class iface : c.getInterfaces()) - { - for(Method im : iface.getMethods()) - { - if(im.getName().equals(m.getName()) - && Arrays.equals(m.getParameterTypes(), im.getParameterTypes())) - { - return im; - } - } - } - Class sc = c.getSuperclass(); - if(sc == null) - return null; - for(Method scm : sc.getMethods()) - { - if(scm.getName().equals(m.getName()) - && Arrays.equals(m.getParameterTypes(), scm.getParameterTypes()) - && Modifier.isPublic(scm.getDeclaringClass().getModifiers())) - { - return scm; - } - } - return getAsMethodOfPublicBase(sc, m); -} - -public static Object invokeConstructor(Class c, Object[] args) throws Exception{ - try - { - Constructor[] allctors = c.getConstructors(); - ArrayList ctors = new ArrayList(); - for(int i = 0; i < allctors.length; i++) - { - Constructor ctor = allctors[i]; - if(ctor.getParameterTypes().length == args.length) - ctors.add(ctor); - } - if(ctors.isEmpty()) - { - throw new IllegalArgumentException("No matching ctor found" - + " for " + c); - } - else if(ctors.size() == 1) - { - Constructor ctor = (Constructor) ctors.get(0); - return ctor.newInstance(boxArgs(ctor.getParameterTypes(), args)); - } - else //overloaded w/same arity - { - for(Iterator iterator = ctors.iterator(); iterator.hasNext();) - { - Constructor ctor = (Constructor) iterator.next(); - Class[] params = ctor.getParameterTypes(); - if(isCongruent(params, args)) - { - Object[] boxedArgs = boxArgs(params, args); - return ctor.newInstance(boxedArgs); - } - } - throw new IllegalArgumentException("No matching ctor found" - + " for " + c); - } - } - catch(InvocationTargetException e) - { - if(e.getCause() instanceof Exception) - throw (Exception) e.getCause(); - else if(e.getCause() instanceof Error) - throw (Error) e.getCause(); - throw e; - } -} - -public static Object invokeStaticMethodVariadic(String className, String methodName, Object... args) throws Exception{ - return invokeStaticMethod(className, methodName, args); - -} - -public static Object invokeStaticMethod(String className, String methodName, Object[] args) throws Exception{ - Class c = RT.classForName(className); - try - { - return invokeStaticMethod(c, methodName, args); - } - catch(InvocationTargetException e) - { - if(e.getCause() instanceof Exception) - throw (Exception) e.getCause(); - else if(e.getCause() instanceof Error) - throw (Error) e.getCause(); - throw e; - } -} - -public static Object invokeStaticMethod(Class c, String methodName, Object[] args) throws Exception{ - if(methodName.equals("new")) - return invokeConstructor(c, args); - List methods = getMethods(c, args.length, methodName, true); - return invokeMatchingMethod(methodName, methods, null, args); -} - -public static Object getStaticField(String className, String fieldName) throws Exception{ - Class c = RT.classForName(className); - return getStaticField(c, fieldName); -} - -public static Object getStaticField(Class c, String fieldName) throws Exception{ -// if(fieldName.equals("class")) -// return c; - Field f = getField(c, fieldName, true); - if(f != null) - { - return prepRet(f.get(null)); - } - throw new IllegalArgumentException("No matching field found: " + fieldName - + " for " + c); -} - -public static Object setStaticField(String className, String fieldName, Object val) throws Exception{ - Class c = RT.classForName(className); - return setStaticField(c, fieldName, val); -} - -public static Object setStaticField(Class c, String fieldName, Object val) throws Exception{ - Field f = getField(c, fieldName, true); - if(f != null) - { - f.set(null, boxArg(f.getType(), val)); - return val; - } - throw new IllegalArgumentException("No matching field found: " + fieldName - + " for " + c); -} - -public static Object getInstanceField(Object target, String fieldName) throws Exception{ - Class c = target.getClass(); - Field f = getField(c, fieldName, false); - if(f != null) - { - return prepRet(f.get(target)); - } - throw new IllegalArgumentException("No matching field found: " + fieldName - + " for " + target.getClass()); -} - -public static Object setInstanceField(Object target, String fieldName, Object val) throws Exception{ - Class c = target.getClass(); - Field f = getField(c, fieldName, false); - if(f != null) - { - f.set(target, boxArg(f.getType(), val)); - return val; - } - throw new IllegalArgumentException("No matching field found: " + fieldName - + " for " + target.getClass()); -} - -public static Object invokeNoArgInstanceMember(Object target, String name) throws Exception{ - //favor method over field - List meths = getMethods(target.getClass(), 0, name, false); - if(meths.size() > 0) - return invokeMatchingMethod(name, meths, target, RT.EMPTY_ARRAY); - else - return getInstanceField(target, name); -} - -public static Object invokeInstanceMember(Object target, String name) throws Exception{ - //check for field first - Class c = target.getClass(); - Field f = getField(c, name, false); - if(f != null) //field get - { - return prepRet(f.get(target)); - } - return invokeInstanceMethod(target, name, RT.EMPTY_ARRAY); -} - -public static Object invokeInstanceMember(String name, Object target, Object arg1) throws Exception{ - //check for field first - Class c = target.getClass(); - Field f = getField(c, name, false); - if(f != null) //field set - { - f.set(target, boxArg(f.getType(), arg1)); - return arg1; - } - return invokeInstanceMethod(target, name, new Object[]{arg1}); -} - -public static Object invokeInstanceMember(String name, Object target, Object... args) throws Exception{ - return invokeInstanceMethod(target, name, args); -} - - -static public Field getField(Class c, String name, boolean getStatics){ - Field[] allfields = c.getFields(); - for(int i = 0; i < allfields.length; i++) - { - if(name.equals(allfields[i].getName()) - && Modifier.isStatic(allfields[i].getModifiers()) == getStatics) - return allfields[i]; - } - return null; -} - -static public List getMethods(Class c, int arity, String name, boolean getStatics){ - Method[] allmethods = c.getMethods(); - ArrayList methods = new ArrayList(); - ArrayList bridgeMethods = new ArrayList(); - for(int i = 0; i < allmethods.length; i++) - { - Method method = allmethods[i]; - if(name.equals(method.getName()) - && Modifier.isStatic(method.getModifiers()) == getStatics - && method.getParameterTypes().length == arity) - { - try - { - if(method.isBridge() - && c.getMethod(method.getName(), method.getParameterTypes()) - .equals(method)) - bridgeMethods.add(method); - else - methods.add(method); - } - catch(NoSuchMethodException e) - { - } - } -// && (!method.isBridge() -// || (c == StringBuilder.class && -// c.getMethod(method.getName(), method.getParameterTypes()) -// .equals(method)))) -// { -// methods.add(allmethods[i]); -// } - } - - if(methods.isEmpty()) - methods.addAll(bridgeMethods); - - if(!getStatics && c.isInterface()) - { - allmethods = Object.class.getMethods(); - for(int i = 0; i < allmethods.length; i++) - { - if(name.equals(allmethods[i].getName()) - && Modifier.isStatic(allmethods[i].getModifiers()) == getStatics - && allmethods[i].getParameterTypes().length == arity) - { - methods.add(allmethods[i]); - } - } - } - return methods; -} - - -static Object boxArg(Class paramType, Object arg){ - if(!paramType.isPrimitive()) - return paramType.cast(arg); - else if(paramType == boolean.class) - return Boolean.class.cast(arg); - else if(paramType == char.class) - return Character.class.cast(arg); - else if(arg instanceof Number) - { - Number n = (Number) arg; - if(paramType == int.class) - return n.intValue(); - else if(paramType == float.class) - return n.floatValue(); - else if(paramType == double.class) - return n.doubleValue(); - else if(paramType == long.class) - return n.longValue(); - else if(paramType == short.class) - return n.shortValue(); - else if(paramType == byte.class) - return n.byteValue(); - } - throw new IllegalArgumentException("Unexpected param type, expected: " + paramType + - ", given: " + arg.getClass().getName()); -} - -static Object[] boxArgs(Class[] params, Object[] args){ - if(params.length == 0) - return null; - Object[] ret = new Object[params.length]; - for(int i = 0; i < params.length; i++) - { - Object arg = args[i]; - Class paramType = params[i]; - ret[i] = boxArg(paramType, arg); - } - return ret; -} - -static public boolean paramArgTypeMatch(Class paramType, Class argType){ - if(argType == null) - return !paramType.isPrimitive(); - if(paramType == argType || paramType.isAssignableFrom(argType)) - return true; - if(paramType == int.class) - return argType == Integer.class;// || argType == FixNum.class; - else if(paramType == float.class) - return argType == Float.class; - else if(paramType == double.class) - return argType == Double.class;// || argType == DoubleNum.class; - else if(paramType == long.class) - return argType == Long.class;// || argType == BigNum.class; - else if(paramType == char.class) - return argType == Character.class; - else if(paramType == short.class) - return argType == Short.class; - else if(paramType == byte.class) - return argType == Byte.class; - else if(paramType == boolean.class) - return argType == Boolean.class; - return false; -} - -static boolean isCongruent(Class[] params, Object[] args){ - boolean ret = false; - if(args == null) - return params.length == 0; - if(params.length == args.length) - { - ret = true; - for(int i = 0; ret && i < params.length; i++) - { - Object arg = args[i]; - Class argType = (arg == null) ? null : arg.getClass(); - Class paramType = params[i]; - ret = paramArgTypeMatch(paramType, argType); - } - } - return ret; -} - -public static Object prepRet(Object x){ -// if(c == boolean.class) -// return ((Boolean) x).booleanValue() ? RT.T : null; - if(x instanceof Boolean) - return ((Boolean) x)?Boolean.TRUE:Boolean.FALSE; - return x; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Repl.java --- a/src/clojure/lang/Repl.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Oct 18, 2007 */ - -package clojure.lang; - -import clojure.main; - -public class Repl { - -public static void main(String[] args) throws Exception{ - main.legacy_repl(args); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/RestFn.java --- a/src/clojure/lang/RestFn.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1366 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ -package clojure.lang; - -public abstract class RestFn extends AFunction{ - -abstract public int getRequiredArity(); - -protected Object doInvoke(Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object args) - throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object args) - throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object args) - throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object args) - throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, - Object arg14, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, - Object arg14, Object arg15, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, - Object arg14, Object arg15, Object arg16, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, - Object arg14, Object arg15, Object arg16, Object arg17, Object args) throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, - Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object args) - throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, - Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, - Object args) - throws Exception{ - return null; -} - -protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, - Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, - Object arg20, Object args) throws Exception{ - return null; -} - - -public Object applyTo(ISeq args) throws Exception{ - if(RT.boundedLength(args, getRequiredArity()) <= getRequiredArity()) - { - return AFn.applyToHelper(this, Util.ret1(args,args = null)); - } - switch(getRequiredArity()) - { - case 0: - return doInvoke(Util.ret1(args,args = null)); - case 1: - return doInvoke(args.first() - , Util.ret1(args.next(),args=null)); - case 2: - return doInvoke(args.first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 3: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 4: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 5: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 6: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 7: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 8: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 9: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 10: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 11: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 12: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 13: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 14: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 15: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 16: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 17: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 18: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 19: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - case 20: - return doInvoke(args.first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , (args = args.next()).first() - , Util.ret1(args.next(),args=null)); - - } - return throwArity(-1); -} - -public Object invoke() throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(null); - default: - return throwArity(0); - } - -} - -public Object invoke(Object arg1) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null))); - case 1: - return doInvoke(Util.ret1(arg1, arg1 = null), null); - default: - return throwArity(1); - } - -} - -public Object invoke(Object arg1, Object arg2) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null))); - case 1: - return doInvoke(Util.ret1(arg1, arg1 = null), ArraySeq.create(Util.ret1(arg2, arg2 = null))); - case 2: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), null); - default: - return throwArity(2); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), - Util.ret1(arg3, arg3 = null))); - case 1: - return doInvoke(Util.ret1(arg1, arg1 = null), - ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null))); - case 2: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), - ArraySeq.create(Util.ret1(arg3, arg3 = null))); - case 3: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - null); - default: - return throwArity(3); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), - Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null))); - case 1: - return doInvoke(Util.ret1(arg1, arg1 = null), - ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - Util.ret1(arg4, arg4 = null))); - case 2: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), - ArraySeq.create(Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null))); - case 3: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - ArraySeq.create(Util.ret1(arg4, arg4 = null))); - case 4: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - Util.ret1(arg4, arg4 = null), null); - default: - return throwArity(4); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), - Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), - Util.ret1(arg5, arg5 = null))); - case 1: - return doInvoke(Util.ret1(arg1, arg1 = null), - ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null))); - case 2: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), - ArraySeq.create(Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), - Util.ret1(arg5, arg5 = null))); - case 3: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - ArraySeq.create(Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null))); - case 4: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - Util.ret1(arg4, arg4 = null), ArraySeq.create(Util.ret1(arg5, arg5 = null))); - case 5: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), null); - default: - return throwArity(5); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), - Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), - Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null))); - case 1: - return doInvoke(Util.ret1(arg1, arg1 = null), - ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), - Util.ret1(arg6, arg6 = null))); - case 2: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), - ArraySeq.create(Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), - Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null))); - case 3: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - ArraySeq.create(Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), - Util.ret1(arg6, arg6 = null))); - case 4: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - Util.ret1(arg4, arg4 = null), - ArraySeq.create(Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null))); - case 5: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), - ArraySeq.create(Util.ret1(arg6, arg6 = null))); - case 6: - return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), - Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null), - null); - default: - return throwArity(6); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) - throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, null); - default: - return throwArity(7); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, null); - default: - return throwArity(8); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, null); - default: - return throwArity(9); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9, arg10)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9, arg10)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, ArraySeq.create(arg10)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, null); - default: - return throwArity(10); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10, arg11)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9, arg10, arg11)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9, arg10, arg11)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, ArraySeq.create(arg10, arg11)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, ArraySeq.create(arg11)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, null); - default: - return throwArity(11); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9, arg10, arg11, arg12)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9, arg10, arg11, arg12)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, ArraySeq.create(arg10, arg11, arg12)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, ArraySeq.create(arg11, arg12)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, ArraySeq.create(arg12)); - case 12: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, null); - default: - return throwArity(12); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) - throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke( - ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13)); - case 2: - return doInvoke(arg1, arg2, - ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13)); - case 3: - return doInvoke(arg1, arg2, arg3, - ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, - ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, - ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, - ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, arg13)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, - ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, - ArraySeq.create(arg9, arg10, arg11, arg12, arg13)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, - ArraySeq.create(arg10, arg11, arg12, arg13)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, - ArraySeq.create(arg11, arg12, arg13)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - ArraySeq.create(arg12, arg13)); - case 12: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - ArraySeq.create(arg13)); - case 13: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, null); - default: - return throwArity(13); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) - throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14)); - case 3: - return doInvoke(arg1, arg2, arg3, - ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, - ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, - ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, - ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, - ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13, arg14)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, - ArraySeq.create(arg9, arg10, arg11, arg12, arg13, arg14)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, - ArraySeq.create(arg10, arg11, arg12, arg13, arg14)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, - ArraySeq.create(arg11, arg12, arg13, arg14)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - ArraySeq.create(arg12, arg13, arg14)); - case 12: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - ArraySeq.create(arg13, arg14)); - case 13: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, - ArraySeq.create(arg14)); - case 14: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - null); - default: - return throwArity(14); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, - ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, - ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, - ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, - ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, - ArraySeq.create(arg9, arg10, arg11, arg12, arg13, arg14, arg15)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, - ArraySeq.create(arg10, arg11, arg12, arg13, arg14, arg15)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, - ArraySeq.create(arg11, arg12, arg13, arg14, arg15)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - ArraySeq.create(arg12, arg13, arg14, arg15)); - case 12: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - ArraySeq.create(arg13, arg14, arg15)); - case 13: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, - ArraySeq.create(arg14, arg15)); - case 14: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - ArraySeq.create(arg15)); - case 15: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, null); - default: - return throwArity(15); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, - ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, - ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, - ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, - ArraySeq.create(arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, - ArraySeq.create(arg10, arg11, arg12, arg13, arg14, arg15, arg16)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, - ArraySeq.create(arg11, arg12, arg13, arg14, arg15, arg16)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - ArraySeq.create(arg12, arg13, arg14, arg15, arg16)); - case 12: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - ArraySeq.create(arg13, arg14, arg15, arg16)); - case 13: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, - ArraySeq.create(arg14, arg15, arg16)); - case 14: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - ArraySeq.create(arg15, arg16)); - case 15: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, ArraySeq.create(arg16)); - case 16: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, null); - default: - return throwArity(16); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, - ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, - ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, - ArraySeq.create(arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, - ArraySeq.create(arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, - ArraySeq.create(arg11, arg12, arg13, arg14, arg15, arg16, arg17)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - ArraySeq.create(arg12, arg13, arg14, arg15, arg16, arg17)); - case 12: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - ArraySeq.create(arg13, arg14, arg15, arg16, arg17)); - case 13: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, - ArraySeq.create(arg14, arg15, arg16, arg17)); - case 14: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - ArraySeq.create(arg15, arg16, arg17)); - case 15: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, ArraySeq.create(arg16, arg17)); - case 16: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, ArraySeq.create(arg17)); - case 17: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, null); - default: - return throwArity(17); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, - arg18)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, - ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, - ArraySeq.create(arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, - ArraySeq.create(arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, - ArraySeq.create(arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - ArraySeq.create(arg12, arg13, arg14, arg15, arg16, arg17, arg18)); - case 12: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - ArraySeq.create(arg13, arg14, arg15, arg16, arg17, arg18)); - case 13: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, - ArraySeq.create(arg14, arg15, arg16, arg17, arg18)); - case 14: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - ArraySeq.create(arg15, arg16, arg17, arg18)); - case 15: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, ArraySeq.create(arg16, arg17, arg18)); - case 16: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, ArraySeq.create(arg17, arg18)); - case 17: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, ArraySeq.create(arg18)); - case 18: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, null); - default: - return throwArity(18); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, arg19)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, arg19)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, arg19)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, arg19)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, arg19)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, - arg19)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, - arg18, arg19)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, - arg18, arg19)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, - arg17, arg18, arg19)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, - ArraySeq.create(arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, - ArraySeq.create(arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - ArraySeq.create(arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19)); - case 12: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - ArraySeq.create(arg13, arg14, arg15, arg16, arg17, arg18, arg19)); - case 13: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, - ArraySeq.create(arg14, arg15, arg16, arg17, arg18, arg19)); - case 14: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - ArraySeq.create(arg15, arg16, arg17, arg18, arg19)); - case 15: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, ArraySeq.create(arg16, arg17, arg18, arg19)); - case 16: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, ArraySeq.create(arg17, arg18, arg19)); - case 17: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, ArraySeq.create(arg18, arg19)); - case 18: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, ArraySeq.create(arg19)); - case 19: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19, null); - default: - return throwArity(19); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) - throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 1: - return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 2: - return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 3: - return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, arg19, - arg20)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, arg18, - arg19, arg20)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, - arg18, arg19, arg20)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, arg17, - arg18, arg19, arg20)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9, arg10, arg11, arg12, - arg13, arg14, arg15, arg16, - arg17, arg18, arg19, - arg20)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, ArraySeq.create(arg10, arg11, arg12, - arg13, arg14, arg15, - arg16, arg17, arg18, - arg19, arg20)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, - ArraySeq.create(arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - ArraySeq.create(arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 12: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - ArraySeq.create(arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 13: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, - ArraySeq.create(arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 14: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - ArraySeq.create(arg15, arg16, arg17, arg18, arg19, arg20)); - case 15: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, ArraySeq.create(arg16, arg17, arg18, arg19, arg20)); - case 16: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, ArraySeq.create(arg17, arg18, arg19, arg20)); - case 17: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, ArraySeq.create(arg18, arg19, arg20)); - case 18: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, ArraySeq.create(arg19, arg20)); - case 19: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19, ArraySeq.create(arg20)); - case 20: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19, arg20, null); - default: - return throwArity(20); - } - -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args) - throws Exception{ - switch(getRequiredArity()) - { - case 0: - return doInvoke(ontoArrayPrepend(args, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 1: - return doInvoke(arg1, ontoArrayPrepend(args, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 2: - return doInvoke(arg1, arg2, ontoArrayPrepend(args, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, - arg20)); - case 3: - return doInvoke(arg1, arg2, arg3, ontoArrayPrepend(args, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, - arg20)); - case 4: - return doInvoke(arg1, arg2, arg3, arg4, ontoArrayPrepend(args, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - arg12, arg13, arg14, arg15, arg16, arg17, arg18, - arg19, arg20)); - case 5: - return doInvoke(arg1, arg2, arg3, arg4, arg5, ontoArrayPrepend(args, arg6, arg7, arg8, arg9, arg10, arg11, - arg12, arg13, arg14, arg15, arg16, arg17, - arg18, arg19, arg20)); - case 6: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ontoArrayPrepend(args, arg7, arg8, arg9, arg10, arg11, - arg12, arg13, arg14, arg15, arg16, - arg17, arg18, arg19, arg20)); - case 7: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ontoArrayPrepend(args, arg8, arg9, arg10, arg11, - arg12, arg13, arg14, arg15, - arg16, arg17, arg18, arg19, - arg20)); - case 8: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ontoArrayPrepend(args, arg9, arg10, arg11, - arg12, arg13, arg14, arg15, - arg16, arg17, arg18, arg19, - arg20)); - case 9: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, ontoArrayPrepend(args, arg10, arg11, - arg12, arg13, arg14, - arg15, arg16, arg17, - arg18, arg19, - arg20)); - case 10: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, ontoArrayPrepend(args, arg11, - arg12, arg13, - arg14, arg15, - arg16, arg17, - arg18, arg19, - arg20)); - case 11: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, - ontoArrayPrepend(args, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 12: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, - ontoArrayPrepend(args, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 13: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, - ontoArrayPrepend(args, arg14, arg15, arg16, arg17, arg18, arg19, arg20)); - case 14: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - ontoArrayPrepend(args, arg15, arg16, arg17, arg18, arg19, arg20)); - case 15: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, ontoArrayPrepend(args, arg16, arg17, arg18, arg19, arg20)); - case 16: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, ontoArrayPrepend(args, arg17, arg18, arg19, arg20)); - case 17: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, ontoArrayPrepend(args, arg18, arg19, arg20)); - case 18: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, ontoArrayPrepend(args, arg19, arg20)); - case 19: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19, ontoArrayPrepend(args, arg20)); - case 20: - return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, - arg15, arg16, arg17, arg18, arg19, arg20, ArraySeq.create(args)); - default: - return throwArity(21); - } - -} - - -protected static ISeq ontoArrayPrepend(Object[] array, Object... args){ - ISeq ret = ArraySeq.create(array); - for(int i = args.length - 1; i >= 0; --i) - ret = RT.cons(args[i], ret); - return ret; -} - -protected static ISeq findKey(Object key, ISeq args){ - while(args != null) - { - if(key == args.first()) - return args.next(); - args = RT.next(args); - args = RT.next(args); - } - return null; -} - - -} - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Reversible.java --- a/src/clojure/lang/Reversible.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jan 5, 2008 */ - -package clojure.lang; - -public interface Reversible{ -ISeq rseq() throws Exception; -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Script.java --- a/src/clojure/lang/Script.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Oct 18, 2007 */ - -package clojure.lang; - -import clojure.main; - -public class Script { - -public static void main(String[] args) throws Exception{ - main.legacy_script(args); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/SeqEnumeration.java --- a/src/clojure/lang/SeqEnumeration.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 3, 2008 */ - -package clojure.lang; - -import java.util.Enumeration; - -public class SeqEnumeration implements Enumeration{ -ISeq seq; - -public SeqEnumeration(ISeq seq){ - this.seq = seq; -} - -public boolean hasMoreElements(){ - return seq != null; -} - -public Object nextElement(){ - Object ret = RT.first(seq); - seq = RT.next(seq); - return ret; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/SeqIterator.java --- a/src/clojure/lang/SeqIterator.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,41 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jun 19, 2007 */ - -package clojure.lang; - -import java.util.Iterator; -import java.util.NoSuchElementException; - -public class SeqIterator implements Iterator{ - -ISeq seq; - -public SeqIterator(ISeq seq){ - this.seq = seq; -} - -public boolean hasNext(){ - return seq != null; -} - -public Object next() throws NoSuchElementException { - if(seq == null) - throw new NoSuchElementException(); - Object ret = RT.first(seq); - seq = RT.next(seq); - return ret; -} - -public void remove(){ -throw new UnsupportedOperationException(); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Seqable.java --- a/src/clojure/lang/Seqable.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jan 28, 2009 */ - -package clojure.lang; - -public interface Seqable { - ISeq seq(); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Sequential.java --- a/src/clojure/lang/Sequential.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -package clojure.lang; - -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - */ -public interface Sequential { -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Settable.java --- a/src/clojure/lang/Settable.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Dec 31, 2008 */ - -package clojure.lang; - -public interface Settable { - Object doSet(Object val) throws Exception; - Object doReset(Object val) throws Exception; -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Sorted.java --- a/src/clojure/lang/Sorted.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,25 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Apr 15, 2008 */ - -package clojure.lang; - -import java.util.Comparator; - -public interface Sorted{ -Comparator comparator(); - -Object entryKey(Object entry); - -ISeq seq(boolean ascending); - -ISeq seqFrom(Object key, boolean ascending); -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/StringSeq.java --- a/src/clojure/lang/StringSeq.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Dec 6, 2007 */ - -package clojure.lang; - -public class StringSeq extends ASeq implements IndexedSeq{ -public final CharSequence s; -public final int i; - -static public StringSeq create(CharSequence s){ - if(s.length() == 0) - return null; - return new StringSeq(null, s, 0); -} - -StringSeq(IPersistentMap meta, CharSequence s, int i){ - super(meta); - this.s = s; - this.i = i; -} - -public Obj withMeta(IPersistentMap meta){ - if(meta == meta()) - return this; - return new StringSeq(meta, s, i); -} - -public Object first(){ - return Character.valueOf(s.charAt(i)); -} - -public ISeq next(){ - if(i + 1 < s.length()) - return new StringSeq(_meta, s, i + 1); - return null; -} - -public int index(){ - return i; -} - -public int count(){ - return s.length() - i; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Symbol.java --- a/src/clojure/lang/Symbol.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,126 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Mar 25, 2006 11:42:47 AM */ - -package clojure.lang; - -import java.io.Serializable; -import java.io.ObjectStreamException; - - -public class Symbol extends AFn implements IObj, Comparable, Named, Serializable{ -//these must be interned strings! -final String ns; -final String name; -final int hash; -final IPersistentMap _meta; - -public String toString(){ - if(ns != null) - return ns + "/" + name; - return name; -} - -public String getNamespace(){ - return ns; -} - -public String getName(){ - return name; -} - -static public Symbol intern(String ns, String name){ - return new Symbol(ns == null ? null : ns.intern(), name.intern()); -} - -static public Symbol intern(String nsname){ - int i = nsname.lastIndexOf('/'); - if(i == -1 || nsname.equals("/")) - return new Symbol(null, nsname.intern()); - else - return new Symbol(nsname.substring(0, i).intern(), nsname.substring(i + 1).intern()); -} - -static public Symbol create(String name_interned){ - return new Symbol(null, name_interned); -} - -static public Symbol create(String ns_interned, String name_interned){ - return new Symbol(ns_interned, name_interned); -} - -private Symbol(String ns_interned, String name_interned){ - this.name = name_interned; - this.ns = ns_interned; - this.hash = Util.hashCombine(name.hashCode(), Util.hash(ns)); - this._meta = null; -} - -public boolean equals(Object o){ - if(this == o) - return true; - if(!(o instanceof Symbol)) - return false; - - Symbol symbol = (Symbol) o; - - //identity compares intended, names are interned - return name == symbol.name && ns == symbol.ns; -} - -public int hashCode(){ - return hash; -} - -public IObj withMeta(IPersistentMap meta){ - return new Symbol(meta, ns, name); -} - -private Symbol(IPersistentMap meta, String ns, String name){ - this.name = name; - this.ns = ns; - this._meta = meta; - this.hash = Util.hashCombine(name.hashCode(), Util.hash(ns)); -} - -public int compareTo(Object o){ - Symbol s = (Symbol) o; - if(this.equals(o)) - return 0; - if(this.ns == null && s.ns != null) - return -1; - if(this.ns != null) - { - if(s.ns == null) - return 1; - int nsc = this.ns.compareTo(s.ns); - if(nsc != 0) - return nsc; - } - return this.name.compareTo(s.name); -} - -private Object readResolve() throws ObjectStreamException{ - return intern(ns, name); -} - -public Object invoke(Object obj) throws Exception{ - return RT.get(obj, this); -} - -public Object invoke(Object obj, Object notFound) throws Exception{ - return RT.get(obj, this, notFound); -} - -public IPersistentMap meta(){ - return _meta; -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/TransactionalHashMap.java --- a/src/clojure/lang/TransactionalHashMap.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,197 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jul 31, 2008 */ - -package clojure.lang; - -import java.util.concurrent.ConcurrentMap; -import java.util.*; - -public class TransactionalHashMap extends AbstractMap implements ConcurrentMap{ -final Ref[] bins; - -IPersistentMap mapAt(int bin){ - return (IPersistentMap) bins[bin].deref(); -} - -final int binFor(Object k){ - //spread hashes, a la Cliff Click - int h = k.hashCode(); - h ^= (h >>> 20) ^ (h >>> 12); - h ^= (h >>> 7) ^ (h >>> 4); - return h % bins.length; -// return k.hashCode() % bins.length; -} - -Entry entryAt(Object k){ - return mapAt(binFor(k)).entryAt(k); -} - -public TransactionalHashMap() throws Exception{ - this(421); -} - -public TransactionalHashMap(int nBins) throws Exception{ - bins = new Ref[nBins]; - for(int i = 0; i < nBins; i++) - bins[i] = new Ref(PersistentHashMap.EMPTY); -} - -public TransactionalHashMap(Map m) throws Exception{ - this(m.size()); - putAll(m); -} - -public int size(){ - int n = 0; - for(int i = 0; i < bins.length; i++) - { - n += mapAt(i).count(); - } - return n; -} - -public boolean isEmpty(){ - return size() == 0; -} - -public boolean containsKey(Object k){ - return entryAt(k) != null; -} - -public V get(Object k){ - Entry e = entryAt(k); - if(e != null) - return (V) e.getValue(); - return null; -} - -public V put(K k, V v){ - Ref r = bins[binFor(k)]; - IPersistentMap map = (IPersistentMap) r.deref(); - Object ret = map.valAt(k); - r.set(map.assoc(k, v)); - return (V) ret; -} - -public V remove(Object k){ - Ref r = bins[binFor(k)]; - IPersistentMap map = (IPersistentMap) r.deref(); - Object ret = map.valAt(k); - //checked exceptions are a bad idea, especially in an interface - try - { - r.set(map.without(k)); - } - catch(Exception e) - { - throw new RuntimeException(e); - } - return (V) ret; -} - -public void putAll(Map map){ - for(Iterator i = map.entrySet().iterator(); i.hasNext();) - { - Entry e = (Entry) i.next(); - put(e.getKey(), e.getValue()); - } -} - -public void clear(){ - for(int i = 0; i < bins.length; i++) - { - Ref r = bins[i]; - IPersistentMap map = (IPersistentMap) r.deref(); - if(map.count() > 0) - { - r.set(PersistentHashMap.EMPTY); - } - } -} - -public Set> entrySet(){ - final ArrayList> entries = new ArrayList(bins.length); - for(int i = 0; i < bins.length; i++) - { - IPersistentMap map = mapAt(i); - if(map.count() > 0) - entries.addAll((Collection) RT.seq(map)); - } - return new AbstractSet>(){ - public Iterator iterator(){ - return Collections.unmodifiableList(entries).iterator(); - } - - public int size(){ - return entries.size(); - } - }; -} - -public V putIfAbsent(K k, V v){ - Ref r = bins[binFor(k)]; - IPersistentMap map = (IPersistentMap) r.deref(); - Entry e = map.entryAt(k); - if(e == null) - { - r.set(map.assoc(k, v)); - return null; - } - else - return (V) e.getValue(); -} - -public boolean remove(Object k, Object v){ - Ref r = bins[binFor(k)]; - IPersistentMap map = (IPersistentMap) r.deref(); - Entry e = map.entryAt(k); - if(e != null && e.getValue().equals(v)) - { - //checked exceptions are a bad idea, especially in an interface - try - { - r.set(map.without(k)); - } - catch(Exception ex) - { - throw new RuntimeException(ex); - } - return true; - } - return false; -} - -public boolean replace(K k, V oldv, V newv){ - Ref r = bins[binFor(k)]; - IPersistentMap map = (IPersistentMap) r.deref(); - Entry e = map.entryAt(k); - if(e != null && e.getValue().equals(oldv)) - { - r.set(map.assoc(k, newv)); - return true; - } - return false; -} - -public V replace(K k, V v){ - Ref r = bins[binFor(k)]; - IPersistentMap map = (IPersistentMap) r.deref(); - Entry e = map.entryAt(k); - if(e != null) - { - r.set(map.assoc(k, v)); - return (V) e.getValue(); - } - return null; -} - -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Util.java --- a/src/clojure/lang/Util.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,116 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Apr 19, 2008 */ - -package clojure.lang; - -import java.math.BigInteger; -import java.util.Map; -import java.util.concurrent.ConcurrentHashMap; -import java.lang.ref.SoftReference; -import java.lang.ref.ReferenceQueue; -import java.lang.ref.Reference; - -public class Util{ -static public boolean equiv(Object k1, Object k2){ - if(k1 == k2) - return true; - if(k1 != null) - { - if(k1 instanceof Number && k2 instanceof Number) - return Numbers.equiv(k1, k2); - else if(k1 instanceof IPersistentCollection || k2 instanceof IPersistentCollection) - return pcequiv(k1,k2); - return k1.equals(k2); - } - return false; -} - -static public boolean pcequiv(Object k1, Object k2){ - if(k1 instanceof IPersistentCollection) - return ((IPersistentCollection)k1).equiv(k2); - return ((IPersistentCollection)k2).equiv(k1); -} - -static public boolean equals(Object k1, Object k2){ - if(k1 == k2) - return true; - return k1 != null && k1.equals(k2); -} - -static public boolean identical(Object k1, Object k2){ - return k1 == k2; -} - -static public Class classOf(Object x){ - if(x != null) - return x.getClass(); - return null; -} - -static public int compare(Object k1, Object k2){ - if(k1 == k2) - return 0; - if(k1 != null) - { - if(k2 == null) - return 1; - if(k1 instanceof Number) - return Numbers.compare((Number) k1, (Number) k2); - return ((Comparable) k1).compareTo(k2); - } - return -1; -} - -static public int hash(Object o){ - if(o == null) - return 0; - return o.hashCode(); -} - -static public int hashCombine(int seed, int hash){ - //a la boost - seed ^= hash + 0x9e3779b9 + (seed << 6) + (seed >> 2); - return seed; -} - -static public boolean isPrimitive(Class c){ - return c != null && c.isPrimitive() && !(c == Void.TYPE); -} - -static public boolean isInteger(Object x){ - return x instanceof Integer - || x instanceof Long - || x instanceof BigInteger; -} - -static public Object ret1(Object ret, Object nil){ - return ret; -} - -static public ISeq ret1(ISeq ret, Object nil){ - return ret; -} - -static public void clearCache(ReferenceQueue rq, ConcurrentHashMap> cache){ - //cleanup any dead entries - if(rq.poll() != null) - { - while(rq.poll() != null) - ; - for(Map.Entry> e : cache.entrySet()) - { - if(e.getValue().get() == null) - cache.remove(e.getKey(), e.getValue()); - } - } -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/Var.java --- a/src/clojure/lang/Var.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,497 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Jul 31, 2007 */ - -package clojure.lang; - -import java.util.concurrent.atomic.AtomicInteger; - - -public final class Var extends ARef implements IFn, IRef, Settable{ - - -static class Frame{ - //Var->Box - Associative bindings; - //Var->val - Associative frameBindings; - Frame prev; - - - public Frame(){ - this(PersistentHashMap.EMPTY, PersistentHashMap.EMPTY, null); - } - - public Frame(Associative frameBindings, Associative bindings, Frame prev){ - this.frameBindings = frameBindings; - this.bindings = bindings; - this.prev = prev; - } -} - -static ThreadLocal dvals = new ThreadLocal(){ - - protected Frame initialValue(){ - return new Frame(); - } -}; - -static Keyword privateKey = Keyword.intern(null, "private"); -static IPersistentMap privateMeta = new PersistentArrayMap(new Object[]{privateKey, Boolean.TRUE}); -static Keyword macroKey = Keyword.intern(null, "macro"); -static Keyword nameKey = Keyword.intern(null, "name"); -static Keyword nsKey = Keyword.intern(null, "ns"); -//static Keyword tagKey = Keyword.intern(null, "tag"); - -volatile Object root; -transient final AtomicInteger count; -public final Symbol sym; -public final Namespace ns; - -//IPersistentMap _meta; - -public static Var intern(Namespace ns, Symbol sym, Object root){ - return intern(ns, sym, root, true); -} - -public static Var intern(Namespace ns, Symbol sym, Object root, boolean replaceRoot){ - Var dvout = ns.intern(sym); - if(!dvout.hasRoot() || replaceRoot) - dvout.bindRoot(root); - return dvout; -} - - -public String toString(){ - if(ns != null) - return "#'" + ns.name + "/" + sym; - return "#"; -} - -public static Var find(Symbol nsQualifiedSym){ - if(nsQualifiedSym.ns == null) - throw new IllegalArgumentException("Symbol must be namespace-qualified"); - Namespace ns = Namespace.find(Symbol.create(nsQualifiedSym.ns)); - if(ns == null) - throw new IllegalArgumentException("No such namespace: " + nsQualifiedSym.ns); - return ns.findInternedVar(Symbol.create(nsQualifiedSym.name)); -} - -public static Var intern(Symbol nsName, Symbol sym){ - Namespace ns = Namespace.findOrCreate(nsName); - return intern(ns, sym); -} - -public static Var internPrivate(String nsName, String sym){ - Namespace ns = Namespace.findOrCreate(Symbol.intern(nsName)); - Var ret = intern(ns, Symbol.intern(sym)); - ret.setMeta(privateMeta); - return ret; -} - -public static Var intern(Namespace ns, Symbol sym){ - return ns.intern(sym); -} - - -public static Var create(){ - return new Var(null, null); -} - -public static Var create(Object root){ - return new Var(null, null, root); -} - -Var(Namespace ns, Symbol sym){ - this.ns = ns; - this.sym = sym; - this.count = new AtomicInteger(); - this.root = dvals; //use dvals as magic not-bound value - setMeta(PersistentHashMap.EMPTY); -} - -Var(Namespace ns, Symbol sym, Object root){ - this(ns, sym); - this.root = root; -} - -public boolean isBound(){ - return hasRoot() || (count.get() > 0 && dvals.get().bindings.containsKey(this)); -} - -final public Object get(){ - if(count.get() == 0 && root != dvals) - return root; - return deref(); -} - -final public Object deref(){ - Box b = getThreadBinding(); - if(b != null) - return b.val; - if(hasRoot()) - return root; - throw new IllegalStateException(String.format("Var %s/%s is unbound.", ns, sym)); -} - -public void setValidator(IFn vf){ - if(hasRoot()) - validate(vf, getRoot()); - validator = vf; -} - -public Object alter(IFn fn, ISeq args) throws Exception{ - set(fn.applyTo(RT.cons(deref(), args))); - return this; -} - -public Object set(Object val){ - validate(getValidator(), val); - Box b = getThreadBinding(); - if(b != null) - return (b.val = val); - //jury still out on this -// if(hasRoot()) -// { -// bindRoot(val); -// return val; -// } - throw new IllegalStateException(String.format("Can't change/establish root binding of: %s with set", sym)); -} - -public Object doSet(Object val) throws Exception { - return set(val); - } - -public Object doReset(Object val) throws Exception { - bindRoot(val); - return val; - } - -public void setMeta(IPersistentMap m) { - //ensure these basis keys - resetMeta(m.assoc(nameKey, sym).assoc(nsKey, ns)); -} - -public void setMacro() { - try - { - alterMeta(assoc, RT.list(macroKey, RT.T)); - } - catch (Exception e) - { - throw new RuntimeException(e); - } -} - -public boolean isMacro(){ - return RT.booleanCast(meta().valAt(macroKey)); -} - -//public void setExported(boolean state){ -// _meta = _meta.assoc(privateKey, state); -//} - -public boolean isPublic(){ - return !RT.booleanCast(meta().valAt(privateKey)); -} - -public Object getRoot(){ - if(hasRoot()) - return root; - throw new IllegalStateException(String.format("Var %s/%s is unbound.", ns, sym)); -} - -public Object getRawRoot(){ - return root; -} - -public Object getTag(){ - return meta().valAt(RT.TAG_KEY); -} - -public void setTag(Symbol tag) { - try - { - alterMeta(assoc, RT.list(RT.TAG_KEY, tag)); - } - catch (Exception e) - { - throw new RuntimeException(e); - } -} - -final public boolean hasRoot(){ - return root != dvals; -} - -//binding root always clears macro flag -synchronized public void bindRoot(Object root){ - validate(getValidator(), root); - Object oldroot = hasRoot()?this.root:null; - this.root = root; - try - { - alterMeta(dissoc, RT.list(macroKey)); - } - catch (Exception e) - { - throw new RuntimeException(e); - } - notifyWatches(oldroot,this.root); -} - -synchronized void swapRoot(Object root){ - validate(getValidator(), root); - Object oldroot = hasRoot()?this.root:null; - this.root = root; - notifyWatches(oldroot,root); -} - -synchronized public void unbindRoot(){ - this.root = dvals; -} - -synchronized public void commuteRoot(IFn fn) throws Exception{ - Object newRoot = fn.invoke(root); - validate(getValidator(), newRoot); - Object oldroot = getRoot(); - this.root = newRoot; - notifyWatches(oldroot,newRoot); -} - -synchronized public Object alterRoot(IFn fn, ISeq args) throws Exception{ - Object newRoot = fn.applyTo(RT.cons(root, args)); - validate(getValidator(), newRoot); - Object oldroot = getRoot(); - this.root = newRoot; - notifyWatches(oldroot,newRoot); - return newRoot; -} - -public static void pushThreadBindings(Associative bindings){ - Frame f = dvals.get(); - Associative bmap = f.bindings; - for(ISeq bs = bindings.seq(); bs != null; bs = bs.next()) - { - IMapEntry e = (IMapEntry) bs.first(); - Var v = (Var) e.key(); - v.validate(v.getValidator(), e.val()); - v.count.incrementAndGet(); - bmap = bmap.assoc(v, new Box(e.val())); - } - dvals.set(new Frame(bindings, bmap, f)); -} - -public static void popThreadBindings(){ - Frame f = dvals.get(); - if(f.prev == null) - throw new IllegalStateException("Pop without matching push"); - for(ISeq bs = RT.keys(f.frameBindings); bs != null; bs = bs.next()) - { - Var v = (Var) bs.first(); - v.count.decrementAndGet(); - } - dvals.set(f.prev); -} - -public static void releaseThreadBindings(){ - Frame f = dvals.get(); - if(f.prev == null) - throw new IllegalStateException("Release without full unwind"); - for(ISeq bs = RT.keys(f.bindings); bs != null; bs = bs.next()) - { - Var v = (Var) bs.first(); - v.count.decrementAndGet(); - } - dvals.set(null); -} - -public static Associative getThreadBindings(){ - Frame f = dvals.get(); - IPersistentMap ret = PersistentHashMap.EMPTY; - for(ISeq bs = f.bindings.seq(); bs != null; bs = bs.next()) - { - IMapEntry e = (IMapEntry) bs.first(); - Var v = (Var) e.key(); - Box b = (Box) e.val(); - ret = ret.assoc(v, b.val); - } - return ret; -} - -public final Box getThreadBinding(){ - if(count.get() > 0) - { - IMapEntry e = dvals.get().bindings.entryAt(this); - if(e != null) - return (Box) e.val(); - } - return null; -} - -final public IFn fn(){ - return (IFn) deref(); -} - -public Object call() throws Exception{ - return invoke(); -} - -public void run(){ - try - { - invoke(); - } - catch(Exception e) - { - throw new RuntimeException(e); - } -} - -public Object invoke() throws Exception{ - return fn().invoke(); -} - -public Object invoke(Object arg1) throws Exception{ - return fn().invoke(arg1); -} - -public Object invoke(Object arg1, Object arg2) throws Exception{ - return fn().invoke(arg1, arg2); -} - -public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ - return fn().invoke(arg1, arg2, arg3); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) - throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) - throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) - throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16, arg17); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16, arg17, arg18); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16, arg17, arg18, arg19); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) - throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16, arg17, arg18, arg19, arg20); -} - -public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, - Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, - Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, - Object... args) - throws Exception{ - return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, - arg16, arg17, arg18, arg19, arg20, args); -} - -public Object applyTo(ISeq arglist) throws Exception{ - return AFn.applyToHelper(this, arglist); -} - -static IFn assoc = new AFn(){ - @Override - public Object invoke(Object m, Object k, Object v) throws Exception { - return RT.assoc(m, k, v); - } -}; -static IFn dissoc = new AFn() { - @Override - public Object invoke(Object c, Object k) throws Exception { - return RT.dissoc(c, k); - } -}; -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/lang/XMLHandler.java --- a/src/clojure/lang/XMLHandler.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,89 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -/* rich Dec 17, 2007 */ - -package clojure.lang; - -import org.xml.sax.Attributes; -import org.xml.sax.ContentHandler; -import org.xml.sax.Locator; -import org.xml.sax.SAXException; -import org.xml.sax.helpers.DefaultHandler; - -public class XMLHandler extends DefaultHandler{ -ContentHandler h; - - -public XMLHandler(ContentHandler h){ - this.h = h; -} - -public void setDocumentLocator(Locator locator){ - h.setDocumentLocator(locator); -} - -public void startDocument() throws SAXException{ - h.startDocument(); -} - -public void endDocument() throws SAXException{ - h.endDocument(); -} - -public void startPrefixMapping(String prefix, String uri) throws SAXException{ - h.startPrefixMapping(prefix, uri); -} - -public void endPrefixMapping(String prefix) throws SAXException{ - h.endPrefixMapping(prefix); -} - -public void startElement(String uri, String localName, String qName, Attributes atts) throws SAXException{ - h.startElement(uri, localName, qName, atts); -} - -public void endElement(String uri, String localName, String qName) throws SAXException{ - h.endElement(uri, localName, qName); -} - -public void characters(char ch[], int start, int length) throws SAXException{ - h.characters(ch, start, length); -} - -public void ignorableWhitespace(char ch[], int start, int length) throws SAXException{ - h.ignorableWhitespace(ch, start, length); -} - -public void processingInstruction(String target, String data) throws SAXException{ - h.processingInstruction(target, data); -} - -public void skippedEntity(String name) throws SAXException{ - h.skippedEntity(name); -} - -/* -public static void main(String[] args){ - try - { - ContentHandler dummy = new DefaultHandler(); - SAXParserFactory f = SAXParserFactory.newInstance(); - //f.setNamespaceAware(true); - SAXParser p = f.newSAXParser(); - p.parse("http://arstechnica.com/journals.rssx",new XMLHandler(dummy)); - } - catch(Exception e) - { - e.printStackTrace(); - } -} -//*/ -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/main.clj --- a/src/clojure/main.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,358 +0,0 @@ -;; Copyright (c) Rich Hickey All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be found -;; in the file epl-v10.html at the root of this distribution. By using this -;; software in any fashion, you are agreeing to be bound by the terms of -;; this license. You must not remove this notice, or any other, from this -;; software. - -;; Originally contributed by Stephen C. Gilardi - -(ns ^{:doc "Top-level main function for Clojure REPL and scripts." - :author "Stephen C. Gilardi and Rich Hickey"} - clojure.main - (:refer-clojure :exclude [with-bindings]) - (:import (clojure.lang Compiler Compiler$CompilerException - LineNumberingPushbackReader RT))) - -(declare main) - -(defmacro with-bindings - "Executes body in the context of thread-local bindings for several vars - that often need to be set!: *ns* *warn-on-reflection* *math-context* - *print-meta* *print-length* *print-level* *compile-path* - *command-line-args* *1 *2 *3 *e" - [& body] - `(binding [*ns* *ns* - *warn-on-reflection* *warn-on-reflection* - *math-context* *math-context* - *print-meta* *print-meta* - *print-length* *print-length* - *print-level* *print-level* - *compile-path* (System/getProperty "clojure.compile.path" "classes") - *command-line-args* *command-line-args* - *assert* *assert* - *1 nil - *2 nil - *3 nil - *e nil] - ~@body)) - -(defn repl-prompt - "Default :prompt hook for repl" - [] - (printf "%s=> " (ns-name *ns*))) - -(defn skip-if-eol - "If the next character on stream s is a newline, skips it, otherwise - leaves the stream untouched. Returns :line-start, :stream-end, or :body - to indicate the relative location of the next character on s. The stream - must either be an instance of LineNumberingPushbackReader or duplicate - its behavior of both supporting .unread and collapsing all of CR, LF, and - CRLF to a single \\newline." - [s] - (let [c (.read s)] - (cond - (= c (int \newline)) :line-start - (= c -1) :stream-end - :else (do (.unread s c) :body)))) - -(defn skip-whitespace - "Skips whitespace characters on stream s. Returns :line-start, :stream-end, - or :body to indicate the relative location of the next character on s. - Interprets comma as whitespace and semicolon as comment to end of line. - Does not interpret #! as comment to end of line because only one - character of lookahead is available. The stream must either be an - instance of LineNumberingPushbackReader or duplicate its behavior of both - supporting .unread and collapsing all of CR, LF, and CRLF to a single - \\newline." - [s] - (loop [c (.read s)] - (cond - (= c (int \newline)) :line-start - (= c -1) :stream-end - (= c (int \;)) (do (.readLine s) :line-start) - (or (Character/isWhitespace c) (= c (int \,))) (recur (.read s)) - :else (do (.unread s c) :body)))) - -(defn repl-read - "Default :read hook for repl. Reads from *in* which must either be an - instance of LineNumberingPushbackReader or duplicate its behavior of both - supporting .unread and collapsing all of CR, LF, and CRLF into a single - \\newline. repl-read: - - skips whitespace, then - - returns request-prompt on start of line, or - - returns request-exit on end of stream, or - - reads an object from the input stream, then - - skips the next input character if it's end of line, then - - returns the object." - [request-prompt request-exit] - (or ({:line-start request-prompt :stream-end request-exit} - (skip-whitespace *in*)) - (let [input (read)] - (skip-if-eol *in*) - input))) - -(defn- root-cause - "Returns the initial cause of an exception or error by peeling off all of - its wrappers" - [^Throwable throwable] - (loop [cause throwable] - (if-let [cause (.getCause cause)] - (recur cause) - cause))) - -(defn repl-exception - "Returns CompilerExceptions in tact, but only the root cause of other - throwables" - [throwable] - (if (instance? Compiler$CompilerException throwable) - throwable - (root-cause throwable))) - -(defn repl-caught - "Default :caught hook for repl" - [e] - (.println *err* (repl-exception e))) - -(defn repl - "Generic, reusable, read-eval-print loop. By default, reads from *in*, - writes to *out*, and prints exception summaries to *err*. If you use the - default :read hook, *in* must either be an instance of - LineNumberingPushbackReader or duplicate its behavior of both supporting - .unread and collapsing CR, LF, and CRLF into a single \\newline. Options - are sequential keyword-value pairs. Available options and their defaults: - - - :init, function of no arguments, initialization hook called with - bindings for set!-able vars in place. - default: #() - - - :need-prompt, function of no arguments, called before each - read-eval-print except the first, the user will be prompted if it - returns true. - default: (if (instance? LineNumberingPushbackReader *in*) - #(.atLineStart *in*) - #(identity true)) - - - :prompt, function of no arguments, prompts for more input. - default: repl-prompt - - - :flush, function of no arguments, flushes output - default: flush - - - :read, function of two arguments, reads from *in*: - - returns its first argument to request a fresh prompt - - depending on need-prompt, this may cause the repl to prompt - before reading again - - returns its second argument to request an exit from the repl - - else returns the next object read from the input stream - default: repl-read - - - :eval, funtion of one argument, returns the evaluation of its - argument - default: eval - - - :print, function of one argument, prints its argument to the output - default: prn - - - :caught, function of one argument, a throwable, called when - read, eval, or print throws an exception or error - default: repl-caught" - [& options] - (let [cl (.getContextClassLoader (Thread/currentThread))] - (.setContextClassLoader (Thread/currentThread) (clojure.lang.DynamicClassLoader. cl))) - (let [{:keys [init need-prompt prompt flush read eval print caught] - :or {init #() - need-prompt (if (instance? LineNumberingPushbackReader *in*) - #(.atLineStart ^LineNumberingPushbackReader *in*) - #(identity true)) - prompt repl-prompt - flush flush - read repl-read - eval eval - print prn - caught repl-caught}} - (apply hash-map options) - request-prompt (Object.) - request-exit (Object.) - read-eval-print - (fn [] - (try - (let [input (read request-prompt request-exit)] - (or (#{request-prompt request-exit} input) - (let [value (eval input)] - (print value) - (set! *3 *2) - (set! *2 *1) - (set! *1 value)))) - (catch Throwable e - (caught e) - (set! *e e))))] - (with-bindings - (try - (init) - (catch Throwable e - (caught e) - (set! *e e))) - (use '[clojure.repl :only (source apropos dir)]) - (use '[clojure.java.javadoc :only (javadoc)]) - (use '[clojure.pprint :only (pp pprint)]) - (prompt) - (flush) - (loop [] - (when-not - (try (= (read-eval-print) request-exit) - (catch Throwable e - (caught e) - (set! *e e) - nil)) - (when (need-prompt) - (prompt) - (flush)) - (recur)))))) - -(defn load-script - "Loads Clojure source from a file or resource given its path. Paths - beginning with @ or @/ are considered relative to classpath." - [^String path] - (if (.startsWith path "@") - (RT/loadResourceScript - (.substring path (if (.startsWith path "@/") 2 1))) - (Compiler/loadFile path))) - -(defn- init-opt - "Load a script" - [path] - (load-script path)) - -(defn- eval-opt - "Evals expressions in str, prints each non-nil result using prn" - [str] - (let [eof (Object.) - reader (LineNumberingPushbackReader. (java.io.StringReader. str))] - (loop [input (read reader false eof)] - (when-not (= input eof) - (let [value (eval input)] - (when-not (nil? value) - (prn value)) - (recur (read reader false eof))))))) - -(defn- init-dispatch - "Returns the handler associated with an init opt" - [opt] - ({"-i" init-opt - "--init" init-opt - "-e" eval-opt - "--eval" eval-opt} opt)) - -(defn- initialize - "Common initialize routine for repl, script, and null opts" - [args inits] - (in-ns 'user) - (set! *command-line-args* args) - (doseq [[opt arg] inits] - ((init-dispatch opt) arg))) - -(defn- repl-opt - "Start a repl with args and inits. Print greeting if no eval options were - present" - [[_ & args] inits] - (when-not (some #(= eval-opt (init-dispatch (first %))) inits) - (println "Clojure" (clojure-version))) - (repl :init #(initialize args inits)) - (prn) - (System/exit 0)) - -(defn- script-opt - "Run a script from a file, resource, or standard in with args and inits" - [[path & args] inits] - (with-bindings - (initialize args inits) - (if (= path "-") - (load-reader *in*) - (load-script path)))) - -(defn- null-opt - "No repl or script opt present, just bind args and run inits" - [args inits] - (with-bindings - (initialize args inits))) - -(defn- help-opt - "Print help text for main" - [_ _] - (println (:doc (meta (var main))))) - -(defn- main-dispatch - "Returns the handler associated with a main option" - [opt] - (or - ({"-r" repl-opt - "--repl" repl-opt - nil null-opt - "-h" help-opt - "--help" help-opt - "-?" help-opt} opt) - script-opt)) - -(defn- legacy-repl - "Called by the clojure.lang.Repl.main stub to run a repl with args - specified the old way" - [args] - (println "WARNING: clojure.lang.Repl is deprecated. -Instead, use clojure.main like this: -java -cp clojure.jar clojure.main -i init.clj -r args...") - (let [[inits [sep & args]] (split-with (complement #{"--"}) args)] - (repl-opt (concat ["-r"] args) (map vector (repeat "-i") inits)))) - -(defn- legacy-script - "Called by the clojure.lang.Script.main stub to run a script with args - specified the old way" - [args] - (println "WARNING: clojure.lang.Script is deprecated. -Instead, use clojure.main like this: -java -cp clojure.jar clojure.main -i init.clj script.clj args...") - (let [[inits [sep & args]] (split-with (complement #{"--"}) args)] - (null-opt args (map vector (repeat "-i") inits)))) - -(defn main - "Usage: java -cp clojure.jar clojure.main [init-opt*] [main-opt] [arg*] - - With no options or args, runs an interactive Read-Eval-Print Loop - - init options: - -i, --init path Load a file or resource - -e, --eval string Evaluate expressions in string; print non-nil values - - main options: - -r, --repl Run a repl - path Run a script from from a file or resource - - Run a script from standard input - -h, -?, --help Print this help message and exit - - operation: - - - Establishes thread-local bindings for commonly set!-able vars - - Enters the user namespace - - Binds *command-line-args* to a seq of strings containing command line - args that appear after any main option - - Runs all init options in order - - Runs a repl or script if requested - - The init options may be repeated and mixed freely, but must appear before - any main option. The appearance of any eval option before running a repl - suppresses the usual repl greeting message: \"Clojure ~(clojure-version)\". - - Paths may be absolute or relative in the filesystem or relative to - classpath. Classpath-relative paths have prefix of @ or @/" - [& args] - (try - (if args - (loop [[opt arg & more :as args] args inits []] - (if (init-dispatch opt) - (recur more (conj inits [opt arg])) - ((main-dispatch opt) args inits))) - (repl-opt nil nil)) - (finally - (flush)))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/main.java --- a/src/clojure/main.java Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/** - * Copyright (c) Rich Hickey. All rights reserved. - * The use and distribution terms for this software are covered by the - * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) - * which can be found in the file epl-v10.html at the root of this distribution. - * By using this software in any fashion, you are agreeing to be bound by - * the terms of this license. - * You must not remove this notice, or any other, from this software. - **/ - -package clojure; - -import clojure.lang.Symbol; -import clojure.lang.Var; -import clojure.lang.RT; - -public class main{ - -final static private Symbol CLOJURE_MAIN = Symbol.intern("clojure.main"); -final static private Var REQUIRE = RT.var("clojure.core", "require"); -final static private Var LEGACY_REPL = RT.var("clojure.main", "legacy-repl"); -final static private Var LEGACY_SCRIPT = RT.var("clojure.main", "legacy-script"); -final static private Var MAIN = RT.var("clojure.main", "main"); - -public static void legacy_repl(String[] args) throws Exception{ - REQUIRE.invoke(CLOJURE_MAIN); - LEGACY_REPL.invoke(RT.seq(args)); -} - -public static void legacy_script(String[] args) throws Exception{ - REQUIRE.invoke(CLOJURE_MAIN); - LEGACY_SCRIPT.invoke(RT.seq(args)); -} - -public static void main(String[] args) throws Exception{ - REQUIRE.invoke(CLOJURE_MAIN); - MAIN.applyTo(RT.seq(args)); -} -} diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/parallel.clj --- a/src/clojure/parallel.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,250 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns ^{:doc "DEPRECATED Wrapper of the ForkJoin library (JSR-166)." - :author "Rich Hickey"} - clojure.parallel) -(alias 'parallel 'clojure.parallel) - -(comment " -The parallel library wraps the ForkJoin library scheduled for inclusion in JDK 7: - -http://gee.cs.oswego.edu/dl/concurrency-interest/index.html - -You'll need jsr166y.jar in your classpath in order to use this -library. The basic idea is that Clojure collections, and most -efficiently vectors, can be turned into parallel arrays for use by -this library with the function par, although most of the functions -take collections and will call par if needed, so normally you will -only need to call par explicitly in order to attach bound/filter/map -ops. Parallel arrays support the attachment of bounds, filters and -mapping functions prior to realization/calculation, which happens as -the result of any of several operations on the -array (pvec/psort/pfilter-nils/pfilter-dupes). Rather than perform -composite operations in steps, as would normally be done with -sequences, maps and filters are instead attached and thus composed by -providing ops to par. Note that there is an order sensitivity to the -attachments - bounds precede filters precede mappings. All operations -then happen in parallel, using multiple threads and a sophisticated -work-stealing system supported by fork-join, either when the array is -realized, or to perform aggregate operations like preduce/pmin/pmax -etc. A parallel array can be realized into a Clojure vector using -pvec. -") - -(import '(jsr166y.forkjoin ParallelArray ParallelArrayWithBounds ParallelArrayWithFilter - ParallelArrayWithMapping - Ops$Op Ops$BinaryOp Ops$Reducer Ops$Predicate Ops$BinaryPredicate - Ops$IntAndObjectPredicate Ops$IntAndObjectToObject)) - -(defn- op [f] - (proxy [Ops$Op] [] - (op [x] (f x)))) - -(defn- binary-op [f] - (proxy [Ops$BinaryOp] [] - (op [x y] (f x y)))) - -(defn- int-and-object-to-object [f] - (proxy [Ops$IntAndObjectToObject] [] - (op [i x] (f x i)))) - -(defn- reducer [f] - (proxy [Ops$Reducer] [] - (op [x y] (f x y)))) - -(defn- predicate [f] - (proxy [Ops$Predicate] [] - (op [x] (boolean (f x))))) - -(defn- binary-predicate [f] - (proxy [Ops$BinaryPredicate] [] - (op [x y] (boolean (f x y))))) - -(defn- int-and-object-predicate [f] - (proxy [Ops$IntAndObjectPredicate] [] - (op [i x] (boolean (f x i))))) - -(defn par - "Creates a parallel array from coll. ops, if supplied, perform - on-the-fly filtering or transformations during parallel realization - or calculation. ops form a chain, and bounds must precede filters, - must precede maps. ops must be a set of keyword value pairs of the - following forms: - - :bound [start end] - - Only elements from start (inclusive) to end (exclusive) will be - processed when the array is realized. - - :filter pred - - Filter preds remove elements from processing when the array is realized. pred - must be a function of one argument whose return will be processed - via boolean. - - :filter-index pred2 - - pred2 must be a function of two arguments, which will be an element - of the collection and the corresponding index, whose return will be - processed via boolean. - - :filter-with [pred2 coll2] - - pred2 must be a function of two arguments, which will be - corresponding elements of the 2 collections. - - :map f - - Map fns will be used to transform elements when the array is - realized. f must be a function of one argument. - - :map-index f2 - - f2 must be a function of two arguments, which will be an element of - the collection and the corresponding index. - - :map-with [f2 coll2] - - f2 must be a function of two arguments, which will be corresponding - elements of the 2 collections." - - ([coll] - (if (instance? ParallelArrayWithMapping coll) - coll - (. ParallelArray createUsingHandoff - (to-array coll) - (. ParallelArray defaultExecutor)))) - ([coll & ops] - (reduce (fn [pa [op args]] - (cond - (= op :bound) (. pa withBounds (args 0) (args 1)) - (= op :filter) (. pa withFilter (predicate args)) - (= op :filter-with) (. pa withFilter (binary-predicate (args 0)) (par (args 1))) - (= op :filter-index) (. pa withIndexedFilter (int-and-object-predicate args)) - (= op :map) (. pa withMapping (parallel/op args)) - (= op :map-with) (. pa withMapping (binary-op (args 0)) (par (args 1))) - (= op :map-index) (. pa withIndexedMapping (int-and-object-to-object args)) - :else (throw (Exception. (str "Unsupported par op: " op))))) - (par coll) - (partition 2 ops)))) - -;;;;;;;;;;;;;;;;;;;;; aggregate operations ;;;;;;;;;;;;;;;;;;;;;; -(defn pany - "Returns some (random) element of the coll if it satisfies the bound/filter/map" - [coll] - (. (par coll) any)) - -(defn pmax - "Returns the maximum element, presuming Comparable elements, unless - a Comparator comp is supplied" - ([coll] (. (par coll) max)) - ([coll comp] (. (par coll) max comp))) - -(defn pmin - "Returns the minimum element, presuming Comparable elements, unless - a Comparator comp is supplied" - ([coll] (. (par coll) min)) - ([coll comp] (. (par coll) min comp))) - -(defn- summary-map [s] - {:min (.min s) :max (.max s) :size (.size s) :min-index (.indexOfMin s) :max-index (.indexOfMax s)}) - -(defn psummary - "Returns a map of summary statistics (min. max, size, min-index, max-index, - presuming Comparable elements, unless a Comparator comp is supplied" - ([coll] (summary-map (. (par coll) summary))) - ([coll comp] (summary-map (. (par coll) summary comp)))) - -(defn preduce - "Returns the reduction of the realized elements of coll - using function f. Note f will not necessarily be called - consecutively, and so must be commutative. Also note that - (f base an-element) might be performed many times, i.e. base is not - an initial value as with sequential reduce." - [f base coll] - (. (par coll) (reduce (reducer f) base))) - -;;;;;;;;;;;;;;;;;;;;; collection-producing operations ;;;;;;;;;;;;;;;;;;;;;; - -(defn- pa-to-vec [pa] - (vec (. pa getArray))) - -(defn- pall - "Realizes a copy of the coll as a parallel array, with any bounds/filters/maps applied" - [coll] - (if (instance? ParallelArrayWithMapping coll) - (. coll all) - (par coll))) - -(defn pvec - "Returns the realized contents of the parallel array pa as a Clojure vector" - [pa] (pa-to-vec (pall pa))) - -(defn pdistinct - "Returns a parallel array of the distinct elements of coll" - [coll] - (pa-to-vec (. (pall coll) allUniqueElements))) - -;this doesn't work, passes null to reducer? -(defn- pcumulate [coll f init] - (.. (pall coll) (precumulate (reducer f) init))) - -(defn psort - "Returns a new vector consisting of the realized items in coll, sorted, - presuming Comparable elements, unless a Comparator comp is supplied" - ([coll] (pa-to-vec (. (pall coll) sort))) - ([coll comp] (pa-to-vec (. (pall coll) sort comp)))) - -(defn pfilter-nils - "Returns a vector containing the non-nil (realized) elements of coll" - [coll] - (pa-to-vec (. (pall coll) removeNulls))) - -(defn pfilter-dupes - "Returns a vector containing the (realized) elements of coll, - without any consecutive duplicates" - [coll] - (pa-to-vec (. (pall coll) removeConsecutiveDuplicates))) - - -(comment -(load-file "src/parallel.clj") -(refer 'parallel) -(pdistinct [1 2 3 2 1]) -;(pcumulate [1 2 3 2 1] + 0) ;broken, not exposed -(def a (make-array Object 1000000)) -(dotimes i (count a) - (aset a i (rand-int i))) -(time (reduce + 0 a)) -(time (preduce + 0 a)) -(time (count (distinct a))) -(time (count (pdistinct a))) - -(preduce + 0 [1 2 3 2 1]) -(preduce + 0 (psort a)) -(pvec (par [11 2 3 2] :filter-index (fn [x i] (> i x)))) -(pvec (par [11 2 3 2] :filter-with [(fn [x y] (> y x)) [110 2 33 2]])) - -(psummary ;or pvec/pmax etc - (par [11 2 3 2] - :filter-with [(fn [x y] (> y x)) - [110 2 33 2]] - :map #(* % 2))) - -(preduce + 0 - (par [11 2 3 2] - :filter-with [< [110 2 33 2]])) - -(time (reduce + 0 (map #(* % %) (range 1000000)))) -(time (preduce + 0 (par (range 1000000) :map-index *))) -(def v (range 1000000)) -(time (preduce + 0 (par v :map-index *))) -(time (preduce + 0 (par v :map #(* % %)))) -(time (reduce + 0 (map #(* % %) v))) -) \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/pprint.clj --- a/src/clojure/pprint.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,48 +0,0 @@ -;;; pprint.clj -- Pretty printer and Common Lisp compatible format function (cl-format) for Clojure - -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber -;; April 3, 2009 - -(ns - ^{:author "Tom Faulhaber", - :doc "A Pretty Printer for Clojure - -clojure.pprint implements a flexible system for printing structured data -in a pleasing, easy-to-understand format. Basic use of the pretty printer is -simple, just call pprint instead of println. More advanced users can use -the building blocks provided to create custom output formats. - -Out of the box, pprint supports a simple structured format for basic data -and a specialized format for Clojure source code. More advanced formats, -including formats that don't look like Clojure data at all like XML and -JSON, can be rendered by creating custom dispatch functions. - -In addition to the pprint function, this module contains cl-format, a text -formatting function which is fully compatible with the format function in -Common Lisp. Because pretty printing directives are directly integrated with -cl-format, it supports very concise custom dispatch. It also provides -a more powerful alternative to Clojure's standard format function. - -See documentation for pprint and cl-format for more information or -complete documentation on the the clojure web site on github.", - :added "1.2"} - clojure.pprint - (:refer-clojure :exclude (deftype))) - - -(load "pprint/utilities") -(load "pprint/column_writer") -(load "pprint/pretty_writer") -(load "pprint/pprint_base") -(load "pprint/cl_format") -(load "pprint/dispatch") - -nil diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/pprint/cl_format.clj --- a/src/clojure/pprint/cl_format.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1890 +0,0 @@ -;;; cl_format.clj -- part of the pretty printer for Clojure - -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber -;; April 3, 2009 - - -;; This module implements the Common Lisp compatible format function as documented -;; in "Common Lisp the Language, 2nd edition", Chapter 22 (available online at: -;; http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) - -(in-ns 'clojure.pprint) - -;;; Forward references -(declare compile-format) -(declare execute-format) -(declare init-navigator) -;;; End forward references - -(defn cl-format - "An implementation of a Common Lisp compatible format function. cl-format formats its -arguments to an output stream or string based on the format control string given. It -supports sophisticated formatting of structured data. - -Writer is an instance of java.io.Writer, true to output to *out* or nil to output -to a string, format-in is the format control string and the remaining arguments -are the data to be formatted. - -The format control string is a string to be output with embedded 'format directives' -describing how to format the various arguments passed in. - -If writer is nil, cl-format returns the formatted result string. Otherwise, cl-format -returns nil. - -For example: - (let [results [46 38 22]] - (cl-format true \"There ~[are~;is~:;are~]~:* ~d result~:p: ~{~d~^, ~}~%\" - (count results) results)) - -Prints to *out*: - There are 3 results: 46, 38, 22 - -Detailed documentation on format control strings is available in the \"Common Lisp the -Language, 2nd edition\", Chapter 22 (available online at: -http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) -and in the Common Lisp HyperSpec at -http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm -" - {:added "1.2", - :see-also [["http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000" - "Common Lisp the Language"] - ["http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm" - "Common Lisp HyperSpec"]]} - [writer format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format writer compiled-format navigator))) - -(def ^{:private true} *format-str* nil) - -(defn- format-error [message offset] - (let [full-message (str message \newline *format-str* \newline - (apply str (repeat offset \space)) "^" \newline)] - (throw (RuntimeException. full-message)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Argument navigators manage the argument list -;;; as the format statement moves through the list -;;; (possibly going forwards and backwards as it does so) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defstruct ^{:private true} - arg-navigator :seq :rest :pos ) - -(defn- init-navigator - "Create a new arg-navigator from the sequence with the position set to 0" - {:skip-wiki true} - [s] - (let [s (seq s)] - (struct arg-navigator s s 0))) - -;; TODO call format-error with offset -(defn- next-arg [ navigator ] - (let [ rst (:rest navigator) ] - (if rst - [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] - (throw (new Exception "Not enough arguments for format definition"))))) - -(defn- next-arg-or-nil [navigator] - (let [rst (:rest navigator)] - (if rst - [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] - [nil navigator]))) - -;; Get an argument off the arg list and compile it if it's not already compiled -(defn- get-format-arg [navigator] - (let [[raw-format navigator] (next-arg navigator) - compiled-format (if (instance? String raw-format) - (compile-format raw-format) - raw-format)] - [compiled-format navigator])) - -(declare relative-reposition) - -(defn- absolute-reposition [navigator position] - (if (>= position (:pos navigator)) - (relative-reposition navigator (- (:pos navigator) position)) - (struct arg-navigator (:seq navigator) (drop position (:seq navigator)) position))) - -(defn- relative-reposition [navigator position] - (let [newpos (+ (:pos navigator) position)] - (if (neg? position) - (absolute-reposition navigator newpos) - (struct arg-navigator (:seq navigator) (drop position (:rest navigator)) newpos)))) - -(defstruct ^{:private true} - compiled-directive :func :def :params :offset) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; When looking at the parameter list, we may need to manipulate -;;; the argument list as well (for 'V' and '#' parameter types). -;;; We hide all of this behind a function, but clients need to -;;; manage changing arg navigator -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: validate parameters when they come from arg list -(defn- realize-parameter [[param [raw-val offset]] navigator] - (let [[real-param new-navigator] - (cond - (contains? #{ :at :colon } param) ;pass flags through unchanged - this really isn't necessary - [raw-val navigator] - - (= raw-val :parameter-from-args) - (next-arg navigator) - - (= raw-val :remaining-arg-count) - [(count (:rest navigator)) navigator] - - true - [raw-val navigator])] - [[param [real-param offset]] new-navigator])) - -(defn- realize-parameter-list [parameter-map navigator] - (let [[pairs new-navigator] - (map-passing-context realize-parameter navigator parameter-map)] - [(into {} pairs) new-navigator])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions that support individual directives -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Common handling code for ~A and ~S -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare opt-base-str) - -(def ^{:private true} - special-radix-markers {2 "#b" 8 "#o", 16 "#x"}) - -(defn- format-simple-number [n] - (cond - (integer? n) (if (= *print-base* 10) - (str n (if *print-radix* ".")) - (str - (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) - (opt-base-str *print-base* n))) - (ratio? n) (str - (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) - (opt-base-str *print-base* (.numerator n)) - "/" - (opt-base-str *print-base* (.denominator n))) - :else nil)) - -(defn- format-ascii [print-func params arg-navigator offsets] - (let [ [arg arg-navigator] (next-arg arg-navigator) - ^String base-output (or (format-simple-number arg) (print-func arg)) - base-width (.length base-output) - min-width (+ base-width (:minpad params)) - width (if (>= min-width (:mincol params)) - min-width - (+ min-width - (* (+ (quot (- (:mincol params) min-width 1) - (:colinc params) ) - 1) - (:colinc params)))) - chars (apply str (repeat (- width base-width) (:padchar params)))] - (if (:at params) - (print (str chars base-output)) - (print (str base-output chars))) - arg-navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the integer directives ~D, ~X, ~O, ~B and some -;;; of ~R -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- integral? - "returns true if a number is actually an integer (that is, has no fractional part)" - [x] - (cond - (integer? x) true - (decimal? x) (>= (.ulp (.stripTrailingZeros (bigdec 0))) 1) ; true iff no fractional part - (float? x) (= x (Math/floor x)) - (ratio? x) (let [^clojure.lang.Ratio r x] - (= 0 (rem (.numerator r) (.denominator r)))) - :else false)) - -(defn- remainders - "Return the list of remainders (essentially the 'digits') of val in the given base" - [base val] - (reverse - (first - (consume #(if (pos? %) - [(rem % base) (quot % base)] - [nil nil]) - val)))) - -;;; TODO: xlated-val does not seem to be used here. -(defn- base-str - "Return val as a string in the given base" - [base val] - (if (zero? val) - "0" - (let [xlated-val (cond - (float? val) (bigdec val) - (ratio? val) (let [^clojure.lang.Ratio r val] - (/ (.numerator r) (.denominator r))) - :else val)] - (apply str - (map - #(if (< % 10) (char (+ (int \0) %)) (char (+ (int \a) (- % 10)))) - (remainders base val)))))) - -(def ^{:private true} - java-base-formats {8 "%o", 10 "%d", 16 "%x"}) - -(defn- opt-base-str - "Return val as a string in the given base, using clojure.core/format if supported -for improved performance" - [base val] - (let [format-str (get java-base-formats base)] - (if (and format-str (integer? val)) - (clojure.core/format format-str val) - (base-str base val)))) - -(defn- group-by* [unit lis] - (reverse - (first - (consume (fn [x] [(seq (reverse (take unit x))) (seq (drop unit x))]) (reverse lis))))) - -(defn- format-integer [base params arg-navigator offsets] - (let [[arg arg-navigator] (next-arg arg-navigator)] - (if (integral? arg) - (let [neg (neg? arg) - pos-arg (if neg (- arg) arg) - raw-str (opt-base-str base pos-arg) - group-str (if (:colon params) - (let [groups (map #(apply str %) (group-by* (:commainterval params) raw-str)) - commas (repeat (count groups) (:commachar params))] - (apply str (next (interleave commas groups)))) - raw-str) - ^String signed-str (cond - neg (str "-" group-str) - (:at params) (str "+" group-str) - true group-str) - padded-str (if (< (.length signed-str) (:mincol params)) - (str (apply str (repeat (- (:mincol params) (.length signed-str)) - (:padchar params))) - signed-str) - signed-str)] - (print padded-str)) - (format-ascii print-str {:mincol (:mincol params) :colinc 1 :minpad 0 - :padchar (:padchar params) :at true} - (init-navigator [arg]) nil)) - arg-navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for english formats (~R and ~:R) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - english-cardinal-units - ["zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" - "ten" "eleven" "twelve" "thirteen" "fourteen" - "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"]) - -(def ^{:private true} - english-ordinal-units - ["zeroth" "first" "second" "third" "fourth" "fifth" "sixth" "seventh" "eighth" "ninth" - "tenth" "eleventh" "twelfth" "thirteenth" "fourteenth" - "fifteenth" "sixteenth" "seventeenth" "eighteenth" "nineteenth"]) - -(def ^{:private true} - english-cardinal-tens - ["" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"]) - -(def ^{:private true} - english-ordinal-tens - ["" "" "twentieth" "thirtieth" "fortieth" "fiftieth" - "sixtieth" "seventieth" "eightieth" "ninetieth"]) - -;; We use "short scale" for our units (see http://en.wikipedia.org/wiki/Long_and_short_scales) -;; Number names from http://www.jimloy.com/math/billion.htm -;; We follow the rules for writing numbers from the Blue Book -;; (http://www.grammarbook.com/numbers/numbers.asp) -(def ^{:private true} - english-scale-numbers - ["" "thousand" "million" "billion" "trillion" "quadrillion" "quintillion" - "sextillion" "septillion" "octillion" "nonillion" "decillion" - "undecillion" "duodecillion" "tredecillion" "quattuordecillion" - "quindecillion" "sexdecillion" "septendecillion" - "octodecillion" "novemdecillion" "vigintillion"]) - -(defn- format-simple-cardinal - "Convert a number less than 1000 to a cardinal english string" - [num] - (let [hundreds (quot num 100) - tens (rem num 100)] - (str - (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) - (if (and (pos? hundreds) (pos? tens)) " ") - (if (pos? tens) - (if (< tens 20) - (nth english-cardinal-units tens) - (let [ten-digit (quot tens 10) - unit-digit (rem tens 10)] - (str - (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) - (if (and (pos? ten-digit) (pos? unit-digit)) "-") - (if (pos? unit-digit) (nth english-cardinal-units unit-digit))))))))) - -(defn- add-english-scales - "Take a sequence of parts, add scale numbers (e.g., million) and combine into a string -offset is a factor of 10^3 to multiply by" - [parts offset] - (let [cnt (count parts)] - (loop [acc [] - pos (dec cnt) - this (first parts) - remainder (next parts)] - (if (nil? remainder) - (str (apply str (interpose ", " acc)) - (if (and (not (empty? this)) (not (empty? acc))) ", ") - this - (if (and (not (empty? this)) (pos? (+ pos offset))) - (str " " (nth english-scale-numbers (+ pos offset))))) - (recur - (if (empty? this) - acc - (conj acc (str this " " (nth english-scale-numbers (+ pos offset))))) - (dec pos) - (first remainder) - (next remainder)))))) - -(defn- format-cardinal-english [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (= 0 arg) - (print "zero") - (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs - parts (remainders 1000 abs-arg)] - (if (<= (count parts) (count english-scale-numbers)) - (let [parts-strs (map format-simple-cardinal parts) - full-str (add-english-scales parts-strs 0)] - (print (str (if (neg? arg) "minus ") full-str))) - (format-integer ;; for numbers > 10^63, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})))) - navigator)) - -(defn- format-simple-ordinal - "Convert a number less than 1000 to a ordinal english string -Note this should only be used for the last one in the sequence" - [num] - (let [hundreds (quot num 100) - tens (rem num 100)] - (str - (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) - (if (and (pos? hundreds) (pos? tens)) " ") - (if (pos? tens) - (if (< tens 20) - (nth english-ordinal-units tens) - (let [ten-digit (quot tens 10) - unit-digit (rem tens 10)] - (if (and (pos? ten-digit) (not (pos? unit-digit))) - (nth english-ordinal-tens ten-digit) - (str - (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) - (if (and (pos? ten-digit) (pos? unit-digit)) "-") - (if (pos? unit-digit) (nth english-ordinal-units unit-digit)))))) - (if (pos? hundreds) "th"))))) - -(defn- format-ordinal-english [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (= 0 arg) - (print "zeroth") - (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs - parts (remainders 1000 abs-arg)] - (if (<= (count parts) (count english-scale-numbers)) - (let [parts-strs (map format-simple-cardinal (drop-last parts)) - head-str (add-english-scales parts-strs 1) - tail-str (format-simple-ordinal (last parts))] - (print (str (if (neg? arg) "minus ") - (cond - (and (not (empty? head-str)) (not (empty? tail-str))) - (str head-str ", " tail-str) - - (not (empty? head-str)) (str head-str "th") - :else tail-str)))) - (do (format-integer ;; for numbers > 10^63, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0}) - (let [low-two-digits (rem arg 100) - not-teens (or (< 11 low-two-digits) (> 19 low-two-digits)) - low-digit (rem low-two-digits 10)] - (print (cond - (and (= low-digit 1) not-teens) "st" - (and (= low-digit 2) not-teens) "nd" - (and (= low-digit 3) not-teens) "rd" - :else "th"))))))) - navigator)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for roman numeral formats (~@R and ~@:R) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - old-roman-table - [[ "I" "II" "III" "IIII" "V" "VI" "VII" "VIII" "VIIII"] - [ "X" "XX" "XXX" "XXXX" "L" "LX" "LXX" "LXXX" "LXXXX"] - [ "C" "CC" "CCC" "CCCC" "D" "DC" "DCC" "DCCC" "DCCCC"] - [ "M" "MM" "MMM"]]) - -(def ^{:private true} - new-roman-table - [[ "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX"] - [ "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC"] - [ "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM"] - [ "M" "MM" "MMM"]]) - -(defn- format-roman - "Format a roman numeral using the specified look-up table" - [table params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (and (number? arg) (> arg 0) (< arg 4000)) - (let [digits (remainders 10 arg)] - (loop [acc [] - pos (dec (count digits)) - digits digits] - (if (empty? digits) - (print (apply str acc)) - (let [digit (first digits)] - (recur (if (= 0 digit) - acc - (conj acc (nth (nth table pos) (dec digit)))) - (dec pos) - (next digits)))))) - (format-integer ;; for anything <= 0 or > 3999, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})) - navigator)) - -(defn- format-old-roman [params navigator offsets] - (format-roman old-roman-table params navigator offsets)) - -(defn- format-new-roman [params navigator offsets] - (format-roman new-roman-table params navigator offsets)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for character formats (~C) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - special-chars { 8 "Backspace", 9 "Tab", 10 "Newline", 13 "Return", 32 "Space"}) - -(defn- pretty-character [params navigator offsets] - (let [[c navigator] (next-arg navigator) - as-int (int c) - base-char (bit-and as-int 127) - meta (bit-and as-int 128) - special (get special-chars base-char)] - (if (> meta 0) (print "Meta-")) - (print (cond - special special - (< base-char 32) (str "Control-" (char (+ base-char 64))) - (= base-char 127) "Control-?" - :else (char base-char))) - navigator)) - -(defn- readable-character [params navigator offsets] - (let [[c navigator] (next-arg navigator)] - (condp = (:char-format params) - \o (cl-format true "\\o~3,'0o" (int c)) - \u (cl-format true "\\u~4,'0x" (int c)) - nil (pr c)) - navigator)) - -(defn- plain-character [params navigator offsets] - (let [[char navigator] (next-arg navigator)] - (print char) - navigator)) - -;; Check to see if a result is an abort (~^) construct -;; TODO: move these funcs somewhere more appropriate -(defn- abort? [context] - (let [token (first context)] - (or (= :up-arrow token) (= :colon-up-arrow token)))) - -;; Handle the execution of "sub-clauses" in bracket constructions -(defn- execute-sub-format [format args base-args] - (second - (map-passing-context - (fn [element context] - (if (abort? context) - [nil context] ; just keep passing it along - (let [[params args] (realize-parameter-list (:params element) context) - [params offsets] (unzip-map params) - params (assoc params :base-args base-args)] - [nil (apply (:func element) [params args offsets])]))) - args - format))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for real number formats -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO - return exponent as int to eliminate double conversion -(defn- float-parts-base - "Produce string parts for the mantissa (normalized 1-9) and exponent" - [^Object f] - (let [^String s (.toLowerCase (.toString f)) - exploc (.indexOf s (int \e))] - (if (neg? exploc) - (let [dotloc (.indexOf s (int \.))] - (if (neg? dotloc) - [s (str (dec (count s)))] - [(str (subs s 0 dotloc) (subs s (inc dotloc))) (str (dec dotloc))])) - [(str (subs s 0 1) (subs s 2 exploc)) (subs s (inc exploc))]))) - - -(defn- float-parts - "Take care of leading and trailing zeros in decomposed floats" - [f] - (let [[m ^String e] (float-parts-base f) - m1 (rtrim m \0) - m2 (ltrim m1 \0) - delta (- (count m1) (count m2)) - ^String e (if (and (pos? (count e)) (= (nth e 0) \+)) (subs e 1) e)] - (if (empty? m2) - ["0" 0] - [m2 (- (Integer/valueOf e) delta)]))) - -(defn- round-str [m e d w] - (if (or d w) - (let [len (count m) - round-pos (if d (+ e d 1)) - round-pos (if (and w (< (inc e) (dec w)) - (or (nil? round-pos) (< (dec w) round-pos))) - (dec w) - round-pos) - [m1 e1 round-pos len] (if (= round-pos 0) - [(str "0" m) (inc e) 1 (inc len)] - [m e round-pos len])] - (if round-pos - (if (neg? round-pos) - ["0" 0 false] - (if (> len round-pos) - (let [round-char (nth m1 round-pos) - ^String result (subs m1 0 round-pos)] - (if (>= (int round-char) (int \5)) - (let [result-val (Integer/valueOf result) - leading-zeros (subs result 0 (min (prefix-count result \0) (- round-pos 1))) - round-up-result (str leading-zeros - (String/valueOf (+ result-val - (if (neg? result-val) -1 1)))) - expanded (> (count round-up-result) (count result))] - [round-up-result e1 expanded]) - [result e1 false])) - [m e false])) - [m e false])) - [m e false])) - -(defn- expand-fixed [m e d] - (let [m1 (if (neg? e) (str (apply str (repeat (dec (- e)) \0)) m) m) - len (count m1) - target-len (if d (+ e d 1) (inc e))] - (if (< len target-len) - (str m1 (apply str (repeat (- target-len len) \0))) - m1))) - -(defn- insert-decimal - "Insert the decimal point at the right spot in the number to match an exponent" - [m e] - (if (neg? e) - (str "." m) - (let [loc (inc e)] - (str (subs m 0 loc) "." (subs m loc))))) - -(defn- get-fixed [m e d] - (insert-decimal (expand-fixed m e d) e)) - -(defn- insert-scaled-decimal - "Insert the decimal point at the right spot in the number to match an exponent" - [m k] - (if (neg? k) - (str "." m) - (str (subs m 0 k) "." (subs m k)))) - -;; the function to render ~F directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -(defn- fixed-float [params navigator offsets] - (let [w (:w params) - d (:d params) - [arg navigator] (next-arg navigator) - [sign abs] (if (neg? arg) ["-" (- arg)] ["+" arg]) - [mantissa exp] (float-parts abs) - scaled-exp (+ exp (:k params)) - add-sign (or (:at params) (neg? arg)) - append-zero (and (not d) (<= (dec (count mantissa)) scaled-exp)) - [rounded-mantissa scaled-exp expanded] (round-str mantissa scaled-exp - d (if w (- w (if add-sign 1 0)))) - fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) - prepend-zero (= (first fixed-repr) \.)] - (if w - (let [len (count fixed-repr) - signed-len (if add-sign (inc len) len) - prepend-zero (and prepend-zero (not (>= signed-len w))) - append-zero (and append-zero (not (>= signed-len w))) - full-len (if (or prepend-zero append-zero) - (inc signed-len) - signed-len)] - (if (and (> full-len w) (:overflowchar params)) - (print (apply str (repeat w (:overflowchar params)))) - (print (str - (apply str (repeat (- w full-len) (:padchar params))) - (if add-sign sign) - (if prepend-zero "0") - fixed-repr - (if append-zero "0"))))) - (print (str - (if add-sign sign) - (if prepend-zero "0") - fixed-repr - (if append-zero "0")))) - navigator)) - - -;; the function to render ~E directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -;; TODO: define ~E representation for Infinity -(defn- exponential-float [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (loop [[mantissa exp] (float-parts (if (neg? arg) (- arg) arg))] - (let [w (:w params) - d (:d params) - e (:e params) - k (:k params) - expchar (or (:exponentchar params) \E) - add-sign (or (:at params) (neg? arg)) - prepend-zero (<= k 0) - ^Integer scaled-exp (- exp (dec k)) - scaled-exp-str (str (Math/abs scaled-exp)) - scaled-exp-str (str expchar (if (neg? scaled-exp) \- \+) - (if e (apply str - (repeat - (- e - (count scaled-exp-str)) - \0))) - scaled-exp-str) - exp-width (count scaled-exp-str) - base-mantissa-width (count mantissa) - scaled-mantissa (str (apply str (repeat (- k) \0)) - mantissa - (if d - (apply str - (repeat - (- d (dec base-mantissa-width) - (if (neg? k) (- k) 0)) \0)))) - w-mantissa (if w (- w exp-width)) - [rounded-mantissa _ incr-exp] (round-str - scaled-mantissa 0 - (cond - (= k 0) (dec d) - (pos? k) d - (neg? k) (dec d)) - (if w-mantissa - (- w-mantissa (if add-sign 1 0)))) - full-mantissa (insert-scaled-decimal rounded-mantissa k) - append-zero (and (= k (count rounded-mantissa)) (nil? d))] - (if (not incr-exp) - (if w - (let [len (+ (count full-mantissa) exp-width) - signed-len (if add-sign (inc len) len) - prepend-zero (and prepend-zero (not (= signed-len w))) - full-len (if prepend-zero (inc signed-len) signed-len) - append-zero (and append-zero (< full-len w))] - (if (and (or (> full-len w) (and e (> (- exp-width 2) e))) - (:overflowchar params)) - (print (apply str (repeat w (:overflowchar params)))) - (print (str - (apply str - (repeat - (- w full-len (if append-zero 1 0) ) - (:padchar params))) - (if add-sign (if (neg? arg) \- \+)) - (if prepend-zero "0") - full-mantissa - (if append-zero "0") - scaled-exp-str)))) - (print (str - (if add-sign (if (neg? arg) \- \+)) - (if prepend-zero "0") - full-mantissa - (if append-zero "0") - scaled-exp-str))) - (recur [rounded-mantissa (inc exp)])))) - navigator)) - -;; the function to render ~G directives -;; This just figures out whether to pass the request off to ~F or ~E based -;; on the algorithm in CLtL. -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -;; TODO: refactor so that float-parts isn't called twice -(defn- general-float [params navigator offsets] - (let [[arg _] (next-arg navigator) - [mantissa exp] (float-parts (if (neg? arg) (- arg) arg)) - w (:w params) - d (:d params) - e (:e params) - n (if (= arg 0.0) 0 (inc exp)) - ee (if e (+ e 2) 4) - ww (if w (- w ee)) - d (if d d (max (count mantissa) (min n 7))) - dd (- d n)] - (if (<= 0 dd d) - (let [navigator (fixed-float {:w ww, :d dd, :k 0, - :overflowchar (:overflowchar params), - :padchar (:padchar params), :at (:at params)} - navigator offsets)] - (print (apply str (repeat ee \space))) - navigator) - (exponential-float params navigator offsets)))) - -;; the function to render ~$ directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -(defn- dollar-float [params navigator offsets] - (let [[^Double arg navigator] (next-arg navigator) - [mantissa exp] (float-parts (Math/abs arg)) - d (:d params) ; digits after the decimal - n (:n params) ; minimum digits before the decimal - w (:w params) ; minimum field width - add-sign (or (:at params) (neg? arg)) - [rounded-mantissa scaled-exp expanded] (round-str mantissa exp d nil) - ^String fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) - full-repr (str (apply str (repeat (- n (.indexOf fixed-repr (int \.))) \0)) fixed-repr) - full-len (+ (count full-repr) (if add-sign 1 0))] - (print (str - (if (and (:colon params) add-sign) (if (neg? arg) \- \+)) - (apply str (repeat (- w full-len) (:padchar params))) - (if (and (not (:colon params)) add-sign) (if (neg? arg) \- \+)) - full-repr)) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~[...~]' conditional construct in its -;;; different flavors -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; ~[...~] without any modifiers chooses one of the clauses based on the param or -;; next argument -;; TODO check arg is positive int -(defn- choice-conditional [params arg-navigator offsets] - (let [arg (:selector params) - [arg navigator] (if arg [arg arg-navigator] (next-arg arg-navigator)) - clauses (:clauses params) - clause (if (or (neg? arg) (>= arg (count clauses))) - (first (:else params)) - (nth clauses arg))] - (if clause - (execute-sub-format clause navigator (:base-args params)) - navigator))) - -;; ~:[...~] with the colon reads the next argument treating it as a truth value -(defn- boolean-conditional [params arg-navigator offsets] - (let [[arg navigator] (next-arg arg-navigator) - clauses (:clauses params) - clause (if arg - (second clauses) - (first clauses))] - (if clause - (execute-sub-format clause navigator (:base-args params)) - navigator))) - -;; ~@[...~] with the at sign executes the conditional if the next arg is not -;; nil/false without consuming the arg -(defn- check-arg-conditional [params arg-navigator offsets] - (let [[arg navigator] (next-arg arg-navigator) - clauses (:clauses params) - clause (if arg (first clauses))] - (if arg - (if clause - (execute-sub-format clause arg-navigator (:base-args params)) - arg-navigator) - navigator))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~{...~}' iteration construct in its -;;; different flavors -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;; ~{...~} without any modifiers uses the next argument as an argument list that -;; is consumed by all the iterations -(defn- iterate-sublist [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator]) - [arg-list navigator] (next-arg navigator) - args (init-navigator arg-list)] - (loop [count 0 - args args - last-pos -1] - (if (and (not max-count) (= (:pos args) last-pos) (> count 1)) - ;; TODO get the offset in here and call format exception - (throw (RuntimeException. "%{ construct not consuming any arguments: Infinite loop!"))) - (if (or (and (empty? (:rest args)) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [iter-result (execute-sub-format clause args (:base-args params))] - (if (= :up-arrow (first iter-result)) - navigator - (recur (inc count) iter-result (:pos args)))))))) - -;; ~:{...~} with the colon treats the next argument as a list of sublists. Each of the -;; sublists is used as the arglist for a single iteration. -(defn- iterate-list-of-sublists [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator]) - [arg-list navigator] (next-arg navigator)] - (loop [count 0 - arg-list arg-list] - (if (or (and (empty? arg-list) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [iter-result (execute-sub-format - clause - (init-navigator (first arg-list)) - (init-navigator (next arg-list)))] - (if (= :colon-up-arrow (first iter-result)) - navigator - (recur (inc count) (next arg-list)))))))) - -;; ~@{...~} with the at sign uses the main argument list as the arguments to the iterations -;; is consumed by all the iterations -(defn- iterate-main-list [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator])] - (loop [count 0 - navigator navigator - last-pos -1] - (if (and (not max-count) (= (:pos navigator) last-pos) (> count 1)) - ;; TODO get the offset in here and call format exception - (throw (RuntimeException. "%@{ construct not consuming any arguments: Infinite loop!"))) - (if (or (and (empty? (:rest navigator)) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [iter-result (execute-sub-format clause navigator (:base-args params))] - (if (= :up-arrow (first iter-result)) - (second iter-result) - (recur - (inc count) iter-result (:pos navigator)))))))) - -;; ~@:{...~} with both colon and at sign uses the main argument list as a set of sublists, one -;; of which is consumed with each iteration -(defn- iterate-main-sublists [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator]) - ] - (loop [count 0 - navigator navigator] - (if (or (and (empty? (:rest navigator)) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [[sublist navigator] (next-arg-or-nil navigator) - iter-result (execute-sub-format clause (init-navigator sublist) navigator)] - (if (= :colon-up-arrow (first iter-result)) - navigator - (recur (inc count) navigator))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The '~< directive has two completely different meanings -;;; in the '~<...~>' form it does justification, but with -;;; ~<...~:>' it represents the logical block operation of the -;;; pretty printer. -;;; -;;; Unfortunately, the current architecture decides what function -;;; to call at form parsing time before the sub-clauses have been -;;; folded, so it is left to run-time to make the decision. -;;; -;;; TODO: make it possible to make these decisions at compile-time. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare format-logical-block) -(declare justify-clauses) - -(defn- logical-block-or-justify [params navigator offsets] - (if (:colon (:right-params params)) - (format-logical-block params navigator offsets) - (justify-clauses params navigator offsets))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~<...~>' justification directive -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- render-clauses [clauses navigator base-navigator] - (loop [clauses clauses - acc [] - navigator navigator] - (if (empty? clauses) - [acc navigator] - (let [clause (first clauses) - [iter-result result-str] (binding [*out* (java.io.StringWriter.)] - [(execute-sub-format clause navigator base-navigator) - (.toString *out*)])] - (if (= :up-arrow (first iter-result)) - [acc (second iter-result)] - (recur (next clauses) (conj acc result-str) iter-result)))))) - -;; TODO support for ~:; constructions -(defn- justify-clauses [params navigator offsets] - (let [[[eol-str] new-navigator] (when-let [else (:else params)] - (render-clauses else navigator (:base-args params))) - navigator (or new-navigator navigator) - [else-params new-navigator] (when-let [p (:else-params params)] - (realize-parameter-list p navigator)) - navigator (or new-navigator navigator) - min-remaining (or (first (:min-remaining else-params)) 0) - max-columns (or (first (:max-columns else-params)) - (get-max-column *out*)) - clauses (:clauses params) - [strs navigator] (render-clauses clauses navigator (:base-args params)) - slots (max 1 - (+ (dec (count strs)) (if (:colon params) 1 0) (if (:at params) 1 0))) - chars (reduce + (map count strs)) - mincol (:mincol params) - minpad (:minpad params) - colinc (:colinc params) - minout (+ chars (* slots minpad)) - result-columns (if (<= minout mincol) - mincol - (+ mincol (* colinc - (+ 1 (quot (- minout mincol 1) colinc))))) - total-pad (- result-columns chars) - pad (max minpad (quot total-pad slots)) - extra-pad (- total-pad (* pad slots)) - pad-str (apply str (repeat pad (:padchar params)))] - (if (and eol-str (> (+ (get-column (:base @@*out*)) min-remaining result-columns) - max-columns)) - (print eol-str)) - (loop [slots slots - extra-pad extra-pad - strs strs - pad-only (or (:colon params) - (and (= (count strs) 1) (not (:at params))))] - (if (seq strs) - (do - (print (str (if (not pad-only) (first strs)) - (if (or pad-only (next strs) (:at params)) pad-str) - (if (pos? extra-pad) (:padchar params)))) - (recur - (dec slots) - (dec extra-pad) - (if pad-only strs (next strs)) - false)))) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for case modification with ~(...~). -;;; We do this by wrapping the underlying writer with -;;; a special writer to do the appropriate modification. This -;;; allows us to support arbitrary-sized output and sources -;;; that may block. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- downcase-writer - "Returns a proxy that wraps writer, converting all characters to lower case" - [^java.io.Writer writer] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s ^String x] - (.write writer (.toLowerCase s))) - - Integer - (let [c ^Character x] - (.write writer (int (Character/toLowerCase (char c)))))))))) - -(defn- upcase-writer - "Returns a proxy that wraps writer, converting all characters to upper case" - [^java.io.Writer writer] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s ^String x] - (.write writer (.toUpperCase s))) - - Integer - (let [c ^Character x] - (.write writer (int (Character/toUpperCase (char c)))))))))) - -(defn- capitalize-string - "Capitalizes the words in a string. If first? is false, don't capitalize the - first character of the string even if it's a letter." - [s first?] - (let [^Character f (first s) - s (if (and first? f (Character/isLetter f)) - (str (Character/toUpperCase f) (subs s 1)) - s)] - (apply str - (first - (consume - (fn [s] - (if (empty? s) - [nil nil] - (let [m (re-matcher #"\W\w" s) - match (re-find m) - offset (and match (inc (.start m)))] - (if offset - [(str (subs s 0 offset) - (Character/toUpperCase ^Character (nth s offset))) - (subs s (inc offset))] - [s nil])))) - s))))) - -(defn- capitalize-word-writer - "Returns a proxy that wraps writer, captializing all words" - [^java.io.Writer writer] - (let [last-was-whitespace? (ref true)] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write - ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s ^String x] - (.write writer - ^String (capitalize-string (.toLowerCase s) @last-was-whitespace?)) - (dosync - (ref-set last-was-whitespace? - (Character/isWhitespace - ^Character (nth s (dec (count s))))))) - - Integer - (let [c (char x)] - (let [mod-c (if @last-was-whitespace? (Character/toUpperCase ^Character (char x)) c)] - (.write writer (int mod-c)) - (dosync (ref-set last-was-whitespace? (Character/isWhitespace ^Character (char x)))))))))))) - -(defn- init-cap-writer - "Returns a proxy that wraps writer, capitalizing the first word" - [^java.io.Writer writer] - (let [capped (ref false)] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s (.toLowerCase ^String x)] - (if (not @capped) - (let [m (re-matcher #"\S" s) - match (re-find m) - offset (and match (.start m))] - (if offset - (do (.write writer - (str (subs s 0 offset) - (Character/toUpperCase ^Character (nth s offset)) - (.toLowerCase ^String (subs s (inc offset))))) - (dosync (ref-set capped true))) - (.write writer s))) - (.write writer (.toLowerCase s)))) - - Integer - (let [c ^Character (char x)] - (if (and (not @capped) (Character/isLetter c)) - (do - (dosync (ref-set capped true)) - (.write writer (int (Character/toUpperCase c)))) - (.write writer (int (Character/toLowerCase c))))))))))) - -(defn- modify-case [make-writer params navigator offsets] - (let [clause (first (:clauses params))] - (binding [*out* (make-writer *out*)] - (execute-sub-format clause navigator (:base-args params))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; If necessary, wrap the writer in a PrettyWriter object -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn get-pretty-writer - "Returns the java.io.Writer passed in wrapped in a pretty writer proxy, unless it's -already a pretty writer. Generally, it is unneccesary to call this function, since pprint, -write, and cl-format all call it if they need to. However if you want the state to be -preserved across calls, you will want to wrap them with this. - -For example, when you want to generate column-aware output with multiple calls to cl-format, -do it like in this example: - - (defn print-table [aseq column-width] - (binding [*out* (get-pretty-writer *out*)] - (doseq [row aseq] - (doseq [col row] - (cl-format true \"~4D~7,vT\" col column-width)) - (prn)))) - -Now when you run: - - user> (print-table (map #(vector % (* % %) (* % % %)) (range 1 11)) 8) - -It prints a table of squares and cubes for the numbers from 1 to 10: - - 1 1 1 - 2 4 8 - 3 9 27 - 4 16 64 - 5 25 125 - 6 36 216 - 7 49 343 - 8 64 512 - 9 81 729 - 10 100 1000" - {:added "1.2"} - [writer] - (if (pretty-writer? writer) - writer - (pretty-writer writer *print-right-margin* *print-miser-width*))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for column-aware operations ~&, ~T -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn fresh-line - "Make a newline if *out* is not already at the beginning of the line. If *out* is -not a pretty writer (which keeps track of columns), this function always outputs a newline." - {:added "1.2"} - [] - (if (instance? clojure.lang.IDeref *out*) - (if (not (= 0 (get-column (:base @@*out*)))) - (prn)) - (prn))) - -(defn- absolute-tabulation [params navigator offsets] - (let [colnum (:colnum params) - colinc (:colinc params) - current (get-column (:base @@*out*)) - space-count (cond - (< current colnum) (- colnum current) - (= colinc 0) 0 - :else (- colinc (rem (- current colnum) colinc)))] - (print (apply str (repeat space-count \space)))) - navigator) - -(defn- relative-tabulation [params navigator offsets] - (let [colrel (:colnum params) - colinc (:colinc params) - start-col (+ colrel (get-column (:base @@*out*))) - offset (if (pos? colinc) (rem start-col colinc) 0) - space-count (+ colrel (if (= 0 offset) 0 (- colinc offset)))] - (print (apply str (repeat space-count \space)))) - navigator) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for accessing the pretty printer from a format -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: support ~@; per-line-prefix separator -;; TODO: get the whole format wrapped so we can start the lb at any column -(defn- format-logical-block [params navigator offsets] - (let [clauses (:clauses params) - clause-count (count clauses) - prefix (cond - (> clause-count 1) (:string (:params (first (first clauses)))) - (:colon params) "(") - body (nth clauses (if (> clause-count 1) 1 0)) - suffix (cond - (> clause-count 2) (:string (:params (first (nth clauses 2)))) - (:colon params) ")") - [arg navigator] (next-arg navigator)] - (pprint-logical-block :prefix prefix :suffix suffix - (execute-sub-format - body - (init-navigator arg) - (:base-args params))) - navigator)) - -(defn- set-indent [params navigator offsets] - (let [relative-to (if (:colon params) :current :block)] - (pprint-indent relative-to (:n params)) - navigator)) - -;;; TODO: support ~:T section options for ~T - -(defn- conditional-newline [params navigator offsets] - (let [kind (if (:colon params) - (if (:at params) :mandatory :fill) - (if (:at params) :miser :linear))] - (pprint-newline kind) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The table of directives we support, each with its params, -;;; properties, and the compilation function -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; We start with a couple of helpers -(defn- process-directive-table-element [ [ char params flags bracket-info & generator-fn ] ] - [char, - {:directive char, - :params `(array-map ~@params), - :flags flags, - :bracket-info bracket-info, - :generator-fn (concat '(fn [ params offset]) generator-fn) }]) - -(defmacro ^{:private true} - defdirectives - [ & directives ] - `(def ^{:private true} - directive-table (hash-map ~@(mapcat process-directive-table-element directives)))) - -(defdirectives - (\A - [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] - #{ :at :colon :both} {} - #(format-ascii print-str %1 %2 %3)) - - (\S - [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] - #{ :at :colon :both} {} - #(format-ascii pr-str %1 %2 %3)) - - (\D - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 10 %1 %2 %3)) - - (\B - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 2 %1 %2 %3)) - - (\O - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 8 %1 %2 %3)) - - (\X - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 16 %1 %2 %3)) - - (\R - [:base [nil Integer] :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - (do - (cond ; ~R is overloaded with bizareness - (first (:base params)) #(format-integer (:base %1) %1 %2 %3) - (and (:at params) (:colon params)) #(format-old-roman %1 %2 %3) - (:at params) #(format-new-roman %1 %2 %3) - (:colon params) #(format-ordinal-english %1 %2 %3) - true #(format-cardinal-english %1 %2 %3)))) - - (\P - [ ] - #{ :at :colon :both } {} - (fn [params navigator offsets] - (let [navigator (if (:colon params) (relative-reposition navigator -1) navigator) - strs (if (:at params) ["y" "ies"] ["" "s"]) - [arg navigator] (next-arg navigator)] - (print (if (= arg 1) (first strs) (second strs))) - navigator))) - - (\C - [:char-format [nil Character]] - #{ :at :colon :both } {} - (cond - (:colon params) pretty-character - (:at params) readable-character - :else plain-character)) - - (\F - [ :w [nil Integer] :d [nil Integer] :k [0 Integer] :overflowchar [nil Character] - :padchar [\space Character] ] - #{ :at } {} - fixed-float) - - (\E - [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] - :overflowchar [nil Character] :padchar [\space Character] - :exponentchar [nil Character] ] - #{ :at } {} - exponential-float) - - (\G - [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] - :overflowchar [nil Character] :padchar [\space Character] - :exponentchar [nil Character] ] - #{ :at } {} - general-float) - - (\$ - [ :d [2 Integer] :n [1 Integer] :w [0 Integer] :padchar [\space Character]] - #{ :at :colon :both} {} - dollar-float) - - (\% - [ :count [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (dotimes [i (:count params)] - (prn)) - arg-navigator)) - - (\& - [ :count [1 Integer] ] - #{ :pretty } {} - (fn [params arg-navigator offsets] - (let [cnt (:count params)] - (if (pos? cnt) (fresh-line)) - (dotimes [i (dec cnt)] - (prn))) - arg-navigator)) - - (\| - [ :count [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (dotimes [i (:count params)] - (print \formfeed)) - arg-navigator)) - - (\~ - [ :n [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (let [n (:n params)] - (print (apply str (repeat n \~))) - arg-navigator))) - - (\newline ;; Whitespace supression is handled in the compilation loop - [ ] - #{:colon :at} {} - (fn [params arg-navigator offsets] - (if (:at params) - (prn)) - arg-navigator)) - - (\T - [ :colnum [1 Integer] :colinc [1 Integer] ] - #{ :at :pretty } {} - (if (:at params) - #(relative-tabulation %1 %2 %3) - #(absolute-tabulation %1 %2 %3))) - - (\* - [ :n [1 Integer] ] - #{ :colon :at } {} - (fn [params navigator offsets] - (let [n (:n params)] - (if (:at params) - (absolute-reposition navigator n) - (relative-reposition navigator (if (:colon params) (- n) n))) - ))) - - (\? - [ ] - #{ :at } {} - (if (:at params) - (fn [params navigator offsets] ; args from main arg list - (let [[subformat navigator] (get-format-arg navigator)] - (execute-sub-format subformat navigator (:base-args params)))) - (fn [params navigator offsets] ; args from sub-list - (let [[subformat navigator] (get-format-arg navigator) - [subargs navigator] (next-arg navigator) - sub-navigator (init-navigator subargs)] - (execute-sub-format subformat sub-navigator (:base-args params)) - navigator)))) - - - (\( - [ ] - #{ :colon :at :both} { :right \), :allows-separator nil, :else nil } - (let [mod-case-writer (cond - (and (:at params) (:colon params)) - upcase-writer - - (:colon params) - capitalize-word-writer - - (:at params) - init-cap-writer - - :else - downcase-writer)] - #(modify-case mod-case-writer %1 %2 %3))) - - (\) [] #{} {} nil) - - (\[ - [ :selector [nil Integer] ] - #{ :colon :at } { :right \], :allows-separator true, :else :last } - (cond - (:colon params) - boolean-conditional - - (:at params) - check-arg-conditional - - true - choice-conditional)) - - (\; [:min-remaining [nil Integer] :max-columns [nil Integer]] - #{ :colon } { :separator true } nil) - - (\] [] #{} {} nil) - - (\{ - [ :max-iterations [nil Integer] ] - #{ :colon :at :both} { :right \}, :allows-separator false } - (cond - (and (:at params) (:colon params)) - iterate-main-sublists - - (:colon params) - iterate-list-of-sublists - - (:at params) - iterate-main-list - - true - iterate-sublist)) - - - (\} [] #{:colon} {} nil) - - (\< - [:mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character]] - #{:colon :at :both :pretty} { :right \>, :allows-separator true, :else :first } - logical-block-or-justify) - - (\> [] #{:colon} {} nil) - - ;; TODO: detect errors in cases where colon not allowed - (\^ [:arg1 [nil Integer] :arg2 [nil Integer] :arg3 [nil Integer]] - #{:colon} {} - (fn [params navigator offsets] - (let [arg1 (:arg1 params) - arg2 (:arg2 params) - arg3 (:arg3 params) - exit (if (:colon params) :colon-up-arrow :up-arrow)] - (cond - (and arg1 arg2 arg3) - (if (<= arg1 arg2 arg3) [exit navigator] navigator) - - (and arg1 arg2) - (if (= arg1 arg2) [exit navigator] navigator) - - arg1 - (if (= arg1 0) [exit navigator] navigator) - - true ; TODO: handle looking up the arglist stack for info - (if (if (:colon params) - (empty? (:rest (:base-args params))) - (empty? (:rest navigator))) - [exit navigator] navigator))))) - - (\W - [] - #{:at :colon :both} {} - (if (or (:at params) (:colon params)) - (let [bindings (concat - (if (:at params) [:level nil :length nil] []) - (if (:colon params) [:pretty true] []))] - (fn [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (apply write arg bindings) - [:up-arrow navigator] - navigator)))) - (fn [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (write-out arg) - [:up-arrow navigator] - navigator))))) - - (\_ - [] - #{:at :colon :both} {} - conditional-newline) - - (\I - [:n [0 Integer]] - #{:colon} {} - set-indent) - ) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Code to manage the parameters and flags associated with each -;;; directive in the format string. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - param-pattern #"^([vV]|#|('.)|([+-]?\d+)|(?=,))") -(def ^{:private true} - special-params #{ :parameter-from-args :remaining-arg-count }) - -(defn- extract-param [[s offset saw-comma]] - (let [m (re-matcher param-pattern s) - param (re-find m)] - (if param - (let [token-str (first (re-groups m)) - remainder (subs s (.end m)) - new-offset (+ offset (.end m))] - (if (not (= \, (nth remainder 0))) - [ [token-str offset] [remainder new-offset false]] - [ [token-str offset] [(subs remainder 1) (inc new-offset) true]])) - (if saw-comma - (format-error "Badly formed parameters in format directive" offset) - [ nil [s offset]])))) - - -(defn- extract-params [s offset] - (consume extract-param [s offset false])) - -(defn- translate-param - "Translate the string representation of a param to the internalized - representation" - [[^String p offset]] - [(cond - (= (.length p) 0) nil - (and (= (.length p) 1) (contains? #{\v \V} (nth p 0))) :parameter-from-args - (and (= (.length p) 1) (= \# (nth p 0))) :remaining-arg-count - (and (= (.length p) 2) (= \' (nth p 0))) (nth p 1) - true (new Integer p)) - offset]) - -(def ^{:private true} - flag-defs { \: :colon, \@ :at }) - -(defn- extract-flags [s offset] - (consume - (fn [[s offset flags]] - (if (empty? s) - [nil [s offset flags]] - (let [flag (get flag-defs (first s))] - (if flag - (if (contains? flags flag) - (format-error - (str "Flag \"" (first s) "\" appears more than once in a directive") - offset) - [true [(subs s 1) (inc offset) (assoc flags flag [true offset])]]) - [nil [s offset flags]])))) - [s offset {}])) - -(defn- check-flags [def flags] - (let [allowed (:flags def)] - (if (and (not (:at allowed)) (:at flags)) - (format-error (str "\"@\" is an illegal flag for format directive \"" (:directive def) "\"") - (nth (:at flags) 1))) - (if (and (not (:colon allowed)) (:colon flags)) - (format-error (str "\":\" is an illegal flag for format directive \"" (:directive def) "\"") - (nth (:colon flags) 1))) - (if (and (not (:both allowed)) (:at flags) (:colon flags)) - (format-error (str "Cannot combine \"@\" and \":\" flags for format directive \"" - (:directive def) "\"") - (min (nth (:colon flags) 1) (nth (:at flags) 1)))))) - -(defn- map-params - "Takes a directive definition and the list of actual parameters and -a map of flags and returns a map of the parameters and flags with defaults -filled in. We check to make sure that there are the right types and number -of parameters as well." - [def params flags offset] - (check-flags def flags) - (if (> (count params) (count (:params def))) - (format-error - (cl-format - nil - "Too many parameters for directive \"~C\": ~D~:* ~[were~;was~:;were~] specified but only ~D~:* ~[are~;is~:;are~] allowed" - (:directive def) (count params) (count (:params def))) - (second (first params)))) - (doall - (map #(let [val (first %1)] - (if (not (or (nil? val) (contains? special-params val) - (instance? (second (second %2)) val))) - (format-error (str "Parameter " (name (first %2)) - " has bad type in directive \"" (:directive def) "\": " - (class val)) - (second %1))) ) - params (:params def))) - - (merge ; create the result map - (into (array-map) ; start with the default values, make sure the order is right - (reverse (for [[name [default]] (:params def)] [name [default offset]]))) - (reduce #(apply assoc %1 %2) {} (filter #(first (nth % 1)) (zipmap (keys (:params def)) params))) ; add the specified parameters, filtering out nils - flags)) ; and finally add the flags - -(defn- compile-directive [s offset] - (let [[raw-params [rest offset]] (extract-params s offset) - [_ [rest offset flags]] (extract-flags rest offset) - directive (first rest) - def (get directive-table (Character/toUpperCase ^Character directive)) - params (if def (map-params def (map translate-param raw-params) flags offset))] - (if (not directive) - (format-error "Format string ended in the middle of a directive" offset)) - (if (not def) - (format-error (str "Directive \"" directive "\" is undefined") offset)) - [(struct compiled-directive ((:generator-fn def) params offset) def params offset) - (let [remainder (subs rest 1) - offset (inc offset) - trim? (and (= \newline (:directive def)) - (not (:colon params))) - trim-count (if trim? (prefix-count remainder [\space \tab]) 0) - remainder (subs remainder trim-count) - offset (+ offset trim-count)] - [remainder offset])])) - -(defn- compile-raw-string [s offset] - (struct compiled-directive (fn [_ a _] (print s) a) nil { :string s } offset)) - -(defn- right-bracket [this] (:right (:bracket-info (:def this)))) -(defn- separator? [this] (:separator (:bracket-info (:def this)))) -(defn- else-separator? [this] - (and (:separator (:bracket-info (:def this))) - (:colon (:params this)))) - - -(declare collect-clauses) - -(defn- process-bracket [this remainder] - (let [[subex remainder] (collect-clauses (:bracket-info (:def this)) - (:offset this) remainder)] - [(struct compiled-directive - (:func this) (:def this) - (merge (:params this) (tuple-map subex (:offset this))) - (:offset this)) - remainder])) - -(defn- process-clause [bracket-info offset remainder] - (consume - (fn [remainder] - (if (empty? remainder) - (format-error "No closing bracket found." offset) - (let [this (first remainder) - remainder (next remainder)] - (cond - (right-bracket this) - (process-bracket this remainder) - - (= (:right bracket-info) (:directive (:def this))) - [ nil [:right-bracket (:params this) nil remainder]] - - (else-separator? this) - [nil [:else nil (:params this) remainder]] - - (separator? this) - [nil [:separator nil nil remainder]] ;; TODO: check to make sure that there are no params on ~; - - true - [this remainder])))) - remainder)) - -(defn- collect-clauses [bracket-info offset remainder] - (second - (consume - (fn [[clause-map saw-else remainder]] - (let [[clause [type right-params else-params remainder]] - (process-clause bracket-info offset remainder)] - (cond - (= type :right-bracket) - [nil [(merge-with concat clause-map - {(if saw-else :else :clauses) [clause] - :right-params right-params}) - remainder]] - - (= type :else) - (cond - (:else clause-map) - (format-error "Two else clauses (\"~:;\") inside bracket construction." offset) - - (not (:else bracket-info)) - (format-error "An else clause (\"~:;\") is in a bracket type that doesn't support it." - offset) - - (and (= :first (:else bracket-info)) (seq (:clauses clause-map))) - (format-error - "The else clause (\"~:;\") is only allowed in the first position for this directive." - offset) - - true ; if the ~:; is in the last position, the else clause - ; is next, this was a regular clause - (if (= :first (:else bracket-info)) - [true [(merge-with concat clause-map { :else [clause] :else-params else-params}) - false remainder]] - [true [(merge-with concat clause-map { :clauses [clause] }) - true remainder]])) - - (= type :separator) - (cond - saw-else - (format-error "A plain clause (with \"~;\") follows an else clause (\"~:;\") inside bracket construction." offset) - - (not (:allows-separator bracket-info)) - (format-error "A separator (\"~;\") is in a bracket type that doesn't support it." - offset) - - true - [true [(merge-with concat clause-map { :clauses [clause] }) - false remainder]])))) - [{ :clauses [] } false remainder]))) - -(defn- process-nesting - "Take a linearly compiled format and process the bracket directives to give it - the appropriate tree structure" - [format] - (first - (consume - (fn [remainder] - (let [this (first remainder) - remainder (next remainder) - bracket (:bracket-info (:def this))] - (if (:right bracket) - (process-bracket this remainder) - [this remainder]))) - format))) - -(defn- compile-format - "Compiles format-str into a compiled format which can be used as an argument -to cl-format just like a plain format string. Use this function for improved -performance when you're using the same format string repeatedly" - [ format-str ] -; (prlabel compiling format-str) - (binding [*format-str* format-str] - (process-nesting - (first - (consume - (fn [[^String s offset]] - (if (empty? s) - [nil s] - (let [tilde (.indexOf s (int \~))] - (cond - (neg? tilde) [(compile-raw-string s offset) ["" (+ offset (.length s))]] - (zero? tilde) (compile-directive (subs s 1) (inc offset)) - true - [(compile-raw-string (subs s 0 tilde) offset) [(subs s tilde) (+ tilde offset)]])))) - [format-str 0]))))) - -(defn- needs-pretty - "determine whether a given compiled format has any directives that depend on the -column number or pretty printing" - [format] - (loop [format format] - (if (empty? format) - false - (if (or (:pretty (:flags (:def (first format)))) - (some needs-pretty (first (:clauses (:params (first format))))) - (some needs-pretty (first (:else (:params (first format)))))) - true - (recur (next format)))))) - -(defn- execute-format - "Executes the format with the arguments." - {:skip-wiki true} - ([stream format args] - (let [^java.io.Writer real-stream (cond - (not stream) (java.io.StringWriter.) - (true? stream) *out* - :else stream) - ^java.io.Writer wrapped-stream (if (and (needs-pretty format) - (not (pretty-writer? real-stream))) - (get-pretty-writer real-stream) - real-stream)] - (binding [*out* wrapped-stream] - (try - (execute-format format args) - (finally - (if-not (identical? real-stream wrapped-stream) - (.flush wrapped-stream)))) - (if (not stream) (.toString real-stream))))) - ([format args] - (map-passing-context - (fn [element context] - (if (abort? context) - [nil context] - (let [[params args] (realize-parameter-list - (:params element) context) - [params offsets] (unzip-map params) - params (assoc params :base-args args)] - [nil (apply (:func element) [params args offsets])]))) - args - format) - nil)) - -;;; This is a bad idea, but it prevents us from leaking private symbols -;;; This should all be replaced by really compiled formats anyway. -(def ^{:private true} cached-compile (memoize compile-format)) - -(defmacro formatter - "Makes a function which can directly run format-in. The function is -fn [stream & args] ... and returns nil unless the stream is nil (meaning -output to a string) in which case it returns the resulting string. - -format-in can be either a control string or a previously compiled format." - {:added "1.2"} - [format-in] - `(let [format-in# ~format-in - my-c-c# (var-get (get (ns-interns (the-ns 'clojure.pprint)) - '~'cached-compile)) - my-e-f# (var-get (get (ns-interns (the-ns 'clojure.pprint)) - '~'execute-format)) - my-i-n# (var-get (get (ns-interns (the-ns 'clojure.pprint)) - '~'init-navigator)) - cf# (if (string? format-in#) (my-c-c# format-in#) format-in#)] - (fn [stream# & args#] - (let [navigator# (my-i-n# args#)] - (my-e-f# stream# cf# navigator#))))) - -(defmacro formatter-out - "Makes a function which can directly run format-in. The function is -fn [& args] ... and returns nil. This version of the formatter macro is -designed to be used with *out* set to an appropriate Writer. In particular, -this is meant to be used as part of a pretty printer dispatch method. - -format-in can be either a control string or a previously compiled format." - {:added "1.2"} - [format-in] - `(let [format-in# ~format-in - cf# (if (string? format-in#) (#'clojure.pprint/cached-compile format-in#) format-in#)] - (fn [& args#] - (let [navigator# (#'clojure.pprint/init-navigator args#)] - (#'clojure.pprint/execute-format cf# navigator#))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/pprint/column_writer.clj --- a/src/clojure/pprint/column_writer.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -;;; column_writer.clj -- part of the pretty printer for Clojure - - -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber -;; April 3, 2009 -;; Revised to use proxy instead of gen-class April 2010 - -;; This module implements a column-aware wrapper around an instance of java.io.Writer - -(in-ns 'clojure.pprint) - -(import [clojure.lang IDeref] - [java.io Writer]) - -(def ^{:private true} *default-page-width* 72) - -(defn- get-field [^Writer this sym] - (sym @@this)) - -(defn- set-field [^Writer this sym new-val] - (alter @this assoc sym new-val)) - -(defn- get-column [this] - (get-field this :cur)) - -(defn- get-line [this] - (get-field this :line)) - -(defn- get-max-column [this] - (get-field this :max)) - -(defn- set-max-column [this new-max] - (dosync (set-field this :max new-max)) - nil) - -(defn- get-writer [this] - (get-field this :base)) - -(defn- c-write-char [^Writer this ^Integer c] - (dosync (if (= c (int \newline)) - (do - (set-field this :cur 0) - (set-field this :line (inc (get-field this :line)))) - (set-field this :cur (inc (get-field this :cur))))) - (.write ^Writer (get-field this :base) c)) - -(defn- column-writer - ([writer] (column-writer writer *default-page-width*)) - ([writer max-columns] - (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})] - (proxy [Writer IDeref] [] - (deref [] fields) - (write - ([^chars cbuf ^Integer off ^Integer len] - (let [^Writer writer (get-field this :base)] - (.write writer cbuf off len))) - ([x] - (condp = (class x) - String - (let [^String s x - nl (.lastIndexOf s (int \newline))] - (dosync (if (neg? nl) - (set-field this :cur (+ (get-field this :cur) (count s))) - (do - (set-field this :cur (- (count s) nl 1)) - (set-field this :line (+ (get-field this :line) - (count (filter #(= % \newline) s))))))) - (.write ^Writer (get-field this :base) s)) - - Integer - (c-write-char this x)))))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/pprint/dispatch.clj --- a/src/clojure/pprint/dispatch.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,467 +0,0 @@ -;; dispatch.clj -- part of the pretty printer for Clojure - -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber -;; April 3, 2009 - - -;; This module implements the default dispatch tables for pretty printing code and -;; data. - -(in-ns 'clojure.pprint) - -(defn- use-method - "Installs a function as a new method of multimethod associated with dispatch-value. " - [multifn dispatch-val func] - (. multifn addMethod dispatch-val func)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Implementations of specific dispatch table entries -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Handle forms that can be "back-translated" to reader macros -;;; Not all reader macros can be dealt with this way or at all. -;;; Macros that we can't deal with at all are: -;;; ; - The comment character is aborbed by the reader and never is part of the form -;;; ` - Is fully processed at read time into a lisp expression (which will contain concats -;;; and regular quotes). -;;; ~@ - Also fully eaten by the processing of ` and can't be used outside. -;;; , - is whitespace and is lost (like all other whitespace). Formats can generate commas -;;; where they deem them useful to help readability. -;;; ^ - Adding metadata completely disappears at read time and the data appears to be -;;; completely lost. -;;; -;;; Most other syntax stuff is dealt with directly by the formats (like (), [], {}, and #{}) -;;; or directly by printing the objects using Clojure's built-in print functions (like -;;; :keyword, \char, or ""). The notable exception is #() which is special-cased. - -(def ^{:private true} reader-macros - {'quote "'", 'clojure.core/deref "@", - 'var "#'", 'clojure.core/unquote "~"}) - -(defn- pprint-reader-macro [alis] - (let [^String macro-char (reader-macros (first alis))] - (when (and macro-char (= 2 (count alis))) - (.write ^java.io.Writer *out* macro-char) - (write-out (second alis)) - true))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dispatch for the basic data types when interpreted -;; as data (as opposed to code). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; TODO: inline these formatter statements into funcs so that we -;;; are a little easier on the stack. (Or, do "real" compilation, a -;;; la Common Lisp) - -;;; (def pprint-simple-list (formatter-out "~:<~@{~w~^ ~_~}~:>")) -(defn- pprint-simple-list [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (loop [alis (seq alis)] - (when alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next alis))))))) - -(defn- pprint-list [alis] - (if-not (pprint-reader-macro alis) - (pprint-simple-list alis))) - -;;; (def pprint-vector (formatter-out "~<[~;~@{~w~^ ~_~}~;]~:>")) -(defn- pprint-vector [avec] - (pprint-logical-block :prefix "[" :suffix "]" - (loop [aseq (seq avec)] - (when aseq - (write-out (first aseq)) - (when (next aseq) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next aseq))))))) - -(def ^{:private true} pprint-array (formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>")) - -;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>")) -(defn- pprint-map [amap] - (pprint-logical-block :prefix "{" :suffix "}" - (loop [aseq (seq amap)] - (when aseq - (pprint-logical-block - (write-out (ffirst aseq)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (write-out (fnext (first aseq)))) - (when (next aseq) - (.write ^java.io.Writer *out* ", ") - (pprint-newline :linear) - (recur (next aseq))))))) - -(def ^{:private true} pprint-set (formatter-out "~<#{~;~@{~w~^ ~:_~}~;}~:>")) - -;;; TODO: don't block on promise (currently impossible) - -(def ^{:private true} - type-map {"core$future_call" "Future", - "core$promise" "Promise"}) - -(defn- map-ref-type - "Map ugly type names to something simpler" - [name] - (or (when-let [match (re-find #"^[^$]+\$[^$]+" name)] - (type-map match)) - name)) - -(defn- pprint-ideref [o] - (let [prefix (format "#<%s@%x%s: " - (map-ref-type (.getSimpleName (class o))) - (System/identityHashCode o) - (if (and (instance? clojure.lang.Agent o) - (agent-error o)) - " FAILED" - ""))] - (pprint-logical-block :prefix prefix :suffix ">" - (pprint-indent :block (-> (count prefix) (- 2) -)) - (pprint-newline :linear) - (write-out (cond - (and (future? o) (not (future-done? o))) :pending - :else @o))))) - -(def ^{:private true} pprint-pqueue (formatter-out "~<<-(~;~@{~w~^ ~_~}~;)-<~:>")) - -(defn- pprint-simple-default [obj] - (cond - (.isArray (class obj)) (pprint-array obj) - (and *print-suppress-namespaces* (symbol? obj)) (print (name obj)) - :else (pr obj))) - - -(defmulti - simple-dispatch - "The pretty print dispatch function for simple data structure format." - {:added "1.2" :arglists '[[object]]} - class) - -(use-method simple-dispatch clojure.lang.ISeq pprint-list) -(use-method simple-dispatch clojure.lang.IPersistentVector pprint-vector) -(use-method simple-dispatch clojure.lang.IPersistentMap pprint-map) -(use-method simple-dispatch clojure.lang.IPersistentSet pprint-set) -(use-method simple-dispatch clojure.lang.PersistentQueue pprint-pqueue) -(use-method simple-dispatch clojure.lang.IDeref pprint-ideref) -(use-method simple-dispatch nil pr) -(use-method simple-dispatch :default pprint-simple-default) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Dispatch for the code table -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare pprint-simple-code-list) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like a simple def (sans metadata, since the reader -;;; won't give it to us now). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} pprint-hold-first (formatter-out "~:<~w~^ ~@_~w~^ ~_~@{~w~^ ~_~}~:>")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like a defn or defmacro -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Format the params and body of a defn with a single arity -(defn- single-defn [alis has-doc-str?] - (if (seq alis) - (do - (if has-doc-str? - ((formatter-out " ~_")) - ((formatter-out " ~@_"))) - ((formatter-out "~{~w~^ ~_~}") alis)))) - -;;; Format the param and body sublists of a defn with multiple arities -(defn- multi-defn [alis has-doc-str?] - (if (seq alis) - ((formatter-out " ~_~{~w~^ ~_~}") alis))) - -;;; TODO: figure out how to support capturing metadata in defns (we might need a -;;; special reader) -(defn- pprint-defn [alis] - (if (next alis) - (let [[defn-sym defn-name & stuff] alis - [doc-str stuff] (if (string? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff]) - [attr-map stuff] (if (map? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff])] - (pprint-logical-block :prefix "(" :suffix ")" - ((formatter-out "~w ~1I~@_~w") defn-sym defn-name) - (if doc-str - ((formatter-out " ~_~w") doc-str)) - (if attr-map - ((formatter-out " ~_~w") attr-map)) - ;; Note: the multi-defn case will work OK for malformed defns too - (cond - (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) - :else (multi-defn stuff (or doc-str attr-map))))) - (pprint-simple-code-list alis))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something with a binding form -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- pprint-binding-form [binding-vec] - (pprint-logical-block :prefix "[" :suffix "]" - (loop [binding binding-vec] - (when (seq binding) - (pprint-logical-block binding - (write-out (first binding)) - (when (next binding) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second binding)))) - (when (next (rest binding)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest binding)))))))) - -(defn- pprint-let [alis] - (let [base-sym (first alis)] - (pprint-logical-block :prefix "(" :suffix ")" - (if (and (next alis) (vector? (second alis))) - (do - ((formatter-out "~w ~1I~@_") base-sym) - (pprint-binding-form (second alis)) - ((formatter-out " ~_~{~w~^ ~_~}") (next (rest alis)))) - (pprint-simple-code-list alis))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like "if" -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} pprint-if (formatter-out "~:<~1I~w~^ ~@_~w~@{ ~_~w~}~:>")) - -(defn- pprint-cond [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (loop [alis (next alis)] - (when alis - (pprint-logical-block alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second alis)))) - (when (next (rest alis)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest alis))))))))) - -(defn- pprint-condp [alis] - (if (> (count alis) 3) - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (apply (formatter-out "~w ~@_~w ~@_~w ~_") alis) - (loop [alis (seq (drop 3 alis))] - (when alis - (pprint-logical-block alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second alis)))) - (when (next (rest alis)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest alis))))))) - (pprint-simple-code-list alis))) - -;;; The map of symbols that are defined in an enclosing #() anonymous function -(def ^{:private true} *symbol-map* {}) - -(defn- pprint-anon-func [alis] - (let [args (second alis) - nlis (first (rest (rest alis)))] - (if (vector? args) - (binding [*symbol-map* (if (= 1 (count args)) - {(first args) "%"} - (into {} - (map - #(vector %1 (str \% %2)) - args - (range 1 (inc (count args))))))] - ((formatter-out "~<#(~;~@{~w~^ ~_~}~;)~:>") nlis)) - (pprint-simple-code-list alis)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The master definitions for formatting lists in code (that is, (fn args...) or -;;; special forms). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; This is the equivalent of (formatter-out "~:<~1I~@{~w~^ ~_~}~:>"), but is -;;; easier on the stack. - -(defn- pprint-simple-code-list [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (loop [alis (seq alis)] - (when alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next alis))))))) - -;;; Take a map with symbols as keys and add versions with no namespace. -;;; That is, if ns/sym->val is in the map, add sym->val to the result. -(defn- two-forms [amap] - (into {} - (mapcat - identity - (for [x amap] - [x [(symbol (name (first x))) (second x)]])))) - -(defn- add-core-ns [amap] - (let [core "clojure.core"] - (into {} - (map #(let [[s f] %] - (if (not (or (namespace s) (special-symbol? s))) - [(symbol core (name s)) f] - %)) - amap)))) - -(def ^{:private true} *code-table* - (two-forms - (add-core-ns - {'def pprint-hold-first, 'defonce pprint-hold-first, - 'defn pprint-defn, 'defn- pprint-defn, 'defmacro pprint-defn, 'fn pprint-defn, - 'let pprint-let, 'loop pprint-let, 'binding pprint-let, - 'with-local-vars pprint-let, 'with-open pprint-let, 'when-let pprint-let, - 'if-let pprint-let, 'doseq pprint-let, 'dotimes pprint-let, - 'when-first pprint-let, - 'if pprint-if, 'if-not pprint-if, 'when pprint-if, 'when-not pprint-if, - 'cond pprint-cond, 'condp pprint-condp, - 'fn* pprint-anon-func, - '. pprint-hold-first, '.. pprint-hold-first, '-> pprint-hold-first, - 'locking pprint-hold-first, 'struct pprint-hold-first, - 'struct-map pprint-hold-first, - }))) - -(defn- pprint-code-list [alis] - (if-not (pprint-reader-macro alis) - (if-let [special-form (*code-table* (first alis))] - (special-form alis) - (pprint-simple-code-list alis)))) - -(defn- pprint-code-symbol [sym] - (if-let [arg-num (sym *symbol-map*)] - (print arg-num) - (if *print-suppress-namespaces* - (print (name sym)) - (pr sym)))) - -(defmulti - code-dispatch - "The pretty print dispatch function for pretty printing Clojure code." - {:added "1.2" :arglists '[[object]]} - class) - -(use-method code-dispatch clojure.lang.ISeq pprint-code-list) -(use-method code-dispatch clojure.lang.Symbol pprint-code-symbol) - -;; The following are all exact copies of simple-dispatch -(use-method code-dispatch clojure.lang.IPersistentVector pprint-vector) -(use-method code-dispatch clojure.lang.IPersistentMap pprint-map) -(use-method code-dispatch clojure.lang.IPersistentSet pprint-set) -(use-method code-dispatch clojure.lang.PersistentQueue pprint-pqueue) -(use-method code-dispatch clojure.lang.IDeref pprint-ideref) -(use-method code-dispatch nil pr) -(use-method code-dispatch :default pprint-simple-default) - -(set-pprint-dispatch simple-dispatch) - - -;;; For testing -(comment - -(with-pprint-dispatch code-dispatch - (pprint - '(defn cl-format - "An implementation of a Common Lisp compatible format function" - [stream format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format stream compiled-format navigator))))) - -(with-pprint-dispatch code-dispatch - (pprint - '(defn cl-format - [stream format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format stream compiled-format navigator))))) - -(with-pprint-dispatch code-dispatch - (pprint - '(defn- -write - ([this x] - (condp = (class x) - String - (let [s0 (write-initial-lines this x) - s (.replaceFirst s0 "\\s+$" "") - white-space (.substring s0 (count s)) - mode (getf :mode)] - (if (= mode :writing) - (dosync - (write-white-space this) - (.col_write this s) - (setf :trailing-white-space white-space)) - (add-to-buffer this (make-buffer-blob s white-space)))) - - Integer - (let [c ^Character x] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (.col_write this x)) - (if (= c (int \newline)) - (write-initial-lines this "\n") - (add-to-buffer this (make-buffer-blob (str (char c)) nil)))))))))) - -(with-pprint-dispatch code-dispatch - (pprint - '(defn pprint-defn [writer alis] - (if (next alis) - (let [[defn-sym defn-name & stuff] alis - [doc-str stuff] (if (string? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff]) - [attr-map stuff] (if (map? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff])] - (pprint-logical-block writer :prefix "(" :suffix ")" - (cl-format true "~w ~1I~@_~w" defn-sym defn-name) - (if doc-str - (cl-format true " ~_~w" doc-str)) - (if attr-map - (cl-format true " ~_~w" attr-map)) - ;; Note: the multi-defn case will work OK for malformed defns too - (cond - (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) - :else (multi-defn stuff (or doc-str attr-map))))) - (pprint-simple-code-list writer alis))))) -) -nil - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/pprint/pprint_base.clj --- a/src/clojure/pprint/pprint_base.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,374 +0,0 @@ -;;; pprint_base.clj -- part of the pretty printer for Clojure - -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber -;; April 3, 2009 - - -;; This module implements the generic pretty print functions and special variables - -(in-ns 'clojure.pprint) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Variables that control the pretty printer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; -;;; *print-length*, *print-level* and *print-dup* are defined in clojure.core -;;; TODO: use *print-dup* here (or is it supplanted by other variables?) -;;; TODO: make dispatch items like "(let..." get counted in *print-length* -;;; constructs - - -(def - ^{:doc "Bind to true if you want write to use pretty printing", :added "1.2"} - *print-pretty* true) - -(defonce ; If folks have added stuff here, don't overwrite - ^{:doc "The pretty print dispatch function. Use with-pprint-dispatch or set-pprint-dispatch -to modify.", - :added "1.2"} - *print-pprint-dispatch* nil) - -(def - ^{:doc "Pretty printing will try to avoid anything going beyond this column. -Set it to nil to have pprint let the line be arbitrarily long. This will ignore all -non-mandatory newlines.", - :added "1.2"} - *print-right-margin* 72) - -(def - ^{:doc "The column at which to enter miser style. Depending on the dispatch table, -miser style add newlines in more places to try to keep lines short allowing for further -levels of nesting.", - :added "1.2"} - *print-miser-width* 40) - -;;; TODO implement output limiting -(def - ^{:private true, - :doc "Maximum number of lines to print in a pretty print instance (N.B. This is not yet used)"} - *print-lines* nil) - -;;; TODO: implement circle and shared -(def - ^{:private true, - :doc "Mark circular structures (N.B. This is not yet used)"} - *print-circle* nil) - -;;; TODO: should we just use *print-dup* here? -(def - ^{:private true, - :doc "Mark repeated structures rather than repeat them (N.B. This is not yet used)"} - *print-shared* nil) - -(def - ^{:doc "Don't print namespaces with symbols. This is particularly useful when -pretty printing the results of macro expansions" - :added "1.2"} - *print-suppress-namespaces* nil) - -;;; TODO: support print-base and print-radix in cl-format -;;; TODO: support print-base and print-radix in rationals -(def - ^{:doc "Print a radix specifier in front of integers and rationals. If *print-base* is 2, 8, -or 16, then the radix specifier used is #b, #o, or #x, respectively. Otherwise the -radix specifier is in the form #XXr where XX is the decimal value of *print-base* " - :added "1.2"} - *print-radix* nil) - -(def - ^{:doc "The base to use for printing integers and rationals." - :added "1.2"} - *print-base* 10) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Internal variables that keep track of where we are in the -;; structure -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{ :private true } *current-level* 0) - -(def ^{ :private true } *current-length* nil) - -;; TODO: add variables for length, lines. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Support for the write function -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare format-simple-number) - -(def ^{:private true} orig-pr pr) - -(defn- pr-with-base [x] - (if-let [s (format-simple-number x)] - (print s) - (orig-pr x))) - -(def ^{:private true} write-option-table - {;:array *print-array* - :base 'clojure.pprint/*print-base*, - ;;:case *print-case*, - :circle 'clojure.pprint/*print-circle*, - ;;:escape *print-escape*, - ;;:gensym *print-gensym*, - :length 'clojure.core/*print-length*, - :level 'clojure.core/*print-level*, - :lines 'clojure.pprint/*print-lines*, - :miser-width 'clojure.pprint/*print-miser-width*, - :dispatch 'clojure.pprint/*print-pprint-dispatch*, - :pretty 'clojure.pprint/*print-pretty*, - :radix 'clojure.pprint/*print-radix*, - :readably 'clojure.core/*print-readably*, - :right-margin 'clojure.pprint/*print-right-margin*, - :suppress-namespaces 'clojure.pprint/*print-suppress-namespaces*}) - - -(defmacro ^{:private true} binding-map [amap & body] - (let [] - `(do - (. clojure.lang.Var (pushThreadBindings ~amap)) - (try - ~@body - (finally - (. clojure.lang.Var (popThreadBindings))))))) - -(defn- table-ize [t m] - (apply hash-map (mapcat - #(when-let [v (get t (key %))] [(find-var v) (val %)]) - m))) - -(defn- pretty-writer? - "Return true iff x is a PrettyWriter" - [x] (and (instance? clojure.lang.IDeref x) (:pretty-writer @@x))) - -(defn- make-pretty-writer - "Wrap base-writer in a PrettyWriter with the specified right-margin and miser-width" - [base-writer right-margin miser-width] - (pretty-writer base-writer right-margin miser-width)) - -(defmacro ^{:private true} with-pretty-writer [base-writer & body] - `(let [base-writer# ~base-writer - new-writer# (not (pretty-writer? base-writer#))] - (binding [*out* (if new-writer# - (make-pretty-writer base-writer# *print-right-margin* *print-miser-width*) - base-writer#)] - ~@body - (.flush *out*)))) - - -;;;TODO: if pretty print is not set, don't use pr but rather something that respects *print-base*, etc. -(defn write-out - "Write an object to *out* subject to the current bindings of the printer control -variables. Use the kw-args argument to override individual variables for this call (and -any recursive calls). - -*out* must be a PrettyWriter if pretty printing is enabled. This is the responsibility -of the caller. - -This method is primarily intended for use by pretty print dispatch functions that -already know that the pretty printer will have set up their environment appropriately. -Normal library clients should use the standard \"write\" interface. " - {:added "1.2"} - [object] - (let [length-reached (and - *current-length* - *print-length* - (>= *current-length* *print-length*))] - (if-not *print-pretty* - (pr object) - (if length-reached - (print "...") - (do - (if *current-length* (set! *current-length* (inc *current-length*))) - (*print-pprint-dispatch* object)))) - length-reached)) - -(defn write - "Write an object subject to the current bindings of the printer control variables. -Use the kw-args argument to override individual variables for this call (and any -recursive calls). Returns the string result if :stream is nil or nil otherwise. - -The following keyword arguments can be passed with values: - Keyword Meaning Default value - :stream Writer for output or nil true (indicates *out*) - :base Base to use for writing rationals Current value of *print-base* - :circle* If true, mark circular structures Current value of *print-circle* - :length Maximum elements to show in sublists Current value of *print-length* - :level Maximum depth Current value of *print-level* - :lines* Maximum lines of output Current value of *print-lines* - :miser-width Width to enter miser mode Current value of *print-miser-width* - :dispatch The pretty print dispatch function Current value of *print-pprint-dispatch* - :pretty If true, do pretty printing Current value of *print-pretty* - :radix If true, prepend a radix specifier Current value of *print-radix* - :readably* If true, print readably Current value of *print-readably* - :right-margin The column for the right margin Current value of *print-right-margin* - :suppress-namespaces If true, no namespaces in symbols Current value of *print-suppress-namespaces* - - * = not yet supported -" - {:added "1.2"} - [object & kw-args] - (let [options (merge {:stream true} (apply hash-map kw-args))] - (binding-map (table-ize write-option-table options) - (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) - (let [optval (if (contains? options :stream) - (:stream options) - true) - base-writer (condp = optval - nil (java.io.StringWriter.) - true *out* - optval)] - (if *print-pretty* - (with-pretty-writer base-writer - (write-out object)) - (binding [*out* base-writer] - (pr object))) - (if (nil? optval) - (.toString ^java.io.StringWriter base-writer))))))) - - -(defn pprint - "Pretty print object to the optional output writer. If the writer is not provided, -print the object to the currently bound value of *out*." - {:added "1.2"} - ([object] (pprint object *out*)) - ([object writer] - (with-pretty-writer writer - (binding [*print-pretty* true] - (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) - (write-out object))) - (if (not (= 0 (get-column *out*))) - (.write *out* (int \newline)))))) - -(defmacro pp - "A convenience macro that pretty prints the last thing output. This is -exactly equivalent to (pprint *1)." - {:added "1.2"} - [] `(pprint *1)) - -(defn set-pprint-dispatch - "Set the pretty print dispatch function to a function matching (fn [obj] ...) -where obj is the object to pretty print. That function will be called with *out* set -to a pretty printing writer to which it should do its printing. - -For example functions, see simple-dispatch and code-dispatch in -clojure.pprint.dispatch.clj." - {:added "1.2"} - [function] - (let [old-meta (meta #'*print-pprint-dispatch*)] - (alter-var-root #'*print-pprint-dispatch* (constantly function)) - (alter-meta! #'*print-pprint-dispatch* (constantly old-meta))) - nil) - -(defmacro with-pprint-dispatch - "Execute body with the pretty print dispatch function bound to function." - {:added "1.2"} - [function & body] - `(binding [*print-pprint-dispatch* ~function] - ~@body)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Support for the functional interface to the pretty printer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- parse-lb-options [opts body] - (loop [body body - acc []] - (if (opts (first body)) - (recur (drop 2 body) (concat acc (take 2 body))) - [(apply hash-map acc) body]))) - -(defn- check-enumerated-arg [arg choices] - (if-not (choices arg) - (throw - (IllegalArgumentException. - ;; TODO clean up choices string - (str "Bad argument: " arg ". It must be one of " choices))))) - -(defn- level-exceeded [] - (and *print-level* (>= *current-level* *print-level*))) - -(defmacro pprint-logical-block - "Execute the body as a pretty printing logical block with output to *out* which -must be a pretty printing writer. When used from pprint or cl-format, this can be -assumed. - -This function is intended for use when writing custom dispatch functions. - -Before the body, the caller can optionally specify options: :prefix, :per-line-prefix, -and :suffix." - {:added "1.2", :arglists '[[options* body]]} - [& args] - (let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)] - `(do (if (#'clojure.pprint/level-exceeded) - (.write ^java.io.Writer *out* "#") - (do - (push-thread-bindings {#'clojure.pprint/*current-level* - (inc (var-get #'clojure.pprint/*current-level*)) - #'clojure.pprint/*current-length* 0}) - (try - (#'clojure.pprint/start-block *out* - ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options)) - ~@body - (#'clojure.pprint/end-block *out*) - (finally - (pop-thread-bindings))))) - nil))) - -(defn pprint-newline - "Print a conditional newline to a pretty printing stream. kind specifies if the -newline is :linear, :miser, :fill, or :mandatory. - -This function is intended for use when writing custom dispatch functions. - -Output is sent to *out* which must be a pretty printing writer." - {:added "1.2"} - [kind] - (check-enumerated-arg kind #{:linear :miser :fill :mandatory}) - (nl *out* kind)) - -(defn pprint-indent - "Create an indent at this point in the pretty printing stream. This defines how -following lines are indented. relative-to can be either :block or :current depending -whether the indent should be computed relative to the start of the logical block or -the current column position. n is an offset. - -This function is intended for use when writing custom dispatch functions. - -Output is sent to *out* which must be a pretty printing writer." - {:added "1.2"} - [relative-to n] - (check-enumerated-arg relative-to #{:block :current}) - (indent *out* relative-to n)) - -;; TODO a real implementation for pprint-tab -(defn pprint-tab - "Tab at this point in the pretty printing stream. kind specifies whether the tab -is :line, :section, :line-relative, or :section-relative. - -Colnum and colinc specify the target column and the increment to move the target -forward if the output is already past the original target. - -This function is intended for use when writing custom dispatch functions. - -Output is sent to *out* which must be a pretty printing writer. - -THIS FUNCTION IS NOT YET IMPLEMENTED." - {:added "1.2"} - [kind colnum colinc] - (check-enumerated-arg kind #{:line :section :line-relative :section-relative}) - (throw (UnsupportedOperationException. "pprint-tab is not yet implemented"))) - - -nil diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/pprint/pretty_writer.clj --- a/src/clojure/pprint/pretty_writer.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,483 +0,0 @@ -;;; pretty_writer.clj -- part of the pretty printer for Clojure - -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber -;; April 3, 2009 -;; Revised to use proxy instead of gen-class April 2010 - -;; This module implements a wrapper around a java.io.Writer which implements the -;; core of the XP algorithm. - -(in-ns 'clojure.pprint) - -(import [clojure.lang IDeref] - [java.io Writer]) - -;; TODO: Support for tab directives - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Forward declarations -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare get-miser-width) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Macros to simplify dealing with types and classes. These are -;;; really utilities, but I'm experimenting with them here. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro ^{:private true} - getf - "Get the value of the field a named by the argument (which should be a keyword)." - [sym] - `(~sym @@~'this)) - -(defmacro ^{:private true} - setf [sym new-val] - "Set the value of the field SYM to NEW-VAL" - `(alter @~'this assoc ~sym ~new-val)) - -(defmacro ^{:private true} - deftype [type-name & fields] - (let [name-str (name type-name)] - `(do - (defstruct ~type-name :type-tag ~@fields) - (alter-meta! #'~type-name assoc :private true) - (defn- ~(symbol (str "make-" name-str)) - [& vals#] (apply struct ~type-name ~(keyword name-str) vals#)) - (defn- ~(symbol (str name-str "?")) [x#] (= (:type-tag x#) ~(keyword name-str)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The data structures used by pretty-writer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defstruct ^{:private true} logical-block - :parent :section :start-col :indent - :done-nl :intra-block-nl - :prefix :per-line-prefix :suffix - :logical-block-callback) - -(defn- ancestor? [parent child] - (loop [child (:parent child)] - (cond - (nil? child) false - (identical? parent child) true - :else (recur (:parent child))))) - -(defstruct ^{:private true} section :parent) - -(defn- buffer-length [l] - (let [l (seq l)] - (if l - (- (:end-pos (last l)) (:start-pos (first l))) - 0))) - -; A blob of characters (aka a string) -(deftype buffer-blob :data :trailing-white-space :start-pos :end-pos) - -; A newline -(deftype nl-t :type :logical-block :start-pos :end-pos) - -(deftype start-block-t :logical-block :start-pos :end-pos) - -(deftype end-block-t :logical-block :start-pos :end-pos) - -(deftype indent-t :logical-block :relative-to :offset :start-pos :end-pos) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions to write tokens in the output buffer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare emit-nl) - -(defmulti ^{:private true} write-token #(:type-tag %2)) -(defmethod write-token :start-block-t [^Writer this token] - (when-let [cb (getf :logical-block-callback)] (cb :start)) - (let [lb (:logical-block token)] - (dosync - (when-let [^String prefix (:prefix lb)] - (.write (getf :base) prefix)) - (let [col (get-column (getf :base))] - (ref-set (:start-col lb) col) - (ref-set (:indent lb) col))))) - -(defmethod write-token :end-block-t [^Writer this token] - (when-let [cb (getf :logical-block-callback)] (cb :end)) - (when-let [^String suffix (:suffix (:logical-block token))] - (.write (getf :base) suffix))) - -(defmethod write-token :indent-t [^Writer this token] - (let [lb (:logical-block token)] - (ref-set (:indent lb) - (+ (:offset token) - (condp = (:relative-to token) - :block @(:start-col lb) - :current (get-column (getf :base))))))) - -(defmethod write-token :buffer-blob [^Writer this token] - (.write (getf :base) ^String (:data token))) - -(defmethod write-token :nl-t [^Writer this token] -; (prlabel wt @(:done-nl (:logical-block token))) -; (prlabel wt (:type token) (= (:type token) :mandatory)) - (if (or (= (:type token) :mandatory) - (and (not (= (:type token) :fill)) - @(:done-nl (:logical-block token)))) - (emit-nl this token) - (if-let [^String tws (getf :trailing-white-space)] - (.write (getf :base) tws))) - (dosync (setf :trailing-white-space nil))) - -(defn- write-tokens [^Writer this tokens force-trailing-whitespace] - (doseq [token tokens] - (if-not (= (:type-tag token) :nl-t) - (if-let [^String tws (getf :trailing-white-space)] - (.write (getf :base) tws))) - (write-token this token) - (setf :trailing-white-space (:trailing-white-space token))) - (let [^String tws (getf :trailing-white-space)] - (when (and force-trailing-whitespace tws) - (.write (getf :base) tws) - (setf :trailing-white-space nil)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; emit-nl? method defs for each type of new line. This makes -;;; the decision about whether to print this type of new line. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defn- tokens-fit? [^Writer this tokens] -;;; (prlabel tf? (get-column (getf :base) (buffer-length tokens)) - (let [maxcol (get-max-column (getf :base))] - (or - (nil? maxcol) - (< (+ (get-column (getf :base)) (buffer-length tokens)) maxcol)))) - -(defn- linear-nl? [this lb section] -; (prlabel lnl? @(:done-nl lb) (tokens-fit? this section)) - (or @(:done-nl lb) - (not (tokens-fit? this section)))) - -(defn- miser-nl? [^Writer this lb section] - (let [miser-width (get-miser-width this) - maxcol (get-max-column (getf :base))] - (and miser-width maxcol - (>= @(:start-col lb) (- maxcol miser-width)) - (linear-nl? this lb section)))) - -(defmulti ^{:private true} emit-nl? (fn [t _ _ _] (:type t))) - -(defmethod emit-nl? :linear [newl this section _] - (let [lb (:logical-block newl)] - (linear-nl? this lb section))) - -(defmethod emit-nl? :miser [newl this section _] - (let [lb (:logical-block newl)] - (miser-nl? this lb section))) - -(defmethod emit-nl? :fill [newl this section subsection] - (let [lb (:logical-block newl)] - (or @(:intra-block-nl lb) - (not (tokens-fit? this subsection)) - (miser-nl? this lb section)))) - -(defmethod emit-nl? :mandatory [_ _ _ _] - true) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Various support functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defn- get-section [buffer] - (let [nl (first buffer) - lb (:logical-block nl) - section (seq (take-while #(not (and (nl-t? %) (ancestor? (:logical-block %) lb))) - (next buffer)))] - [section (seq (drop (inc (count section)) buffer))])) - -(defn- get-sub-section [buffer] - (let [nl (first buffer) - lb (:logical-block nl) - section (seq (take-while #(let [nl-lb (:logical-block %)] - (not (and (nl-t? %) (or (= nl-lb lb) (ancestor? nl-lb lb))))) - (next buffer)))] - section)) - -(defn- update-nl-state [lb] - (dosync - (ref-set (:intra-block-nl lb) false) - (ref-set (:done-nl lb) true) - (loop [lb (:parent lb)] - (if lb - (do (ref-set (:done-nl lb) true) - (ref-set (:intra-block-nl lb) true) - (recur (:parent lb))))))) - -(defn- emit-nl [^Writer this nl] - (.write (getf :base) (int \newline)) - (dosync (setf :trailing-white-space nil)) - (let [lb (:logical-block nl) - ^String prefix (:per-line-prefix lb)] - (if prefix - (.write (getf :base) prefix)) - (let [^String istr (apply str (repeat (- @(:indent lb) (count prefix)) - \space))] - (.write (getf :base) istr)) - (update-nl-state lb))) - -(defn- split-at-newline [tokens] - (let [pre (seq (take-while #(not (nl-t? %)) tokens))] - [pre (seq (drop (count pre) tokens))])) - -;;; Methods for showing token strings for debugging - -(defmulti ^{:private true} tok :type-tag) -(defmethod tok :nl-t [token] - (:type token)) -(defmethod tok :buffer-blob [token] - (str \" (:data token) (:trailing-white-space token) \")) -(defmethod tok :default [token] - (:type-tag token)) -(defn- toks [toks] (map tok toks)) - -;;; write-token-string is called when the set of tokens in the buffer -;;; is longer than the available space on the line - -(defn- write-token-string [this tokens] - (let [[a b] (split-at-newline tokens)] -;; (prlabel wts (toks a) (toks b)) - (if a (write-tokens this a false)) - (if b - (let [[section remainder] (get-section b) - newl (first b)] -;; (prlabel wts (toks section)) (prlabel wts (:type newl)) (prlabel wts (toks remainder)) - (let [do-nl (emit-nl? newl this section (get-sub-section b)) - result (if do-nl - (do -;; (prlabel emit-nl (:type newl)) - (emit-nl this newl) - (next b)) - b) - long-section (not (tokens-fit? this result)) - result (if long-section - (let [rem2 (write-token-string this section)] -;;; (prlabel recurse (toks rem2)) - (if (= rem2 section) - (do ; If that didn't produce any output, it has no nls - ; so we'll force it - (write-tokens this section false) - remainder) - (into [] (concat rem2 remainder)))) - result) -;; ff (prlabel wts (toks result)) - ] - result))))) - -(defn- write-line [^Writer this] - (dosync - (loop [buffer (getf :buffer)] -;; (prlabel wl1 (toks buffer)) - (setf :buffer (into [] buffer)) - (if (not (tokens-fit? this buffer)) - (let [new-buffer (write-token-string this buffer)] -;; (prlabel wl new-buffer) - (if-not (identical? buffer new-buffer) - (recur new-buffer))))))) - -;;; Add a buffer token to the buffer and see if it's time to start -;;; writing -(defn- add-to-buffer [^Writer this token] -; (prlabel a2b token) - (dosync - (setf :buffer (conj (getf :buffer) token)) - (if (not (tokens-fit? this (getf :buffer))) - (write-line this)))) - -;;; Write all the tokens that have been buffered -(defn- write-buffered-output [^Writer this] - (write-line this) - (if-let [buf (getf :buffer)] - (do - (write-tokens this buf true) - (setf :buffer [])))) - -;;; If there are newlines in the string, print the lines up until the last newline, -;;; making the appropriate adjustments. Return the remainder of the string -(defn- write-initial-lines - [^Writer this ^String s] - (let [lines (.split s "\n" -1)] - (if (= (count lines) 1) - s - (dosync - (let [^String prefix (:per-line-prefix (first (getf :logical-blocks))) - ^String l (first lines)] - (if (= :buffering (getf :mode)) - (let [oldpos (getf :pos) - newpos (+ oldpos (count l))] - (setf :pos newpos) - (add-to-buffer this (make-buffer-blob l nil oldpos newpos)) - (write-buffered-output this)) - (.write (getf :base) l)) - (.write (getf :base) (int \newline)) - (doseq [^String l (next (butlast lines))] - (.write (getf :base) l) - (.write (getf :base) (int \newline)) - (if prefix - (.write (getf :base) prefix))) - (setf :buffering :writing) - (last lines)))))) - - -(defn- write-white-space [^Writer this] - (if-let [^String tws (getf :trailing-white-space)] - (dosync - (.write (getf :base) tws) - (setf :trailing-white-space nil)))) - -(defn- p-write-char [^Writer this ^Integer c] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (.write (getf :base) c)) - (if (= c \newline) - (write-initial-lines this "\n") - (let [oldpos (getf :pos) - newpos (inc oldpos)] - (dosync - (setf :pos newpos) - (add-to-buffer this (make-buffer-blob (str (char c)) nil oldpos newpos))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Initialize the pretty-writer instance -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defn- pretty-writer [writer max-columns miser-width] - (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false)) - fields (ref {:pretty-writer true - :base (column-writer writer max-columns) - :logical-blocks lb - :sections nil - :mode :writing - :buffer [] - :buffer-block lb - :buffer-level 1 - :miser-width miser-width - :trailing-white-space nil - :pos 0})] - (proxy [Writer IDeref] [] - (deref [] fields) - - (write - ([x] - ;; (prlabel write x (getf :mode)) - (condp = (class x) - String - (let [^String s0 (write-initial-lines this x) - ^String s (.replaceFirst s0 "\\s+$" "") - white-space (.substring s0 (count s)) - mode (getf :mode)] - (dosync - (if (= mode :writing) - (do - (write-white-space this) - (.write (getf :base) s) - (setf :trailing-white-space white-space)) - (let [oldpos (getf :pos) - newpos (+ oldpos (count s0))] - (setf :pos newpos) - (add-to-buffer this (make-buffer-blob s white-space oldpos newpos)))))) - - Integer - (p-write-char this x)))) - - (flush [] - (if (= (getf :mode) :buffering) - (dosync - (write-tokens this (getf :buffer) true) - (setf :buffer [])) - (write-white-space this))) - - (close [] - (.flush this))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Methods for pretty-writer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- start-block - [^Writer this - ^String prefix ^String per-line-prefix ^String suffix] - (dosync - (let [lb (struct logical-block (getf :logical-blocks) nil (ref 0) (ref 0) - (ref false) (ref false) - prefix per-line-prefix suffix)] - (setf :logical-blocks lb) - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (when-let [cb (getf :logical-block-callback)] (cb :start)) - (if prefix - (.write (getf :base) prefix)) - (let [col (get-column (getf :base))] - (ref-set (:start-col lb) col) - (ref-set (:indent lb) col))) - (let [oldpos (getf :pos) - newpos (+ oldpos (if prefix (count prefix) 0))] - (setf :pos newpos) - (add-to-buffer this (make-start-block-t lb oldpos newpos))))))) - -(defn- end-block [^Writer this] - (dosync - (let [lb (getf :logical-blocks) - ^String suffix (:suffix lb)] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (if suffix - (.write (getf :base) suffix)) - (when-let [cb (getf :logical-block-callback)] (cb :end))) - (let [oldpos (getf :pos) - newpos (+ oldpos (if suffix (count suffix) 0))] - (setf :pos newpos) - (add-to-buffer this (make-end-block-t lb oldpos newpos)))) - (setf :logical-blocks (:parent lb))))) - -(defn- nl [^Writer this type] - (dosync - (setf :mode :buffering) - (let [pos (getf :pos)] - (add-to-buffer this (make-nl-t type (getf :logical-blocks) pos pos))))) - -(defn- indent [^Writer this relative-to offset] - (dosync - (let [lb (getf :logical-blocks)] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (ref-set (:indent lb) - (+ offset (condp = relative-to - :block @(:start-col lb) - :current (get-column (getf :base)))))) - (let [pos (getf :pos)] - (add-to-buffer this (make-indent-t lb relative-to offset pos pos))))))) - -(defn- get-miser-width [^Writer this] - (getf :miser-width)) - -(defn- set-miser-width [^Writer this new-miser-width] - (dosync (setf :miser-width new-miser-width))) - -(defn- set-logical-block-callback [^Writer this f] - (dosync (setf :logical-block-callback f))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/pprint/utilities.clj --- a/src/clojure/pprint/utilities.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,104 +0,0 @@ -;;; utilities.clj -- part of the pretty printer for Clojure - -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber -;; April 3, 2009 - -;; This module implements some utility function used in formatting and pretty -;; printing. The functions here could go in a more general purpose library, -;; perhaps. - -(in-ns 'clojure.pprint) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Helper functions for digesting formats in the various -;;; phases of their lives. -;;; These functions are actually pretty general. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- map-passing-context [func initial-context lis] - (loop [context initial-context - lis lis - acc []] - (if (empty? lis) - [acc context] - (let [this (first lis) - remainder (next lis) - [result new-context] (apply func [this context])] - (recur new-context remainder (conj acc result)))))) - -(defn- consume [func initial-context] - (loop [context initial-context - acc []] - (let [[result new-context] (apply func [context])] - (if (not result) - [acc new-context] - (recur new-context (conj acc result)))))) - -(defn- consume-while [func initial-context] - (loop [context initial-context - acc []] - (let [[result continue new-context] (apply func [context])] - (if (not continue) - [acc context] - (recur new-context (conj acc result)))))) - -(defn- unzip-map [m] - "Take a map that has pairs in the value slots and produce a pair of maps, - the first having all the first elements of the pairs and the second all - the second elements of the pairs" - [(into {} (for [[k [v1 v2]] m] [k v1])) - (into {} (for [[k [v1 v2]] m] [k v2]))]) - -(defn- tuple-map [m v1] - "For all the values, v, in the map, replace them with [v v1]" - (into {} (for [[k v] m] [k [v v1]]))) - -(defn- rtrim [s c] - "Trim all instances of c from the end of sequence s" - (let [len (count s)] - (if (and (pos? len) (= (nth s (dec (count s))) c)) - (loop [n (dec len)] - (cond - (neg? n) "" - (not (= (nth s n) c)) (subs s 0 (inc n)) - true (recur (dec n)))) - s))) - -(defn- ltrim [s c] - "Trim all instances of c from the beginning of sequence s" - (let [len (count s)] - (if (and (pos? len) (= (nth s 0) c)) - (loop [n 0] - (if (or (= n len) (not (= (nth s n) c))) - (subs s n) - (recur (inc n)))) - s))) - -(defn- prefix-count [aseq val] - "Return the number of times that val occurs at the start of sequence aseq, -if val is a seq itself, count the number of times any element of val occurs at the -beginning of aseq" - (let [test (if (coll? val) (set val) #{val})] - (loop [pos 0] - (if (or (= pos (count aseq)) (not (test (nth aseq pos)))) - pos - (recur (inc pos)))))) - -(defn- prerr [& args] - "Println to *err*" - (binding [*out* *err*] - (apply println args))) - -(defmacro ^{:private true} prlabel [prefix arg & more-args] - "Print args to *err* in name = value format" - `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) - (cons arg (seq more-args)))))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/repl.clj --- a/src/clojure/repl.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,74 +0,0 @@ -; Copyright (c) Chris Houser, Dec 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) -; which can be found in the file CPL.TXT at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Utilities meant to be used interactively at the REPL - -(ns - #^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim, Christophe Grande" - :doc "Utilities meant to be used interactively at the REPL"} - clojure.repl - (:import (java.io LineNumberReader InputStreamReader PushbackReader) - (clojure.lang RT Reflector))) - -;; ---------------------------------------------------------------------- -;; Examine Clojure functions (Vars, really) - -(defn source-fn - "Returns a string of the source code for the given symbol, if it can - find it. This requires that the symbol resolve to a Var defined in - a namespace for which the .clj is in the classpath. Returns nil if - it can't find the source. For most REPL usage, 'source' is more - convenient. - - Example: (source-fn 'filter)" - [x] - (when-let [v (resolve x)] - (when-let [filepath (:file (meta v))] - (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)] - (with-open [rdr (LineNumberReader. (InputStreamReader. strm))] - (dotimes [_ (dec (:line (meta v)))] (.readLine rdr)) - (let [text (StringBuilder.) - pbr (proxy [PushbackReader] [rdr] - (read [] (let [i (proxy-super read)] - (.append text (char i)) - i)))] - (read (PushbackReader. pbr)) - (str text))))))) - -(defmacro source - "Prints the source code for the given symbol, if it can find it. - This requires that the symbol resolve to a Var defined in a - namespace for which the .clj is in the classpath. - - Example: (source filter)" - [n] - `(println (or (source-fn '~n) (str "Source not found")))) - -(defn apropos - "Given a regular expression or stringable thing, return a seq of -all definitions in all currently-loaded namespaces that match the -str-or-pattern." - [str-or-pattern] - (let [matches? (if (instance? java.util.regex.Pattern str-or-pattern) - #(re-find str-or-pattern (str %)) - #(.contains (str %) (str str-or-pattern)))] - (mapcat (fn [ns] - (filter matches? (keys (ns-publics ns)))) - (all-ns)))) - -(defn dir-fn - "Returns a sorted seq of symbols naming public vars in - a namespace" - [ns] - (sort (map first (ns-publics (the-ns ns))))) - -(defmacro dir - "Prints a sorted directory of public vars in a namespace" - [nsname] - `(doseq [v# (dir-fn '~nsname)] - (println v#))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/set.clj --- a/src/clojure/set.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,177 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns ^{:doc "Set operations such as union/intersection." - :author "Rich Hickey"} - clojure.set) - -(defn- bubble-max-key [k coll] - "Move a maximal element of coll according to fn k (which returns a number) - to the front of coll." - (let [max (apply max-key k coll)] - (cons max (remove #(identical? max %) coll)))) - -(defn union - "Return a set that is the union of the input sets" - {:added "1.0"} - ([] #{}) - ([s1] s1) - ([s1 s2] - (if (< (count s1) (count s2)) - (reduce conj s2 s1) - (reduce conj s1 s2))) - ([s1 s2 & sets] - (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))] - (reduce into (first bubbled-sets) (rest bubbled-sets))))) - -(defn intersection - "Return a set that is the intersection of the input sets" - {:added "1.0"} - ([s1] s1) - ([s1 s2] - (if (< (count s2) (count s1)) - (recur s2 s1) - (reduce (fn [result item] - (if (contains? s2 item) - result - (disj result item))) - s1 s1))) - ([s1 s2 & sets] - (let [bubbled-sets (bubble-max-key #(- (count %)) (conj sets s2 s1))] - (reduce intersection (first bubbled-sets) (rest bubbled-sets))))) - -(defn difference - "Return a set that is the first set without elements of the remaining sets" - {:added "1.0"} - ([s1] s1) - ([s1 s2] - (if (< (count s1) (count s2)) - (reduce (fn [result item] - (if (contains? s2 item) - (disj result item) - result)) - s1 s1) - (reduce disj s1 s2))) - ([s1 s2 & sets] - (reduce difference s1 (conj sets s2)))) - - -(defn select - "Returns a set of the elements for which pred is true" - {:added "1.0"} - [pred xset] - (reduce (fn [s k] (if (pred k) s (disj s k))) - xset xset)) - -(defn project - "Returns a rel of the elements of xrel with only the keys in ks" - {:added "1.0"} - [xrel ks] - (set (map #(select-keys % ks) xrel))) - -(defn rename-keys - "Returns the map with the keys in kmap renamed to the vals in kmap" - {:added "1.0"} - [map kmap] - (reduce - (fn [m [old new]] - (if (and (not= old new) - (contains? m old)) - (-> m (assoc new (get m old)) (dissoc old)) - m)) - map kmap)) - -(defn rename - "Returns a rel of the maps in xrel with the keys in kmap renamed to the vals in kmap" - {:added "1.0"} - [xrel kmap] - (set (map #(rename-keys % kmap) xrel))) - -(defn index - "Returns a map of the distinct values of ks in the xrel mapped to a - set of the maps in xrel with the corresponding values of ks." - {:added "1.0"} - [xrel ks] - (reduce - (fn [m x] - (let [ik (select-keys x ks)] - (assoc m ik (conj (get m ik #{}) x)))) - {} xrel)) - -(defn map-invert - "Returns the map with the vals mapped to the keys." - {:added "1.0"} - [m] (reduce (fn [m [k v]] (assoc m v k)) {} m)) - -(defn join - "When passed 2 rels, returns the rel corresponding to the natural - join. When passed an additional keymap, joins on the corresponding - keys." - {:added "1.0"} - ([xrel yrel] ;natural join - (if (and (seq xrel) (seq yrel)) - (let [ks (intersection (set (keys (first xrel))) (set (keys (first yrel)))) - [r s] (if (<= (count xrel) (count yrel)) - [xrel yrel] - [yrel xrel]) - idx (index r ks)] - (reduce (fn [ret x] - (let [found (idx (select-keys x ks))] - (if found - (reduce #(conj %1 (merge %2 x)) ret found) - ret))) - #{} s)) - #{})) - ([xrel yrel km] ;arbitrary key mapping - (let [[r s k] (if (<= (count xrel) (count yrel)) - [xrel yrel (map-invert km)] - [yrel xrel km]) - idx (index r (vals k))] - (reduce (fn [ret x] - (let [found (idx (rename-keys (select-keys x (keys k)) k))] - (if found - (reduce #(conj %1 (merge %2 x)) ret found) - ret))) - #{} s)))) - -(defn subset? - "Is set1 a subset of set2?" - {:added "1.2", - :tag Boolean} - [set1 set2] - (and (<= (count set1) (count set2)) - (every? set2 set1))) - -(defn superset? - "Is set1 a superset of set2?" - {:added "1.2", - :tag Boolean} - [set1 set2] - (and (>= (count set1) (count set2)) - (every? set1 set2))) - -(comment -(refer 'set) -(def xs #{{:a 11 :b 1 :c 1 :d 4} - {:a 2 :b 12 :c 2 :d 6} - {:a 3 :b 3 :c 3 :d 8 :f 42}}) - -(def ys #{{:a 11 :b 11 :c 11 :e 5} - {:a 12 :b 11 :c 12 :e 3} - {:a 3 :b 3 :c 3 :e 7 }}) - -(join xs ys) -(join xs (rename ys {:b :yb :c :yc}) {:a :a}) - -(union #{:a :b :c} #{:c :d :e }) -(difference #{:a :b :c} #{:c :d :e}) -(intersection #{:a :b :c} #{:c :d :e}) - -(index ys [:b]) -) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/stacktrace.clj --- a/src/clojure/stacktrace.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;;; stacktrace.clj: print Clojure-centric stack traces - -;; by Stuart Sierra -;; January 6, 2009 - -(ns ^{:doc "Print stack traces oriented towards Clojure, not Java." - :author "Stuart Sierra"} - clojure.stacktrace) - -(defn root-cause - "Returns the last 'cause' Throwable in a chain of Throwables." - {:added "1.1"} - [tr] - (if-let [cause (.getCause tr)] - (recur cause) - tr)) - -(defn print-trace-element - "Prints a Clojure-oriented view of one element in a stack trace." - {:added "1.1"} - [e] - (let [class (.getClassName e) - method (.getMethodName e)] - (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" class)] - (if (and match (= "invoke" method)) - (apply printf "%s/%s" (rest match)) - (printf "%s.%s" class method)))) - (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e))) - -(defn print-throwable - "Prints the class and message of a Throwable." - {:added "1.1"} - [tr] - (printf "%s: %s" (.getName (class tr)) (.getMessage tr))) - -(defn print-stack-trace - "Prints a Clojure-oriented stack trace of tr, a Throwable. - Prints a maximum of n stack frames (default: unlimited). - Does not print chained exceptions (causes)." - {:added "1.1"} - ([tr] (print-stack-trace tr nil)) - ([tr n] - (let [st (.getStackTrace tr)] - (print-throwable tr) - (newline) - (print " at ") - (print-trace-element (first st)) - (newline) - (doseq [e (if (nil? n) - (rest st) - (take (dec n) (rest st)))] - (print " ") - (print-trace-element e) - (newline))))) - -(defn print-cause-trace - "Like print-stack-trace but prints chained exceptions (causes)." - {:added "1.1"} - ([tr] (print-cause-trace tr nil)) - ([tr n] - (print-stack-trace tr n) - (when-let [cause (.getCause tr)] - (print "Caused by: " ) - (recur cause n)))) - -(defn e - "REPL utility. Prints a brief stack trace for the root cause of the - most recent exception." - {:added "1.1"} - [] - (print-stack-trace (root-cause *e) 8)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/string.clj --- a/src/clojure/string.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,254 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns ^{:doc "Clojure String utilities - -It is poor form to (:use clojure.string). Instead, use require -with :as to specify a prefix, e.g. - -(ns your.namespace.here - (:require '[clojure.string :as str])) - -Design notes for clojure.string: - -1. Strings are objects (as opposed to sequences). As such, the - string being manipulated is the first argument to a function; - passing nil will result in a NullPointerException unless - documented otherwise. If you want sequence-y behavior instead, - use a sequence. - -2. Functions are generally not lazy, and call straight to host - methods where those are available and efficient. - -3. Functions take advantage of String implementation details to - write high-performing loop/recurs instead of using higher-order - functions. (This is not idiomatic in general-purpose application - code.) - -4. When a function is documented to accept a string argument, it - will take any implementation of the correct *interface* on the - host platform. In Java, this is CharSequence, which is more - general than String. In ordinary usage you will almost always - pass concrete strings. If you are doing something unusual, - e.g. passing a mutable implementation of CharSequence, then - thead-safety is your responsibility." - :author "Stuart Sierra, Stuart Halloway, David Liebke"} - clojure.string - (:refer-clojure :exclude (replace reverse)) - (:import (java.util.regex Pattern) - clojure.lang.LazilyPersistentVector)) - -(defn ^String reverse - "Returns s with its characters reversed." - {:added "1.2"} - [^CharSequence s] - (.toString (.reverse (StringBuilder. s)))) - -(defn- replace-by - [^CharSequence s re f] - (let [m (re-matcher re s)] - (let [buffer (StringBuffer. (.length s))] - (loop [] - (if (.find m) - (do (.appendReplacement m buffer (f (re-groups m))) - (recur)) - (do (.appendTail m buffer) - (.toString buffer))))))) - -(defn ^String replace - "Replaces all instance of match with replacement in s. - - match/replacement can be: - - string / string - char / char - pattern / (string or function of match). - - See also replace-first." - {:added "1.2"} - [^CharSequence s match replacement] - (let [s (.toString s)] - (cond - (instance? Character match) (.replace s ^Character match ^Character replacement) - (instance? CharSequence match) (.replace s ^CharSequence match ^CharSequence replacement) - (instance? Pattern match) (if (instance? CharSequence replacement) - (.replaceAll (re-matcher ^Pattern match s) - (.toString ^CharSequence replacement)) - (replace-by s match replacement)) - :else (throw (IllegalArgumentException. (str "Invalid match arg: " match)))))) - -(defn- replace-first-by - [^CharSequence s ^Pattern re f] - (let [m (re-matcher re s)] - (let [buffer (StringBuffer. (.length s))] - (if (.find m) - (let [rep (f (re-groups m))] - (.appendReplacement m buffer rep) - (.appendTail m buffer) - (str buffer)))))) - -(defn- replace-first-char - [^CharSequence s ^Character match replace] - (let [s (.toString s) - i (.indexOf s (int match))] - (if (= -1 i) - s - (str (subs s 0 i) replace (subs s (inc i)))))) - -(defn ^String replace-first - "Replaces the first instance of match with replacement in s. - - match/replacement can be: - - char / char - string / string - pattern / (string or function of match). - - See also replace-all." - {:added "1.2"} - [^CharSequence s match replacement] - (let [s (.toString s)] - (cond - (instance? Character match) - (replace-first-char s match replacement) - (instance? CharSequence match) - (.replaceFirst s (Pattern/quote (.toString ^CharSequence match)) - (.toString ^CharSequence replacement)) - (instance? Pattern match) - (if (instance? CharSequence replacement) - (.replaceFirst (re-matcher ^Pattern match s) - (.toString ^CharSequence replacement)) - (replace-first-by s match replacement)) - :else (throw (IllegalArgumentException. (str "Invalid match arg: " match)))))) - - -(defn ^String join - "Returns a string of all elements in coll, separated by - an optional separator. Like Perl's join." - {:added "1.2"} - ([coll] - (apply str coll)) - ([separator [x & more]] - (loop [sb (StringBuilder. (str x)) - more more - sep (str separator)] - (if more - (recur (-> sb (.append sep) (.append (str (first more)))) - (next more) - sep) - (str sb))))) - -(defn ^String capitalize - "Converts first character of the string to upper-case, all other - characters to lower-case." - {:added "1.2"} - [^CharSequence s] - (let [s (.toString s)] - (if (< (count s) 2) - (.toUpperCase s) - (str (.toUpperCase (subs s 0 1)) - (.toLowerCase (subs s 1)))))) - -(defn ^String upper-case - "Converts string to all upper-case." - {:added "1.2"} - [^CharSequence s] - (.. s toString toUpperCase)) - -(defn ^String lower-case - "Converts string to all lower-case." - {:added "1.2"} - [^CharSequence s] - (.. s toString toLowerCase)) - -(defn split - "Splits string on a regular expression. Optional argument limit is - the maximum number of splits. Not lazy. Returns vector of the splits." - {:added "1.2"} - ([^CharSequence s ^Pattern re] - (LazilyPersistentVector/createOwning (.split re s))) - ([ ^CharSequence s ^Pattern re limit] - (LazilyPersistentVector/createOwning (.split re s limit)))) - -(defn split-lines - "Splits s on \\n or \\r\\n." - {:added "1.2"} - [^CharSequence s] - (split s #"\r?\n")) - -(defn ^String trim - "Removes whitespace from both ends of string." - {:added "1.2"} - [^CharSequence s] - (.. s toString trim)) - -(defn ^String triml - "Removes whitespace from the left side of string." - {:added "1.2"} - [^CharSequence s] - (loop [index (int 0)] - (if (= (.length s) index) - "" - (if (Character/isWhitespace (.charAt s index)) - (recur (inc index)) - (.. s (subSequence index (.length s)) toString))))) - -(defn ^String trimr - "Removes whitespace from the right side of string." - {:added "1.2"} - [^CharSequence s] - (loop [index (.length s)] - (if (zero? index) - "" - (if (Character/isWhitespace (.charAt s (dec index))) - (recur (dec index)) - (.. s (subSequence 0 index) toString))))) - -(defn ^String trim-newline - "Removes all trailing newline \\n or return \\r characters from - string. Similar to Perl's chomp." - {:added "1.2"} - [^CharSequence s] - (loop [index (.length s)] - (if (zero? index) - "" - (let [ch (.charAt s (dec index))] - (if (or (= ch \newline) (= ch \return)) - (recur (dec index)) - (.. s (subSequence 0 index) toString)))))) - -(defn blank? - "True if s is nil, empty, or contains only whitespace." - {:added "1.2"} - [^CharSequence s] - (if s - (loop [index (int 0)] - (if (= (.length s) index) - true - (if (Character/isWhitespace (.charAt s index)) - (recur (inc index)) - false))) - true)) - -(defn ^String escape - "Return a new string, using cmap to escape each character ch - from s as follows: - - If (cmap ch) is nil, append ch to the new string. - If (cmap ch) is non-nil, append (str (cmap ch)) instead." - {:added "1.2"} - [^CharSequence s cmap] - (loop [index (int 0) - buffer (StringBuilder. (.length s))] - (if (= (.length s) index) - (.toString buffer) - (let [ch (.charAt s index)] - (if-let [replacement (cmap ch)] - (.append buffer replacement) - (.append buffer ch)) - (recur (inc index) buffer))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/template.clj --- a/src/clojure/template.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;;; template.clj - anonymous functions that pre-evaluate sub-expressions - -;; By Stuart Sierra -;; June 23, 2009 - -;; CHANGE LOG -;; -;; June 23, 2009: complete rewrite, eliminated _1,_2,... argument -;; syntax -;; -;; January 20, 2009: added "template?" and checks for valid template -;; expressions. -;; -;; December 15, 2008: first version - - -(ns ^{:doc "Macros that expand to repeated copies of a template expression." - :author "Stuart Sierra"} - clojure.template - (:require [clojure.walk :as walk])) - -(defn apply-template - "For use in macros. argv is an argument list, as in defn. expr is - a quoted expression using the symbols in argv. values is a sequence - of values to be used for the arguments. - - apply-template will recursively replace argument symbols in expr - with their corresponding values, returning a modified expr. - - Example: (apply-template '[x] '(+ x x) '[2]) - ;=> (+ 2 2)" - [argv expr values] - (assert (vector? argv)) - (assert (every? symbol? argv)) - (walk/prewalk-replace (zipmap argv values) expr)) - -(defmacro do-template - "Repeatedly copies expr (in a do block) for each group of arguments - in values. values are automatically partitioned by the number of - arguments in argv, an argument vector as in defn. - - Example: (macroexpand '(do-template [x y] (+ y x) 2 4 3 5)) - ;=> (do (+ 4 2) (+ 5 3))" - [argv expr & values] - (let [c (count argv)] - `(do ~@(map (fn [a] (apply-template argv expr a)) - (partition c values))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test.clj --- a/src/clojure/test.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,758 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;;; test.clj: test framework for Clojure - -;; by Stuart Sierra -;; March 28, 2009 - -;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for -;; contributions and suggestions. - -(ns - ^{:author "Stuart Sierra, with contributions and suggestions by - Chas Emerick, Allen Rohner, and Stuart Halloway", - :doc "A unit testing framework. - - ASSERTIONS - - The core of the library is the \"is\" macro, which lets you make - assertions of any arbitrary expression: - - (is (= 4 (+ 2 2))) - (is (instance? Integer 256)) - (is (.startsWith \"abcde\" \"ab\")) - - You can type an \"is\" expression directly at the REPL, which will - print a message if it fails. - - user> (is (= 5 (+ 2 2))) - - FAIL in (:1) - expected: (= 5 (+ 2 2)) - actual: (not (= 5 4)) - false - - The \"expected:\" line shows you the original expression, and the - \"actual:\" shows you what actually happened. In this case, it - shows that (+ 2 2) returned 4, which is not = to 5. Finally, the - \"false\" on the last line is the value returned from the - expression. The \"is\" macro always returns the result of the - inner expression. - - There are two special assertions for testing exceptions. The - \"(is (thrown? c ...))\" form tests if an exception of class c is - thrown: - - (is (thrown? ArithmeticException (/ 1 0))) - - \"(is (thrown-with-msg? c re ...))\" does the same thing and also - tests that the message on the exception matches the regular - expression re: - - (is (thrown-with-msg? ArithmeticException #\"Divide by zero\" - (/ 1 0))) - - DOCUMENTING TESTS - - \"is\" takes an optional second argument, a string describing the - assertion. This message will be included in the error report. - - (is (= 5 (+ 2 2)) \"Crazy arithmetic\") - - In addition, you can document groups of assertions with the - \"testing\" macro, which takes a string followed by any number of - assertions. The string will be included in failure reports. - Calls to \"testing\" may be nested, and all of the strings will be - joined together with spaces in the final report, in a style - similar to RSpec - - (testing \"Arithmetic\" - (testing \"with positive integers\" - (is (= 4 (+ 2 2))) - (is (= 7 (+ 3 4)))) - (testing \"with negative integers\" - (is (= -4 (+ -2 -2))) - (is (= -1 (+ 3 -4))))) - - Note that, unlike RSpec, the \"testing\" macro may only be used - INSIDE a \"deftest\" or \"with-test\" form (see below). - - - DEFINING TESTS - - There are two ways to define tests. The \"with-test\" macro takes - a defn or def form as its first argument, followed by any number - of assertions. The tests will be stored as metadata on the - definition. - - (with-test - (defn my-function [x y] - (+ x y)) - (is (= 4 (my-function 2 2))) - (is (= 7 (my-function 3 4)))) - - As of Clojure SVN rev. 1221, this does not work with defmacro. - See http://code.google.com/p/clojure/issues/detail?id=51 - - The other way lets you define tests separately from the rest of - your code, even in a different namespace: - - (deftest addition - (is (= 4 (+ 2 2))) - (is (= 7 (+ 3 4)))) - - (deftest subtraction - (is (= 1 (- 4 3))) - (is (= 3 (- 7 4)))) - - This creates functions named \"addition\" and \"subtraction\", which - can be called like any other function. Therefore, tests can be - grouped and composed, in a style similar to the test framework in - Peter Seibel's \"Practical Common Lisp\" - - - (deftest arithmetic - (addition) - (subtraction)) - - The names of the nested tests will be joined in a list, like - \"(arithmetic addition)\", in failure reports. You can use nested - tests to set up a context shared by several tests. - - - RUNNING TESTS - - Run tests with the function \"(run-tests namespaces...)\": - - (run-tests 'your.namespace 'some.other.namespace) - - If you don't specify any namespaces, the current namespace is - used. To run all tests in all namespaces, use \"(run-all-tests)\". - - By default, these functions will search for all tests defined in - a namespace and run them in an undefined order. However, if you - are composing tests, as in the \"arithmetic\" example above, you - probably do not want the \"addition\" and \"subtraction\" tests run - separately. In that case, you must define a special function - named \"test-ns-hook\" that runs your tests in the correct order: - - (defn test-ns-hook [] - (arithmetic)) - - - OMITTING TESTS FROM PRODUCTION CODE - - You can bind the variable \"*load-tests*\" to false when loading or - compiling code in production. This will prevent any tests from - being created by \"with-test\" or \"deftest\". - - - FIXTURES (new) - - Fixtures allow you to run code before and after tests, to set up - the context in which tests should be run. - - A fixture is just a function that calls another function passed as - an argument. It looks like this: - - (defn my-fixture [f] - Perform setup, establish bindings, whatever. - (f) Then call the function we were passed. - Tear-down / clean-up code here. - ) - - Fixtures are attached to namespaces in one of two ways. \"each\" - fixtures are run repeatedly, once for each test function created - with \"deftest\" or \"with-test\". \"each\" fixtures are useful for - establishing a consistent before/after state for each test, like - clearing out database tables. - - \"each\" fixtures can be attached to the current namespace like this: - (use-fixtures :each fixture1 fixture2 ...) - The fixture1, fixture2 are just functions like the example above. - They can also be anonymous functions, like this: - (use-fixtures :each (fn [f] setup... (f) cleanup...)) - - The other kind of fixture, a \"once\" fixture, is only run once, - around ALL the tests in the namespace. \"once\" fixtures are useful - for tasks that only need to be performed once, like establishing - database connections, or for time-consuming tasks. - - Attach \"once\" fixtures to the current namespace like this: - (use-fixtures :once fixture1 fixture2 ...) - - - SAVING TEST OUTPUT TO A FILE - - All the test reporting functions write to the var *test-out*. By - default, this is the same as *out*, but you can rebind it to any - PrintWriter. For example, it could be a file opened with - clojure.java.io/writer. - - - EXTENDING TEST-IS (ADVANCED) - - You can extend the behavior of the \"is\" macro by defining new - methods for the \"assert-expr\" multimethod. These methods are - called during expansion of the \"is\" macro, so they should return - quoted forms to be evaluated. - - You can plug in your own test-reporting framework by rebinding - the \"report\" function: (report event) - - The 'event' argument is a map. It will always have a :type key, - whose value will be a keyword signaling the type of event being - reported. Standard events with :type value of :pass, :fail, and - :error are called when an assertion passes, fails, and throws an - exception, respectively. In that case, the event will also have - the following keys: - - :expected The form that was expected to be true - :actual A form representing what actually occurred - :message The string message given as an argument to 'is' - - The \"testing\" strings will be a list in \"*testing-contexts*\", and - the vars being tested will be a list in \"*testing-vars*\". - - Your \"report\" function should wrap any printing calls in the - \"with-test-out\" macro, which rebinds *out* to the current value - of *test-out*. - - For additional event types, see the examples in the code. -"} - clojure.test - (:require [clojure.template :as temp] - [clojure.stacktrace :as stack])) - -;; Nothing is marked "private" here, so you can rebind things to plug -;; in your own testing or reporting frameworks. - - -;;; USER-MODIFIABLE GLOBALS - -(defonce - ^{:doc "True by default. If set to false, no test functions will - be created by deftest, set-test, or with-test. Use this to omit - tests when compiling or loading production code." - :added "1.1"} - *load-tests* true) - -(def - ^{:doc "The maximum depth of stack traces to print when an Exception - is thrown during a test. Defaults to nil, which means print the - complete stack trace." - :added "1.1"} - *stack-trace-depth* nil) - - -;;; GLOBALS USED BY THE REPORTING FUNCTIONS - -(def *report-counters* nil) ; bound to a ref of a map in test-ns - -(def *initial-report-counters* ; used to initialize *report-counters* - {:test 0, :pass 0, :fail 0, :error 0}) - -(def *testing-vars* (list)) ; bound to hierarchy of vars being tested - -(def *testing-contexts* (list)) ; bound to hierarchy of "testing" strings - -(def *test-out* *out*) ; PrintWriter for test reporting output - -(defmacro with-test-out - "Runs body with *out* bound to the value of *test-out*." - {:added "1.1"} - [& body] - `(binding [*out* *test-out*] - ~@body)) - -;;; UTILITIES FOR REPORTING FUNCTIONS - -(defn file-position - "Returns a vector [filename line-number] for the nth call up the - stack. - - Deprecated in 1.2: The information needed for test reporting is - now on :file and :line keys in the result map." - {:added "1.1" - :deprecated "1.2"} - [n] - (let [^StackTraceElement s (nth (.getStackTrace (new java.lang.Throwable)) n)] - [(.getFileName s) (.getLineNumber s)])) - -(defn testing-vars-str - "Returns a string representation of the current test. Renders names - in *testing-vars* as a list, then the source file and line of - current assertion." - {:added "1.1"} - [m] - (let [{:keys [file line]} m] - (str - ;; Uncomment to include namespace in failure report: - ;;(ns-name (:ns (meta (first *testing-vars*)))) "/ " - (reverse (map #(:name (meta %)) *testing-vars*)) - " (" file ":" line ")"))) - -(defn testing-contexts-str - "Returns a string representation of the current test context. Joins - strings in *testing-contexts* with spaces." - {:added "1.1"} - [] - (apply str (interpose " " (reverse *testing-contexts*)))) - -(defn inc-report-counter - "Increments the named counter in *report-counters*, a ref to a map. - Does nothing if *report-counters* is nil." - {:added "1.1"} - [name] - (when *report-counters* - (dosync (commute *report-counters* assoc name - (inc (or (*report-counters* name) 0)))))) - -;;; TEST RESULT REPORTING - -(defmulti - ^{:doc "Generic reporting function, may be overridden to plug in - different report formats (e.g., TAP, JUnit). Assertions such as - 'is' call 'report' to indicate results. The argument given to - 'report' will be a map with a :type key. See the documentation at - the top of test_is.clj for more information on the types of - arguments for 'report'." - :dynamic true - :added "1.1"} - report :type) - -(defn- file-and-line - [exception depth] - (let [^StackTraceElement s (nth (.getStackTrace exception) depth)] - {:file (.getFileName s) :line (.getLineNumber s)})) - -(defn do-report - "Add file and line information to a test result and call report. - If you are writing a custom assert-expr method, call this function - to pass test results to report." - {:added "1.2"} - [m] - (report - (case - (:type m) - :fail (merge (file-and-line (new java.lang.Throwable) 1) m) - :error (merge (file-and-line (:actual m) 0) m) - m))) - -(defmethod report :default [m] - (with-test-out (prn m))) - -(defmethod report :pass [m] - (with-test-out (inc-report-counter :pass))) - -(defmethod report :fail [m] - (with-test-out - (inc-report-counter :fail) - (println "\nFAIL in" (testing-vars-str m)) - (when (seq *testing-contexts*) (println (testing-contexts-str))) - (when-let [message (:message m)] (println message)) - (println "expected:" (pr-str (:expected m))) - (println " actual:" (pr-str (:actual m))))) - -(defmethod report :error [m] - (with-test-out - (inc-report-counter :error) - (println "\nERROR in" (testing-vars-str m)) - (when (seq *testing-contexts*) (println (testing-contexts-str))) - (when-let [message (:message m)] (println message)) - (println "expected:" (pr-str (:expected m))) - (print " actual: ") - (let [actual (:actual m)] - (if (instance? Throwable actual) - (stack/print-cause-trace actual *stack-trace-depth*) - (prn actual))))) - -(defmethod report :summary [m] - (with-test-out - (println "\nRan" (:test m) "tests containing" - (+ (:pass m) (:fail m) (:error m)) "assertions.") - (println (:fail m) "failures," (:error m) "errors."))) - -(defmethod report :begin-test-ns [m] - (with-test-out - (println "\nTesting" (ns-name (:ns m))))) - -;; Ignore these message types: -(defmethod report :end-test-ns [m]) -(defmethod report :begin-test-var [m]) -(defmethod report :end-test-var [m]) - - - -;;; UTILITIES FOR ASSERTIONS - -(defn get-possibly-unbound-var - "Like var-get but returns nil if the var is unbound." - {:added "1.1"} - [v] - (try (var-get v) - (catch IllegalStateException e - nil))) - -(defn function? - "Returns true if argument is a function or a symbol that resolves to - a function (not a macro)." - {:added "1.1"} - [x] - (if (symbol? x) - (when-let [v (resolve x)] - (when-let [value (get-possibly-unbound-var v)] - (and (fn? value) - (not (:macro (meta v)))))) - (fn? x))) - -(defn assert-predicate - "Returns generic assertion code for any functional predicate. The - 'expected' argument to 'report' will contains the original form, the - 'actual' argument will contain the form with all its sub-forms - evaluated. If the predicate returns false, the 'actual' form will - be wrapped in (not...)." - {:added "1.1"} - [msg form] - (let [args (rest form) - pred (first form)] - `(let [values# (list ~@args) - result# (apply ~pred values#)] - (if result# - (do-report {:type :pass, :message ~msg, - :expected '~form, :actual (cons ~pred values#)}) - (do-report {:type :fail, :message ~msg, - :expected '~form, :actual (list '~'not (cons '~pred values#))})) - result#))) - -(defn assert-any - "Returns generic assertion code for any test, including macros, Java - method calls, or isolated symbols." - {:added "1.1"} - [msg form] - `(let [value# ~form] - (if value# - (do-report {:type :pass, :message ~msg, - :expected '~form, :actual value#}) - (do-report {:type :fail, :message ~msg, - :expected '~form, :actual value#})) - value#)) - - - -;;; ASSERTION METHODS - -;; You don't call these, but you can add methods to extend the 'is' -;; macro. These define different kinds of tests, based on the first -;; symbol in the test expression. - -(defmulti assert-expr - (fn [msg form] - (cond - (nil? form) :always-fail - (seq? form) (first form) - :else :default))) - -(defmethod assert-expr :always-fail [msg form] - ;; nil test: always fail - `(do-report {:type :fail, :message ~msg})) - -(defmethod assert-expr :default [msg form] - (if (and (sequential? form) (function? (first form))) - (assert-predicate msg form) - (assert-any msg form))) - -(defmethod assert-expr 'instance? [msg form] - ;; Test if x is an instance of y. - `(let [klass# ~(nth form 1) - object# ~(nth form 2)] - (let [result# (instance? klass# object#)] - (if result# - (do-report {:type :pass, :message ~msg, - :expected '~form, :actual (class object#)}) - (do-report {:type :fail, :message ~msg, - :expected '~form, :actual (class object#)})) - result#))) - -(defmethod assert-expr 'thrown? [msg form] - ;; (is (thrown? c expr)) - ;; Asserts that evaluating expr throws an exception of class c. - ;; Returns the exception thrown. - (let [klass (second form) - body (nthnext form 2)] - `(try ~@body - (do-report {:type :fail, :message ~msg, - :expected '~form, :actual nil}) - (catch ~klass e# - (do-report {:type :pass, :message ~msg, - :expected '~form, :actual e#}) - e#)))) - -(defmethod assert-expr 'thrown-with-msg? [msg form] - ;; (is (thrown-with-msg? c re expr)) - ;; Asserts that evaluating expr throws an exception of class c. - ;; Also asserts that the message string of the exception matches - ;; (with re-find) the regular expression re. - (let [klass (nth form 1) - re (nth form 2) - body (nthnext form 3)] - `(try ~@body - (do-report {:type :fail, :message ~msg, :expected '~form, :actual nil}) - (catch ~klass e# - (let [m# (.getMessage e#)] - (if (re-find ~re m#) - (do-report {:type :pass, :message ~msg, - :expected '~form, :actual e#}) - (do-report {:type :fail, :message ~msg, - :expected '~form, :actual e#}))) - e#)))) - - -(defmacro try-expr - "Used by the 'is' macro to catch unexpected exceptions. - You don't call this." - {:added "1.1"} - [msg form] - `(try ~(assert-expr msg form) - (catch Throwable t# - (do-report {:type :error, :message ~msg, - :expected '~form, :actual t#})))) - - - -;;; ASSERTION MACROS - -;; You use these in your tests. - -(defmacro is - "Generic assertion macro. 'form' is any predicate test. - 'msg' is an optional message to attach to the assertion. - - Example: (is (= 4 (+ 2 2)) \"Two plus two should be 4\") - - Special forms: - - (is (thrown? c body)) checks that an instance of c is thrown from - body, fails if not; then returns the thing thrown. - - (is (thrown-with-msg? c re body)) checks that an instance of c is - thrown AND that the message on the exception matches (with - re-find) the regular expression re." - {:added "1.1"} - ([form] `(is ~form nil)) - ([form msg] `(try-expr ~msg ~form))) - -(defmacro are - "Checks multiple assertions with a template expression. - See clojure.template/do-template for an explanation of - templates. - - Example: (are [x y] (= x y) - 2 (+ 1 1) - 4 (* 2 2)) - Expands to: - (do (is (= 2 (+ 1 1))) - (is (= 4 (* 2 2)))) - - Note: This breaks some reporting features, such as line numbers." - {:added "1.1"} - [argv expr & args] - `(temp/do-template ~argv (is ~expr) ~@args)) - -(defmacro testing - "Adds a new string to the list of testing contexts. May be nested, - but must occur inside a test function (deftest)." - {:added "1.1"} - [string & body] - `(binding [*testing-contexts* (conj *testing-contexts* ~string)] - ~@body)) - - - -;;; DEFINING TESTS - -(defmacro with-test - "Takes any definition form (that returns a Var) as the first argument. - Remaining body goes in the :test metadata function for that Var. - - When *load-tests* is false, only evaluates the definition, ignoring - the tests." - {:added "1.1"} - [definition & body] - (if *load-tests* - `(doto ~definition (alter-meta! assoc :test (fn [] ~@body))) - definition)) - - -(defmacro deftest - "Defines a test function with no arguments. Test functions may call - other tests, so tests may be composed. If you compose tests, you - should also define a function named test-ns-hook; run-tests will - call test-ns-hook instead of testing all vars. - - Note: Actually, the test body goes in the :test metadata on the var, - and the real function (the value of the var) calls test-var on - itself. - - When *load-tests* is false, deftest is ignored." - {:added "1.1"} - [name & body] - (when *load-tests* - `(def ~(vary-meta name assoc :test `(fn [] ~@body)) - (fn [] (test-var (var ~name)))))) - -(defmacro deftest- - "Like deftest but creates a private var." - {:added "1.1"} - [name & body] - (when *load-tests* - `(def ~(vary-meta name assoc :test `(fn [] ~@body) :private true) - (fn [] (test-var (var ~name)))))) - - -(defmacro set-test - "Experimental. - Sets :test metadata of the named var to a fn with the given body. - The var must already exist. Does not modify the value of the var. - - When *load-tests* is false, set-test is ignored." - {:added "1.1"} - [name & body] - (when *load-tests* - `(alter-meta! (var ~name) assoc :test (fn [] ~@body)))) - - - -;;; DEFINING FIXTURES - -(defn- add-ns-meta - "Adds elements in coll to the current namespace metadata as the - value of key." - {:added "1.1"} - [key coll] - (alter-meta! *ns* assoc key coll)) - -(defmulti use-fixtures - "Wrap test runs in a fixture function to perform setup and - teardown. Using a fixture-type of :each wraps every test - individually, while:once wraps the whole run in a single function." - {:added "1.1"} - (fn [fixture-type & args] fixture-type)) - -(defmethod use-fixtures :each [fixture-type & args] - (add-ns-meta ::each-fixtures args)) - -(defmethod use-fixtures :once [fixture-type & args] - (add-ns-meta ::once-fixtures args)) - -(defn- default-fixture - "The default, empty, fixture function. Just calls its argument." - {:added "1.1"} - [f] - (f)) - -(defn compose-fixtures - "Composes two fixture functions, creating a new fixture function - that combines their behavior." - {:added "1.1"} - [f1 f2] - (fn [g] (f1 (fn [] (f2 g))))) - -(defn join-fixtures - "Composes a collection of fixtures, in order. Always returns a valid - fixture function, even if the collection is empty." - {:added "1.1"} - [fixtures] - (reduce compose-fixtures default-fixture fixtures)) - - - - -;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS - -(defn test-var - "If v has a function in its :test metadata, calls that function, - with *testing-vars* bound to (conj *testing-vars* v)." - {:dynamic true, :added "1.1"} - [v] - (when-let [t (:test (meta v))] - (binding [*testing-vars* (conj *testing-vars* v)] - (do-report {:type :begin-test-var, :var v}) - (inc-report-counter :test) - (try (t) - (catch Throwable e - (do-report {:type :error, :message "Uncaught exception, not in assertion." - :expected nil, :actual e}))) - (do-report {:type :end-test-var, :var v})))) - -(defn test-all-vars - "Calls test-var on every var interned in the namespace, with fixtures." - {:added "1.1"} - [ns] - (let [once-fixture-fn (join-fixtures (::once-fixtures (meta ns))) - each-fixture-fn (join-fixtures (::each-fixtures (meta ns)))] - (once-fixture-fn - (fn [] - (doseq [v (vals (ns-interns ns))] - (when (:test (meta v)) - (each-fixture-fn (fn [] (test-var v))))))))) - -(defn test-ns - "If the namespace defines a function named test-ns-hook, calls that. - Otherwise, calls test-all-vars on the namespace. 'ns' is a - namespace object or a symbol. - - Internally binds *report-counters* to a ref initialized to - *inital-report-counters*. Returns the final, dereferenced state of - *report-counters*." - {:added "1.1"} - [ns] - (binding [*report-counters* (ref *initial-report-counters*)] - (let [ns-obj (the-ns ns)] - (do-report {:type :begin-test-ns, :ns ns-obj}) - ;; If the namespace has a test-ns-hook function, call that: - (if-let [v (find-var (symbol (str (ns-name ns-obj)) "test-ns-hook"))] - ((var-get v)) - ;; Otherwise, just test every var in the namespace. - (test-all-vars ns-obj)) - (do-report {:type :end-test-ns, :ns ns-obj})) - @*report-counters*)) - - - -;;; RUNNING TESTS: HIGH-LEVEL FUNCTIONS - -(defn run-tests - "Runs all tests in the given namespaces; prints results. - Defaults to current namespace if none given. Returns a map - summarizing test results." - {:added "1.1"} - ([] (run-tests *ns*)) - ([& namespaces] - (let [summary (assoc (apply merge-with + (map test-ns namespaces)) - :type :summary)] - (do-report summary) - summary))) - -(defn run-all-tests - "Runs all tests in all namespaces; prints results. - Optional argument is a regular expression; only namespaces with - names matching the regular expression (with re-matches) will be - tested." - {:added "1.1"} - ([] (apply run-tests (all-ns))) - ([re] (apply run-tests (filter #(re-matches re (name (ns-name %))) (all-ns))))) - -(defn successful? - "Returns true if the given test summary indicates all tests - were successful, false otherwise." - {:added "1.1"} - [summary] - (and (zero? (:fail summary 0)) - (zero? (:error summary 0)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test/junit.clj --- a/src/clojure/test/junit.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,194 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; test/junit.clj: Extension to clojure.test for JUnit-compatible XML output - -;; by Jason Sankey -;; June 2009 - -;; DOCUMENTATION -;; - -(ns ^{:doc "clojure.test extension for JUnit-compatible XML output. - - JUnit (http://junit.org/) is the most popular unit-testing library - for Java. As such, tool support for JUnit output formats is - common. By producing compatible output from tests, this tool - support can be exploited. - - To use, wrap any calls to clojure.test/run-tests in the - with-junit-output macro, like this: - - (use 'clojure.test) - (use 'clojure.test.junit) - - (with-junit-output - (run-tests 'my.cool.library)) - - To write the output to a file, rebind clojure.test/*test-out* to - your own PrintWriter (perhaps opened using - clojure.java.io/writer)." - :author "Jason Sankey"} - clojure.test.junit - (:require [clojure.stacktrace :as stack] - [clojure.test :as t])) - -;; copied from clojure.contrib.lazy-xml -(def ^{:private true} - escape-xml-map - (zipmap "'<>\"&" (map #(str \& % \;) '[apos lt gt quot amp]))) -(defn- escape-xml [text] - (apply str (map #(escape-xml-map % %) text))) - -(def *var-context*) -(def *depth*) - -(defn indent - [] - (dotimes [n (* *depth* 4)] (print " "))) - -(defn start-element - [tag pretty & [attrs]] - (if pretty (indent)) - (print (str "<" tag)) - (if (seq attrs) - (doseq [[key value] attrs] - (print (str " " (name key) "=\"" (escape-xml value) "\"")))) - (print ">") - (if pretty (println)) - (set! *depth* (inc *depth*))) - -(defn element-content - [content] - (print (escape-xml content))) - -(defn finish-element - [tag pretty] - (set! *depth* (dec *depth*)) - (if pretty (indent)) - (print (str "")) - (if pretty (println))) - -(defn test-name - [vars] - (apply str (interpose "." - (reverse (map #(:name (meta %)) vars))))) - -(defn package-class - [name] - (let [i (.lastIndexOf name ".")] - (if (< i 0) - [nil name] - [(.substring name 0 i) (.substring name (+ i 1))]))) - -(defn start-case - [name classname] - (start-element 'testcase true {:name name :classname classname})) - -(defn finish-case - [] - (finish-element 'testcase true)) - -(defn suite-attrs - [package classname] - (let [attrs {:name classname}] - (if package - (assoc attrs :package package) - attrs))) - -(defn start-suite - [name] - (let [[package classname] (package-class name)] - (start-element 'testsuite true (suite-attrs package classname)))) - -(defn finish-suite - [] - (finish-element 'testsuite true)) - -(defn message-el - [tag message expected-str actual-str] - (indent) - (start-element tag false (if message {:message message} {})) - (element-content - (let [[file line] (t/file-position 5) - detail (apply str (interpose - "\n" - [(str "expected: " expected-str) - (str " actual: " actual-str) - (str " at: " file ":" line)]))] - (if message (str message "\n" detail) detail))) - (finish-element tag false) - (println)) - -(defn failure-el - [message expected actual] - (message-el 'failure message (pr-str expected) (pr-str actual))) - -(defn error-el - [message expected actual] - (message-el 'error - message - (pr-str expected) - (if (instance? Throwable actual) - (with-out-str (stack/print-cause-trace actual t/*stack-trace-depth*)) - (prn actual)))) - -;; This multimethod will override test-is/report -(defmulti junit-report :type) - -(defmethod junit-report :begin-test-ns [m] - (t/with-test-out - (start-suite (name (ns-name (:ns m)))))) - -(defmethod junit-report :end-test-ns [_] - (t/with-test-out - (finish-suite))) - -(defmethod junit-report :begin-test-var [m] - (t/with-test-out - (let [var (:var m)] - (binding [*var-context* (conj *var-context* var)] - (start-case (test-name *var-context*) (name (ns-name (:ns (meta var))))))))) - -(defmethod junit-report :end-test-var [m] - (t/with-test-out - (finish-case))) - -(defmethod junit-report :pass [m] - (t/with-test-out - (t/inc-report-counter :pass))) - -(defmethod junit-report :fail [m] - (t/with-test-out - (t/inc-report-counter :fail) - (failure-el (:message m) - (:expected m) - (:actual m)))) - -(defmethod junit-report :error [m] - (t/with-test-out - (t/inc-report-counter :error) - (error-el (:message m) - (:expected m) - (:actual m)))) - -(defmethod junit-report :default [_]) - -(defmacro with-junit-output - "Execute body with modified test-is reporting functions that write - JUnit-compatible XML output." - {:added "1.1"} - [& body] - `(binding [t/report junit-report - *var-context* (list) - *depth* 1] - (println "") - (println "") - (let [result# ~@body] - (println "") - result#))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test/tap.clj --- a/src/clojure/test/tap.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,116 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;;; test_is/tap.clj: Extension to test for TAP output - -;; by Stuart Sierra -;; March 31, 2009 - -;; Inspired by ClojureCheck by Meikel Brandmeyer: -;; http://kotka.de/projects/clojure/clojurecheck.html - - -;; DOCUMENTATION -;; - - - -(ns ^{:doc "clojure.test extensions for the Test Anything Protocol (TAP) - - TAP is a simple text-based syntax for reporting test results. TAP - was originally develped for Perl, and now has implementations in - several languages. For more information on TAP, see - http://testanything.org/ and - http://search.cpan.org/~petdance/TAP-1.0.0/TAP.pm - - To use this library, wrap any calls to - clojure.test/run-tests in the with-tap-output macro, - like this: - - (use 'clojure.test) - (use 'clojure.test.tap) - - (with-tap-output - (run-tests 'my.cool.library))" - :author "Stuart Sierra"} - clojure.test.tap - (:require [clojure.test :as t] - [clojure.stacktrace :as stack])) - -(defn print-tap-plan - "Prints a TAP plan line like '1..n'. n is the number of tests" - {:added "1.1"} - [n] - (println (str "1.." n))) - -(defn print-tap-diagnostic - "Prints a TAP diagnostic line. data is a (possibly multi-line) - string." - {:added "1.1"} - [data] - (doseq [line (.split ^String data "\n")] - (println "#" line))) - -(defn print-tap-pass - "Prints a TAP 'ok' line. msg is a string, with no line breaks" - {:added "1.1"} - [msg] - (println "ok" msg)) - -(defn print-tap-fail - "Prints a TAP 'not ok' line. msg is a string, with no line breaks" - {:added "1.1"} - [msg] - (println "not ok" msg)) - -;; This multimethod will override test/report -(defmulti tap-report (fn [data] (:type data))) - -(defmethod tap-report :default [data] - (t/with-test-out - (print-tap-diagnostic (pr-str data)))) - -(defmethod tap-report :pass [data] - (t/with-test-out - (t/inc-report-counter :pass) - (print-tap-pass (t/testing-vars-str)) - (when (seq t/*testing-contexts*) - (print-tap-diagnostic (t/testing-contexts-str))) - (when (:message data) - (print-tap-diagnostic (:message data))) - (print-tap-diagnostic (str "expected:" (pr-str (:expected data)))) - (print-tap-diagnostic (str " actual:" (pr-str (:actual data)))))) - -(defmethod tap-report :error [data] - (t/with-test-out - (t/inc-report-counter :error) - (print-tap-fail (t/testing-vars-str)) - (when (seq t/*testing-contexts*) - (print-tap-diagnostic (t/testing-contexts-str))) - (when (:message data) - (print-tap-diagnostic (:message data))) - (print-tap-diagnostic "expected:" (pr-str (:expected data))) - (print-tap-diagnostic " actual: ") - (print-tap-diagnostic - (with-out-str - (if (instance? Throwable (:actual data)) - (stack/print-cause-trace (:actual data) t/*stack-trace-depth*) - (prn (:actual data))))))) - -(defmethod tap-report :summary [data] - (t/with-test-out - (print-tap-plan (+ (:pass data) (:fail data) (:error data))))) - - -(defmacro with-tap-output - "Execute body with modified test reporting functions that produce - TAP output" - {:added "1.1"} - [& body] - `(binding [t/report tap-report] - ~@body)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure.clj --- a/src/clojure/test_clojure.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,99 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. -; - -;; clojure.test-clojure -;; -;; Tests for the facilities provided by Clojure -;; -;; scgilardi (gmail) -;; Created 22 October 2008 - -(ns clojure.test-clojure - (:require [clojure.test :as t]) - (:gen-class)) - -(def test-names - [:reader - :printer - :compilation - :evaluation - :special - :macros - :metadata - :ns-libs - :logic - :predicates - :control - :data-structures - :numbers - :sequences - :for - :multimethods - :other-functions - :vars - :refs - :agents - :atoms - :parallel - :java-interop - :test - :test-fixtures - ;; libraries - :clojure-set - :clojure-xml - :clojure-zip - :protocols - :genclass - :main - :vectors - :annotations - :pprint - :serialization - :rt - :repl - :java.io - :string - :java.javadoc - :java.shell - :transients - :def - ]) - -(def test-namespaces - (map #(symbol (str "clojure.test-clojure." (name %))) - test-names)) - -(defn run - "Runs all defined tests" - [] - (println "Loading tests...") - (apply require :reload-all test-namespaces) - (apply t/run-tests test-namespaces)) - -(defn run-ant - "Runs all defined tests, prints report to *err*, throw if failures. This works well for running in an ant java task." - [] - (let [rpt t/report] - (binding [;; binding to *err* because, in ant, when the test target - ;; runs after compile-clojure, *out* doesn't print anything - *out* *err* - t/*test-out* *err* - t/report (fn report [m] - (if (= :summary (:type m)) - (do (rpt m) - (if (or (pos? (:fail m)) (pos? (:error m))) - (throw (new Exception (str (:fail m) " failures, " (:error m) " errors."))))) - (rpt m)))] - (run)))) - -(defn -main - "Run all defined tests from the command line" - [& args] - (run) - (System/exit 0)) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/agents.clj --- a/src/clojure/test_clojure/agents.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,120 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Shawn Hoover - -(ns clojure.test-clojure.agents - (:use clojure.test)) - -(deftest handle-all-throwables-during-agent-actions - ;; Bug fixed in r1198; previously hung Clojure or didn't report agent errors - ;; after OutOfMemoryError, yet wouldn't execute new actions. - (let [agt (agent nil)] - (send agt (fn [state] (throw (Throwable. "just testing Throwables")))) - (try - ;; Let the action finish; eat the "agent has errors" error that bubbles up - (await-for 100 agt) - (catch RuntimeException _)) - (is (instance? Throwable (first (agent-errors agt)))) - (is (= 1 (count (agent-errors agt)))) - - ;; And now send an action that should work - (clear-agent-errors agt) - (is (= nil @agt)) - (send agt nil?) - (is (true? (await-for 100 agt))) - (is (true? @agt)))) - -(deftest default-modes - (is (= :fail (error-mode (agent nil)))) - (is (= :continue (error-mode (agent nil :error-handler println))))) - -(deftest continue-handler - (let [err (atom nil) - agt (agent 0 :error-mode :continue :error-handler #(reset! err %&))] - (send agt /) - (is (true? (await-for 100 agt))) - (is (= 0 @agt)) - (is (nil? (agent-error agt))) - (is (= agt (first @err))) - (is (true? (instance? ArithmeticException (second @err)))))) - -(deftest fail-handler - (let [err (atom nil) - agt (agent 0 :error-mode :fail :error-handler #(reset! err %&))] - (send agt /) - (Thread/sleep 100) - (is (true? (instance? ArithmeticException (agent-error agt)))) - (is (= 0 @agt)) - (is (= agt (first @err))) - (is (true? (instance? ArithmeticException (second @err)))) - (is (thrown? RuntimeException (send agt inc))))) - -(deftest restart-no-clear - (let [p (promise) - agt (agent 1 :error-mode :fail)] - (send agt (fn [v] @p)) - (send agt /) - (send agt inc) - (send agt inc) - (deliver p 0) - (Thread/sleep 100) - (is (= 0 @agt)) - (is (= ArithmeticException (class (agent-error agt)))) - (restart-agent agt 10) - (is (true? (await-for 100 agt))) - (is (= 12 @agt)) - (is (nil? (agent-error agt))))) - -(deftest restart-clear - (let [p (promise) - agt (agent 1 :error-mode :fail)] - (send agt (fn [v] @p)) - (send agt /) - (send agt inc) - (send agt inc) - (deliver p 0) - (Thread/sleep 100) - (is (= 0 @agt)) - (is (= ArithmeticException (class (agent-error agt)))) - (restart-agent agt 10 :clear-actions true) - (is (true? (await-for 100 agt))) - (is (= 10 @agt)) - (is (nil? (agent-error agt))) - (send agt inc) - (is (true? (await-for 100 agt))) - (is (= 11 @agt)) - (is (nil? (agent-error agt))))) - -(deftest invalid-restart - (let [p (promise) - agt (agent 2 :error-mode :fail :validator even?)] - (is (thrown? RuntimeException (restart-agent agt 4))) - (send agt (fn [v] @p)) - (send agt (partial + 2)) - (send agt (partial + 2)) - (deliver p 3) - (Thread/sleep 100) - (is (= 2 @agt)) - (is (= IllegalStateException (class (agent-error agt)))) - (is (thrown? RuntimeException (restart-agent agt 5))) - (restart-agent agt 6) - (is (true? (await-for 100 agt))) - (is (= 10 @agt)) - (is (nil? (agent-error agt))))) - -; http://clojure.org/agents - -; agent -; deref, @-reader-macro, agent-errors -; send send-off clear-agent-errors -; await await-for -; set-validator get-validator -; add-watch remove-watch -; shutdown-agents - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/annotations.clj --- a/src/clojure/test_clojure/annotations.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,29 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Authors: Stuart Halloway, Rich Hickey - -(ns clojure.test-clojure.annotations - (:use clojure.test)) - -(defn vm-has-ws-annotations? - "Does the vm have the ws annotations we use to test some - annotation features. If not, fall back to Java 5 tests." - [] - (try - (doseq [n ["javax.xml.ws.soap.Addressing" - "javax.xml.ws.WebServiceRef" - "javax.xml.ws.WebServiceRefs"]] - (Class/forName n)) - true - (catch ClassNotFoundException e - false))) - -(if (vm-has-ws-annotations?) - (load "annotations/java_6_and_later") - (load "annotations/java_5")) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/annotations/java_5.clj --- a/src/clojure/test_clojure/annotations/java_5.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -;; java 5 annotation tests -(in-ns 'clojure.test-clojure.annotations) - -(import [java.lang.annotation Annotation Retention RetentionPolicy Target ElementType]) -(definterface Foo (foo [])) - -(deftype #^{Deprecated true - Retention RetentionPolicy/RUNTIME} - Bar [#^int a - #^{:tag int - Deprecated true - Retention RetentionPolicy/RUNTIME} b] - Foo (#^{Deprecated true - Retention RetentionPolicy/RUNTIME} - foo [this] 42)) - -(defn annotation->map - "Converts a Java annotation (which conceals data) - into a map (which makes is usable). Not lazy. - Works recursively. Returns non-annotations unscathed." - [#^java.lang.annotation.Annotation o] - (cond - (instance? Annotation o) - (let [type (.annotationType o) - itfs (-> (into #{type} (supers type)) (disj java.lang.annotation.Annotation)) - data-methods (into #{} (mapcat #(.getDeclaredMethods %) itfs))] - (into - {:annotationType (.annotationType o)} - (map - (fn [m] [(keyword (.getName m)) (annotation->map (.invoke m o nil))]) - data-methods))) - (or (sequential? o) (.isArray (class o))) - (map annotation->map o) - :else o)) - -(def expected-annotations - #{{:annotationType java.lang.annotation.Retention, :value RetentionPolicy/RUNTIME} - {:annotationType java.lang.Deprecated}}) - -(deftest test-annotations-on-type - (is (= - expected-annotations - (into #{} (map annotation->map (.getAnnotations Bar)))))) - -(deftest test-annotations-on-field - (is (= - expected-annotations - (into #{} (map annotation->map (.getAnnotations (.getField Bar "b"))))))) - -(deftest test-annotations-on-method - (is (= - expected-annotations - (into #{} (map annotation->map (.getAnnotations (.getMethod Bar "foo" nil))))))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/annotations/java_6_and_later.clj --- a/src/clojure/test_clojure/annotations/java_6_and_later.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,73 +0,0 @@ -;; java 6 annotation tests -(in-ns 'clojure.test-clojure.annotations) - -(import [java.lang.annotation Annotation Retention RetentionPolicy Target ElementType] - [javax.xml.ws WebServiceRef WebServiceRefs]) -(definterface Foo (foo [])) - -(deftype #^{Deprecated true - Retention RetentionPolicy/RUNTIME - javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"] - javax.xml.ws.soap.Addressing {:enabled false :required true} - WebServiceRefs [(WebServiceRef {:name "fred" :type String}) - (WebServiceRef {:name "ethel" :mappedName "lucy"})]} - Bar [#^int a - #^{:tag int - Deprecated true - Retention RetentionPolicy/RUNTIME - javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"] - javax.xml.ws.soap.Addressing {:enabled false :required true} - WebServiceRefs [(WebServiceRef {:name "fred" :type String}) - (WebServiceRef {:name "ethel" :mappedName "lucy"})]} - b] - Foo (#^{Deprecated true - Retention RetentionPolicy/RUNTIME - javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"] - javax.xml.ws.soap.Addressing {:enabled false :required true} - WebServiceRefs [(WebServiceRef {:name "fred" :type String}) - (WebServiceRef {:name "ethel" :mappedName "lucy"})]} - foo [this] 42)) - -(defn annotation->map - "Converts a Java annotation (which conceals data) - into a map (which makes is usable). Not lazy. - Works recursively. Returns non-annotations unscathed." - [#^java.lang.annotation.Annotation o] - (cond - (instance? Annotation o) - (let [type (.annotationType o) - itfs (-> (into #{type} (supers type)) (disj java.lang.annotation.Annotation)) - data-methods (into #{} (mapcat #(.getDeclaredMethods %) itfs))] - (into - {:annotationType (.annotationType o)} - (map - (fn [m] [(keyword (.getName m)) (annotation->map (.invoke m o nil))]) - data-methods))) - (or (sequential? o) (.isArray (class o))) - (map annotation->map o) - :else o)) - -(def expected-annotations - #{{:annotationType java.lang.annotation.Retention, :value RetentionPolicy/RUNTIME} - {:annotationType javax.xml.ws.WebServiceRefs, - :value [{:annotationType javax.xml.ws.WebServiceRef, :name "fred", :mappedName "", :type java.lang.String, :wsdlLocation "", :value java.lang.Object} - {:annotationType javax.xml.ws.WebServiceRef, :name "ethel", :mappedName "lucy", :type java.lang.Object, :wsdlLocation "", :value java.lang.Object}]} - {:annotationType javax.xml.ws.soap.Addressing, :enabled false, :required true} - {:annotationType javax.annotation.processing.SupportedOptions, :value ["foo" "bar" "baz"]} - {:annotationType java.lang.Deprecated}}) - -(deftest test-annotations-on-type - (is (= - expected-annotations - (into #{} (map annotation->map (.getAnnotations Bar)))))) - -(deftest test-annotations-on-field - (is (= - expected-annotations - (into #{} (map annotation->map (.getAnnotations (.getField Bar "b"))))))) - -(deftest test-annotations-on-method - (is (= - expected-annotations - (into #{} (map annotation->map (.getAnnotations (.getMethod Bar "foo" nil))))))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/atoms.clj --- a/src/clojure/test_clojure/atoms.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;;Author: Frantisek Sodomka - -(ns clojure.test-clojure.atoms - (:use clojure.test)) - -; http://clojure.org/atoms - -; atom -; deref, @-reader-macro -; swap! reset! -; compare-and-set! - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/clojure_set.clj --- a/src/clojure/test_clojure/clojure_set.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,206 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Frantisek Sodomka - - -(ns clojure.test-clojure.clojure-set - (:use clojure.test) - (:require [clojure.set :as set])) - -(deftest test-union - (are [x y] (= x y) - (set/union) #{} - - ; identity - (set/union #{}) #{} - (set/union #{1}) #{1} - (set/union #{1 2 3}) #{1 2 3} - - ; 2 sets, at least one is empty - (set/union #{} #{}) #{} - (set/union #{} #{1}) #{1} - (set/union #{} #{1 2 3}) #{1 2 3} - (set/union #{1} #{}) #{1} - (set/union #{1 2 3} #{}) #{1 2 3} - - ; 2 sets - (set/union #{1} #{2}) #{1 2} - (set/union #{1} #{1 2}) #{1 2} - (set/union #{2} #{1 2}) #{1 2} - (set/union #{1 2} #{3}) #{1 2 3} - (set/union #{1 2} #{2 3}) #{1 2 3} - - ; 3 sets, some are empty - (set/union #{} #{} #{}) #{} - (set/union #{1} #{} #{}) #{1} - (set/union #{} #{1} #{}) #{1} - (set/union #{} #{} #{1}) #{1} - (set/union #{1 2} #{2 3} #{}) #{1 2 3} - - ; 3 sets - (set/union #{1 2} #{3 4} #{5 6}) #{1 2 3 4 5 6} - (set/union #{1 2} #{2 3} #{1 3 4}) #{1 2 3 4} - - ; different data types - (set/union #{1 2} #{:a :b} #{nil} #{false true} #{\c "abc"} #{[] [1 2]} - #{{} {:a 1}} #{#{} #{1 2}}) - #{1 2 :a :b nil false true \c "abc" [] [1 2] {} {:a 1} #{} #{1 2}} - - ; different types of sets - (set/union (hash-set) (hash-set 1 2) (hash-set 2 3)) - (hash-set 1 2 3) - (set/union (sorted-set) (sorted-set 1 2) (sorted-set 2 3)) - (sorted-set 1 2 3) - (set/union (hash-set) (hash-set 1 2) (hash-set 2 3) - (sorted-set) (sorted-set 4 5) (sorted-set 5 6)) - (hash-set 1 2 3 4 5 6) ; also equals (sorted-set 1 2 3 4 5 6) -)) - -(deftest test-intersection - ; at least one argument is needed - (is (thrown? IllegalArgumentException (set/intersection))) - - (are [x y] (= x y) - ; identity - (set/intersection #{}) #{} - (set/intersection #{1}) #{1} - (set/intersection #{1 2 3}) #{1 2 3} - - ; 2 sets, at least one is empty - (set/intersection #{} #{}) #{} - (set/intersection #{} #{1}) #{} - (set/intersection #{} #{1 2 3}) #{} - (set/intersection #{1} #{}) #{} - (set/intersection #{1 2 3} #{}) #{} - - ; 2 sets - (set/intersection #{1 2} #{1 2}) #{1 2} - (set/intersection #{1 2} #{3 4}) #{} - (set/intersection #{1 2} #{1}) #{1} - (set/intersection #{1 2} #{2}) #{2} - (set/intersection #{1 2 4} #{2 3 4 5}) #{2 4} - - ; 3 sets, some are empty - (set/intersection #{} #{} #{}) #{} - (set/intersection #{1} #{} #{}) #{} - (set/intersection #{1} #{1} #{}) #{} - (set/intersection #{1} #{} #{1}) #{} - (set/intersection #{1 2} #{2 3} #{}) #{} - - ; 3 sets - (set/intersection #{1 2} #{2 3} #{5 2}) #{2} - (set/intersection #{1 2 3} #{1 3 4} #{1 3}) #{1 3} - (set/intersection #{1 2 3} #{3 4 5} #{8 2 3}) #{3} - - ; different types of sets - (set/intersection (hash-set 1 2) (hash-set 2 3)) #{2} - (set/intersection (sorted-set 1 2) (sorted-set 2 3)) #{2} - (set/intersection - (hash-set 1 2) (hash-set 2 3) - (sorted-set 1 2) (sorted-set 2 3)) #{2} )) - -(deftest test-difference - (are [x y] (= x y) - ; identity - (set/difference #{}) #{} - (set/difference #{1}) #{1} - (set/difference #{1 2 3}) #{1 2 3} - - ; 2 sets - (set/difference #{1 2} #{1 2}) #{} - (set/difference #{1 2} #{3 4}) #{1 2} - (set/difference #{1 2} #{1}) #{2} - (set/difference #{1 2} #{2}) #{1} - (set/difference #{1 2 4} #{2 3 4 5}) #{1} - - ; 3 sets - (set/difference #{1 2} #{2 3} #{5 2}) #{1} - (set/difference #{1 2 3} #{1 3 4} #{1 3}) #{2} - (set/difference #{1 2 3} #{3 4 5} #{8 2 3}) #{1} )) - -(deftest test-select - (are [x y] (= x y) - (set/select integer? #{}) #{} - (set/select integer? #{1 2}) #{1 2} - (set/select integer? #{1 2 :a :b :c}) #{1 2} - (set/select integer? #{:a :b :c}) #{}) ) - -(def compositions - #{{:name "Art of the Fugue" :composer "J. S. Bach"} - {:name "Musical Offering" :composer "J. S. Bach"} - {:name "Requiem" :composer "Giuseppe Verdi"} - {:name "Requiem" :composer "W. A. Mozart"}}) - -(deftest test-project - (are [x y] (= x y) - (set/project compositions [:name]) #{{:name "Art of the Fugue"} - {:name "Requiem"} - {:name "Musical Offering"}} - (set/project compositions [:composer]) #{{:composer "W. A. Mozart"} - {:composer "Giuseppe Verdi"} - {:composer "J. S. Bach"}} - (set/project compositions [:year]) #{{}} - (set/project #{{}} [:name]) #{{}} )) - -(deftest test-rename - (are [x y] (= x y) - (set/rename compositions {:name :title}) #{{:title "Art of the Fugue" :composer "J. S. Bach"} - {:title "Musical Offering" :composer "J. S. Bach"} - {:title "Requiem" :composer "Giuseppe Verdi"} - {:title "Requiem" :composer "W. A. Mozart"}} - (set/rename compositions {:year :decade}) #{{:name "Art of the Fugue" :composer "J. S. Bach"} - {:name "Musical Offering" :composer "J. S. Bach"} - {:name "Requiem" :composer "Giuseppe Verdi"} - {:name "Requiem" :composer "W. A. Mozart"}} - (set/rename #{{}} {:year :decade}) #{{}})) - -(deftest test-rename-keys - (are [x y] (= x y) - (set/rename-keys {:a "one" :b "two"} {:a :z}) {:z "one" :b "two"} - )) - -(deftest test-index - (are [x y] (= x y) - (set/index #{{:c 2} {:b 1} {:a 1 :b 2}} [:b]) {{:b 2} #{{:a 1 :b 2}}, {:b 1} #{{:b 1}} {} #{{:c 2}}} - )) - -(deftest test-join - (are [x y] (= x y) - (set/join compositions compositions) compositions - (set/join compositions #{{:name "Art of the Fugue" :genre "Classical"}}) - #{{:name "Art of the Fugue" :composer "J. S. Bach" :genre "Classical"}} - )) - -(deftest test-map-invert - (are [x y] (= x y) - (set/map-invert {:a "one" :b "two"}) {"one" :a "two" :b})) - -(deftest test-subset? - (are [sub super] (set/subset? sub super) - #{} #{} - #{} #{1} - #{1} #{1} - #{1 2} #{1 2} - #{1 2} #{1 2 42}) - (are [notsub super] (not (set/subset? notsub super)) - #{1} #{} - #{2} #{1} - #{1 3} #{1})) - -(deftest test-superset? - (are [super sub] (set/superset? super sub) - #{} #{} - #{1} #{} - #{1} #{1} - #{1 2} #{1 2} - #{1 2 42} #{1 2}) - (are [notsuper sub] (not (set/superset? notsuper sub)) - #{} #{1} - #{2} #{1} - #{1} #{1 3})) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/clojure_xml.clj --- a/src/clojure/test_clojure/clojure_xml.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,21 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;;Author: Frantisek Sodomka - - -(ns clojure.test-clojure.clojure-xml - (:use clojure.test) - (:require [clojure.xml :as xml])) - - -; parse - -; emit-element -; emit - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/clojure_zip.clj --- a/src/clojure/test_clojure/clojure_zip.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,48 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - - -(ns clojure.test-clojure.clojure-zip - (:use clojure.test) - (:require [clojure.zip :as zip])) - - -; zipper -; -; seq-zip -; vector-zip -; xml-zip -; -; node -; branch? -; children -; make-node -; path -; lefts -; rights -; down -; up -; root -; right -; rightmost -; left -; leftmost -; -; insert-left -; insert-right -; replace -; edit -; insert-child -; append-child -; next -; prev -; end? -; remove - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/compilation.clj --- a/src/clojure/test_clojure/compilation.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - - -(ns clojure.test-clojure.compilation - (:use clojure.test)) - -; http://clojure.org/compilation - -; compile -; gen-class, gen-interface - - -(deftest test-compiler-metadata - (let [m (meta #'when)] - (are [x y] (= x y) - (list? (:arglists m)) true - (> (count (:arglists m)) 0) true - - (string? (:doc m)) true - (> (.length (:doc m)) 0) true - - (string? (:file m)) true - (> (.length (:file m)) 0) true - - (integer? (:line m)) true - (> (:line m) 0) true - - (:macro m) true - (:name m) 'when ))) - -(deftest test-embedded-constants - (testing "Embedded constants" - (is (eval `(= Boolean/TYPE ~Boolean/TYPE))) - (is (eval `(= Byte/TYPE ~Byte/TYPE))) - (is (eval `(= Character/TYPE ~Character/TYPE))) - (is (eval `(= Double/TYPE ~Double/TYPE))) - (is (eval `(= Float/TYPE ~Float/TYPE))) - (is (eval `(= Integer/TYPE ~Integer/TYPE))) - (is (eval `(= Long/TYPE ~Long/TYPE))) - (is (eval `(= Short/TYPE ~Short/TYPE))))) - -(deftest test-compiler-resolution - (testing "resolve nonexistent class create should return nil (assembla #262)" - (is (nil? (resolve 'NonExistentClass.))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/control.clj --- a/src/clojure/test_clojure/control.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,333 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka, Mike Hinchey, Stuart Halloway - -;; -;; Test "flow control" constructs. -;; - -(ns clojure.test-clojure.control - (:use clojure.test - [clojure.test-clojure.helpers :only (exception)])) - -;; *** Helper functions *** - -(defn maintains-identity [f] - (are [x] (= (f x) x) - nil - false true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - () '(1 2) - [] [1 2] - {} {:a 1 :b 2} - #{} #{1 2} )) - - -; http://clojure.org/special_forms -; http://clojure.org/macros - -(deftest test-do - (are [x y] (= x y) - ; no params => nil - (do) nil - - ; return last - (do 1) 1 - (do 1 2) 2 - (do 1 2 3 4 5) 5 - - ; evaluate and return last - (let [a (atom 0)] - (do (reset! a (+ @a 1)) ; 1 - (reset! a (+ @a 1)) ; 2 - (reset! a (+ @a 1)) ; 3 - @a)) 3 ) - - ; identity (= (do x) x) - (maintains-identity (fn [_] (do _))) ) - - -;; loop/recur -(deftest test-loop - (are [x y] (= x y) - 1 (loop [] - 1) - 3 (loop [a 1] - (if (< a 3) - (recur (inc a)) - a)) - [2 4 6] (loop [a [] - b [1 2 3]] - (if (seq b) - (recur (conj a (* 2 (first b))) - (next b)) - a)) - [6 4 2] (loop [a () - b [1 2 3]] - (if (seq b) - (recur (conj a (* 2 (first b))) - (next b)) - a)) - ) - ) - - -;; throw, try - -; if: see logic.clj - -(deftest test-when - (are [x y] (= x y) - 1 (when true 1) - nil (when true) - nil (when false) - nil (when false (exception)) - )) - -(deftest test-when-not - (are [x y] (= x y) - 1 (when-not false 1) - nil (when-not true) - nil (when-not false) - nil (when-not true (exception)) - )) - -(deftest test-if-not - (are [x y] (= x y) - 1 (if-not false 1) - 1 (if-not false 1 (exception)) - nil (if-not true 1) - 2 (if-not true 1 2) - nil (if-not true (exception)) - 1 (if-not true (exception) 1) - )) - -(deftest test-when-let - (are [x y] (= x y) - 1 (when-let [a 1] - a) - 2 (when-let [[a b] '(1 2)] - b) - nil (when-let [a false] - (exception)) - )) - -(deftest test-if-let - (are [x y] (= x y) - 1 (if-let [a 1] - a) - 2 (if-let [[a b] '(1 2)] - b) - nil (if-let [a false] - (exception)) - 1 (if-let [a false] - a 1) - 1 (if-let [[a b] nil] - b 1) - 1 (if-let [a false] - (exception) - 1) - )) - -(deftest test-when-first - (are [x y] (= x y) - 1 (when-first [a [1 2]] - a) - 2 (when-first [[a b] '((1 2) 3)] - b) - nil (when-first [a nil] - (exception)) - )) - - -(deftest test-cond - (are [x y] (= x y) - (cond) nil - - (cond nil true) nil - (cond false true) nil - - (cond true 1 true (exception)) 1 - (cond nil 1 false 2 true 3 true 4) 3 - (cond nil 1 false 2 true 3 true (exception)) 3 ) - - ; false - (are [x] (= (cond x :a true :b) :b) - nil false ) - - ; true - (are [x] (= (cond x :a true :b) :a) - true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - () '(1 2) - [] [1 2] - {} {:a 1 :b 2} - #{} #{1 2} ) - - ; evaluation - (are [x y] (= x y) - (cond (> 3 2) (+ 1 2) true :result true (exception)) 3 - (cond (< 3 2) (+ 1 2) true :result true (exception)) :result ) - - ; identity (= (cond true x) x) - (maintains-identity (fn [_] (cond true _))) ) - - -(deftest test-condp - (are [x] (= :pass x) - (condp = 1 - 1 :pass - 2 :fail) - (condp = 1 - 2 :fail - 1 :pass) - (condp = 1 - 2 :fail - :pass) - (condp = 1 - :pass) - (condp = 1 - 2 :fail - ;; doc of condp says result-expr is returned - ;; shouldn't it say similar to cond: "evaluates and returns - ;; the value of the corresponding expr and doesn't evaluate any of the - ;; other tests or exprs." - (identity :pass)) - (condp + 1 - 1 :>> #(if (= % 2) :pass :fail)) - (condp + 1 - 1 :>> #(if (= % 3) :fail :pass)) - ) - (is (thrown? IllegalArgumentException - (condp = 1) - )) - (is (thrown? IllegalArgumentException - (condp = 1 - 2 :fail) - )) - ) - - -; [for, doseq (for.clj)] - -(deftest test-dotimes - ;; dotimes always returns nil - (is (= nil (dotimes [n 1] n))) - ;; test using an atom since dotimes is for modifying - ;; test executes n times - (is (= 3 - (let [a (atom 0)] - (dotimes [n 3] - (swap! a inc)) - @a) - )) - ;; test all values of n - (is (= [0 1 2] - (let [a (atom [])] - (dotimes [n 3] - (swap! a conj n)) - @a))) - (is (= [] - (let [a (atom [])] - (dotimes [n 0] - (swap! a conj n)) - @a))) - ) - -(deftest test-while - (is (= nil (while nil (throw (Exception. "never"))))) - (is (= [0 nil] - ;; a will dec to 0 - ;; while always returns nil - (let [a (atom 3) - w (while (pos? @a) - (swap! a dec))] - [@a w]))) - (is (thrown? Exception (while true (throw (Exception. "expected to throw"))))) - ) - -; locking, monitor-enter, monitor-exit - -; case -(deftest test-case - (testing "can match many kinds of things" - (let [two 2 - test-fn - #(case % - 1 :number - "foo" :string - \a :char - pow :symbol - :zap :keyword - (2 \b "bar") :one-of-many - [1 2] :sequential-thing - {:a 2} :map - {:r 2 :d 2} :droid - #{2 3 4 5} :set - [1 [[[2]]]] :deeply-nested - :default)] - (are [result input] (= result (test-fn input)) - :number 1 - :string "foo" - :char \a - :keyword :zap - :symbol 'pow - :one-of-many 2 - :one-of-many \b - :one-of-many "bar" - :sequential-thing [1 2] - :sequential-thing (list 1 2) - :sequential-thing [1 two] - :map {:a 2} - :map {:a two} - :set #{2 3 4 5} - :set #{two 3 4 5} - :default #{2 3 4 5 6} - :droid {:r 2 :d 2} - :deeply-nested [1 [[[two]]]] - :default :anything-not-appearing-above))) - (testing "throws IllegalArgumentException if no match" - (is (thrown-with-msg? - IllegalArgumentException #"No matching clause: 2" - (case 2 1 :ok)))) - (testing "sorting doesn't matter" - (let [test-fn - #(case % - {:b 2 :a 1} :map - #{3 2 1} :set - :default)] - (are [result input] (= result (test-fn input)) - :map {:a 1 :b 2} - :map (sorted-map :a 1 :b 2) - :set #{3 2 1} - :set (sorted-set 2 1 3)))) - (testing "test constants are *not* evaluated" - (let [test-fn - ;; never write code like this... - #(case % - (throw (RuntimeException. "boom")) :piece-of-throw-expr - :no-match)] - (are [result input] (= result (test-fn input)) - :piece-of-throw-expr 'throw - :piece-of-throw-expr '[RuntimeException. "boom"] - :no-match nil)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/data_structures.clj --- a/src/clojure/test_clojure/data_structures.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,830 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - - -(ns clojure.test-clojure.data-structures - (:use clojure.test)) - - -;; *** Helper functions *** - -(defn diff [s1 s2] - (seq (reduce disj (set s1) (set s2)))) - - -;; *** General *** - -(defstruct equality-struct :a :b) - -(deftest test-equality - ; nil is not equal to any other value - (are [x] (not (= nil x)) - true false - 0 0.0 - \space - "" #"" - () [] #{} {} - (lazy-seq nil) ; SVN 1292: fixed (= (lazy-seq nil) nil) - (lazy-seq ()) - (lazy-seq []) - (lazy-seq {}) - (lazy-seq #{}) - (lazy-seq "") - (lazy-seq (into-array [])) - (new Object) ) - - ; numbers equality across types (see tests below - NOT IMPLEMENTED YET) - - ; ratios - (is (= 1/2 0.5)) - (is (= 1/1000 0.001)) - (is (not= 2/3 0.6666666666666666)) - - ; vectors equal other seqs by items equality - (are [x y] (= x y) - '() [] ; regression fixed in r1208; was not equal - '(1) [1] - '(1 2) [1 2] - - [] '() ; same again, but vectors first - [1] '(1) - [1 2] '(1 2) ) - (is (not= [1 2] '(2 1))) ; order of items matters - - ; list and vector vs. set and map - (are [x y] (not= x y) - ; only () equals [] - () #{} - () {} - [] #{} - [] {} - #{} {} - ; only '(1) equals [1] - '(1) #{1} - [1] #{1} ) - - ; sorted-map, hash-map and array-map - classes differ, but content is equal - -;; TODO: reimplement all-are with new do-template? -;; (all-are (not= (class _1) (class _2)) -;; (sorted-map :a 1) -;; (hash-map :a 1) -;; (array-map :a 1)) -;; (all-are (= _1 _2) -;; (sorted-map) -;; (hash-map) -;; (array-map)) -;; (all-are (= _1 _2) -;; (sorted-map :a 1) -;; (hash-map :a 1) -;; (array-map :a 1)) -;; (all-are (= _1 _2) -;; (sorted-map :a 1 :z 3 :c 2) -;; (hash-map :a 1 :z 3 :c 2) -;; (array-map :a 1 :z 3 :c 2)) - - ; struct-map vs. sorted-map, hash-map and array-map - (are [x] (and (not= (class (struct equality-struct 1 2)) (class x)) - (= (struct equality-struct 1 2) x)) - (sorted-map-by compare :a 1 :b 2) - (sorted-map :a 1 :b 2) - (hash-map :a 1 :b 2) - (array-map :a 1 :b 2)) - - ; sorted-set vs. hash-set - (is (not= (class (sorted-set 1)) (class (hash-set 1)))) - (are [x y] (= x y) - (sorted-set-by <) (hash-set) - (sorted-set-by < 1) (hash-set 1) - (sorted-set-by < 3 2 1) (hash-set 3 2 1) - (sorted-set) (hash-set) - (sorted-set 1) (hash-set 1) - (sorted-set 3 2 1) (hash-set 3 2 1) )) - - -;; *** Collections *** - -(deftest test-count - (are [x y] (= x y) - (count nil) 0 - - (count ()) 0 - (count '(1)) 1 - (count '(1 2 3)) 3 - - (count []) 0 - (count [1]) 1 - (count [1 2 3]) 3 - - (count #{}) 0 - (count #{1}) 1 - (count #{1 2 3}) 3 - - (count {}) 0 - (count {:a 1}) 1 - (count {:a 1 :b 2 :c 3}) 3 - - (count "") 0 - (count "a") 1 - (count "abc") 3 - - (count (into-array [])) 0 - (count (into-array [1])) 1 - (count (into-array [1 2 3])) 3 - - (count (java.util.ArrayList. [])) 0 - (count (java.util.ArrayList. [1])) 1 - (count (java.util.ArrayList. [1 2 3])) 3 - - (count (java.util.HashMap. {})) 0 - (count (java.util.HashMap. {:a 1})) 1 - (count (java.util.HashMap. {:a 1 :b 2 :c 3})) 3 ) - - ; different types - (are [x] (= (count [x]) 1) - nil true false - 0 0.0 "" \space - () [] #{} {} )) - - -(deftest test-conj - ; doesn't work on strings or arrays - (is (thrown? ClassCastException (conj "" \a))) - (is (thrown? ClassCastException (conj (into-array []) 1))) - - (are [x y] (= x y) - (conj nil 1) '(1) - (conj nil 3 2 1) '(1 2 3) - - (conj nil nil) '(nil) - (conj nil nil nil) '(nil nil) - (conj nil nil nil 1) '(1 nil nil) - - ; list -> conj puts the item at the front of the list - (conj () 1) '(1) - (conj () 1 2) '(2 1) - - (conj '(2 3) 1) '(1 2 3) - (conj '(2 3) 1 4 3) '(3 4 1 2 3) - - (conj () nil) '(nil) - (conj () ()) '(()) - - ; vector -> conj puts the item at the end of the vector - (conj [] 1) [1] - (conj [] 1 2) [1 2] - - (conj [2 3] 1) [2 3 1] - (conj [2 3] 1 4 3) [2 3 1 4 3] - - (conj [] nil) [nil] - (conj [] []) [[]] - - ; map -> conj expects another (possibly single entry) map as the item, - ; and returns a new map which is the old map plus the entries - ; from the new, which may overwrite entries of the old. - ; conj also accepts a MapEntry or a vector of two items (key and value). - (conj {} {}) {} - (conj {} {:a 1}) {:a 1} - (conj {} {:a 1 :b 2}) {:a 1 :b 2} - (conj {} {:a 1 :b 2} {:c 3}) {:a 1 :b 2 :c 3} - (conj {} {:a 1 :b 2} {:a 3 :c 4}) {:a 3 :b 2 :c 4} - - (conj {:a 1} {:a 7}) {:a 7} - (conj {:a 1} {:b 2}) {:a 1 :b 2} - (conj {:a 1} {:a 7 :b 2}) {:a 7 :b 2} - (conj {:a 1} {:a 7 :b 2} {:c 3}) {:a 7 :b 2 :c 3} - (conj {:a 1} {:a 7 :b 2} {:b 4 :c 5}) {:a 7 :b 4 :c 5} - - (conj {} (first {:a 1})) {:a 1} ; MapEntry - (conj {:a 1} (first {:b 2})) {:a 1 :b 2} - (conj {:a 1} (first {:a 7})) {:a 7} - (conj {:a 1} (first {:b 2}) (first {:a 5})) {:a 5 :b 2} - - (conj {} [:a 1]) {:a 1} ; vector - (conj {:a 1} [:b 2]) {:a 1 :b 2} - (conj {:a 1} [:a 7]) {:a 7} - (conj {:a 1} [:b 2] [:a 5]) {:a 5 :b 2} - - (conj {} {nil {}}) {nil {}} - (conj {} {{} nil}) {{} nil} - (conj {} {{} {}}) {{} {}} - - ; set - (conj #{} 1) #{1} - (conj #{} 1 2 3) #{1 2 3} - - (conj #{2 3} 1) #{3 1 2} - (conj #{3 2} 1) #{1 2 3} - - (conj #{2 3} 2) #{2 3} - (conj #{2 3} 2 3) #{2 3} - (conj #{2 3} 4 1 2 3) #{1 2 3 4} - - (conj #{} nil) #{nil} - (conj #{} #{}) #{#{}} )) - - -;; *** Lists and Vectors *** - -(deftest test-peek - ; doesn't work for sets and maps - (is (thrown? ClassCastException (peek #{1}))) - (is (thrown? ClassCastException (peek {:a 1}))) - - (are [x y] (= x y) - (peek nil) nil - - ; list = first - (peek ()) nil - (peek '(1)) 1 - (peek '(1 2 3)) 1 - - (peek '(nil)) nil ; special cases - (peek '(1 nil)) 1 - (peek '(nil 2)) nil - (peek '(())) () - (peek '(() nil)) () - (peek '(() 2 nil)) () - - ; vector = last - (peek []) nil - (peek [1]) 1 - (peek [1 2 3]) 3 - - (peek [nil]) nil ; special cases - (peek [1 nil]) nil - (peek [nil 2]) 2 - (peek [[]]) [] - (peek [[] nil]) nil - (peek [[] 2 nil]) nil )) - - -(deftest test-pop - ; doesn't work for sets and maps - (is (thrown? ClassCastException (pop #{1}))) - (is (thrown? ClassCastException (pop #{:a 1}))) - - ; collection cannot be empty - (is (thrown? IllegalStateException (pop ()))) - (is (thrown? IllegalStateException (pop []))) - - (are [x y] (= x y) - (pop nil) nil - - ; list - pop first - (pop '(1)) () - (pop '(1 2 3)) '(2 3) - - (pop '(nil)) () - (pop '(1 nil)) '(nil) - (pop '(nil 2)) '(2) - (pop '(())) () - (pop '(() nil)) '(nil) - (pop '(() 2 nil)) '(2 nil) - - ; vector - pop last - (pop [1]) [] - (pop [1 2 3]) [1 2] - - (pop [nil]) [] - (pop [1 nil]) [1] - (pop [nil 2]) [nil] - (pop [[]]) [] - (pop [[] nil]) [[]] - (pop [[] 2 nil]) [[] 2] )) - - -;; *** Lists (IPersistentList) *** - -(deftest test-list - (are [x] (list? x) - () - '() - (list) - (list 1 2 3) ) - - ; order is important - (are [x y] (not (= x y)) - (list 1 2) (list 2 1) - (list 3 1 2) (list 1 2 3) ) - - (are [x y] (= x y) - '() () - (list) '() - (list 1) '(1) - (list 1 2) '(1 2) - - ; nesting - (list 1 (list 2 3) (list 3 (list 4 5 (list 6 (list 7))))) - '(1 (2 3) (3 (4 5 (6 (7))))) - - ; different data structures - (list true false nil) - '(true false nil) - (list 1 2.5 2/3 "ab" \x 'cd :kw) - '(1 2.5 2/3 "ab" \x cd :kw) - (list (list 1 2) [3 4] {:a 1 :b 2} #{:c :d}) - '((1 2) [3 4] {:a 1 :b 2} #{:c :d}) - - ; evaluation - (list (+ 1 2) [(+ 2 3) 'a] (list (* 2 3) 8)) - '(3 [5 a] (6 8)) - - ; special cases - (list nil) '(nil) - (list 1 nil) '(1 nil) - (list nil 2) '(nil 2) - (list ()) '(()) - (list 1 ()) '(1 ()) - (list () 2) '(() 2) )) - - -;; *** Maps (IPersistentMap) *** - -(deftest test-find - (are [x y] (= x y) - (find {} :a) nil - - (find {:a 1} :a) [:a 1] - (find {:a 1} :b) nil - - (find {:a 1 :b 2} :a) [:a 1] - (find {:a 1 :b 2} :b) [:b 2] - (find {:a 1 :b 2} :c) nil - - (find {} nil) nil - (find {:a 1} nil) nil - (find {:a 1 :b 2} nil) nil )) - - -(deftest test-contains? - ; contains? is designed to work preferably on maps and sets - (are [x y] (= x y) - (contains? {} :a) false - (contains? {} nil) false - - (contains? {:a 1} :a) true - (contains? {:a 1} :b) false - (contains? {:a 1} nil) false - - (contains? {:a 1 :b 2} :a) true - (contains? {:a 1 :b 2} :b) true - (contains? {:a 1 :b 2} :c) false - (contains? {:a 1 :b 2} nil) false - - ; sets - (contains? #{} 1) false - (contains? #{} nil) false - - (contains? #{1} 1) true - (contains? #{1} 2) false - (contains? #{1} nil) false - - (contains? #{1 2 3} 1) true - (contains? #{1 2 3} 3) true - (contains? #{1 2 3} 10) false - (contains? #{1 2 3} nil) false) - - ; numerically indexed collections (e.g. vectors and Java arrays) - ; => test if the numeric key is WITHIN THE RANGE OF INDEXES - (are [x y] (= x y) - (contains? [] 0) false - (contains? [] -1) false - (contains? [] 1) false - - (contains? [1] 0) true - (contains? [1] -1) false - (contains? [1] 1) false - - (contains? [1 2 3] 0) true - (contains? [1 2 3] 2) true - (contains? [1 2 3] 3) false - (contains? [1 2 3] -1) false - - ; arrays - (contains? (into-array []) 0) false - (contains? (into-array []) -1) false - (contains? (into-array []) 1) false - - (contains? (into-array [1]) 0) true - (contains? (into-array [1]) -1) false - (contains? (into-array [1]) 1) false - - (contains? (into-array [1 2 3]) 0) true - (contains? (into-array [1 2 3]) 2) true - (contains? (into-array [1 2 3]) 3) false - (contains? (into-array [1 2 3]) -1) false) - - ; 'contains?' operates constant or logarithmic time, - ; it WILL NOT perform a linear search for a value. - (are [x] (= x false) - (contains? '(1 2 3) 0) - (contains? '(1 2 3) 1) - (contains? '(1 2 3) 3) - (contains? '(1 2 3) 10) - (contains? '(1 2 3) nil) - (contains? '(1 2 3) ()) )) - - -(deftest test-keys - (are [x y] (= x y) ; other than map data structures - (keys ()) nil - (keys []) nil - (keys #{}) nil - (keys "") nil ) - - (are [x y] (= x y) - ; (class {:a 1}) => clojure.lang.PersistentArrayMap - (keys {}) nil - (keys {:a 1}) '(:a) - (diff (keys {:a 1 :b 2}) '(:a :b)) nil ; (keys {:a 1 :b 2}) '(:a :b) - - ; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap - (keys (sorted-map)) nil - (keys (sorted-map :a 1)) '(:a) - (diff (keys (sorted-map :a 1 :b 2)) '(:a :b)) nil ; (keys (sorted-map :a 1 :b 2)) '(:a :b) - - ; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap - (keys (hash-map)) nil - (keys (hash-map :a 1)) '(:a) - (diff (keys (hash-map :a 1 :b 2)) '(:a :b)) nil )) ; (keys (hash-map :a 1 :b 2)) '(:a :b) - - -(deftest test-vals - (are [x y] (= x y) ; other than map data structures - (vals ()) nil - (vals []) nil - (vals #{}) nil - (vals "") nil ) - - (are [x y] (= x y) - ; (class {:a 1}) => clojure.lang.PersistentArrayMap - (vals {}) nil - (vals {:a 1}) '(1) - (diff (vals {:a 1 :b 2}) '(1 2)) nil ; (vals {:a 1 :b 2}) '(1 2) - - ; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap - (vals (sorted-map)) nil - (vals (sorted-map :a 1)) '(1) - (diff (vals (sorted-map :a 1 :b 2)) '(1 2)) nil ; (vals (sorted-map :a 1 :b 2)) '(1 2) - - ; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap - (vals (hash-map)) nil - (vals (hash-map :a 1)) '(1) - (diff (vals (hash-map :a 1 :b 2)) '(1 2)) nil )) ; (vals (hash-map :a 1 :b 2)) '(1 2) - - -(deftest test-key - (are [x] (= (key (first (hash-map x :value))) x) - nil - false true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - () '(1 2) - [] [1 2] - {} {:a 1 :b 2} - #{} #{1 2} )) - - -(deftest test-val - (are [x] (= (val (first (hash-map :key x))) x) - nil - false true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - () '(1 2) - [] [1 2] - {} {:a 1 :b 2} - #{} #{1 2} )) - -(deftest test-get - (let [m {:a 1, :b 2, :c {:d 3, :e 4}, :f nil, :g false, nil {:h 5}}] - (is (thrown? IllegalArgumentException (get-in {:a 1} 5))) - (are [x y] (= x y) - (get m :a) 1 - (get m :e) nil - (get m :e 0) 0 - (get m :b 0) 2 - (get m :f 0) nil - - (get-in m [:c :e]) 4 - (get-in m '(:c :e)) 4 - (get-in m [:c :x]) nil - (get-in m [:f]) nil - (get-in m [:g]) false - (get-in m [:h]) nil - (get-in m []) m - (get-in m nil) m - - (get-in m [:c :e] 0) 4 - (get-in m '(:c :e) 0) 4 - (get-in m [:c :x] 0) 0 - (get-in m [:b] 0) 2 - (get-in m [:f] 0) nil - (get-in m [:g] 0) false - (get-in m [:h] 0) 0 - (get-in m [:x :y] {:y 1}) {:y 1} - (get-in m [] 0) m - (get-in m nil 0) m))) - -;; *** Sets *** - -(deftest test-hash-set - (are [x] (set? x) - #{} - #{1 2} - (hash-set) - (hash-set 1 2) ) - - ; order isn't important - (are [x y] (= x y) - #{1 2} #{2 1} - #{3 1 2} #{1 2 3} - (hash-set 1 2) (hash-set 2 1) - (hash-set 3 1 2) (hash-set 1 2 3) ) - - - (are [x y] (= x y) - ; equal classes - (class #{}) (class (hash-set)) - (class #{1 2}) (class (hash-set 1 2)) - - ; creating - (hash-set) #{} - (hash-set 1) #{1} - (hash-set 1 2) #{1 2} - - ; nesting - (hash-set 1 (hash-set 2 3) (hash-set 3 (hash-set 4 5 (hash-set 6 (hash-set 7))))) - #{1 #{2 3} #{3 #{4 5 #{6 #{7}}}}} - - ; different data structures - (hash-set true false nil) - #{true false nil} - (hash-set 1 2.5 2/3 "ab" \x 'cd :kw) - #{1 2.5 2/3 "ab" \x 'cd :kw} - (hash-set (list 1 2) [3 4] {:a 1 :b 2} #{:c :d}) - #{'(1 2) [3 4] {:a 1 :b 2} #{:c :d}} - - ; evaluation - (hash-set (+ 1 2) [(+ 2 3) :a] (hash-set (* 2 3) 8)) - #{3 [5 :a] #{6 8}} - - ; special cases - (hash-set nil) #{nil} - (hash-set 1 nil) #{1 nil} - (hash-set nil 2) #{nil 2} - (hash-set #{}) #{#{}} - (hash-set 1 #{}) #{1 #{}} - (hash-set #{} 2) #{#{} 2} )) - - -(deftest test-sorted-set - ; only compatible types can be used - (is (thrown? ClassCastException (sorted-set 1 "a"))) - (is (thrown? ClassCastException (sorted-set '(1 2) [3 4]))) - - ; creates set? - (are [x] (set? x) - (sorted-set) - (sorted-set 1 2) ) - - ; equal and unique - (are [x] (and (= (sorted-set x) #{x}) - (= (sorted-set x x) (sorted-set x))) - nil - false true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - () ; '(1 2) - [] [1 2] - {} ; {:a 1 :b 2} - #{} ; #{1 2} - ) - ; cannot be cast to java.lang.Comparable - (is (thrown? ClassCastException (sorted-set '(1 2) '(1 2)))) - (is (thrown? ClassCastException (sorted-set {:a 1 :b 2} {:a 1 :b 2}))) - (is (thrown? ClassCastException (sorted-set #{1 2} #{1 2}))) - - (are [x y] (= x y) - ; generating - (sorted-set) #{} - (sorted-set 1) #{1} - (sorted-set 1 2) #{1 2} - - ; sorting - (seq (sorted-set 5 4 3 2 1)) '(1 2 3 4 5) - - ; special cases - (sorted-set nil) #{nil} - (sorted-set 1 nil) #{nil 1} - (sorted-set nil 2) #{nil 2} - (sorted-set #{}) #{#{}} )) - - -(deftest test-sorted-set-by - ; only compatible types can be used - ; NB: not a ClassCastException, but a RuntimeException is thrown, - ; requires discussion on whether this should be symmetric with test-sorted-set - (is (thrown? Exception (sorted-set-by < 1 "a"))) - (is (thrown? Exception (sorted-set-by < '(1 2) [3 4]))) - - ; creates set? - (are [x] (set? x) - (sorted-set-by <) - (sorted-set-by < 1 2) ) - - ; equal and unique - (are [x] (and (= (sorted-set-by compare x) #{x}) - (= (sorted-set-by compare x x) (sorted-set-by compare x))) - nil - false true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - () ; '(1 2) - [] [1 2] - {} ; {:a 1 :b 2} - #{} ; #{1 2} - ) - ; cannot be cast to java.lang.Comparable - ; NB: not a ClassCastException, but a RuntimeException is thrown, - ; requires discussion on whether this should be symmetric with test-sorted-set - (is (thrown? Exception (sorted-set-by compare '(1 2) '(1 2)))) - (is (thrown? Exception (sorted-set-by compare {:a 1 :b 2} {:a 1 :b 2}))) - (is (thrown? Exception (sorted-set-by compare #{1 2} #{1 2}))) - - (are [x y] (= x y) - ; generating - (sorted-set-by >) #{} - (sorted-set-by > 1) #{1} - (sorted-set-by > 1 2) #{1 2} - - ; sorting - (seq (sorted-set-by < 5 4 3 2 1)) '(1 2 3 4 5) - - ; special cases - (sorted-set-by compare nil) #{nil} - (sorted-set-by compare 1 nil) #{nil 1} - (sorted-set-by compare nil 2) #{nil 2} - (sorted-set-by compare #{}) #{#{}} )) - - -(deftest test-set - ; set? - (are [x] (set? (set x)) - () '(1 2) - [] [1 2] - #{} #{1 2} - {} {:a 1 :b 2} - (into-array []) (into-array [1 2]) - "" "abc" ) - - ; unique - (are [x] (= (set [x x]) #{x}) - nil - false true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - () '(1 2) - [] [1 2] - {} {:a 1 :b 2} - #{} #{1 2} ) - - ; conversion - (are [x y] (= (set x) y) - () #{} - '(1 2) #{1 2} - - [] #{} - [1 2] #{1 2} - - #{} #{} ; identity - #{1 2} #{1 2} ; identity - - {} #{} - {:a 1 :b 2} #{[:a 1] [:b 2]} - - (into-array []) #{} - (into-array [1 2]) #{1 2} - - "" #{} - "abc" #{\a \b \c} )) - - -(deftest test-disj - ; doesn't work on lists, vectors or maps - (is (thrown? ClassCastException (disj '(1 2) 1))) - (is (thrown? ClassCastException (disj [1 2] 1))) - (is (thrown? ClassCastException (disj {:a 1} :a))) - - ; identity - (are [x] (= (disj x) x) - nil - #{} - #{1 2 3} - ; different data types - #{nil - false true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - [] [1 2] - {} {:a 1 :b 2} - #{} #{1 2}} ) - - ; type identity - (are [x] (= (class (disj x)) (class x)) - (hash-set) - (hash-set 1 2) - (sorted-set) - (sorted-set 1 2) ) - - (are [x y] (= x y) - (disj nil :a) nil - (disj nil :a :b) nil - - (disj #{} :a) #{} - (disj #{} :a :b) #{} - - (disj #{:a} :a) #{} - (disj #{:a} :a :b) #{} - (disj #{:a} :c) #{:a} - - (disj #{:a :b :c :d} :a) #{:b :c :d} - (disj #{:a :b :c :d} :a :d) #{:b :c} - (disj #{:a :b :c :d} :a :b :c) #{:d} - (disj #{:a :b :c :d} :d :a :c :b) #{} - - (disj #{nil} :a) #{nil} - (disj #{nil} #{}) #{nil} - (disj #{nil} nil) #{} - - (disj #{#{}} nil) #{#{}} - (disj #{#{}} #{}) #{} - (disj #{#{nil}} #{nil}) #{} )) - - -;; *** Queues *** - -(deftest test-queues - (let [EMPTY clojure.lang.PersistentQueue/EMPTY] - (are [x y] (= x y) - EMPTY EMPTY - (into EMPTY (range 50)) (into EMPTY (range 50)) - (range 5) (into EMPTY (range 5)) - (range 1 6) (-> EMPTY - (into (range 6)) - pop)) - (are [x y] (not= x y) - (range 5) (into EMPTY (range 6)) - (range 6) (into EMPTY (range 5)) - (range 0 6) (-> EMPTY - (into (range 6)) - pop) - (range 1 6) (-> EMPTY - (into (range 7)) - pop)))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/def.clj --- a/src/clojure/test_clojure/def.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.test-clojure.def - (:use clojure.test clojure.test-clojure.helpers - clojure.test-clojure.protocols)) - -(deftest defn-error-messages - (testing "bad arglist forms" - (is (fails-with-cause? IllegalArgumentException '#"Parameter declaration arg1 should be a vector" - (eval-in-temp-ns (defn foo (arg1 arg2))))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/evaluation.clj --- a/src/clojure/test_clojure/evaluation.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,225 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - - -;; Tests for the Clojure functions documented at the URL: -;; -;; http://clojure.org/Evaluation -;; -;; by J. McConnell -;; Created 22 October 2008 - -(ns clojure.test-clojure.evaluation - (:use clojure.test)) - -(import '(java.lang Boolean) - '(clojure.lang Compiler Compiler$CompilerException)) - -(defmacro test-that - "Provides a useful way for specifying the purpose of tests. If the first-level - forms are lists that make a call to a clojure.test function, it supplies the - purpose as the msg argument to those functions. Otherwise, the purpose just - acts like a comment and the forms are run unchanged." - [purpose & test-forms] - (let [tests (map - #(if (= (:ns (meta (resolve (first %)))) - (the-ns 'clojure.test)) - (concat % (list purpose)) - %) - test-forms)] - `(do ~@tests))) - -(deftest Eval - (is (= (eval '(+ 1 2 3)) (Compiler/eval '(+ 1 2 3)))) - (is (= (eval '(list 1 2 3)) '(1 2 3))) - (is (= (eval '(list + 1 2 3)) (list clojure.core/+ 1 2 3))) - (test-that "Non-closure fns are supported as code" - (is (= (eval (eval '(list + 1 2 3))) 6))) - (is (= (eval (list '+ 1 2 3)) 6))) - -; not using Clojure's RT/classForName since a bug in it could hide a bug in -; eval's resolution -(defn class-for-name [name] - (java.lang.Class/forName name)) - -(defmacro in-test-ns [& body] - `(binding [*ns* *ns*] - (in-ns 'clojure.test-clojure.evaluation) - ~@body)) - -;;; Literals tests ;;; - -(defmacro #^{:private true} evaluates-to-itself? [expr] - `(let [v# ~expr - q# (quote ~expr)] - (is (= (eval q#) q#) (str q# " does not evaluate to itself")))) - -(deftest Literals - ; Strings, numbers, characters, nil and keywords should evaluate to themselves - (evaluates-to-itself? "test") - (evaluates-to-itself? "test - multi-line - string") - (evaluates-to-itself? 1) - (evaluates-to-itself? 1.0) - (evaluates-to-itself? 1.123456789) - (evaluates-to-itself? 1/2) - (evaluates-to-itself? 1M) - (evaluates-to-itself? 999999999999999999) - (evaluates-to-itself? \a) - (evaluates-to-itself? \newline) - (evaluates-to-itself? nil) - (evaluates-to-itself? :test) - ; Boolean literals should evaluate to Boolean.{TRUE|FALSE} - (is (identical? (eval true) Boolean/TRUE)) - (is (identical? (eval false) Boolean/FALSE))) - -;;; Symbol resolution tests ;;; - -(def foo "abc") -(in-ns 'resolution-test) -(def bar 123) -(def #^{:private true} baz 456) -(in-ns 'clojure.test-clojure.evaluation) - -(defn a-match? [re s] (not (nil? (re-matches re s)))) - -(defmacro throws-with-msg - ([re form] `(throws-with-msg ~re ~form Exception)) - ([re form x] `(throws-with-msg - ~re - ~form - ~(if (instance? Exception x) x Exception) - ~(if (instance? String x) x nil))) - ([re form class msg] - `(let [ex# (try - ~form - (catch ~class e# e#) - (catch Exception e# - (let [cause# (.getCause e#)] - (if (= ~class (class cause#)) cause# (throw e#)))))] - (is (a-match? ~re (.toString ex#)) - (or ~msg - (str "Expected exception that matched " (pr-str ~re) - ", but got exception with message: \"" ex#)))))) - -(deftest SymbolResolution - (test-that - "If a symbol is namespace-qualified, the evaluated value is the value - of the binding of the global var named by the symbol" - (is (= (eval 'resolution-test/bar) 123))) - - (test-that - "It is an error if there is no global var named by the symbol" - (throws-with-msg - #".*Unable to resolve symbol: bar.*" (eval 'bar))) - - (test-that - "It is an error if the symbol reference is to a non-public var in a - different namespace" - (throws-with-msg - #".*resolution-test/baz is not public.*" - (eval 'resolution-test/baz) - Compiler$CompilerException)) - - (test-that - "If a symbol is package-qualified, its value is the Java class named by the - symbol" - (is (= (eval 'java.lang.Math) (class-for-name "java.lang.Math")))) - - (test-that - "If a symbol is package-qualified, it is an error if there is no Class named - by the symbol" - (is (thrown? Compiler$CompilerException (eval 'java.lang.FooBar)))) - - (test-that - "If a symbol is not qualified, the following applies, in this order: - - 1. If it names a special form it is considered a special form, and must - be utilized accordingly. - - 2. A lookup is done in the current namespace to see if there is a mapping - from the symbol to a class. If so, the symbol is considered to name a - Java class object. - - 3. If in a local scope (i.e. in a function definition), a lookup is done - to see if it names a local binding (e.g. a function argument or - let-bound name). If so, the value is the value of the local binding. - - 4. A lookup is done in the current namespace to see if there is a mapping - from the symbol to a var. If so, the value is the value of the binding - of the var referred-to by the symbol. - - 5. It is an error." - - ; First - (doall (for [form '(def if do let quote var fn loop recur throw try - monitor-enter monitor-exit)] - (is (thrown? Compiler$CompilerException (eval form))))) - (let [if "foo"] - (is (thrown? Compiler$CompilerException (eval 'if))) - - ; Second - (is (= (eval 'Boolean) (class-for-name "java.lang.Boolean")))) - (let [Boolean "foo"] - (is (= (eval 'Boolean) (class-for-name "java.lang.Boolean")))) - - ; Third - (is (= (eval '(let [foo "bar"] foo)) "bar")) - - ; Fourth - (in-test-ns (is (= (eval 'foo) "abc"))) - (is (thrown? Compiler$CompilerException (eval 'bar))) ; not in this namespace - - ; Fifth - (is (thrown? Compiler$CompilerException (eval 'foobar))))) - -;;; Metadata tests ;;; - -(defstruct struct-with-symbols (with-meta 'k {:a "A"})) - -(deftest Metadata - - (test-that - "find returns key symbols and their metadata" - (let [s (struct struct-with-symbols 1)] - (is (= {:a "A"} (meta (first (find s 'k)))))))) - -;;; Collections tests ;;; -(def x 1) -(def y 2) - -(deftest Collections - (in-test-ns - (test-that - "Vectors and Maps yield vectors and (hash) maps whose contents are the - evaluated values of the objects they contain." - (is (= (eval '[x y 3]) [1 2 3])) - (is (= (eval '{:x x :y y :z 3}) {:x 1 :y 2 :z 3})) - (is (instance? clojure.lang.IPersistentMap (eval '{:x x :y y}))))) - - (in-test-ns - (test-that - "Metadata maps yield maps whose contents are the evaluated values of - the objects they contain. If a vector or map has metadata, the evaluated - metadata map will become the metadata of the resulting value." - (is (= (eval #^{:x x} '[x y]) #^{:x 1} [1 2])))) - - (test-that - "An empty list () evaluates to an empty list." - (is (= (eval '()) ())) - (is (empty? (eval ()))) - (is (= (eval (list)) ()))) - - (test-that - "Non-empty lists are considered calls" - (is (thrown? Compiler$CompilerException (eval '(1 2 3)))))) - -(deftest Macros) - -(deftest Loading) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/for.clj --- a/src/clojure/test_clojure/for.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,128 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Tests for the Clojure 'for' macro -;; -;; by Chouser -;; Created Dec 2008 - -(ns clojure.test-clojure.for - (:use clojure.test)) - -(deftest Docstring-Example - (is (= (take 100 (for [x (range 100000000) - y (range 1000000) :while (< y x)] - [x y])) - '([1 0] [2 0] [2 1] [3 0] [3 1] [3 2] [4 0] [4 1] [4 2] [4 3] - [5 0] [5 1] [5 2] [5 3] [5 4] - [6 0] [6 1] [6 2] [6 3] [6 4] [6 5] - [7 0] [7 1] [7 2] [7 3] [7 4] [7 5] [7 6] - [8 0] [8 1] [8 2] [8 3] [8 4] [8 5] [8 6] [8 7] - [9 0] [9 1] [9 2] [9 3] [9 4] [9 5] [9 6] [9 7] [9 8] - [10 0] [10 1] [10 2] [10 3] [10 4] [10 5] [10 6] [10 7] [10 8] [10 9] - [11 0] [11 1] [11 2] [11 3] [11 4] [11 5] [11 6] [11 7] [11 8] [11 9] - [11 10] - [12 0] [12 1] [12 2] [12 3] [12 4] [12 5] [12 6] [12 7] [12 8] [12 9] - [12 10] [12 11] - [13 0] [13 1] [13 2] [13 3] [13 4] [13 5] [13 6] [13 7] [13 8] [13 9] - [13 10] [13 11] [13 12] - [14 0] [14 1] [14 2] [14 3] [14 4] [14 5] [14 6] [14 7] [14 8])))) - -(defmacro deftest-both [txt & ises] - `(do - (deftest ~(symbol (str "For-" txt)) ~@ises) - (deftest ~(symbol (str "Doseq-" txt)) - ~@(map (fn [[x-is [x-= [x-for binds body] value]]] - (when (and (= x-is 'is) (= x-= '=) (= x-for 'for)) - `(is (= (let [acc# (atom [])] - (doseq ~binds (swap! acc# conj ~body)) - @acc#) - ~value)))) - ises)))) - -(deftest-both When - (is (= (for [x (range 10) :when (odd? x)] x) '(1 3 5 7 9))) - (is (= (for [x (range 4) y (range 4) :when (odd? y)] [x y]) - '([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3]))) - (is (= (for [x (range 4) y (range 4) :when (odd? x)] [x y]) - '([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3]))) - (is (= (for [x (range 4) :when (odd? x) y (range 4)] [x y]) - '([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3]))) - (is (= (for [x (range 5) y (range 5) :when (< x y)] [x y]) - '([0 1] [0 2] [0 3] [0 4] [1 2] [1 3] [1 4] [2 3] [2 4] [3 4])))) - -(defn only - "Returns a lazy seq of increasing ints starting at 0. Trying to get - the nth+1 value of the seq throws an exception. This is meant to - help detecting over-eagerness in lazy seq consumers." - [n] - (lazy-cat (range n) - (throw (Exception. "consumer went too far in lazy seq")))) - -(deftest-both While - (is (= (for [x (only 6) :while (< x 5)] x) '(0 1 2 3 4))) - (is (= (for [x (range 4) y (only 4) :while (< y 3)] [x y]) - '([0 0] [0 1] [0 2] [1 0] [1 1] [1 2] - [2 0] [2 1] [2 2] [3 0] [3 1] [3 2]))) - (is (= (for [x (range 4) y (range 4) :while (< x 3)] [x y]) - '([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3] - [2 0] [2 1] [2 2] [2 3]))) - (is (= (for [x (only 4) :while (< x 3) y (range 4)] [x y]) - '([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3] - [2 0] [2 1] [2 2] [2 3]))) - (is (= (for [x (range 4) y (range 4) :while (even? x)] [x y]) - '([0 0] [0 1] [0 2] [0 3] [2 0] [2 1] [2 2] [2 3]))) - (is (= (for [x (only 2) :while (even? x) y (range 4)] [x y]) - '([0 0] [0 1] [0 2] [0 3]))) - (is (= (for [x (range 4) y (only 4) :while (< y x)] [x y]) - '([1 0] [2 0] [2 1] [3 0] [3 1] [3 2])))) - -(deftest-both While-and-When - (is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? y)] [x y]) - '([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3] [4 1] [4 3]))) - (is (= (for [x (range 4) :when (odd? x) y (only 6) :while (< y 5)] [x y]) - '([1 0] [1 1] [1 2] [1 3] [1 4] [3 0] [3 1] [3 2] [3 3] [3 4]))) - (is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? (+ x y))] - [x y]) - '([0 1] [0 3] [1 0] [1 2] [2 1] [2 3] [3 0] [3 2] [4 1] [4 3]))) - (is (= (for [x (range 4) :when (odd? x) y (only 2) :while (odd? (+ x y))] - [x y]) - '([1 0] [3 0])))) - -(deftest-both While-and-When-Same-Binding - (is (= (for [x (only 6) :while (< x 5) :when (odd? x)] x) '(1 3))) - (is (= (for [x (only 6) - :while (< x 5) ; if :while is false, :when should not be evaled - :when (do (if (< x 5) (odd? x)))] x) '(1 3))) - (is (= (for [a (range -2 5) - :when (not= a 0) ; :when may guard :while - :while (> (Math/abs (/ 1.0 a)) 1/3)] a) '(-2 -1 1 2)))) - -(deftest-both Nesting - (is (= (for [x '(a b) y (interpose x '(1 2)) z (list x y)] [x y z]) - '([a 1 a] [a 1 1] [a a a] [a a a] [a 2 a] [a 2 2] - [b 1 b] [b 1 1] [b b b] [b b b] [b 2 b] [b 2 2]))) - (is (= (for [x ['a nil] y [x 'b]] [x y]) - '([a a] [a b] [nil nil] [nil b])))) - -(deftest-both Destructuring - (is (= (for [{:syms [a b c]} (map #(zipmap '(a b c) (range % 5)) (range 3)) - x [a b c]] - (Integer. (str a b c x))) - '(120 121 122 1231 1232 1233 2342 2343 2344)))) - -(deftest-both Let - (is (= (for [x (range 3) y (range 3) :let [z (+ x y)] :when (odd? z)] [x y z]) - '([0 1 1] [1 0 1] [1 2 3] [2 1 3]))) - (is (= (for [x (range 6) :let [y (rem x 2)] :when (even? y) z [8 9]] [x z]) - '([0 8] [0 9] [2 8] [2 9] [4 8] [4 9])))) - -; :while must skip all subsequent chunks as well as the remainder of -; the current chunk: -(deftest-both Chunked-While - (is (= (for [x (range 100) :while (even? x)] x) '(0)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/genclass.clj --- a/src/clojure/test_clojure/genclass.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,65 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns ^{:doc "Tests for clojure.core/gen-class" - :author "Stuart Halloway, Daniel Solano Gómez"} - clojure.test-clojure.genclass - (:use clojure.test clojure.test-clojure.helpers) - (:import [clojure.test_clojure.genclass.examples ExampleClass - ExampleAnnotationClass] - [java.lang.annotation ElementType - Retention - RetentionPolicy - Target])) - -(deftest arg-support - (let [example (ExampleClass.) - o (Object.)] - (is (= "foo with o, o" (.foo example o o))) - (is (= "foo with o, i" (.foo example o (int 1)))) - (is (thrown? java.lang.UnsupportedOperationException (.foo example o))))) - -(deftest name-munging - (testing "mapping from Java fields to Clojure vars" - (is (= #'clojure.test-clojure.genclass.examples/-foo-Object-int - (get-field ExampleClass 'foo_Object_int__var))) - (is (= #'clojure.test-clojure.genclass.examples/-toString - (get-field ExampleClass 'toString__var))))) - -(deftest test-annotations - (let [annot-class ExampleAnnotationClass - foo-method (.getDeclaredMethod annot-class "foo" (into-array [String]))] - (testing "Class annotations:" - (is (= 2 (count (.getDeclaredAnnotations annot-class)))) - (testing "@Deprecated" - (let [deprecated (.getAnnotation annot-class Deprecated)] - (is deprecated))) - (testing "@Target([])" - (let [resource (.getAnnotation annot-class Target)] - (is (= 0 (count (.value resource))))))) - (testing "Method annotations:" - (testing "@Deprecated void foo(String):" - (is (= 1 (count (.getDeclaredAnnotations foo-method)))) - (is (.getAnnotation foo-method Deprecated)))) - (testing "Parameter annotations:" - (let [param-annots (.getParameterAnnotations foo-method)] - (is (= 1 (alength param-annots))) - (let [first-param-annots (aget param-annots 0)] - (is (= 2 (alength first-param-annots))) - (testing "void foo(@Retention(…) String)" - (let [retention (aget first-param-annots 0)] - (is (instance? Retention retention)) - (= RetentionPolicy/SOURCE (.value retention)))) - (testing "void foo(@Target(…) String)" - (let [target (aget first-param-annots 1)] - (is (instance? Target target)) - (is (= [ElementType/TYPE ElementType/PARAMETER] (seq (.value target))))))))))) - -(deftest genclass-option-validation - (is (fails-with-cause? IllegalArgumentException #"Not a valid method name: has-hyphen" - (@#'clojure.core/validate-generate-class-options {:methods '[[fine [] void] [has-hyphen [] void]]})))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/genclass/examples.clj --- a/src/clojure/test_clojure/genclass/examples.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,42 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns ^{:doc "Test classes that are AOT-compile for the tests in - clojure.test-clojure.genclass." - :author "Stuart Halloway, Daniel Solano Gómez"} - clojure.test-clojure.genclass.examples) - -(definterface ExampleInterface - (foo [a]) - (foo [a b]) - (foo [a #^int b])) - -(gen-class :name clojure.test_clojure.genclass.examples.ExampleClass - :implements [clojure.test_clojure.genclass.examples.ExampleInterface]) - -;; -foo-Object unimplemented to test missing fn case - -(defn -foo-Object-Object - [_ o1 o2] - "foo with o, o") - -(defn -foo-Object-int - [_ o i] - "foo with o, i") - -(gen-class :name ^{Deprecated {} - SuppressWarnings ["Warning1"] ; discarded - java.lang.annotation.Target []} - clojure.test_clojure.genclass.examples.ExampleAnnotationClass - :prefix "annot-" - :methods [[^{Deprecated {} - Override {}} ;discarded - foo [^{java.lang.annotation.Retention java.lang.annotation.RetentionPolicy/SOURCE - java.lang.annotation.Target [java.lang.annotation.ElementType/TYPE - java.lang.annotation.ElementType/PARAMETER]} - String] void]]) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/helpers.clj --- a/src/clojure/test_clojure/helpers.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,86 +0,0 @@ -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Stuart Halloway - -(ns clojure.test-clojure.helpers - (:use clojure.test)) - -(defn temp-ns - "Create and return a temporary ns, using clojure.core + uses" - [& uses] - (binding [*ns* *ns*] - (in-ns (gensym)) - (apply clojure.core/use 'clojure.core uses) - *ns*)) - -(defmacro eval-in-temp-ns [& forms] - `(binding [*ns* *ns*] - (in-ns (gensym)) - (clojure.core/use 'clojure.core) - (eval - '(do ~@forms)))) - -(defn causes - [^Throwable throwable] - (loop [causes [] - t throwable] - (if t (recur (conj causes t) (.getCause t)) causes))) - -;; this is how I wish clojure.test/thrown? worked... -;; Does body throw expected exception, anywhere in the .getCause chain? -(defmethod assert-expr 'fails-with-cause? - [msg [_ exception-class msg-re & body :as form]] - `(try - ~@body - (report {:type :fail, :message ~msg, :expected '~form, :actual nil}) - (catch Throwable t# - (if (some (fn [cause#] - (and - (= ~exception-class (class cause#)) - (re-find ~msg-re (.getMessage cause#)))) - (causes t#)) - (report {:type :pass, :message ~msg, - :expected '~form, :actual t#}) - (report {:type :fail, :message ~msg, - :expected '~form, :actual t#}))))) - - -(defn get-field - "Access to private or protected field. field-name is a symbol or - keyword." - ([klass field-name] - (get-field klass field-name nil)) - ([klass field-name inst] - (-> klass (.getDeclaredField (name field-name)) - (doto (.setAccessible true)) - (.get inst)))) - -(defn set-var-roots - [maplike] - (doseq [[var val] maplike] - (alter-var-root var (fn [_] val)))) - -(defn with-var-roots* - "Temporarily set var roots, run block, then put original roots back." - [root-map f & args] - (let [originals (doall (map (fn [[var _]] [var @var]) root-map))] - (set-var-roots root-map) - (try - (apply f args) - (finally - (set-var-roots originals))))) - -(defmacro with-var-roots - [root-map & body] - `(with-var-roots* ~root-map (fn [] ~@body))) - -(defn exception - "Use this function to ensure that execution of a program doesn't - reach certain point." - [] - (throw (new Exception "Exception which should never occur"))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/java/io.clj --- a/src/clojure/test_clojure/java/io.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,206 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.test-clojure.java.io - (:use clojure.test clojure.java.io) - (:import (java.io File BufferedInputStream - FileInputStream InputStreamReader InputStream - FileOutputStream OutputStreamWriter OutputStream - ByteArrayInputStream ByteArrayOutputStream) - (java.net URL URI Socket ServerSocket))) - -(defn temp-file - [prefix suffix] - (doto (File/createTempFile prefix suffix) - (.deleteOnExit))) - -(deftest test-spit-and-slurp - (let [f (temp-file "clojure.java.io" "test")] - (spit f "foobar") - (is (= "foobar" (slurp f))) - (spit f "foobar" :encoding "UTF-16") - (is (= "foobar" (slurp f :encoding "UTF-16"))) - (testing "deprecated arity" - (is (= - "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).\n" - (with-out-str - (is (= "foobar" (slurp f "UTF-16"))))))))) - -(deftest test-streams-defaults - (let [f (temp-file "clojure.java.io" "test-reader-writer") - content "testing"] - (try - (is (thrown? Exception (reader (Object.)))) - (is (thrown? Exception (writer (Object.)))) - - (are [write-to read-from] (= content (do - (spit write-to content :encoding "UTF-8") - (slurp read-from :encoding "UTF-8"))) - f f - (.getAbsolutePath f) (.getAbsolutePath f) - (.toURL f) (.toURL f) - (.toURI f) (.toURI f) - (FileOutputStream. f) (FileInputStream. f) - (OutputStreamWriter. (FileOutputStream. f) "UTF-8") (reader f :encoding "UTF-8") - f (FileInputStream. f) - (writer f :encoding "UTF-8") (InputStreamReader. (FileInputStream. f) "UTF-8")) - - (is (= content (slurp (.getBytes content "UTF-8")))) - (is (= content (slurp (.toCharArray content)))) - (finally - (.delete f))))) - -(defn bytes-should-equal [byte-array-1 byte-array-2 msg] - (is (= @#'clojure.java.io/byte-array-type (class byte-array-1) (class byte-array-2)) msg) - (is (= (into [] byte-array-1) (into [] byte-array-2)) msg)) - -(defn data-fixture - "in memory fixture data for tests" - [encoding] - (let [bs (.getBytes "hello" encoding) - cs (.toCharArray "hello") - i (ByteArrayInputStream. bs) - r (InputStreamReader. i) - o (ByteArrayOutputStream.) - w (OutputStreamWriter. o)] - {:bs bs - :i i - :r r - :o o - :s "hello" - :cs cs - :w w})) - -(deftest test-copy - (dorun - (for [{:keys [in out flush] :as test} - [{:in :i :out :o} - {:in :i :out :w} - {:in :r :out :o} - {:in :r :out :w} - {:in :cs :out :o} - {:in :cs :out :w} - {:in :bs :out :o} - {:in :bs :out :w}] - - opts - [{} {:buffer-size 256}]] - (let [{:keys [s o] :as d} (data-fixture "UTF-8")] - (apply copy (in d) (out d) (flatten (vec opts))) - #_(when (= out :w) (.flush (:w d))) - (.flush (out d)) - (bytes-should-equal (.getBytes s "UTF-8") - (.toByteArray o) - (str "combination " test opts)))))) - -(deftest test-copy-encodings - (testing "from inputstream UTF-16 to writer UTF-8" - (let [{:keys [i s o w bs]} (data-fixture "UTF-16")] - (copy i w :encoding "UTF-16") - (.flush w) - (bytes-should-equal (.getBytes s "UTF-8") (.toByteArray o) ""))) - (testing "from reader UTF-8 to output-stream UTF-16" - (let [{:keys [r o s]} (data-fixture "UTF-8")] - (copy r o :encoding "UTF-16") - (bytes-should-equal (.getBytes s "UTF-16") (.toByteArray o) "")))) - -(deftest test-as-file - (are [result input] (= result (as-file input)) - (File. "foo") "foo" - (File. "bar") (File. "bar") - (File. "baz") (URL. "file:baz") - (File. "quux") (URI. "file:quux") - nil nil)) - -(deftest test-file - (are [result args] (= (File. result) (apply file args)) - "foo" ["foo"] - "foo/bar" ["foo" "bar"] - "foo/bar/baz" ["foo" "bar" "baz"])) -(deftest test-as-url - (are [file-part input] (= (URL. (str "file:" file-part)) (as-url input)) - "foo" "file:foo" - "baz" (URL. "file:baz") - "quux" (URI. "file:quux")) - (is (nil? (as-url nil)))) - -(deftest test-delete-file - (let [file (temp-file "test" "deletion") - not-file (File. (str (java.util.UUID/randomUUID)))] - (delete-file (.getAbsolutePath file)) - (is (not (.exists file))) - (is (thrown? java.io.IOException (delete-file not-file))) - (is (= :silently (delete-file not-file :silently))))) - -(deftest test-as-relative-path - (testing "strings" - (is (= "foo" (as-relative-path "foo")))) - (testing "absolute path strings are forbidden" - (is (thrown? IllegalArgumentException (as-relative-path (.getAbsolutePath (File. "baz")))))) - (testing "relative File paths" - (is (= "bar" (as-relative-path (File. "bar"))))) - (testing "absolute File paths are forbidden" - (is (thrown? IllegalArgumentException (as-relative-path (File. (.getAbsolutePath (File. "quux")))))))) - -(defn stream-should-have [stream expected-bytes msg] - (let [actual-bytes (byte-array (alength expected-bytes))] - (.read stream actual-bytes) - (is (= -1 (.read stream)) (str msg " : should be end of stream")) - (is (= (seq expected-bytes) (seq actual-bytes)) (str msg " : byte arrays should match")))) - -(deftest test-input-stream - (let [file (temp-file "test-input-stream" "txt") - bytes (.getBytes "foobar")] - (spit file "foobar") - (doseq [[expr msg] - [[file File] - [(FileInputStream. file) FileInputStream] - [(BufferedInputStream. (FileInputStream. file)) BufferedInputStream] - [(.. file toURI) URI] - [(.. file toURI toURL) URL] - [(.. file toURI toURL toString) "URL as String"] - [(.. file toString) "File as String"]]] - (with-open [s (input-stream expr)] - (stream-should-have s bytes msg))))) - -(deftest test-streams-buffering - (let [data (.getBytes "")] - (is (instance? java.io.BufferedReader (reader data))) - (is (instance? java.io.BufferedWriter (writer (java.io.ByteArrayOutputStream.)))) - (is (instance? java.io.BufferedInputStream (input-stream data))) - (is (instance? java.io.BufferedOutputStream (output-stream (java.io.ByteArrayOutputStream.)))))) - -(deftest test-resource - (is (nil? (resource "non/existent/resource"))) - (is (instance? URL (resource "clojure/core.clj"))) - (let [file (temp-file "test-resource" "txt") - url (as-url (.getParentFile file)) - loader (java.net.URLClassLoader. (into-array [url]))] - (is (nil? (resource "non/existent/resource" loader))) - (is (instance? URL (resource (.getName file) loader))))) - -(deftest test-make-parents - (let [tmp (System/getProperty "java.io.tmpdir")] - (delete-file (file tmp "test-make-parents" "child" "grandchild") :silently) - (delete-file (file tmp "test-make-parents" "child") :silently) - (delete-file (file tmp "test-make-parents") :silently) - (make-parents tmp "test-make-parents" "child" "grandchild") - (is (.isDirectory (file tmp "test-make-parents" "child"))) - (is (not (.isDirectory (file tmp "test-make-parents" "child" "grandchild")))) - (delete-file (file tmp "test-make-parents" "child")) - (delete-file (file tmp "test-make-parents")))) - -(deftest test-socket-iofactory - (let [port 65321 - server-socket (ServerSocket. port) - client-socket (Socket. "localhost" port)] - (try - (is (instance? InputStream (input-stream client-socket))) - (is (instance? OutputStream (output-stream client-socket))) - (finally (.close server-socket) - (.close client-socket))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/java/javadoc.clj --- a/src/clojure/test_clojure/java/javadoc.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.test-clojure.java.javadoc - (:use clojure.test - [clojure.java.javadoc :as j]) - (:import (java.io File))) - -(deftest javadoc-url-test - (testing "for a core api" - (binding [*feeling-lucky* false] - (are [x y] (= x (#'j/javadoc-url y)) - nil "foo.Bar" - (str *core-java-api* "java/lang/String.html") "java.lang.String"))) - (testing "for a remote javadoc" - (binding [*remote-javadocs* (ref (sorted-map "java." "http://example.com/"))] - (is (= "http://example.com/java/lang/Number.html" (#'j/javadoc-url "java.lang.Number")))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/java/shell.clj --- a/src/clojure/test_clojure/java/shell.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,41 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.test-clojure.java.shell - (:use clojure.test - [clojure.java.shell :as sh]) - (:import (java.io File))) - -(def platform-enc (.name (java.nio.charset.Charset/defaultCharset))) -(def default-enc "UTF-8") - -(deftest test-parse-args - (are [x y] (= x y) - [[] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args []) - [["ls"] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args ["ls"]) - [["ls" "-l"] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args ["ls" "-l"]) - [["ls"] {:in-enc default-enc :out-enc "ISO-8859-1" :dir nil :env nil}] (#'sh/parse-args ["ls" :out-enc "ISO-8859-1"]) - [[] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args [:in-enc platform-enc :out-enc platform-enc]))) - -(deftest test-with-sh-dir - (are [x y] (= x y) - nil *sh-dir* - "foo" (with-sh-dir "foo" *sh-dir*))) - -(deftest test-with-sh-env - (are [x y] (= x y) - nil *sh-env* - {:KEY "VAL"} (with-sh-env {:KEY "VAL"} *sh-env*))) - -(deftest test-as-env-strings - (are [x y] (= x y) - nil (#'sh/as-env-strings nil) - ["FOO=BAR"] (seq (#'sh/as-env-strings {"FOO" "BAR"})) - ["FOO_SYMBOL=BAR"] (seq (#'sh/as-env-strings {'FOO_SYMBOL "BAR"})) - ["FOO_KEYWORD=BAR"] (seq (#'sh/as-env-strings {:FOO_KEYWORD "BAR"})))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/java_interop.clj --- a/src/clojure/test_clojure/java_interop.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,427 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - - -(ns clojure.test-clojure.java-interop - (:use clojure.test)) - -; http://clojure.org/java_interop -; http://clojure.org/compilation - - -(deftest test-dot - ; (.instanceMember instance args*) - (are [x] (= x "FRED") - (.toUpperCase "fred") - (. "fred" toUpperCase) - (. "fred" (toUpperCase)) ) - - (are [x] (= x true) - (.startsWith "abcde" "ab") - (. "abcde" startsWith "ab") - (. "abcde" (startsWith "ab")) ) - - ; (.instanceMember Classname args*) - (are [x] (= x "java.lang.String") - (.getName String) - (. (identity String) getName) - (. (identity String) (getName)) ) - - ; (Classname/staticMethod args*) - (are [x] (= x 7) - (Math/abs -7) - (. Math abs -7) - (. Math (abs -7)) ) - - ; Classname/staticField - (are [x] (= x 2147483647) - Integer/MAX_VALUE - (. Integer MAX_VALUE) )) - - -(deftest test-double-dot - (is (= (.. System (getProperties) (get "os.name")) - (. (. System (getProperties)) (get "os.name"))))) - - -(deftest test-doto - (let [m (doto (new java.util.HashMap) - (.put "a" 1) - (.put "b" 2))] - (are [x y] (= x y) - (class m) java.util.HashMap - m {"a" 1 "b" 2} ))) - - -(deftest test-new - ; Integer - (are [expr cls value] (and (= (class expr) cls) - (= expr value)) - (new java.lang.Integer 42) java.lang.Integer 42 - (java.lang.Integer. 123) java.lang.Integer 123 ) - - ; Date - (are [x] (= (class x) java.util.Date) - (new java.util.Date) - (java.util.Date.) )) - - -(deftest test-instance? - ; evaluation - (are [x y] (= x y) - (instance? java.lang.Integer (+ 1 2)) true - (instance? java.lang.Long (+ 1 2)) false ) - - ; different types - (are [type literal] (instance? literal type) - 1 java.lang.Integer - 1.0 java.lang.Double - 1M java.math.BigDecimal - \a java.lang.Character - "a" java.lang.String ) - - ; it is an int, nothing else - (are [x y] (= (instance? x 42) y) - java.lang.Integer true - java.lang.Long false - java.lang.Character false - java.lang.String false )) - - -; set! - -; memfn - - -(deftest test-bean - (let [b (bean java.awt.Color/black)] - (are [x y] (= x y) - (map? b) true - - (:red b) 0 - (:green b) 0 - (:blue b) 0 - (:RGB b) -16777216 - - (:alpha b) 255 - (:transparency b) 1 - - (:class b) java.awt.Color ))) - - -; proxy, proxy-super - - -(deftest test-bases - (are [x y] (= x y) - (bases java.lang.Math) - (list java.lang.Object) - (bases java.lang.Integer) - (list java.lang.Number java.lang.Comparable) )) - -(deftest test-supers - (are [x y] (= x y) - (supers java.lang.Math) - #{java.lang.Object} - (supers java.lang.Integer) - #{java.lang.Number java.lang.Object - java.lang.Comparable java.io.Serializable} )) - - -; Arrays: [alength] aget aset [make-array to-array into-array to-array-2d aclone] -; [float-array, int-array, etc] -; amap, areduce - -(defmacro deftest-type-array [type-array type] - `(deftest ~(symbol (str "test-" type-array)) - ; correct type - (is (= (class (first (~type-array [1 2]))) (class (~type 1)))) - - ; given size (and empty) - (are [x] (and (= (alength (~type-array x)) x) - (= (vec (~type-array x)) (repeat x 0))) - 0 1 5 ) - - ; copy of a sequence - (are [x] (and (= (alength (~type-array x)) (count x)) - (= (vec (~type-array x)) x)) - [] - [1] - [1 -2 3 0 5] ) - - ; given size and init-value - (are [x] (and (= (alength (~type-array x 42)) x) - (= (vec (~type-array x 42)) (repeat x 42))) - 0 1 5 ) - - ; given size and init-seq - (are [x y z] (and (= (alength (~type-array x y)) x) - (= (vec (~type-array x y)) z)) - 0 [] [] - 0 [1] [] - 0 [1 2 3] [] - 1 [] [0] - 1 [1] [1] - 1 [1 2 3] [1] - 5 [] [0 0 0 0 0] - 5 [1] [1 0 0 0 0] - 5 [1 2 3] [1 2 3 0 0] - 5 [1 2 3 4 5] [1 2 3 4 5] - 5 [1 2 3 4 5 6 7] [1 2 3 4 5] ))) - -(deftest-type-array int-array int) -(deftest-type-array long-array long) -(deftest-type-array float-array float) -(deftest-type-array double-array double) - -; separate test for exceptions (doesn't work with above macro...) -(deftest test-type-array-exceptions - (are [x] (thrown? NegativeArraySizeException x) - (int-array -1) - (long-array -1) - (float-array -1) - (double-array -1) )) - - -(deftest test-make-array - ; negative size - (is (thrown? NegativeArraySizeException (make-array Integer -1))) - - ; one-dimensional - (are [x] (= (alength (make-array Integer x)) x) - 0 1 5 ) - - (let [a (make-array Integer 5)] - (aset a 3 42) - (are [x y] (= x y) - (aget a 3) 42 - (class (aget a 3)) Integer )) - - ; multi-dimensional - (let [a (make-array Integer 3 2 4)] - (aset a 0 1 2 987) - (are [x y] (= x y) - (alength a) 3 - (alength (first a)) 2 - (alength (first (first a))) 4 - - (aget a 0 1 2) 987 - (class (aget a 0 1 2)) Integer ))) - - -(deftest test-to-array - (let [v [1 "abc" :kw \c []] - a (to-array v)] - (are [x y] (= x y) - ; length - (alength a) (count v) - - ; content - (vec a) v - (class (aget a 0)) (class (nth v 0)) - (class (aget a 1)) (class (nth v 1)) - (class (aget a 2)) (class (nth v 2)) - (class (aget a 3)) (class (nth v 3)) - (class (aget a 4)) (class (nth v 4)) )) - - ; different kinds of collections - (are [x] (and (= (alength (to-array x)) (count x)) - (= (vec (to-array x)) (vec x))) - () - '(1 2) - [] - [1 2] - (sorted-set) - (sorted-set 1 2) - - (int-array 0) - (int-array [1 2 3]) - - (to-array []) - (to-array [1 2 3]) )) - - -(deftest test-into-array - ; compatible types only - (is (thrown? IllegalArgumentException (into-array [1 "abc" :kw]))) - (is (thrown? IllegalArgumentException (into-array [1.2 4]))) - (is (thrown? IllegalArgumentException (into-array [(byte 2) (short 3)]))) - - ; simple case - (let [v [1 2 3 4 5] - a (into-array v)] - (are [x y] (= x y) - (alength a) (count v) - (vec a) v - (class (first a)) (class (first v)) )) - - ; given type - (let [a (into-array Integer/TYPE [(byte 2) (short 3) (int 4)])] - (are [x] (= x Integer) - (class (aget a 0)) - (class (aget a 1)) - (class (aget a 2)) )) - - ; different kinds of collections - (are [x] (and (= (alength (into-array x)) (count x)) - (= (vec (into-array x)) (vec x)) - (= (alength (into-array Integer/TYPE x)) (count x)) - (= (vec (into-array Integer/TYPE x)) (vec x))) - () - '(1 2) - [] - [1 2] - (sorted-set) - (sorted-set 1 2) - - (int-array 0) - (int-array [1 2 3]) - - (to-array []) - (to-array [1 2 3]) )) - - -(deftest test-to-array-2d - ; needs to be a collection of collection(s) - (is (thrown? Exception (to-array-2d [1 2 3]))) - - ; ragged array - (let [v [[1] [2 3] [4 5 6]] - a (to-array-2d v)] - (are [x y] (= x y) - (alength a) (count v) - (alength (aget a 0)) (count (nth v 0)) - (alength (aget a 1)) (count (nth v 1)) - (alength (aget a 2)) (count (nth v 2)) - - (vec (aget a 0)) (nth v 0) - (vec (aget a 1)) (nth v 1) - (vec (aget a 2)) (nth v 2) )) - - ; empty array - (let [a (to-array-2d [])] - (are [x y] (= x y) - (alength a) 0 - (vec a) [] ))) - - -(deftest test-alength - (are [x] (= (alength x) 0) - (int-array 0) - (long-array 0) - (float-array 0) - (double-array 0) - (boolean-array 0) - (byte-array 0) - (char-array 0) - (short-array 0) - (make-array Integer/TYPE 0) - (to-array []) - (into-array []) - (to-array-2d []) ) - - (are [x] (= (alength x) 1) - (int-array 1) - (long-array 1) - (float-array 1) - (double-array 1) - (boolean-array 1) - (byte-array 1) - (char-array 1) - (short-array 1) - (make-array Integer/TYPE 1) - (to-array [1]) - (into-array [1]) - (to-array-2d [[1]]) ) - - (are [x] (= (alength x) 3) - (int-array 3) - (long-array 3) - (float-array 3) - (double-array 3) - (boolean-array 3) - (byte-array 3) - (char-array 3) - (short-array 3) - (make-array Integer/TYPE 3) - (to-array [1 "a" :k]) - (into-array [1 2 3]) - (to-array-2d [[1] [2 3] [4 5 6]]) )) - - -(deftest test-aclone - ; clone all arrays except 2D - (are [x] (and (= (alength (aclone x)) (alength x)) - (= (vec (aclone x)) (vec x))) - (int-array 0) - (long-array 0) - (float-array 0) - (double-array 0) - (boolean-array 0) - (byte-array 0) - (char-array 0) - (short-array 0) - (make-array Integer/TYPE 0) - (to-array []) - (into-array []) - - (int-array [1 2 3]) - (long-array [1 2 3]) - (float-array [1 2 3]) - (double-array [1 2 3]) - (boolean-array [true false]) - (byte-array [(byte 1) (byte 2)]) - (char-array [\a \b \c]) - (short-array [(short 1) (short 2)]) - (make-array Integer/TYPE 3) - (to-array [1 "a" :k]) - (into-array [1 2 3]) ) - - ; clone 2D - (are [x] (and (= (alength (aclone x)) (alength x)) - (= (map alength (aclone x)) (map alength x)) - (= (map vec (aclone x)) (map vec x))) - (to-array-2d []) - (to-array-2d [[1] [2 3] [4 5 6]]) )) - - -; Type Hints, *warn-on-reflection* -; #^ints, #^floats, #^longs, #^doubles - -; Coercions: [int, long, float, double, char, boolean, short, byte] -; num -; ints/longs/floats/doubles - -(deftest test-boolean - (are [x y] (and (instance? java.lang.Boolean (boolean x)) - (= (boolean x) y)) - nil false - false false - true true - - 0 true - 1 true - () true - [1] true - - "" true - \space true - :kw true )) - - -(deftest test-char - ; int -> char - (is (instance? java.lang.Character (char 65))) - - ; char -> char - (is (instance? java.lang.Character (char \a))) - (is (= (char \a) \a))) - -;; Note: More coercions in numbers.clj diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/logic.clj --- a/src/clojure/test_clojure/logic.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,205 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - -;; -;; Created 1/29/2009 - -(ns clojure.test-clojure.logic - (:use clojure.test - [clojure.test-clojure.helpers :only (exception)])) - - -;; *** Tests *** - -(deftest test-if - ; true/false/nil - (are [x y] (= x y) - (if true :t) :t - (if true :t :f) :t - (if true :t (exception)) :t - - (if false :t) nil - (if false :t :f) :f - (if false (exception) :f) :f - - (if nil :t) nil - (if nil :t :f) :f - (if nil (exception) :f) :f ) - - ; zero/empty is true - (are [x] (= (if x :t :f) :t) - (byte 0) - (short 0) - (int 0) - (long 0) - (bigint 0) - (float 0) - (double 0) - (bigdec 0) - - 0/2 - "" - #"" - (symbol "") - - () - [] - {} - #{} - (into-array []) ) - - ; anything except nil/false is true - (are [x] (= (if x :t :f) :t) - (byte 2) - (short 2) - (int 2) - (long 2) - (bigint 2) - (float 2) - (double 2) - (bigdec 2) - - 2/3 - \a - "abc" - #"a*b" - 'abc - :kw - - '(1 2) - [1 2] - {:a 1 :b 2} - #{1 2} - (into-array [1 2]) - - (new java.util.Date) )) - - -(deftest test-nil-punning - (are [x y] (= (if x :no :yes) y) - (first []) :yes - (next [1]) :yes - (rest [1]) :no - - (butlast [1]) :yes - - (seq nil) :yes - (seq []) :yes - - (sequence nil) :no - (sequence []) :no - - (lazy-seq nil) :no - (lazy-seq []) :no - - (filter #(> % 10) [1 2 3]) :no - (map identity []) :no - (apply concat []) :no - - (concat) :no - (concat []) :no - - (reverse nil) :no - (reverse []) :no - - (sort nil) :no - (sort []) :no )) - - -(deftest test-and - (are [x y] (= x y) - (and) true - (and true) true - (and nil) nil - (and false) false - - (and true nil) nil - (and true false) false - - (and 1 true :kw 'abc "abc") "abc" - - (and 1 true :kw nil 'abc "abc") nil - (and 1 true :kw nil (exception) 'abc "abc") nil - - (and 1 true :kw 'abc "abc" false) false - (and 1 true :kw 'abc "abc" false (exception)) false )) - - -(deftest test-or - (are [x y] (= x y) - (or) nil - (or true) true - (or nil) nil - (or false) false - - (or nil false true) true - (or nil false 1 2) 1 - (or nil false "abc" :kw) "abc" - - (or false nil) nil - (or nil false) false - (or nil nil nil false) false - - (or nil true false) true - (or nil true (exception) false) true - (or nil false "abc" (exception)) "abc" )) - - -(deftest test-not - (is (thrown? IllegalArgumentException (not))) - (are [x] (= (not x) true) - nil - false ) - (are [x] (= (not x) false) - true - - ; numbers - 0 - 0.0 - 42 - 1.2 - 0/2 - 2/3 - - ; characters - \space - \tab - \a - - ; strings - "" - "abc" - - ; regexes - #"" - #"a*b" - - ; symbols - (symbol "") - 'abc - - ; keywords - :kw - - ; collections/arrays - () - '(1 2) - [] - [1 2] - {} - {:a 1 :b 2} - #{} - #{1 2} - (into-array []) - (into-array [1 2]) - - ; Java objects - (new java.util.Date) )) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/macros.clj --- a/src/clojure/test_clojure/macros.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - -(ns clojure.test-clojure.macros - (:use clojure.test)) - -; http://clojure.org/macros - -; -> -; defmacro definline macroexpand-1 macroexpand - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/main.clj --- a/src/clojure/test_clojure/main.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,50 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Stuart Halloway - - -(ns clojure.test-clojure.main - (:use clojure.test) - (:require [clojure.main :as main])) - -(deftest eval-opt - (testing "evals and prints forms" - (is (= "2\n4\n" (with-out-str (#'clojure.main/eval-opt "(+ 1 1) (+ 2 2)"))))) - - (testing "skips printing nils" - (is (= ":a\n:c\n" (with-out-str (#'clojure.main/eval-opt ":a nil :c"))))) - - (testing "does not block access to *in* (#299)" - (with-in-str "(+ 1 1)" - (is (= "(+ 1 1)\n" (with-out-str (#'clojure.main/eval-opt "(read)"))))))) - -(defmacro with-err-str - "Evaluates exprs in a context in which *err* is bound to a fresh - StringWriter. Returns the string created by any nested printing - calls." - [& body] - `(let [s# (new java.io.StringWriter) - p# (new java.io.PrintWriter s#)] - (binding [*err* p#] - ~@body - (str s#)))) - -(defn run-repl-and-return-err - "Run repl, swallowing stdout and returing stderr." - [in-str] - (with-err-str - (with-out-str - (with-in-str in-str - (main/repl))))) - -(deftest repl-exception-safety - (testing "catches and prints exception on bad equals" - (is (re-matches #"java\.lang\.NullPointerException\r?\n" - (run-repl-and-return-err - "(proxy [Object] [] (equals [o] (.toString nil)))"))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/metadata.clj --- a/src/clojure/test_clojure/metadata.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,76 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Authors: Stuart Halloway, Frantisek Sodomka - -(ns clojure.test-clojure.metadata - (:use clojure.test - [clojure.test-clojure.helpers :only (eval-in-temp-ns)])) - -(def public-namespaces - '[clojure.core - clojure.pprint - clojure.inspector - clojure.set - clojure.stacktrace - clojure.test - clojure.walk - clojure.xml - clojure.zip - clojure.java.io - clojure.java.browse - clojure.java.javadoc - clojure.java.shell - clojure.string]) - -(doseq [ns public-namespaces] - (require ns)) - -(def public-vars - (mapcat #(vals (ns-publics %)) public-namespaces)) - -(def public-vars-with-docstrings - (filter (comp :doc meta) public-vars)) - -(deftest public-vars-with-docstrings-have-added - (is (= [] (remove (comp :added meta) public-vars-with-docstrings)))) - -(deftest interaction-of-def-with-metadata - (testing "initial def sets metadata" - (let [v (eval-in-temp-ns - (def ^{:a 1} foo 0) - #'foo)] - (is (= 1 (-> v meta :a))))) - (testing "subsequent declare doesn't overwrite metadata" - (let [v (eval-in-temp-ns - (def ^{:b 2} bar 0) - (declare bar) - #'bar)] - (is (= 2 (-> v meta :b)))) - (testing "when compiled" - (let [v (eval-in-temp-ns - (def ^{:c 3} bar 0) - (defn declare-bar [] - (declare bar)) - (declare-bar) - #'bar)] - (is (= 3 (-> v meta :c)))))) - (testing "subsequent def with init-expr *does* overwrite metadata" - (let [v (eval-in-temp-ns - (def ^{:d 4} quux 0) - (def quux 1) - #'quux)] - (is (nil? (-> v meta :d)))) - (testing "when compiled" - (let [v (eval-in-temp-ns - (def ^{:e 5} quux 0) - (defn def-quux [] - (def quux 1)) - (def-quux) - #'quux)] - (is (nil? (-> v meta :e))))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/multimethods.clj --- a/src/clojure/test_clojure/multimethods.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,160 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka, Robert Lachlan - -(ns clojure.test-clojure.multimethods - (:use clojure.test [clojure.test-clojure.helpers :only (with-var-roots)]) - (:require [clojure.set :as set])) - -; http://clojure.org/multimethods - -; defmulti -; defmethod -; remove-method -; prefer-method -; methods -; prefers - -(defmacro for-all - [& args] - `(dorun (for ~@args))) - -(defn hierarchy-tags - "Return all tags in a derivation hierarchy" - [h] - (set/select - #(instance? clojure.lang.Named %) - (reduce into #{} (map keys (vals h))))) - -(defn transitive-closure - "Return all objects reachable by calling f starting with o, - not including o itself. f should return a collection." - [o f] - (loop [results #{} - more #{o}] - (let [new-objects (set/difference more results)] - (if (seq new-objects) - (recur (set/union results more) (reduce into #{} (map f new-objects))) - (disj results o))))) - -(defn tag-descendants - "Set of descedants which are tags (i.e. Named)." - [& args] - (set/select - #(instance? clojure.lang.Named %) - (or (apply descendants args) #{}))) - -(defn assert-valid-hierarchy - [h] - (let [tags (hierarchy-tags h)] - (testing "ancestors are the transitive closure of parents" - (for-all [tag tags] - (is (= (transitive-closure tag #(parents h %)) - (or (ancestors h tag) #{}))))) - (testing "ancestors are transitive" - (for-all [tag tags] - (is (= (transitive-closure tag #(ancestors h %)) - (or (ancestors h tag) #{}))))) - (testing "tag descendants are transitive" - (for-all [tag tags] - (is (= (transitive-closure tag #(tag-descendants h %)) - (or (tag-descendants h tag) #{}))))) - (testing "a tag isa? all of its parents" - (for-all [tag tags - :let [parents (parents h tag)] - parent parents] - (is (isa? h tag parent)))) - (testing "a tag isa? all of its ancestors" - (for-all [tag tags - :let [ancestors (ancestors h tag)] - ancestor ancestors] - (is (isa? h tag ancestor)))) - (testing "all my descendants have me as an ancestor" - (for-all [tag tags - :let [descendants (descendants h tag)] - descendant descendants] - (is (isa? h descendant tag)))) - (testing "there are no cycles in parents" - (for-all [tag tags] - (is (not (contains? (transitive-closure tag #(parents h %)) tag))))) - (testing "there are no cycles in descendants" - (for-all [tag tags] - (is (not (contains? (descendants h tag) tag))))))) - -(def family - (reduce #(apply derive (cons %1 %2)) (make-hierarchy) - [[::parent-1 ::ancestor-1] - [::parent-1 ::ancestor-2] - [::parent-2 ::ancestor-2] - [::child ::parent-2] - [::child ::parent-1]])) - -(deftest cycles-are-forbidden - (testing "a tag cannot be its own parent" - (is (thrown-with-msg? Throwable #"\(not= tag parent\)" - (derive family ::child ::child)))) - (testing "a tag cannot be its own ancestor" - (is (thrown-with-msg? Throwable #"Cyclic derivation: :clojure.test-clojure.multimethods/child has :clojure.test-clojure.multimethods/ancestor-1 as ancestor" - (derive family ::ancestor-1 ::child))))) - -(deftest using-diamond-inheritance - (let [diamond (reduce #(apply derive (cons %1 %2)) (make-hierarchy) - [[::mammal ::animal] - [::bird ::animal] - [::griffin ::mammal] - [::griffin ::bird]]) - bird-no-more (underive diamond ::griffin ::bird)] - (assert-valid-hierarchy diamond) - (assert-valid-hierarchy bird-no-more) - (testing "a griffin is a mammal, indirectly through mammal and bird" - (is (isa? diamond ::griffin ::animal))) - (testing "a griffin is a bird" - (is (isa? diamond ::griffin ::bird))) - (testing "after underive, griffin is no longer a bird" - (is (not (isa? bird-no-more ::griffin ::bird)))) - (testing "but it is still an animal, via mammal" - (is (isa? bird-no-more ::griffin ::animal))))) - -(deftest derivation-world-bridges-to-java-inheritance - (let [h (derive (make-hierarchy) java.util.Map ::map)] - (testing "a Java class can be isa? a tag" - (is (isa? h java.util.Map ::map))) - (testing "if a Java class isa? a tag, so are its subclasses..." - (is (isa? h java.util.HashMap ::map))) - (testing "...but not its superclasses!" - (is (not (isa? h java.util.Collection ::map)))))) - -(deftest global-hierarchy-test - (with-var-roots {#'clojure.core/global-hierarchy (make-hierarchy)} - (assert-valid-hierarchy @#'clojure.core/global-hierarchy) - (testing "when you add some derivations..." - (derive ::lion ::cat) - (derive ::manx ::cat) - (assert-valid-hierarchy @#'clojure.core/global-hierarchy)) - (testing "...isa? sees the derivations" - (is (isa? ::lion ::cat)) - (is (not (isa? ::cat ::lion)))) - (testing "... you can traverse the derivations" - (is (= #{::manx ::lion} (descendants ::cat))) - (is (= #{::cat} (parents ::manx))) - (is (= #{::cat} (ancestors ::manx)))) - (testing "then, remove a derivation..." - (underive ::manx ::cat)) - (testing "... traversals update accordingly" - (is (= #{::lion} (descendants ::cat))) - (is (nil? (parents ::manx))) - (is (nil? (ancestors ::manx)))))) - -#_(defmacro for-all - "Better than the actual for-all, if only it worked." - [& args] - `(reduce - #(and %1 %2) - (map true? (for ~@args)))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/ns_libs.clj --- a/src/clojure/test_clojure/ns_libs.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,85 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Authors: Frantisek Sodomka, Stuart Halloway - -(ns clojure.test-clojure.ns-libs - (:use clojure.test)) - -; http://clojure.org/namespaces - -; in-ns ns create-ns -; alias import intern refer -; all-ns find-ns -; ns-name ns-aliases ns-imports ns-interns ns-map ns-publics ns-refers -; resolve ns-resolve namespace -; ns-unalias ns-unmap remove-ns - - -; http://clojure.org/libs - -; require use -; loaded-libs - -(deftest test-require - (is (thrown? Exception (require :foo))) - (is (thrown? Exception (require)))) - -(deftest test-use - (is (thrown? Exception (use :foo))) - (is (thrown? Exception (use)))) - -(deftest reimporting-deftypes - (let [inst1 (binding [*ns* *ns*] - (eval '(do (ns exporter) - (defrecord ReimportMe [a]) - (ns importer) - (import exporter.ReimportMe) - (ReimportMe. 1)))) - inst2 (binding [*ns* *ns*] - (eval '(do (ns exporter) - (defrecord ReimportMe [a b]) - (ns importer) - (import exporter.ReimportMe) - (ReimportMe. 1 2))))] - (testing "you can reimport a changed class and see the changes" - (is (= [:a] (keys inst1))) - (is (= [:a :b] (keys inst2)))) - (testing "you cannot import same local name from a different namespace" - (is (thrown? clojure.lang.Compiler$CompilerException - #"ReimportMe already refers to: class exporter.ReimportMe in namespace: importer" - (binding [*ns* *ns*] - (eval '(do (ns exporter-2) - (defrecord ReimportMe [a b]) - (ns importer) - (import exporter-2.ReimportMe) - (ReimportMe. 1 2))))))))) - -(deftest naming-types - (testing "you cannot use a name already referred from another namespace" - (is (thrown? IllegalStateException - #"String already refers to: class java.lang.String" - (definterface String))) - (is (thrown? IllegalStateException - #"StringBuffer already refers to: class java.lang.StringBuffer" - (deftype StringBuffer []))) - (is (thrown? IllegalStateException - #"Integer already refers to: class java.lang.Integer" - (defrecord Integer []))))) - -(deftest refer-error-messages - (let [temp-ns (gensym)] - (binding [*ns* *ns*] - (in-ns temp-ns) - (eval '(def ^{:private true} hidden-var))) - (testing "referring to something that does not exist" - (is (thrown-with-msg? IllegalAccessError #"nonexistent-var does not exist" - (refer temp-ns :only '(nonexistent-var))))) - (testing "referring to something non-public" - (is (thrown-with-msg? IllegalAccessError #"hidden-var is not public" - (refer temp-ns :only '(hidden-var))))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/numbers.clj --- a/src/clojure/test_clojure/numbers.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,444 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Stephen C. Gilardi -;; scgilardi (gmail) -;; Created 30 October 2008 -;; - -(ns clojure.test-clojure.numbers - (:use clojure.test)) - - -; TODO: -; == -; and more... - - -;; *** Types *** - -(deftest Coerced-Byte - (let [v (byte 3)] - (are [x] (true? x) - (instance? Byte v) - (number? v) - (integer? v) - (rational? v)))) - -(deftest Coerced-Short - (let [v (short 3)] - (are [x] (true? x) - (instance? Short v) - (number? v) - (integer? v) - (rational? v)))) - -(deftest Coerced-Integer - (let [v (int 3)] - (are [x] (true? x) - (instance? Integer v) - (number? v) - (integer? v) - (rational? v)))) - -(deftest Coerced-Long - (let [v (long 3)] - (are [x] (true? x) - (instance? Long v) - (number? v) - (integer? v) - (rational? v)))) - -(deftest Coerced-BigInteger - (let [v (bigint 3)] - (are [x] (true? x) - (instance? BigInteger v) - (number? v) - (integer? v) - (rational? v)))) - -(deftest Coerced-Float - (let [v (float 3)] - (are [x] (true? x) - (instance? Float v) - (number? v) - (float? v)))) - -(deftest Coerced-Double - (let [v (double 3)] - (are [x] (true? x) - (instance? Double v) - (number? v) - (float? v)))) - -(deftest Coerced-BigDecimal - (let [v (bigdec 3)] - (are [x] (true? x) - (instance? BigDecimal v) - (number? v) - (decimal? v) - (not (float? v))))) - - -;; *** Functions *** - -(defonce DELTA 1e-12) - -(deftest test-add - (are [x y] (= x y) - (+) 0 - (+ 1) 1 - (+ 1 2) 3 - (+ 1 2 3) 6 - - (+ -1) -1 - (+ -1 -2) -3 - (+ -1 +2 -3) -2 - - (+ 1 -1) 0 - (+ -1 1) 0 - - (+ 2/3) 2/3 - (+ 2/3 1) 5/3 - (+ 2/3 1/3) 1 ) - - (are [x y] (< (- x y) DELTA) - (+ 1.2) 1.2 - (+ 1.1 2.4) 3.5 - (+ 1.1 2.2 3.3) 6.6 ) - - (is (> (+ Integer/MAX_VALUE 10) Integer/MAX_VALUE)) ; no overflow - (is (thrown? ClassCastException (+ "ab" "cd"))) ) ; no string concatenation - - -(deftest test-subtract - (is (thrown? IllegalArgumentException (-))) - (are [x y] (= x y) - (- 1) -1 - (- 1 2) -1 - (- 1 2 3) -4 - - (- -2) 2 - (- 1 -2) 3 - (- 1 -2 -3) 6 - - (- 1 1) 0 - (- -1 -1) 0 - - (- 2/3) -2/3 - (- 2/3 1) -1/3 - (- 2/3 1/3) 1/3 ) - - (are [x y] (< (- x y) DELTA) - (- 1.2) -1.2 - (- 2.2 1.1) 1.1 - (- 6.6 2.2 1.1) 3.3 ) - - (is (< (- Integer/MIN_VALUE 10) Integer/MIN_VALUE)) ) ; no underflow - - -(deftest test-multiply - (are [x y] (= x y) - (*) 1 - (* 2) 2 - (* 2 3) 6 - (* 2 3 4) 24 - - (* -2) -2 - (* 2 -3) -6 - (* 2 -3 -1) 6 - - (* 1/2) 1/2 - (* 1/2 1/3) 1/6 - (* 1/2 1/3 -1/4) -1/24 ) - - (are [x y] (< (- x y) DELTA) - (* 1.2) 1.2 - (* 2.0 1.2) 2.4 - (* 3.5 2.0 1.2) 8.4 ) - - (is (> (* 3 (int (/ Integer/MAX_VALUE 2.0))) Integer/MAX_VALUE)) ) ; no overflow - -(deftest test-ratios-simplify-to-ints-where-appropriate - (testing "negative denominator (assembla #275)" - (is (integer? (/ 1 -1/2))) - (is (integer? (/ 0 -1/2))))) - -(deftest test-divide - (are [x y] (= x y) - (/ 1) 1 - (/ 2) 1/2 - (/ 3 2) 3/2 - (/ 4 2) 2 - (/ 24 3 2) 4 - (/ 24 3 2 -1) -4 - - (/ -1) -1 - (/ -2) -1/2 - (/ -3 -2) 3/2 - (/ -4 -2) 2 - (/ -4 2) -2 ) - - (are [x y] (< (- x y) DELTA) - (/ 4.5 3) 1.5 - (/ 4.5 3.0 3.0) 0.5 ) - - (is (thrown? ArithmeticException (/ 0))) - (is (thrown? ArithmeticException (/ 2 0))) - (is (thrown? IllegalArgumentException (/))) ) - - -;; mod -;; http://en.wikipedia.org/wiki/Modulo_operation -;; http://mathforum.org/library/drmath/view/52343.html -;; -;; is mod correct? -;; http://groups.google.com/group/clojure/browse_frm/thread/2a0ee4d248f3d131# -;; -;; Issue 23: mod (modulo) operator -;; http://code.google.com/p/clojure/issues/detail?id=23 - -(deftest test-mod - ; wrong number of args - (is (thrown? IllegalArgumentException (mod))) - (is (thrown? IllegalArgumentException (mod 1))) - (is (thrown? IllegalArgumentException (mod 3 2 1))) - - ; divide by zero - (is (thrown? ArithmeticException (mod 9 0))) - (is (thrown? ArithmeticException (mod 0 0))) - - (are [x y] (= x y) - (mod 4 2) 0 - (mod 3 2) 1 - (mod 6 4) 2 - (mod 0 5) 0 - - (mod 2 1/2) 0 - (mod 2/3 1/2) 1/6 - (mod 1 2/3) 1/3 - - (mod 4.0 2.0) 0.0 - (mod 4.5 2.0) 0.5 - - ; |num| > |div|, num != k * div - (mod 42 5) 2 ; (42 / 5) * 5 + (42 mod 5) = 8 * 5 + 2 = 42 - (mod 42 -5) -3 ; (42 / -5) * (-5) + (42 mod -5) = -9 * (-5) + (-3) = 42 - (mod -42 5) 3 ; (-42 / 5) * 5 + (-42 mod 5) = -9 * 5 + 3 = -42 - (mod -42 -5) -2 ; (-42 / -5) * (-5) + (-42 mod -5) = 8 * (-5) + (-2) = -42 - - ; |num| > |div|, num = k * div - (mod 9 3) 0 ; (9 / 3) * 3 + (9 mod 3) = 3 * 3 + 0 = 9 - (mod 9 -3) 0 - (mod -9 3) 0 - (mod -9 -3) 0 - - ; |num| < |div| - (mod 2 5) 2 ; (2 / 5) * 5 + (2 mod 5) = 0 * 5 + 2 = 2 - (mod 2 -5) -3 ; (2 / -5) * (-5) + (2 mod -5) = (-1) * (-5) + (-3) = 2 - (mod -2 5) 3 ; (-2 / 5) * 5 + (-2 mod 5) = (-1) * 5 + 3 = -2 - (mod -2 -5) -2 ; (-2 / -5) * (-5) + (-2 mod -5) = 0 * (-5) + (-2) = -2 - - ; num = 0, div != 0 - (mod 0 3) 0 ; (0 / 3) * 3 + (0 mod 3) = 0 * 3 + 0 = 0 - (mod 0 -3) 0 - ) -) - -;; rem & quot -;; http://en.wikipedia.org/wiki/Remainder - -(deftest test-rem - ; wrong number of args - (is (thrown? IllegalArgumentException (rem))) - (is (thrown? IllegalArgumentException (rem 1))) - (is (thrown? IllegalArgumentException (rem 3 2 1))) - - ; divide by zero - (is (thrown? ArithmeticException (rem 9 0))) - (is (thrown? ArithmeticException (rem 0 0))) - - (are [x y] (= x y) - (rem 4 2) 0 - (rem 3 2) 1 - (rem 6 4) 2 - (rem 0 5) 0 - - (rem 2 1/2) 0 - (rem 2/3 1/2) 1/6 - (rem 1 2/3) 1/3 - - (rem 4.0 2.0) 0.0 - (rem 4.5 2.0) 0.5 - - ; |num| > |div|, num != k * div - (rem 42 5) 2 ; (8 * 5) + 2 == 42 - (rem 42 -5) 2 ; (-8 * -5) + 2 == 42 - (rem -42 5) -2 ; (-8 * 5) + -2 == -42 - (rem -42 -5) -2 ; (8 * -5) + -2 == -42 - - ; |num| > |div|, num = k * div - (rem 9 3) 0 - (rem 9 -3) 0 - (rem -9 3) 0 - (rem -9 -3) 0 - - ; |num| < |div| - (rem 2 5) 2 - (rem 2 -5) 2 - (rem -2 5) -2 - (rem -2 -5) -2 - - ; num = 0, div != 0 - (rem 0 3) 0 - (rem 0 -3) 0 - ) -) - -(deftest test-quot - ; wrong number of args - (is (thrown? IllegalArgumentException (quot))) - (is (thrown? IllegalArgumentException (quot 1))) - (is (thrown? IllegalArgumentException (quot 3 2 1))) - - ; divide by zero - (is (thrown? ArithmeticException (quot 9 0))) - (is (thrown? ArithmeticException (quot 0 0))) - - (are [x y] (= x y) - (quot 4 2) 2 - (quot 3 2) 1 - (quot 6 4) 1 - (quot 0 5) 0 - - (quot 2 1/2) 4 - (quot 2/3 1/2) 1 - (quot 1 2/3) 1 - - (quot 4.0 2.0) 2.0 - (quot 4.5 2.0) 2.0 - - ; |num| > |div|, num != k * div - (quot 42 5) 8 ; (8 * 5) + 2 == 42 - (quot 42 -5) -8 ; (-8 * -5) + 2 == 42 - (quot -42 5) -8 ; (-8 * 5) + -2 == -42 - (quot -42 -5) 8 ; (8 * -5) + -2 == -42 - - ; |num| > |div|, num = k * div - (quot 9 3) 3 - (quot 9 -3) -3 - (quot -9 3) -3 - (quot -9 -3) 3 - - ; |num| < |div| - (quot 2 5) 0 - (quot 2 -5) 0 - (quot -2 5) 0 - (quot -2 -5) 0 - - ; num = 0, div != 0 - (quot 0 3) 0 - (quot 0 -3) 0 - ) -) - - -;; *** Predicates *** - -;; pos? zero? neg? - -(deftest test-pos?-zero?-neg? - (let [nums [[(byte 2) (byte 0) (byte -2)] - [(short 3) (short 0) (short -3)] - [(int 4) (int 0) (int -4)] - [(long 5) (long 0) (long -5)] - [(bigint 6) (bigint 0) (bigint -6)] - [(float 7) (float 0) (float -7)] - [(double 8) (double 0) (double -8)] - [(bigdec 9) (bigdec 0) (bigdec -9)] - [2/3 0 -2/3]] - pred-result [[pos? [true false false]] - [zero? [false true false]] - [neg? [false false true]]] ] - (doseq [pr pred-result] - (doseq [n nums] - (is (= (map (first pr) n) (second pr)) - (pr-str (first pr) n)))))) - - -;; even? odd? - -(deftest test-even? - (are [x] (true? x) - (even? -4) - (not (even? -3)) - (even? 0) - (not (even? 5)) - (even? 8)) - (is (thrown? ArithmeticException (even? 1/2))) - (is (thrown? ArithmeticException (even? (double 10))))) - -(deftest test-odd? - (are [x] (true? x) - (not (odd? -4)) - (odd? -3) - (not (odd? 0)) - (odd? 5) - (not (odd? 8))) - (is (thrown? ArithmeticException (odd? 1/2))) - (is (thrown? ArithmeticException (odd? (double 10))))) - -(defn- expt - "clojure.contrib.math/expt is a better and much faster impl, but this works. -Math/pow overflows to Infinity." - [x n] (apply * (replicate n x))) - -(deftest test-bit-shift-left - (are [x y] (= x y) - 2r10 (bit-shift-left 2r1 1) - 2r100 (bit-shift-left 2r1 2) - 2r1000 (bit-shift-left 2r1 3) - 2r00101110 (bit-shift-left 2r00010111 1) - 2r00101110 (apply bit-shift-left [2r00010111 1]) - 2r01 (bit-shift-left 2r10 -1) - (expt 2 32) (bit-shift-left 1 32) - (expt 2 10000) (bit-shift-left 1 10000) - )) - -(deftest test-bit-shift-right - (are [x y] (= x y) - 2r0 (bit-shift-right 2r1 1) - 2r010 (bit-shift-right 2r100 1) - 2r001 (bit-shift-right 2r100 2) - 2r000 (bit-shift-right 2r100 3) - 2r0001011 (bit-shift-right 2r00010111 1) - 2r0001011 (apply bit-shift-right [2r00010111 1]) - 2r100 (bit-shift-right 2r10 -1) - 1 (bit-shift-right (expt 2 32) 32) - 1 (bit-shift-right (expt 2 10000) 10000) - )) - - -;; arrays -(deftest test-array-types - (are [x y z] (= (Class/forName x) (class y) (class z)) - "[Z" (boolean-array 1) (booleans (boolean-array 1 true)) - "[B" (byte-array 1) (bytes (byte-array 1 (byte 1))) - "[C" (char-array 1) (chars (char-array 1 \a)) - "[S" (short-array 1) (shorts (short-array 1 (short 1))) - "[F" (float-array 1) (floats (float-array 1 1)) - "[D" (double-array 1) (doubles (double-array 1 1)) - "[I" (int-array 1) (ints (int-array 1 1)) - "[J" (long-array 1) (longs (long-array 1 1)))) - - -(deftest test-ratios - (is (= (denominator 1/2) 2)) - (is (= (numerator 1/2) 1)) - (is (= (bigint (/ 100000000000000000000 3)) 33333333333333333333)) - (is (= (long 10000000000000000000/3) 3333333333333333333))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/other_functions.clj --- a/src/clojure/test_clojure/other_functions.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,86 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - - -(ns clojure.test-clojure.other-functions - (:use clojure.test)) - -; http://clojure.org/other_functions - -; [= not= (tests in data_structures.clj and elsewhere)] - - -(deftest test-identity - ; exactly 1 argument needed - (is (thrown? IllegalArgumentException (identity))) - (is (thrown? IllegalArgumentException (identity 1 2))) - - (are [x] (= (identity x) x) - nil - false true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - () '(1 2) - [] [1 2] - {} {:a 1 :b 2} - #{} #{1 2} ) - - ; evaluation - (are [x y] (= (identity x) y) - (+ 1 2) 3 - (> 5 0) true )) - - -(deftest test-name - (are [x y] (= x (name y)) - "foo" :foo - "bar" 'bar - "quux" "quux")) - -(deftest test-fnil - (let [f1 (fnil vector :a) - f2 (fnil vector :a :b) - f3 (fnil vector :a :b :c)] - (are [result input] (= result [(apply f1 input) (apply f2 input) (apply f3 input)]) - [[1 2 3 4] [1 2 3 4] [1 2 3 4]] [1 2 3 4] - [[:a 2 3 4] [:a 2 3 4] [:a 2 3 4]] [nil 2 3 4] - [[:a nil 3 4] [:a :b 3 4] [:a :b 3 4]] [nil nil 3 4] - [[:a nil nil 4] [:a :b nil 4] [:a :b :c 4]] [nil nil nil 4] - [[:a nil nil nil] [:a :b nil nil] [:a :b :c nil]] [nil nil nil nil])) - (are [x y] (= x y) - ((fnil + 0) nil 42) 42 - ((fnil conj []) nil 42) [42] - (reduce #(update-in %1 [%2] (fnil inc 0)) {} - ["fun" "counting" "words" "fun"]) - {"words" 1, "counting" 1, "fun" 2} - (reduce #(update-in %1 [(first %2)] (fnil conj []) (second %2)) {} - [[:a 1] [:a 2] [:b 3]]) - {:b [3], :a [1 2]})) - -; time assert comment doc - -; partial -; comp -; complement -; constantly - -; Printing -; pr prn print println newline -; pr-str prn-str print-str println-str [with-out-str (vars.clj)] - -; Regex Support -; re-matcher re-find re-matches re-groups re-seq - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/parallel.clj --- a/src/clojure/test_clojure/parallel.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,29 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - - -(ns clojure.test-clojure.parallel - (:use clojure.test)) - -;; !! Tests for the parallel library will be in a separate file clojure_parallel.clj !! - -; future-call -; future -; pmap -; pcalls -; pvalues - - -;; pmap -;; -(deftest pmap-does-its-thing - ;; regression fixed in r1218; was OutOfMemoryError - (is (= '(1) (pmap inc [0])))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/pprint.clj --- a/src/clojure/test_clojure/pprint.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber - -(ns clojure.test-clojure.pprint - (:refer-clojure :exclude [format]) - (:use [clojure.test :only (deftest are run-tests)] - clojure.test-clojure.pprint.test-helper - clojure.pprint)) - -(load "pprint/test_cl_format") -(load "pprint/test_pretty") diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/pprint/test_cl_format.clj --- a/src/clojure/test_clojure/pprint/test_cl_format.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,688 +0,0 @@ -;;; test_cl_format.clj -- part of the pretty printer for Clojure - -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber -;; April 3, 2009 - -;; This test set tests the basic cl-format functionality - - -(in-ns 'clojure.test-clojure.pprint) - -(def format cl-format) - -;; TODO tests for ~A, ~D, etc. -;; TODO add tests for ~F, etc.: 0.0, 9.9999 with rounding, 9.9999E99 with rounding - -(simple-tests d-tests - (cl-format nil "~D" 0) "0" - (cl-format nil "~D" 2e6) "2000000" - (cl-format nil "~D" 2000000) "2000000" - (cl-format nil "~:D" 2000000) "2,000,000" - (cl-format nil "~D" 1/2) "1/2" - (cl-format nil "~D" 'fred) "fred" -) - -(simple-tests base-tests - (cl-format nil "~{~2r~^ ~}~%" (range 10)) - "0 1 10 11 100 101 110 111 1000 1001\n" - (with-out-str - (dotimes [i 35] - (binding [*print-base* (+ i 2)] ;print the decimal number 40 - (write 40) ;in each base from 2 to 36 - (if (zero? (mod i 10)) (prn) (cl-format true " "))))) - "101000 -1111 220 130 104 55 50 44 40 37 34 -31 2c 2a 28 26 24 22 20 1j 1i -1h 1g 1f 1e 1d 1c 1b 1a 19 18 -17 16 15 14 " - (with-out-str - (doseq [pb [2 3 8 10 16]] - (binding [*print-radix* true ;print the integer 10 and - *print-base* pb] ;the ratio 1/10 in bases 2, - (cl-format true "~&~S ~S~%" 10 1/10)))) ;3, 8, 10, 16 - "#b1010 #b1/1010 -#3r101 #3r1/101 -#o12 #o1/12 -10. #10r1/10 -#xa #x1/a -") - - - -(simple-tests cardinal-tests - (cl-format nil "~R" 0) "zero" - (cl-format nil "~R" 4) "four" - (cl-format nil "~R" 15) "fifteen" - (cl-format nil "~R" -15) "minus fifteen" - (cl-format nil "~R" 25) "twenty-five" - (cl-format nil "~R" 20) "twenty" - (cl-format nil "~R" 200) "two hundred" - (cl-format nil "~R" 203) "two hundred three" - - (cl-format nil "~R" 44879032) - "forty-four million, eight hundred seventy-nine thousand, thirty-two" - - (cl-format nil "~R" -44879032) - "minus forty-four million, eight hundred seventy-nine thousand, thirty-two" - - (cl-format nil "~R = ~:*~:D" 44000032) - "forty-four million, thirty-two = 44,000,032" - - (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) - "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-four = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" - - (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475 = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" - - (cl-format nil "~R = ~:*~:D" 2e6) - "two million = 2,000,000" - - (cl-format nil "~R = ~:*~:D" 200000200000) - "two hundred billion, two hundred thousand = 200,000,200,000") - -(simple-tests ordinal-tests - (cl-format nil "~:R" 0) "zeroth" - (cl-format nil "~:R" 4) "fourth" - (cl-format nil "~:R" 15) "fifteenth" - (cl-format nil "~:R" -15) "minus fifteenth" - (cl-format nil "~:R" 25) "twenty-fifth" - (cl-format nil "~:R" 20) "twentieth" - (cl-format nil "~:R" 200) "two hundredth" - (cl-format nil "~:R" 203) "two hundred third" - - (cl-format nil "~:R" 44879032) - "forty-four million, eight hundred seventy-nine thousand, thirty-second" - - (cl-format nil "~:R" -44879032) - "minus forty-four million, eight hundred seventy-nine thousand, thirty-second" - - (cl-format nil "~:R = ~:*~:D" 44000032) - "forty-four million, thirty-second = 44,000,032" - - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) - "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-fourth = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475th = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593471) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471st = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471" - (cl-format nil "~:R = ~:*~:D" 2e6) - "two millionth = 2,000,000") - -(simple-tests ordinal1-tests - (cl-format nil "~:R" 1) "first" - (cl-format nil "~:R" 11) "eleventh" - (cl-format nil "~:R" 21) "twenty-first" - (cl-format nil "~:R" 20) "twentieth" - (cl-format nil "~:R" 220) "two hundred twentieth" - (cl-format nil "~:R" 200) "two hundredth" - (cl-format nil "~:R" 999) "nine hundred ninety-ninth" - ) - -(simple-tests roman-tests - (cl-format nil "~@R" 3) "III" - (cl-format nil "~@R" 4) "IV" - (cl-format nil "~@R" 9) "IX" - (cl-format nil "~@R" 29) "XXIX" - (cl-format nil "~@R" 429) "CDXXIX" - (cl-format nil "~@:R" 429) "CCCCXXVIIII" - (cl-format nil "~@:R" 3429) "MMMCCCCXXVIIII" - (cl-format nil "~@R" 3429) "MMMCDXXIX" - (cl-format nil "~@R" 3479) "MMMCDLXXIX" - (cl-format nil "~@R" 3409) "MMMCDIX" - (cl-format nil "~@R" 300) "CCC" - (cl-format nil "~@R ~D" 300 20) "CCC 20" - (cl-format nil "~@R" 5000) "5,000" - (cl-format nil "~@R ~D" 5000 20) "5,000 20" - (cl-format nil "~@R" "the quick") "the quick") - -(simple-tests c-tests - (cl-format nil "~{~c~^, ~}~%" "hello") "h, e, l, l, o\n" - (cl-format nil "~{~:c~^, ~}~%" "hello") "h, e, l, l, o\n" - (cl-format nil "~@C~%" \m) "\\m\n" - (cl-format nil "~@C~%" (char 222)) "\\Þ\n" - (cl-format nil "~@C~%" (char 8)) "\\backspace\n" - (cl-format nil "~@C~%" (char 3)) "\\\n") - -(simple-tests e-tests - (cl-format nil "*~E*" 0.0) "*0.0E+0*" - (cl-format nil "*~6E*" 0.0) "*0.0E+0*" - (cl-format nil "*~6,0E*" 0.0) "* 0.E+0*" - (cl-format nil "*~7,2E*" 0.0) "*0.00E+0*" - (cl-format nil "*~5E*" 0.0) "*0.E+0*" - (cl-format nil "*~10,2,2,,'?E*" 2.8E120) "*??????????*" - (cl-format nil "*~10,2E*" 9.99999) "* 1.00E+1*" - (cl-format nil "*~10,2E*" 9.99999E99) "* 1.00E+100*" - (cl-format nil "*~10,2,2E*" 9.99999E99) "* 1.00E+100*" - (cl-format nil "*~10,2,2,,'?E*" 9.99999E99) "*??????????*" - ) - -(simple-tests $-tests - (cl-format nil "~$" 22.3) "22.30" - (cl-format nil "~$" 22.375) "22.38" - (cl-format nil "~3,5$" 22.375) "00022.375" - (cl-format nil "~3,5,8$" 22.375) "00022.375" - (cl-format nil "~3,5,10$" 22.375) " 00022.375" - (cl-format nil "~3,5,14@$" 22.375) " +00022.375" - (cl-format nil "~3,5,14@$" 22.375) " +00022.375" - (cl-format nil "~3,5,14@:$" 22.375) "+ 00022.375" - (cl-format nil "~3,,14@:$" 0.375) "+ 0.375" - (cl-format nil "~1,1$" -12.0) "-12.0" - (cl-format nil "~1,1$" 12.0) "12.0" - (cl-format nil "~1,1$" 12.0) "12.0" - (cl-format nil "~1,1@$" 12.0) "+12.0" - (cl-format nil "~1,1,8,' @:$" 12.0) "+ 12.0" - (cl-format nil "~1,1,8,' @$" 12.0) " +12.0" - (cl-format nil "~1,1,8,' :$" 12.0) " 12.0" - (cl-format nil "~1,1,8,' $" 12.0) " 12.0" - (cl-format nil "~1,1,8,' @:$" -12.0) "- 12.0" - (cl-format nil "~1,1,8,' @$" -12.0) " -12.0" - (cl-format nil "~1,1,8,' :$" -12.0) "- 12.0" - (cl-format nil "~1,1,8,' $" -12.0) " -12.0" - (cl-format nil "~1,1$" 0.001) "0.0" - (cl-format nil "~2,1$" 0.001) "0.00" - (cl-format nil "~1,1,6$" 0.001) " 0.0" - (cl-format nil "~1,1,6$" 0.0015) " 0.0" - (cl-format nil "~2,1,6$" 0.005) " 0.01" - (cl-format nil "~2,1,6$" 0.01) " 0.01" - (cl-format nil "~$" 0.099) "0.10" - (cl-format nil "~1$" 0.099) "0.1" - (cl-format nil "~1$" 0.1) "0.1" - (cl-format nil "~1$" 0.99) "1.0" - (cl-format nil "~1$" -0.99) "-1.0") - -(simple-tests f-tests - (cl-format nil "~,1f" -12.0) "-12.0" - (cl-format nil "~,0f" 9.4) "9." - (cl-format nil "~,0f" 9.5) "10." - (cl-format nil "~,0f" -0.99) "-1." - (cl-format nil "~,1f" -0.99) "-1.0" - (cl-format nil "~,2f" -0.99) "-0.99" - (cl-format nil "~,3f" -0.99) "-0.990" - (cl-format nil "~,0f" 0.99) "1." - (cl-format nil "~,1f" 0.99) "1.0" - (cl-format nil "~,2f" 0.99) "0.99" - (cl-format nil "~,3f" 0.99) "0.990" - (cl-format nil "~f" -1) "-1.0" - (cl-format nil "~2f" -1) "-1." - (cl-format nil "~3f" -1) "-1." - (cl-format nil "~4f" -1) "-1.0" - (cl-format nil "~8f" -1) " -1.0" - (cl-format nil "~1,1f" 0.1) ".1") - -(simple-tests ampersand-tests - (cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5) - "The quick brown elephant jumped over 5 lazy dogs" - (cl-format nil "The quick brown ~&~a jumped over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped over 5 lazy dogs" - (cl-format nil "The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~3&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "\n\nThe quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~@{~&The quick brown ~a jumped over ~d lazy dogs~}" 'elephant 5 'fox 10) - "The quick brown elephant jumped over 5 lazy dogs\nThe quick brown fox jumped over 10 lazy dogs" - (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 1) "I d\no have one\n") - -(simple-tests t-tests - (cl-format nil "~@{~&~A~8,4T~:*~A~}" - 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" - (cl-format nil "~@{~&~A~,4T~:*~A~}" - 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" - (cl-format nil "~@{~&~A~2,6@T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" -) - -(simple-tests paren-tests - (cl-format nil "~(PLEASE SPEAK QUIETLY IN HERE~)") "please speak quietly in here" - (cl-format nil "~@(PLEASE SPEAK QUIETLY IN HERE~)") "Please speak quietly in here" - (cl-format nil "~@:(but this Is imporTant~)") "BUT THIS IS IMPORTANT" - (cl-format nil "~:(the greAt gatsby~)!") "The Great Gatsby!" - ;; Test cases from CLtL 18.3 - string-upcase, et al. - (cl-format nil "~@:(~A~)" "Dr. Livingstone, I presume?") "DR. LIVINGSTONE, I PRESUME?" - (cl-format nil "~(~A~)" "Dr. Livingstone, I presume?") "dr. livingstone, i presume?" - (cl-format nil "~:(~A~)" " hello ") " Hello " - (cl-format nil "~:(~A~)" "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") - "Occluded Casements Forestall Inadvertent Defenestration" - (cl-format nil "~:(~A~)" 'kludgy-hash-search) "Kludgy-Hash-Search" - (cl-format nil "~:(~A~)" "DON'T!") "Don'T!" ;not "Don't!" - (cl-format nil "~:(~A~)" "pipe 13a, foo16c") "Pipe 13a, Foo16c" -) - -(simple-tests square-bracket-tests - ;; Tests for format without modifiers - (cl-format nil "I ~[don't ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~]have one~%" 1) "I have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 1) "I do have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 2) "I have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 1) "I do have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 2) "I do have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 700) "I do have one\n" - - ;; Tests for format with a colon - (cl-format nil "I ~:[don't ~;do ~]have one~%" true) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" 700) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" '(a b)) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" nil) "I don't have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" false) "I don't have one\n" - - ;; Tests for format with an at sign - (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 nil) "We had 15 wins.\n" - (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 17) - "We had 15 wins (out of 17 tries).\n" - - ;; Format tests with directives - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 0, 7) - "Max 15: Blue team 7.\n" - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 1, 12) - "Max 15: Red team 12.\n" - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" - 15, -1, "(system failure)") - "Max 15: No team (system failure).\n" - - ;; Nested format tests - (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" - 15, 0, 7, true) - "Max 15: Blue team 7 (complete success).\n" - (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" - 15, 0, 7, false) - "Max 15: Blue team 7.\n" - - ;; Test the selector as part of the argument - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~].") - "The answer is nothing." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 4) - "The answer is 4." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 7 22) - "The answer is 7 out of 22." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 1 2 3 4) - "The answer is something crazy." -) - -(simple-tests curly-brace-plain-tests - ;; Iteration from sublist - (cl-format nil "Coordinates are~{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) - "Coordinates are\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) - "Coordinates are none\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3 1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~{~:}~%" "" []) - "Coordinates are\n" - - (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3 1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) - "Coordinates are none\n" -) - - -(simple-tests curly-brace-colon-tests - ;; Iteration from list of sublists - (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) - "Coordinates are\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) - "Coordinates are none\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [[2 3] [1]]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~:{~:}~%" "" []) - "Coordinates are\n" - - (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [[2 3] [1]]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) - "Coordinates are none\n" -) - -(simple-tests curly-brace-at-tests - ;; Iteration from main list - (cl-format nil "Coordinates are~@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") - "Coordinates are none\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" 2 3 1) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@{~:}~%" "") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" 2 3 1) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") - "Coordinates are none\n" -) - -(simple-tests curly-brace-colon-at-tests - ;; Iteration from sublists on the main arg list - (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1] ) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") - "Coordinates are none\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3] [1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@:{~:}~%" "") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3] [1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") - "Coordinates are none\n" -) - -;; TODO tests for ~^ in ~[ constructs and other brackets -;; TODO test ~:^ generates an error when used improperly -;; TODO test ~:^ works in ~@:{...~} -(let [aseq '(a quick brown fox jumped over the lazy dog) - lseq (mapcat identity (for [x aseq] [x (.length (name x))]))] - (simple-tests up-tests - (cl-format nil "~{~a~^, ~}" aseq) "a, quick, brown, fox, jumped, over, the, lazy, dog" - (cl-format nil "~{~a~0^, ~}" aseq) "a" - (cl-format nil "~{~a~#,3^, ~}" aseq) "a, quick, brown, fox, jumped, over" - (cl-format nil "~{~a~v,3^, ~}" lseq) "a, quick, brown, fox" - (cl-format nil "~{~a~3,v,4^, ~}" lseq) "a, quick, brown, fox" -)) - -(simple-tests angle-bracket-tests - (cl-format nil "~") "foobarbaz" - (cl-format nil "~20") "foo bar baz" - (cl-format nil "~,,2") "foo bar baz" - (cl-format nil "~20<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~20:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz" - (cl-format nil "~20@<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz " - (cl-format nil "~20@:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz " - (cl-format nil "~10,,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~10,10,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~10,10<~A~;~A~;~A~>" "foo" "bar" "baz") "foo barbaz" - (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar") "foo bar" - (cl-format nil "~20@<~A~;~^~A~;~^~A~>" "foo") "foo " - (cl-format nil "~20:<~A~;~^~A~;~^~A~>" "foo") " foo" -) - -(simple-tests angle-bracket-max-column-tests - (cl-format nil "~%;; ~{~<~%;; ~1,50:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance" "\\s"))) - "\n;; This function computes the circular\n;; thermodynamic coefficient of the thrombulator\n;; angle for use in determining the reaction\n;; distance.\n" -(cl-format true "~%;; ~{~<~%;; ~:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance." "\\s")))) - -(defn list-to-table [aseq column-width] - (let [stream (get-pretty-writer (java.io.StringWriter.))] - (binding [*out* stream] - (doseq [row aseq] - (doseq [col row] - (cl-format true "~4D~7,vT" col column-width)) - (prn))) - (.flush stream) - (.toString (:base @@(:base @@stream))))) - -(simple-tests column-writer-test - (list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8) - " 1 1 1 \n 2 4 8 \n 3 9 27 \n 4 16 64 \n 5 25 125 \n 6 36 216 \n 7 49 343 \n 8 64 512 \n 9 81 729 \n 10 100 1000 \n 11 121 1331 \n 12 144 1728 \n 13 169 2197 \n 14 196 2744 \n 15 225 3375 \n 16 256 4096 \n 17 289 4913 \n 18 324 5832 \n 19 361 6859 \n 20 400 8000 \n") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The following tests are the various examples from the format -;; documentation in Common Lisp, the Language, 2nd edition, Chapter 22.3 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn expt [base pow] (reduce * (repeat pow base))) - -(let [x 5, y "elephant", n 3] - (simple-tests cltl-intro-tests - (format nil "foo") "foo" - (format nil "The answer is ~D." x) "The answer is 5." - (format nil "The answer is ~3D." x) "The answer is 5." - (format nil "The answer is ~3,'0D." x) "The answer is 005." - (format nil "The answer is ~:D." (expt 47 x)) "The answer is 229,345,007." - (format nil "Look at the ~A!" y) "Look at the elephant!" - (format nil "Type ~:C to ~A." (char 4) "delete all your files") - "Type Control-D to delete all your files." - (format nil "~D item~:P found." n) "3 items found." - (format nil "~R dog~:[s are~; is~] here." n (= n 1)) "three dogs are here." - (format nil "~R dog~:*~[s are~; is~:;s are~] here." n) "three dogs are here." - (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) "Here are three puppies.")) - -(simple-tests cltl-B-tests - ;; CLtL didn't have the colons here, but the spec requires them - (format nil "~,,' ,4:B" 0xFACE) "1111 1010 1100 1110" - (format nil "~,,' ,4:B" 0x1CE) "1 1100 1110" - (format nil "~19,,' ,4:B" 0xFACE) "1111 1010 1100 1110" - ;; This one was a nice idea, but nothing in the spec supports it working this way - ;; (and SBCL doesn't work this way either) - ;(format nil "~19,,' ,4:B" 0x1CE) "0000 0001 1100 1110") - ) - -(simple-tests cltl-P-tests - (format nil "~D tr~:@P/~D win~:P" 7 1) "7 tries/1 win" - (format nil "~D tr~:@P/~D win~:P" 1 0) "1 try/0 wins" - (format nil "~D tr~:@P/~D win~:P" 1 3) "1 try/3 wins") - -(defn foo [x] - (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" - x x x x x x)) - -(simple-tests cltl-F-tests - (foo 3.14159) " 3.14| 31.42| 3.14|3.1416|3.14|3.14159" - (foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" - (foo 100.0) "100.00|******|100.00| 100.0|100.00|100.0" - (foo 1234.0) "1234.00|******|??????|1234.0|1234.00|1234.0" - (foo 0.006) " 0.01| 0.06| 0.01| 0.006|0.01|0.006") - -(defn foo-e [x] - (format nil - "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E" - x x x x)) - -;; Clojure doesn't support float/double differences in representation -(simple-tests cltl-E-tests - (foo-e 0.0314159) " 3.14E-2| 31.42$-03|+.003E+01| 3.14E-2" ; Added this one - (foo-e 3.14159) " 3.14E+0| 31.42$-01|+.003E+03| 3.14E+0" - (foo-e -3.14159) " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0" - (foo-e 1100.0) " 1.10E+3| 11.00$+02|+.001E+06| 1.10E+3" -; In Clojure, this is identical to the above -; (foo-e 1100.0L0) " 1.10L+3| 11.00$+02|+.001L+06| 1.10L+3" - (foo-e 1.1E13) "*********| 11.00$+12|+.001E+16| 1.10E+13" - (foo-e 1.1E120) "*********|??????????|%%%%%%%%%|1.10E+120" -; Clojure doesn't support real numbers this large -; (foo-e 1.1L1200) "*********|??????????|%%%%%%%%%|1.10L+1200" -) - -(simple-tests cltl-E-scale-tests - (map - (fn [k] (format nil "Scale factor ~2D~:*: |~13,6,2,VE|" - (- k 5) 3.14159)) ;Prints 13 lines - (range 13)) - '("Scale factor -5: | 0.000003E+06|" - "Scale factor -4: | 0.000031E+05|" - "Scale factor -3: | 0.000314E+04|" - "Scale factor -2: | 0.003142E+03|" - "Scale factor -1: | 0.031416E+02|" - "Scale factor 0: | 0.314159E+01|" - "Scale factor 1: | 3.141590E+00|" - "Scale factor 2: | 31.41590E-01|" - "Scale factor 3: | 314.1590E-02|" - "Scale factor 4: | 3141.590E-03|" - "Scale factor 5: | 31415.90E-04|" - "Scale factor 6: | 314159.0E-05|" - "Scale factor 7: | 3141590.E-06|")) - -(defn foo-g [x] - (format nil - "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G" - x x x x)) - -;; Clojure doesn't support float/double differences in representation -(simple-tests cltl-G-tests - (foo-g 0.0314159) " 3.14E-2|314.2$-04|0.314E-01| 3.14E-2" - (foo-g 0.314159) " 0.31 |0.314 |0.314 | 0.31 " - (foo-g 3.14159) " 3.1 | 3.14 | 3.14 | 3.1 " - (foo-g 31.4159) " 31. | 31.4 | 31.4 | 31. " - (foo-g 314.159) " 3.14E+2| 314. | 314. | 3.14E+2" - (foo-g 3141.59) " 3.14E+3|314.2$+01|0.314E+04| 3.14E+3" -; In Clojure, this is identical to the above -; (foo-g 3141.59L0) " 3.14L+3|314.2$+01|0.314L+04| 3.14L+3" - (foo-g 3.14E12) "*********|314.0$+10|0.314E+13| 3.14E+12" - (foo-g 3.14E120) "*********|?????????|%%%%%%%%%|3.14E+120" -; Clojure doesn't support real numbers this large -; (foo-g 3.14L1200) "*********|?????????|%%%%%%%%%|3.14L+1200" -) - -(defn type-clash-error [fun nargs argnum right-type wrong-type] - (format nil ;; CLtL has this format string slightly wrong - "~&Function ~S requires its ~:[~:R ~;~*~]~ - argument to be of type ~S,~%but it was called ~ - with an argument of type ~S.~%" - fun (= nargs 1) argnum right-type wrong-type)) - -(simple-tests cltl-Newline-tests - (type-clash-error 'aref nil 2 'integer 'vector) -"Function aref requires its second argument to be of type integer, -but it was called with an argument of type vector.\n" - (type-clash-error 'car 1 1 'list 'short-float) -"Function car requires its argument to be of type list, -but it was called with an argument of type short-float.\n") - -(simple-tests cltl-?-tests - (format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) " 7" - (format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) " 7" - (format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) " 7" - (format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) " 14") - -(defn f [n] (format nil "~@(~R~) error~:P detected." n)) - -(simple-tests cltl-paren-tests - (format nil "~@R ~(~@R~)" 14 14) "XIV xiv" - (f 0) "Zero errors detected." - (f 1) "One error detected." - (f 23) "Twenty-three errors detected.") - -(let [*print-level* nil *print-length* 5] - (simple-tests cltl-bracket-tests - (format nil "~@[ print level = ~D~]~@[ print length = ~D~]" - *print-level* *print-length*) - " print length = 5")) - -(let [foo "Items:~#[ none~; ~S~; ~S and ~S~ - ~:;~@{~#[~; and~] ~ - ~S~^,~}~]."] - (simple-tests cltl-bracket1-tests - (format nil foo) "Items: none." - (format nil foo 'foo) "Items: foo." - (format nil foo 'foo 'bar) "Items: foo and bar." - (format nil foo 'foo 'bar 'baz) "Items: foo, bar, and baz." - (format nil foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux.")) - -(simple-tests cltl-curly-bracket-tests - (format nil - "The winners are:~{ ~S~}." - '(fred harry jill)) - "The winners are: fred harry jill." - - (format nil "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3)) - "Pairs: ." - - (format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3))) - "Pairs: ." - - (format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3) - "Pairs: ." - - (format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3)) - "Pairs: .") - -(simple-tests cltl-angle-bracket-tests - (format nil "~10") "foo bar" - (format nil "~10:") " foo bar" - (format nil "~10:@") " foo bar " - (format nil "~10") " foobar" - (format nil "~10:") " foobar" - (format nil "~10@") "foobar " - (format nil "~10:@") " foobar ") - -(let [donestr "Done.~^ ~D warning~:P.~^ ~D error~:P." - tellstr "~@{~@(~@[~R~^ ~]~A~)~}."] ;; The CLtL example is a little wrong here - - (simple-tests cltl-up-tests - (format nil donestr) "Done." - (format nil donestr 3) "Done. 3 warnings." - (format nil donestr 1 5) "Done. 1 warning. 5 errors." - (format nil tellstr 23) "Twenty-three." - (format nil tellstr nil "losers") "Losers." - (format nil tellstr 23 "losers") "Twenty-three losers." - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo) - " foo" - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar) - "foo bar" - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz) - "foo bar baz")) - -(simple-tests cltl-up-x3j13-tests - (format nil - "~:{/~S~^ ...~}" - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger/ice .../french ..." - (format nil - "~:{/~S~:^ ...~}" - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger .../ice .../french" - - (format nil - "~:{/~S~#:^ ...~}" ;; This is wrong in CLtL - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger") - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/pprint/test_helper.clj --- a/src/clojure/test_clojure/pprint/test_helper.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,27 +0,0 @@ -;;; test_helper.clj -- part of the pretty printer for Clojure - -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber -;; April 3, 2009 - - -;; This is just a macro to make my tests a little cleaner - -(ns clojure.test-clojure.pprint.test-helper - (:use [clojure.test :only (deftest is)])) - -(defn- back-match [x y] (re-matches y x)) -(defmacro simple-tests [name & test-pairs] - `(deftest ~name - ~@(for [[x y] (partition 2 test-pairs)] - (if (instance? java.util.regex.Pattern y) - `(is (#'clojure.test-clojure.pprint.test-helper/back-match ~x ~y)) - `(is (= ~x ~y)))))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/pprint/test_pretty.clj --- a/src/clojure/test_clojure/pprint/test_pretty.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,275 +0,0 @@ -;;; test_pretty.clj -- part of the pretty printer for Clojure - -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Tom Faulhaber -;; April 3, 2009 - - -(in-ns 'clojure.test-clojure.pprint) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Unit tests for the pretty printer -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(simple-tests xp-fill-test - (binding [*print-pprint-dispatch* simple-dispatch - *print-right-margin* 38 - *print-miser-width* nil] - (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" - '((x 4) (*print-length* nil) (z 2) (list nil)))) - "(let ((x 4) (*print-length* nil)\n (z 2) (list nil))\n ...)\n" - - (binding [*print-pprint-dispatch* simple-dispatch - *print-right-margin* 22] - (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" - '((x 4) (*print-length* nil) (z 2) (list nil)))) - "(let ((x 4)\n (*print-length*\n nil)\n (z 2)\n (list nil))\n ...)\n") - -(simple-tests xp-miser-test - (binding [*print-pprint-dispatch* simple-dispatch - *print-right-margin* 10, *print-miser-width* 9] - (cl-format nil "~:" '(first second third))) - "(LIST\n first\n second\n third)" - - (binding [*print-pprint-dispatch* simple-dispatch - *print-right-margin* 10, *print-miser-width* 8] - (cl-format nil "~:" '(first second third))) - "(LIST first second third)") - -(simple-tests mandatory-fill-test - (cl-format nil - "

~%~~%
~%" - [ "hello" "gooodbye" ]) - "
-Usage: *hello*
-       *gooodbye*
-
-") - -(simple-tests prefix-suffix-test - (binding [*print-pprint-dispatch* simple-dispatch - *print-right-margin* 10, *print-miser-width* 10] - (cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third))) - "{LIST\n first\n second\n third}") - -(simple-tests pprint-test - (binding [*print-pprint-dispatch* simple-dispatch] - (write '(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true "That number is too big") - (cl-format true "The result of ~d x ~d is ~d" x y result)))) - :stream nil)) - "(defn - foo - [x y] - (let - [result (* x y)] - (if - (> result 400) - (cl-format true \"That number is too big\") - (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" - - (with-pprint-dispatch code-dispatch - (write '(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true "That number is too big") - (cl-format true "The result of ~d x ~d is ~d" x y result)))) - :stream nil)) - "(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true \"That number is too big\") - (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" - - (binding [*print-pprint-dispatch* simple-dispatch - *print-right-margin* 15] - (write '(fn (cons (car x) (cdr y))) :stream nil)) - "(fn\n (cons\n (car x)\n (cdr y)))" - - (with-pprint-dispatch code-dispatch - (binding [*print-right-margin* 52] - (write - '(add-to-buffer this (make-buffer-blob (str (char c)) nil)) - :stream nil))) - "(add-to-buffer\n this\n (make-buffer-blob (str (char c)) nil))" - ) - - - -(simple-tests pprint-reader-macro-test - (with-pprint-dispatch code-dispatch - (write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])") - :stream nil)) - "(map #(first %) [[1 2 3] [4 5 6] [7]])" - - (with-pprint-dispatch code-dispatch - (write (read-string "@@(ref (ref 1))") - :stream nil)) - "@@(ref (ref 1))" - - (with-pprint-dispatch code-dispatch - (write (read-string "'foo") - :stream nil)) - "'foo" -) - -(simple-tests code-block-tests - (with-out-str - (with-pprint-dispatch code-dispatch - (pprint - '(defn cl-format - "An implementation of a Common Lisp compatible format function" - [stream format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format stream compiled-format navigator)))))) - "(defn cl-format - \"An implementation of a Common Lisp compatible format function\" - [stream format-in & args] - (let [compiled-format (if (string? format-in) - (compile-format format-in) - format-in) - navigator (init-navigator args)] - (execute-format stream compiled-format navigator))) -" - - (with-out-str - (with-pprint-dispatch code-dispatch - (pprint - '(defn pprint-defn [writer alis] - (if (next alis) - (let [[defn-sym defn-name & stuff] alis - [doc-str stuff] (if (string? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff]) - [attr-map stuff] (if (map? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff])] - (pprint-logical-block writer :prefix "(" :suffix ")" - (cl-format true "~w ~1I~@_~w" defn-sym defn-name) - (if doc-str - (cl-format true " ~_~w" doc-str)) - (if attr-map - (cl-format true " ~_~w" attr-map)) - ;; Note: the multi-defn case will work OK for malformed defns too - (cond - (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) - :else (multi-defn stuff (or doc-str attr-map))))) - (pprint-simple-code-list writer alis)))))) - "(defn pprint-defn [writer alis] - (if (next alis) - (let [[defn-sym defn-name & stuff] alis - [doc-str stuff] (if (string? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff]) - [attr-map stuff] (if (map? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff])] - (pprint-logical-block - writer - :prefix - \"(\" - :suffix - \")\" - (cl-format true \"~w ~1I~@_~w\" defn-sym defn-name) - (if doc-str (cl-format true \" ~_~w\" doc-str)) - (if attr-map (cl-format true \" ~_~w\" attr-map)) - (cond - (vector? (first stuff)) (single-defn - stuff - (or doc-str attr-map)) - :else (multi-defn stuff (or doc-str attr-map))))) - (pprint-simple-code-list writer alis))) -") - - -(defn tst-pprint - "A helper function to pprint to a string with a restricted right margin" - [right-margin obj] - (binding [*print-right-margin* right-margin - *print-pretty* true] - (write obj :stream nil))) - -;;; A bunch of predefined data to print -(def future-filled (future-call (fn [] 100))) -@future-filled -(def future-unfilled (future-call (fn [] (.acquire (java.util.concurrent.Semaphore. 0))))) -(def promise-filled (promise)) -(deliver promise-filled '(first second third)) -(def promise-unfilled (promise)) -(def basic-agent (agent '(first second third))) -(defn failed-agent - "must be a fn because you cannot await agents during load" - [] - (let [a (agent "foo")] - (send a +) - (try (await-for 100 failed-agent) (catch RuntimeException re)) - a)) -(def basic-atom (atom '(first second third))) -(def basic-ref (ref '(first second third))) -(def delay-forced (delay '(first second third))) -(force delay-forced) -(def delay-unforced (delay '(first second third))) -(defrecord pprint-test-rec [a b c]) - -(simple-tests pprint-datastructures-tests - (tst-pprint 20 future-filled) #"#" - (tst-pprint 20 future-unfilled) #"#" - (tst-pprint 20 promise-filled) #"#" - ;; This hangs currently, cause we can't figure out whether a promise is filled - ;;(tst-pprint 20 promise-unfilled) #"#" - (tst-pprint 20 basic-agent) #"#" - (tst-pprint 20 (failed-agent)) #"#" - (tst-pprint 20 basic-atom) #"#" - (tst-pprint 20 basic-ref) #"#" - (tst-pprint 20 delay-forced) #"#" - ;; Currently no way not to force the delay - ;;(tst-pprint 20 delay-unforced) #"#" - (tst-pprint 20 (pprint-test-rec. 'first 'second 'third)) "{:a first,\n :b second,\n :c third}" - - ;; basic java arrays: fails owing to assembla ticket #346 - ;;(tst-pprint 10 (int-array (range 7))) "[0,\n 1,\n 2,\n 3,\n 4,\n 5,\n 6]" - (tst-pprint 15 (reduce conj clojure.lang.PersistentQueue/EMPTY (range 10))) - "<-(0\n 1\n 2\n 3\n 4\n 5\n 6\n 7\n 8\n 9)-<" - ) - - -;;; Some simple tests of dispatch - -(defmulti - test-dispatch - "A test dispatch method" - {:added "1.2" :arglists '[[object]]} - #(and (seq %) (not (string? %)))) - -(defmethod test-dispatch true [avec] - (pprint-logical-block :prefix "[" :suffix "]" - (loop [aseq (seq avec)] - (when aseq - (write-out (first aseq)) - (when (next aseq) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next aseq))))))) - -(defmethod test-dispatch false [aval] (pr aval)) - -(simple-tests dispatch-tests - (with-pprint-dispatch test-dispatch - (with-out-str - (pprint '("hello" "there")))) - "[\"hello\" \"there\"]\n" -) - - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/predicates.clj --- a/src/clojure/test_clojure/predicates.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,142 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - -;; -;; Created 1/28/2009 - -(ns clojure.test-clojure.predicates - (:use clojure.test)) - - -;; *** Type predicates *** - -(def myvar 42) - -(def sample-data { - :nil nil - - :bool-true true - :bool-false false - - :byte (byte 7) - :short (short 7) - :int (int 7) - :long (long 7) - :bigint (bigint 7) - :float (float 7) - :double (double 7) - :bigdec (bigdec 7) - - :ratio 2/3 - - :character \a - :symbol 'abc - :keyword :kw - - :empty-string "" - :empty-regex #"" - :empty-list () - :empty-lazy-seq (lazy-seq nil) - :empty-vector [] - :empty-map {} - :empty-set #{} - :empty-array (into-array []) - - :string "abc" - :regex #"a*b" - :list '(1 2 3) - :lazy-seq (lazy-seq [1 2 3]) - :vector [1 2 3] - :map {:a 1 :b 2 :c 3} - :set #{1 2 3} - :array (into-array [1 2 3]) - - :fn (fn [x] (* 2 x)) - - :class java.util.Date - :object (new java.util.Date) - - :var (var myvar) - :delay (delay (+ 1 2)) -}) - - -(def type-preds { - nil? [:nil] - - true? [:bool-true] - false? [:bool-false] - ; boolean? - - integer? [:byte :short :int :long :bigint] - float? [:float :double] - decimal? [:bigdec] - ratio? [:ratio] - rational? [:byte :short :int :long :bigint :ratio :bigdec] - number? [:byte :short :int :long :bigint :ratio :bigdec :float :double] - - ; character? - symbol? [:symbol] - keyword? [:keyword] - - string? [:empty-string :string] - ; regex? - - list? [:empty-list :list] - vector? [:empty-vector :vector] - map? [:empty-map :map] - set? [:empty-set :set] - - coll? [:empty-list :list - :empty-lazy-seq :lazy-seq - :empty-vector :vector - :empty-map :map - :empty-set :set] - - seq? [:empty-list :list - :empty-lazy-seq :lazy-seq] - ; array? - - fn? [:fn] - ifn? [:fn - :empty-vector :vector :empty-map :map :empty-set :set - :keyword :symbol :var] - - class? [:class] - var? [:var] - delay? [:delay] -}) - - -;; Test all type predicates against all data types -;; -(defn- get-fn-name [f] - (str - (apply str (nthnext (first (.split (str f) "_")) - (count "clojure.core$"))) - "?")) - -(deftest test-type-preds - (doseq [tp type-preds] - (doseq [dt sample-data] - (if (some #(= % (first dt)) (second tp)) - (is ((first tp) (second dt)) - (pr-str (list (get-fn-name (first tp)) (second dt)))) - (is (not ((first tp) (second dt))) - (pr-str (list 'not (list (get-fn-name (first tp)) (second dt))))))))) - - -;; Additional tests: -;; http://groups.google.com/group/clojure/browse_thread/thread/537761a06edb4b06/bfd4f0705b746a38 -;; -(deftest test-string?-more - (are [x] (not (string? x)) - (new java.lang.StringBuilder "abc") - (new java.lang.StringBuffer "xyz"))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/printer.clj --- a/src/clojure/test_clojure/printer.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,83 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Stephen C. Gilardi - -;; clojure.test-clojure.printer -;; -;; scgilardi (gmail) -;; Created 29 October 2008 - -(ns clojure.test-clojure.printer - (:use clojure.test)) - -(deftest print-length-empty-seq - (let [coll () val "()"] - (is (= val (binding [*print-length* 0] (print-str coll)))) - (is (= val (binding [*print-length* 1] (print-str coll)))))) - -(deftest print-length-seq - (let [coll (range 5) - length-val '((0 "(...)") - (1 "(0 ...)") - (2 "(0 1 ...)") - (3 "(0 1 2 ...)") - (4 "(0 1 2 3 ...)") - (5 "(0 1 2 3 4)"))] - (doseq [[length val] length-val] - (binding [*print-length* length] - (is (= val (print-str coll))))))) - -(deftest print-length-empty-vec - (let [coll [] val "[]"] - (is (= val (binding [*print-length* 0] (print-str coll)))) - (is (= val (binding [*print-length* 1] (print-str coll)))))) - -(deftest print-length-vec - (let [coll [0 1 2 3 4] - length-val '((0 "[...]") - (1 "[0 ...]") - (2 "[0 1 ...]") - (3 "[0 1 2 ...]") - (4 "[0 1 2 3 ...]") - (5 "[0 1 2 3 4]"))] - (doseq [[length val] length-val] - (binding [*print-length* length] - (is (= val (print-str coll))))))) - -(deftest print-level-seq - (let [coll '(0 (1 (2 (3 (4))))) - level-val '((0 "#") - (1 "(0 #)") - (2 "(0 (1 #))") - (3 "(0 (1 (2 #)))") - (4 "(0 (1 (2 (3 #))))") - (5 "(0 (1 (2 (3 (4)))))"))] - (doseq [[level val] level-val] - (binding [*print-level* level] - (is (= val (print-str coll))))))) - -(deftest print-level-length-coll - (let [coll '(if (member x y) (+ (first x) 3) (foo (a b c d "Baz"))) - level-length-val - '((0 1 "#") - (1 1 "(if ...)") - (1 2 "(if # ...)") - (1 3 "(if # # ...)") - (1 4 "(if # # #)") - (2 1 "(if ...)") - (2 2 "(if (member x ...) ...)") - (2 3 "(if (member x y) (+ # 3) ...)") - (3 2 "(if (member x ...) ...)") - (3 3 "(if (member x y) (+ (first x) 3) ...)") - (3 4 "(if (member x y) (+ (first x) 3) (foo (a b c d ...)))") - (3 5 "(if (member x y) (+ (first x) 3) (foo (a b c d Baz)))"))] - (doseq [[level length val] level-length-val] - (binding [*print-level* level - *print-length* length] - (is (= val (print-str coll))))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/protocols.clj --- a/src/clojure/test_clojure/protocols.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,300 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Stuart Halloway - -(ns clojure.test-clojure.protocols - (:use clojure.test clojure.test-clojure.protocols.examples) - (:require [clojure.test-clojure.protocols.more-examples :as other] - [clojure.set :as set] - clojure.test-clojure.helpers) - (:import [clojure.test_clojure.protocols.examples ExampleInterface])) - -;; temporary hack until I decide how to cleanly reload protocol -(defn reload-example-protocols - [] - (alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol - assoc :impls {}) - (alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol - assoc :impls {}) - (require :reload - 'clojure.test-clojure.protocols.examples - 'clojure.test-clojure.protocols.more-examples)) - -(defn method-names - "return sorted list of method names on a class" - [c] - (->> (.getMethods c) - (map #(.getName %)) - (sort))) - -(defrecord EmptyRecord []) -(defrecord TestRecord [a b]) -(defn r - ([a b] (TestRecord. a b)) - ([a b meta ext] (TestRecord. a b meta ext))) -(defrecord MapEntry [k v] - java.util.Map$Entry - (getKey [_] k) - (getValue [_] v)) - -(deftest protocols-test - (testing "protocol fns have useful metadata" - (let [common-meta {:ns (find-ns 'clojure.test-clojure.protocols.examples) - :protocol #'ExampleProtocol}] - (are [m f] (= (merge (quote m) common-meta) - (meta (var f))) - {:name foo :arglists ([a]) :doc "method with one arg"} foo - {:name bar :arglists ([a b]) :doc "method with two args"} bar - {:name baz :arglists ([a] [a b]) :doc "method with multiple arities" :tag String} baz - {:name with-quux :arglists ([a]) :doc "method name with a hyphen"} with-quux))) - (testing "protocol fns throw IllegalArgumentException if no impl matches" - (is (thrown-with-msg? - IllegalArgumentException - #"No implementation of method: :foo of protocol: #'clojure.test-clojure.protocols.examples/ExampleProtocol found for class: java.lang.Integer" - (foo 10)))) - (testing "protocols generate a corresponding interface using _ instead of - for method names" - (is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test_clojure.protocols.examples.ExampleProtocol)))) - (testing "protocol will work with instances of its interface (use for interop, not in Clojure!)" - (let [obj (proxy [clojure.test_clojure.protocols.examples.ExampleProtocol] [] - (foo [] "foo!"))] - (is (= "foo!" (.foo obj)) "call through interface") - (is (= "foo!" (foo obj)) "call through protocol"))) - (testing "you can implement just part of a protocol if you want" - (let [obj (reify ExampleProtocol - (baz [a b] "two-arg baz!"))] - (is (= "two-arg baz!" (baz obj nil))) - (is (thrown? AbstractMethodError (baz obj))))) - (testing "you can redefine a protocol with different methods" - (eval '(defprotocol Elusive (old-method [x]))) - (eval '(defprotocol Elusive (new-method [x]))) - (is (= :new-method (eval '(new-method (reify Elusive (new-method [x] :new-method)))))) - (is (fails-with-cause? IllegalArgumentException #"No method of interface: user\.Elusive found for function: old-method of protocol: Elusive \(The protocol method may have been defined before and removed\.\)" - (eval '(old-method (reify Elusive (new-method [x] :new-method)))))))) - -(deftype ExtendTestWidget [name]) -(deftype HasProtocolInline [] - ExampleProtocol - (foo [this] :inline)) -(deftest extend-test - (testing "you can extend a protocol to a class" - (extend String ExampleProtocol - {:foo identity}) - (is (= "pow" (foo "pow")))) - (testing "you can have two methods with the same name. Just use namespaces!" - (extend String other/SimpleProtocol - {:foo (fn [s] (.toUpperCase s))}) - (is (= "POW" (other/foo "pow")))) - (testing "you can extend deftype types" - (extend - ExtendTestWidget - ExampleProtocol - {:foo (fn [this] (str "widget " (.name this)))}) - (is (= "widget z" (foo (ExtendTestWidget. "z")))))) - -(deftest illegal-extending - (testing "you cannot extend a protocol to a type that implements the protocol inline" - (is (fails-with-cause? IllegalArgumentException #".*HasProtocolInline already directly implements interface" - (eval '(extend clojure.test-clojure.protocols.HasProtocolInline - clojure.test-clojure.protocols.examples/ExampleProtocol - {:foo (fn [_] :extended)}))))) - (testing "you cannot extend to an interface" - (is (fails-with-cause? IllegalArgumentException #"interface clojure.test_clojure.protocols.examples.ExampleProtocol is not a protocol" - (eval '(extend clojure.test-clojure.protocols.HasProtocolInline - clojure.test_clojure.protocols.examples.ExampleProtocol - {:foo (fn [_] :extended)})))))) - -(deftype ExtendsTestWidget [] - ExampleProtocol) -(deftest extends?-test - (reload-example-protocols) - (testing "returns false if a type does not implement the protocol at all" - (is (false? (extends? other/SimpleProtocol ExtendsTestWidget)))) - (testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010 - (is (true? (extends? ExampleProtocol ExtendsTestWidget)))) - (testing "returns true if a type explicitly extends protocol" - (extend - ExtendsTestWidget - other/SimpleProtocol - {:foo identity}) - (is (true? (extends? other/SimpleProtocol ExtendsTestWidget))))) - -(deftype ExtendersTestWidget []) -(deftest extenders-test - (reload-example-protocols) - (testing "a fresh protocol has no extenders" - (is (nil? (extenders ExampleProtocol)))) - (testing "extending with no methods doesn't count!" - (deftype Something []) - (extend ::Something ExampleProtocol) - (is (nil? (extenders ExampleProtocol)))) - (testing "extending a protocol (and including an impl) adds an entry to extenders" - (extend ExtendersTestWidget ExampleProtocol {:foo identity}) - (is (= [ExtendersTestWidget] (extenders ExampleProtocol))))) - -(deftype SatisfiesTestWidget [] - ExampleProtocol) -(deftest satisifies?-test - (reload-example-protocols) - (let [whatzit (SatisfiesTestWidget.)] - (testing "returns false if a type does not implement the protocol at all" - (is (false? (satisfies? other/SimpleProtocol whatzit)))) - (testing "returns true if a type implements the protocol directly" - (is (true? (satisfies? ExampleProtocol whatzit)))) - (testing "returns true if a type explicitly extends protocol" - (extend - SatisfiesTestWidget - other/SimpleProtocol - {:foo identity}) - (is (true? (satisfies? other/SimpleProtocol whatzit))))) ) - -(deftype ReExtendingTestWidget []) -(deftest re-extending-test - (reload-example-protocols) - (extend - ReExtendingTestWidget - ExampleProtocol - {:foo (fn [_] "first foo") - :baz (fn [_] "first baz")}) - (testing "if you re-extend, the old implementation is replaced (not merged!)" - (extend - ReExtendingTestWidget - ExampleProtocol - {:baz (fn [_] "second baz") - :bar (fn [_ _] "second bar")}) - (let [whatzit (ReExtendingTestWidget.)] - (is (thrown? IllegalArgumentException (foo whatzit))) - (is (= "second bar" (bar whatzit nil))) - (is (= "second baz" (baz whatzit)))))) - -(defrecord DefrecordObjectMethodsWidgetA [a]) -(defrecord DefrecordObjectMethodsWidgetB [a]) -(deftest defrecord-object-methods-test - (testing "= depends on fields and type" - (is (true? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1)))) - (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2)))) - (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1)))))) - -(deftest defrecord-acts-like-a-map - (let [rec (r 1 2)] - (is (.equals (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4}))) - (is (.equals {:foo 1 :b 2} (set/rename-keys rec {:a :foo}))) - (is (.equals {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10}))))) - -(deftest degenerate-defrecord-test - (let [empty (EmptyRecord.)] - (is (nil? (seq empty))) - (is (not (.containsValue empty :a))))) - -(deftest defrecord-interfaces-test - (testing "java.util.Map" - (let [rec (r 1 2)] - (is (= 2 (.size rec))) - (is (= 3 (.size (assoc rec :c 3)))) - (is (not (.isEmpty rec))) - (is (.isEmpty (EmptyRecord.))) - (is (.containsKey rec :a)) - (is (not (.containsKey rec :c))) - (is (.containsValue rec 1)) - (is (not (.containsValue rec 3))) - (is (= 1 (.get rec :a))) - (is (thrown? UnsupportedOperationException (.put rec :a 1))) - (is (thrown? UnsupportedOperationException (.remove rec :a))) - (is (thrown? UnsupportedOperationException (.putAll rec {}))) - (is (thrown? UnsupportedOperationException (.clear rec))) - (is (= #{:a :b} (.keySet rec))) - (is (= #{1 2} (set (.values rec)))) - (is (= #{[:a 1] [:b 2]} (.entrySet rec))) - - )) - (testing "IPersistentCollection" - (testing ".cons" - (let [rec (r 1 2)] - (are [x] (= rec (.cons rec x)) - nil {}) - (is (= (r 1 3) (.cons rec {:b 3}))) - (is (= (r 1 4) (.cons rec [:b 4]))) - (is (= (r 1 5) (.cons rec (MapEntry. :b 5)))))))) - -(defrecord RecordWithSpecificFieldNames [this that k m o]) -(deftest defrecord-with-specific-field-names - (let [rec (new RecordWithSpecificFieldNames 1 2 3 4 5)] - (is (= rec rec)) - (is (= 1 (:this (with-meta rec {:foo :bar})))) - (is (= 3 (get rec :k))) - (is (= (seq rec) '([:this 1] [:that 2] [:k 3] [:m 4] [:o 5]))) - (is (= (dissoc rec :k) {:this 1, :that 2, :m 4, :o 5})))) - -(deftest reify-test - (testing "of an interface" - (let [s :foo - r (reify - java.util.List - (contains [_ o] (= s o)))] - (testing "implemented methods" - (is (true? (.contains r :foo))) - (is (false? (.contains r :bar)))) - (testing "unimplemented methods" - (is (thrown? AbstractMethodError (.add r :baz)))))) - (testing "of two interfaces" - (let [r (reify - java.util.List - (contains [_ o] (= :foo o)) - java.util.Collection - (isEmpty [_] false))] - (is (true? (.contains r :foo))) - (is (false? (.contains r :bar))) - (is (false? (.isEmpty r))))) - (testing "you can't define a method twice" - (is (fails-with-cause? - java.lang.ClassFormatError #"^(Repetitive|Duplicate) method name" - (eval '(reify - java.util.List - (size [_] 10) - java.util.Collection - (size [_] 20)))))) - (testing "you can't define a method not on an interface/protocol/j.l.Object" - (is (fails-with-cause? - IllegalArgumentException #"^Can't define method not in interfaces: foo" - (eval '(reify java.util.List (foo [_])))))) - (testing "of a protocol" - (let [r (reify - ExampleProtocol - (bar [this o] o) - (baz [this] 1) - (baz [this o] 2))] - (= :foo (.bar r :foo)) - (= 1 (.baz r)) - (= 2 (.baz r nil)))) - (testing "destructuring in method def" - (let [r (reify - ExampleProtocol - (bar [this [_ _ item]] item))] - (= :c (.bar r [:a :b :c])))) - (testing "methods can recur" - (let [r (reify - java.util.List - (get [_ index] - (if (zero? index) - :done - (recur (dec index)))))] - (is (= :done (.get r 0))) - (is (= :done (.get r 1))))) - (testing "disambiguating with type hints" - (testing "you must hint an overloaded method" - (is (fails-with-cause? - IllegalArgumentException #"Must hint overloaded method: hinted" - (eval '(reify clojure.test_clojure.protocols.examples.ExampleInterface (hinted [_ o])))))) - (testing "hinting" - (let [r (reify - ExampleInterface - (hinted [_ ^int i] (inc i)) - (hinted [_ ^String s] (str s s)))] - (is (= 2 (.hinted r 1))) - (is (= "xoxo" (.hinted r "xo"))))))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/protocols/examples.clj --- a/src/clojure/test_clojure/protocols/examples.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -(ns clojure.test-clojure.protocols.examples) - -(defprotocol ExampleProtocol - "example protocol used by clojure tests" - - (foo [a] "method with one arg") - (bar [a b] "method with two args") - (^String baz [a] [a b] "method with multiple arities") - (with-quux [a] "method name with a hyphen")) - -(definterface ExampleInterface - (hinted [^int i]) - (hinted [^String s])) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/protocols/more_examples.clj --- a/src/clojure/test_clojure/protocols/more_examples.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -(ns clojure.test-clojure.protocols.more-examples) - -(defprotocol SimpleProtocol - "example protocol used by clojure tests. Note that - foo collides with examples/ExampleProtocol." - - (foo [a] "")) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/reader.clj --- a/src/clojure/test_clojure/reader.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,319 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Stephen C. Gilardi - -;; -;; Tests for the Clojure functions documented at the URL: -;; -;; http://clojure.org/Reader -;; -;; scgilardi (gmail) -;; Created 22 October 2008 - -(ns clojure.test-clojure.reader - (:use clojure.test)) - -;; Symbols - -(deftest Symbols - (is (= 'abc (symbol "abc"))) - (is (= '*+!-_? (symbol "*+!-_?"))) - (is (= 'abc:def:ghi (symbol "abc:def:ghi"))) - (is (= 'abc/def (symbol "abc" "def"))) - (is (= 'abc.def/ghi (symbol "abc.def" "ghi"))) - (is (= 'abc/def.ghi (symbol "abc" "def.ghi"))) - (is (= 'abc:def/ghi:jkl.mno (symbol "abc:def" "ghi:jkl.mno"))) - (is (instance? clojure.lang.Symbol 'alphabet)) - ) - -;; Literals - -(deftest Literals - ; 'nil 'false 'true are reserved by Clojure and are not symbols - (is (= 'nil nil)) - (is (= 'false false)) - (is (= 'true true)) ) - -;; Strings - -(deftest Strings - (is (= "abcde" (str \a \b \c \d \e))) - (is (= "abc - def" (str \a \b \c \newline \space \space \d \e \f))) - ) - -;; Numbers - -(deftest Numbers - - ; Read Integer - (is (instance? Integer 2147483647)) - (is (instance? Integer +1)) - (is (instance? Integer 1)) - (is (instance? Integer +0)) - (is (instance? Integer 0)) - (is (instance? Integer -0)) - (is (instance? Integer -1)) - (is (instance? Integer -2147483648)) - - ; Read Long - (is (instance? Long 2147483648)) - (is (instance? Long -2147483649)) - (is (instance? Long 9223372036854775807)) - (is (instance? Long -9223372036854775808)) - - ;; Numeric constants of different types don't wash out. Regression fixed in - ;; r1157. Previously the compiler saw 0 and 0.0 as the same constant and - ;; caused the sequence to be built of Doubles. - (let [x 0.0] - (let [sequence (loop [i 0 l '()] - (if (< i 5) - (recur (inc i) (conj l i)) - l))] - (is (= [4 3 2 1 0] sequence)) - (is (every? #(instance? Integer %) - sequence)))) - - ; Read BigInteger - (is (instance? BigInteger 9223372036854775808)) - (is (instance? BigInteger -9223372036854775809)) - (is (instance? BigInteger 10000000000000000000000000000000000000000000000000)) - (is (instance? BigInteger -10000000000000000000000000000000000000000000000000)) - - ; Read Double - (is (instance? Double +1.0e+1)) - (is (instance? Double +1.e+1)) - (is (instance? Double +1e+1)) - - (is (instance? Double +1.0e1)) - (is (instance? Double +1.e1)) - (is (instance? Double +1e1)) - - (is (instance? Double +1.0e-1)) - (is (instance? Double +1.e-1)) - (is (instance? Double +1e-1)) - - (is (instance? Double 1.0e+1)) - (is (instance? Double 1.e+1)) - (is (instance? Double 1e+1)) - - (is (instance? Double 1.0e1)) - (is (instance? Double 1.e1)) - (is (instance? Double 1e1)) - - (is (instance? Double 1.0e-1)) - (is (instance? Double 1.e-1)) - (is (instance? Double 1e-1)) - - (is (instance? Double -1.0e+1)) - (is (instance? Double -1.e+1)) - (is (instance? Double -1e+1)) - - (is (instance? Double -1.0e1)) - (is (instance? Double -1.e1)) - (is (instance? Double -1e1)) - - (is (instance? Double -1.0e-1)) - (is (instance? Double -1.e-1)) - (is (instance? Double -1e-1)) - - (is (instance? Double +1.0)) - (is (instance? Double +1.)) - - (is (instance? Double 1.0)) - (is (instance? Double 1.)) - - (is (instance? Double +0.0)) - (is (instance? Double +0.)) - - (is (instance? Double 0.0)) - (is (instance? Double 0.)) - - (is (instance? Double -0.0)) - (is (instance? Double -0.)) - - (is (instance? Double -1.0)) - (is (instance? Double -1.)) - - ; Read BigDecimal - (is (instance? BigDecimal 9223372036854775808M)) - (is (instance? BigDecimal -9223372036854775809M)) - (is (instance? BigDecimal 2147483647M)) - (is (instance? BigDecimal +1M)) - (is (instance? BigDecimal 1M)) - (is (instance? BigDecimal +0M)) - (is (instance? BigDecimal 0M)) - (is (instance? BigDecimal -0M)) - (is (instance? BigDecimal -1M)) - (is (instance? BigDecimal -2147483648M)) - - (is (instance? BigDecimal +1.0e+1M)) - (is (instance? BigDecimal +1.e+1M)) - (is (instance? BigDecimal +1e+1M)) - - (is (instance? BigDecimal +1.0e1M)) - (is (instance? BigDecimal +1.e1M)) - (is (instance? BigDecimal +1e1M)) - - (is (instance? BigDecimal +1.0e-1M)) - (is (instance? BigDecimal +1.e-1M)) - (is (instance? BigDecimal +1e-1M)) - - (is (instance? BigDecimal 1.0e+1M)) - (is (instance? BigDecimal 1.e+1M)) - (is (instance? BigDecimal 1e+1M)) - - (is (instance? BigDecimal 1.0e1M)) - (is (instance? BigDecimal 1.e1M)) - (is (instance? BigDecimal 1e1M)) - - (is (instance? BigDecimal 1.0e-1M)) - (is (instance? BigDecimal 1.e-1M)) - (is (instance? BigDecimal 1e-1M)) - - (is (instance? BigDecimal -1.0e+1M)) - (is (instance? BigDecimal -1.e+1M)) - (is (instance? BigDecimal -1e+1M)) - - (is (instance? BigDecimal -1.0e1M)) - (is (instance? BigDecimal -1.e1M)) - (is (instance? BigDecimal -1e1M)) - - (is (instance? BigDecimal -1.0e-1M)) - (is (instance? BigDecimal -1.e-1M)) - (is (instance? BigDecimal -1e-1M)) - - (is (instance? BigDecimal +1.0M)) - (is (instance? BigDecimal +1.M)) - - (is (instance? BigDecimal 1.0M)) - (is (instance? BigDecimal 1.M)) - - (is (instance? BigDecimal +0.0M)) - (is (instance? BigDecimal +0.M)) - - (is (instance? BigDecimal 0.0M)) - (is (instance? BigDecimal 0.M)) - - (is (instance? BigDecimal -0.0M)) - (is (instance? BigDecimal -0.M)) - - (is (instance? BigDecimal -1.0M)) - (is (instance? BigDecimal -1.M)) -) - -;; Characters - -(deftest t-Characters) - -;; nil - -(deftest t-nil) - -;; Booleans - -(deftest t-Booleans) - -;; Keywords - -(deftest t-Keywords - (is (= :abc (keyword "abc"))) - (is (= :abc (keyword 'abc))) - (is (= :*+!-_? (keyword "*+!-_?"))) - (is (= :abc:def:ghi (keyword "abc:def:ghi"))) - (is (= :abc/def (keyword "abc" "def"))) - (is (= :abc/def (keyword 'abc/def))) - (is (= :abc.def/ghi (keyword "abc.def" "ghi"))) - (is (= :abc/def.ghi (keyword "abc" "def.ghi"))) - (is (= :abc:def/ghi:jkl.mno (keyword "abc:def" "ghi:jkl.mno"))) - (is (instance? clojure.lang.Keyword :alphabet)) - ) - -(deftest reading-keywords - (are [x y] (= x (read-string y)) - :foo ":foo" - :foo/bar ":foo/bar" - :user/foo "::foo") - (are [err msg form] (thrown-with-msg? err msg (read-string form)) - Exception #"Invalid token: foo:" "foo:" - Exception #"Invalid token: :bar/" ":bar/" - Exception #"Invalid token: ::does.not/exist" "::does.not/exist")) -;; Lists - -(deftest t-Lists) - -;; Vectors - -(deftest t-Vectors) - -;; Maps - -(deftest t-Maps) - -;; Sets - -(deftest t-Sets) - -;; Macro characters - -;; Quote (') - -(deftest t-Quote) - -;; Character (\) - -(deftest t-Character) - -;; Comment (;) - -(deftest t-Comment) - -;; Meta (^) - -(deftest t-Meta) - -;; Deref (@) - -(deftest t-Deref) - -;; Dispatch (#) - -;; #{} - see Sets above - -;; Regex patterns (#"pattern") - -(deftest t-Regex) - -;; Metadata (#^) - -(deftest t-Metadata) - -;; Var-quote (#') - -(deftest t-Var-quote) - -;; Anonymous function literal (#()) - -(deftest t-Anonymouns-function-literal) - -;; Syntax-quote (`, note, the "backquote" character), Unquote (~) and -;; Unquote-splicing (~@) - -(deftest t-Syntax-quote - (are [x y] (= x y) - `() () ; was NPE before SVN r1337 - )) - -;; (read) -;; (read stream) -;; (read stream eof-is-error) -;; (read stream eof-is-error eof-value) -;; (read stream eof-is-error eof-value is-recursive) - -(deftest t-read) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/refs.clj --- a/src/clojure/test_clojure/refs.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - - -(ns clojure.test-clojure.refs - (:use clojure.test)) - -; http://clojure.org/refs - -; ref -; deref, @-reader-macro -; dosync io! -; ensure ref-set alter commute -; set-validator get-validator - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/repl.clj --- a/src/clojure/test_clojure/repl.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,30 +0,0 @@ -(ns clojure.test-clojure.repl - (:use clojure.test - clojure.repl - clojure.test-clojure.repl.example)) - -(deftest test-source - (is (= "(defn foo [])" (source-fn 'clojure.test-clojure.repl.example/foo))) - (is (= "(defn foo [])\n" (with-out-str (source clojure.test-clojure.repl.example/foo)))) - (is (nil? (source-fn 'non-existent-fn)))) - -(deftest test-dir - (is (thrown? Exception (dir-fn 'non-existent-ns))) - (is (= '[bar foo] (dir-fn 'clojure.test-clojure.repl.example))) - (is (= "bar\nfoo\n" (with-out-str (dir clojure.test-clojure.repl.example))))) - -(deftest test-apropos - (testing "with a regular expression" - (is (= '[defmacro] (apropos #"^defmacro$"))) - (is (some #{'defmacro} (apropos #"def.acr."))) - (is (= [] (apropos #"nothing-has-this-name")))) - - (testing "with a string" - (is (some #{'defmacro} (apropos "defmacro"))) - (is (some #{'defmacro} (apropos "efmac"))) - (is (= [] (apropos "nothing-has-this-name")))) - - (testing "with a symbol" - (is (some #{'defmacro} (apropos 'defmacro))) - (is (some #{'defmacro} (apropos 'efmac))) - (is (= [] (apropos 'nothing-has-this-name))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/repl/example.clj --- a/src/clojure/test_clojure/repl/example.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -(ns clojure.test-clojure.repl.example) - -;; sample namespace for repl tests, don't add anything here -(defn foo []) -(defn bar []) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/rt.clj --- a/src/clojure/test_clojure/rt.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,111 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Stuart Halloway - -(ns clojure.test-clojure.rt - (:use clojure.test clojure.test-clojure.helpers)) - -(defmacro with-err-print-writer - "Evaluate with err pointing to a temporary PrintWriter, and - return err contents as a string." - [& body] - `(let [s# (java.io.StringWriter.) - p# (java.io.PrintWriter. s#)] - (binding [*err* p#] - ~@body - (str s#)))) - -(defmacro with-err-string-writer - "Evaluate with err pointing to a temporary StringWriter, and - return err contents as a string." - [& body] - `(let [s# (java.io.StringWriter.)] - (binding [*err* s#] - ~@body - (str s#)))) - -(defmacro should-print-err-message - "Turn on all warning flags, and test that error message prints - correctly for all semi-reasonable bindings of *err*." - [msg-re form] - `(binding [*warn-on-reflection* true] - (is (re-matches ~msg-re (with-err-string-writer (eval-in-temp-ns ~form)))) - (is (re-matches ~msg-re (with-err-print-writer (eval-in-temp-ns ~form)))))) - -(defn bare-rt-print - "Return string RT would print prior to print-initialize" - [x] - (with-out-str - (try - (push-thread-bindings {#'clojure.core/print-initialized false}) - (clojure.lang.RT/print x *out*) - (finally - (pop-thread-bindings))))) - -(deftest rt-print-prior-to-print-initialize - (testing "pattern literals" - (is (= "#\"foo\"" (bare-rt-print #"foo"))))) - -(deftest error-messages - (testing "binding a core var that already refers to something" - (should-print-err-message - #"WARNING: prefers already refers to: #'clojure.core/prefers in namespace: .*\r?\n" - (defn prefers [] (throw (RuntimeException. "rebound!"))))) - (testing "reflection cannot resolve field" - (should-print-err-message - #"Reflection warning, NO_SOURCE_PATH:\d+ - reference to field blah can't be resolved\.\r?\n" - (defn foo [x] (.blah x)))) - (testing "reflection cannot resolve instance method" - (should-print-err-message - #"Reflection warning, NO_SOURCE_PATH:\d+ - call to zap can't be resolved\.\r?\n" - (defn foo [x] (.zap x 1)))) - (testing "reflection cannot resolve static method" - (should-print-err-message - #"Reflection warning, NO_SOURCE_PATH:\d+ - call to valueOf can't be resolved\.\r?\n" - (defn foo [] (Integer/valueOf #"boom")))) - (testing "reflection cannot resolve constructor" - (should-print-err-message - #"Reflection warning, NO_SOURCE_PATH:\d+ - call to java.lang.String ctor can't be resolved\.\r?\n" - (defn foo [] (String. 1 2 3))))) - -(def example-var) -(deftest binding-root-clears-macro-metadata - (alter-meta! #'example-var assoc :macro true) - (is (contains? (meta #'example-var) :macro)) - (.bindRoot #'example-var 0) - (is (not (contains? (meta #'example-var) :macro)))) - -(deftest last-var-wins-for-core - (testing "you can replace a core name, with warning" - (let [ns (temp-ns) - replacement (gensym)] - (with-err-string-writer (intern ns 'prefers replacement)) - (is (= replacement @('prefers (ns-publics ns)))))) - (testing "you can replace a name you defined before" - (let [ns (temp-ns) - s (gensym) - v1 (intern ns 'foo s) - v2 (intern ns 'bar s)] - (with-err-string-writer (.refer ns 'flatten v1)) - (.refer ns 'flatten v2) - (is (= v2 (ns-resolve ns 'flatten))))) - (testing "you cannot intern over an existing non-core name" - (let [ns (temp-ns 'clojure.set) - replacement (gensym)] - (is (thrown? IllegalStateException - (intern ns 'subset? replacement))) - (is (nil? ('subset? (ns-publics ns)))) - (is (= #'clojure.set/subset? ('subset? (ns-refers ns)))))) - (testing "you cannot refer over an existing non-core name" - (let [ns (temp-ns 'clojure.set) - replacement (gensym)] - (is (thrown? IllegalStateException - (.refer ns 'subset? #'clojure.set/intersection))) - (is (nil? ('subset? (ns-publics ns)))) - (is (= #'clojure.set/subset? ('subset? (ns-refers ns))))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/sequences.clj --- a/src/clojure/test_clojure/sequences.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1162 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka -; Contributors: Stuart Halloway - -(ns clojure.test-clojure.sequences - (:use clojure.test)) - -;; *** Tests *** - -; TODO: -; apply, map, filter, remove -; and more... - -(deftest test-reduce-from-chunked-into-unchunked - (= [1 2 \a \b] (into [] (concat [1 2] "ab")))) - -(deftest test-reduce - (let [int+ (fn [a b] (+ (int a) (int b))) - arange (range 100) ;; enough to cross nodes - avec (into [] arange) - alist (into () arange) - obj-array (into-array arange) - int-array (into-array Integer/TYPE arange) - long-array (into-array Long/TYPE arange) - float-array (into-array Float/TYPE arange) - char-array (into-array Character/TYPE (map char arange)) - double-array (into-array Double/TYPE arange) - byte-array (into-array Byte/TYPE (map byte arange)) - int-vec (into (vector-of :int) arange) - long-vec (into (vector-of :long) arange) - float-vec (into (vector-of :float) arange) - char-vec (into (vector-of :char) (map char arange)) - double-vec (into (vector-of :double) arange) - byte-vec (into (vector-of :byte) (map byte arange)) - all-true (into-array Boolean/TYPE (repeat 10 true))] - (is (= 4950 - (reduce + arange) - (reduce + avec) - (reduce + alist) - (reduce + obj-array) - (reduce + int-array) - (reduce + long-array) - (reduce + float-array) - (reduce int+ char-array) - (reduce + double-array) - (reduce int+ byte-array) - (reduce + int-vec) - (reduce + long-vec) - (reduce + float-vec) - (reduce int+ char-vec) - (reduce + double-vec) - (reduce int+ byte-vec))) - (is (= 4951 - (reduce + 1 arange) - (reduce + 1 avec) - (reduce + 1 alist) - (reduce + 1 obj-array) - (reduce + 1 int-array) - (reduce + 1 long-array) - (reduce + 1 float-array) - (reduce int+ 1 char-array) - (reduce + 1 double-array) - (reduce int+ 1 byte-array) - (reduce + 1 int-vec) - (reduce + 1 long-vec) - (reduce + 1 float-vec) - (reduce int+ 1 char-vec) - (reduce + 1 double-vec) - (reduce int+ 1 byte-vec))) - (is (= true - (reduce #(and %1 %2) all-true) - (reduce #(and %1 %2) true all-true))))) - -(deftest test-equality - ; lazy sequences - (are [x y] (= x y) - ; fixed SVN 1288 - LazySeq and EmptyList equals/equiv - ; http://groups.google.com/group/clojure/browse_frm/thread/286d807be9cae2a5# - (map inc nil) () - (map inc ()) () - (map inc []) () - (map inc #{}) () - (map inc {}) () )) - - -(deftest test-lazy-seq - (are [x] (seq? x) - (lazy-seq nil) - (lazy-seq []) - (lazy-seq [1 2])) - - (are [x y] (= x y) - (lazy-seq nil) () - (lazy-seq [nil]) '(nil) - - (lazy-seq ()) () - (lazy-seq []) () - (lazy-seq #{}) () - (lazy-seq {}) () - (lazy-seq "") () - (lazy-seq (into-array [])) () - - (lazy-seq (list 1 2)) '(1 2) - (lazy-seq [1 2]) '(1 2) - (lazy-seq (sorted-set 1 2)) '(1 2) - (lazy-seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2]) - (lazy-seq "abc") '(\a \b \c) - (lazy-seq (into-array [1 2])) '(1 2) )) - - -(deftest test-seq - (is (not (seq? (seq [])))) - (is (seq? (seq [1 2]))) - - (are [x y] (= x y) - (seq nil) nil - (seq [nil]) '(nil) - - (seq ()) nil - (seq []) nil - (seq #{}) nil - (seq {}) nil - (seq "") nil - (seq (into-array [])) nil - - (seq (list 1 2)) '(1 2) - (seq [1 2]) '(1 2) - (seq (sorted-set 1 2)) '(1 2) - (seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2]) - (seq "abc") '(\a \b \c) - (seq (into-array [1 2])) '(1 2) )) - - -(deftest test-cons - (is (thrown? IllegalArgumentException (cons 1 2))) - (are [x y] (= x y) - (cons 1 nil) '(1) - (cons nil nil) '(nil) - - (cons \a nil) '(\a) - (cons \a "") '(\a) - (cons \a "bc") '(\a \b \c) - - (cons 1 ()) '(1) - (cons 1 '(2 3)) '(1 2 3) - - (cons 1 []) [1] - (cons 1 [2 3]) [1 2 3] - - (cons 1 #{}) '(1) - (cons 1 (sorted-set 2 3)) '(1 2 3) - - (cons 1 (into-array [])) '(1) - (cons 1 (into-array [2 3])) '(1 2 3) )) - - -(deftest test-empty - (are [x y] (and (= (empty x) y) - (= (class (empty x)) (class y))) - nil nil - - () () - '(1 2) () - - [] [] - [1 2] [] - - {} {} - {:a 1 :b 2} {} - - (sorted-map) (sorted-map) - (sorted-map :a 1 :b 2) (sorted-map) - - #{} #{} - #{1 2} #{} - - (sorted-set) (sorted-set) - (sorted-set 1 2) (sorted-set) - - (seq ()) nil ; (seq ()) => nil - (seq '(1 2)) () - - (seq []) nil ; (seq []) => nil - (seq [1 2]) () - - (seq "") nil ; (seq "") => nil - (seq "ab") () - - (lazy-seq ()) () - (lazy-seq '(1 2)) () - - (lazy-seq []) () - (lazy-seq [1 2]) () - - ; non-coll, non-seq => nil - 42 nil - 1.2 nil - "abc" nil )) - -;Tests that the comparator is preservered -;The first element should be the same in each set if preserved. -(deftest test-empty-sorted - (let [inv-compare (comp - compare)] - (are [x y] (= (first (into (empty x) x)) - (first y)) - (sorted-set 1 2 3) (sorted-set 1 2 3) - (sorted-set-by inv-compare 1 2 3) (sorted-set-by inv-compare 1 2 3) - - (sorted-map 1 :a 2 :b 3 :c) (sorted-map 1 :a 2 :b 3 :c) - (sorted-map-by inv-compare 1 :a 2 :b 3 :c) (sorted-map-by inv-compare 1 :a 2 :b 3 :c)))) - - -(deftest test-not-empty - ; empty coll/seq => nil - (are [x] (= (not-empty x) nil) - () - [] - {} - #{} - (seq ()) - (seq []) - (lazy-seq ()) - (lazy-seq []) ) - - ; non-empty coll/seq => identity - (are [x] (and (= (not-empty x) x) - (= (class (not-empty x)) (class x))) - '(1 2) - [1 2] - {:a 1} - #{1 2} - (seq '(1 2)) - (seq [1 2]) - (lazy-seq '(1 2)) - (lazy-seq [1 2]) )) - - -(deftest test-first - (is (thrown? IllegalArgumentException (first))) - (is (thrown? IllegalArgumentException (first true))) - (is (thrown? IllegalArgumentException (first false))) - (is (thrown? IllegalArgumentException (first 1))) - (is (thrown? IllegalArgumentException (first 1 2))) - (is (thrown? IllegalArgumentException (first \a))) - (is (thrown? IllegalArgumentException (first 's))) - (is (thrown? IllegalArgumentException (first :k))) - (are [x y] (= x y) - (first nil) nil - - ; string - (first "") nil - (first "a") \a - (first "abc") \a - - ; list - (first ()) nil - (first '(1)) 1 - (first '(1 2 3)) 1 - - (first '(nil)) nil - (first '(1 nil)) 1 - (first '(nil 2)) nil - (first '(())) () - (first '(() nil)) () - (first '(() 2 nil)) () - - ; vector - (first []) nil - (first [1]) 1 - (first [1 2 3]) 1 - - (first [nil]) nil - (first [1 nil]) 1 - (first [nil 2]) nil - (first [[]]) [] - (first [[] nil]) [] - (first [[] 2 nil]) [] - - ; set - (first #{}) nil - (first #{1}) 1 - (first (sorted-set 1 2 3)) 1 - - (first #{nil}) nil - (first (sorted-set 1 nil)) nil - (first (sorted-set nil 2)) nil - (first #{#{}}) #{} - (first (sorted-set #{} nil)) nil - ;(first (sorted-set #{} 2 nil)) nil - - ; map - (first {}) nil - (first (sorted-map :a 1)) '(:a 1) - (first (sorted-map :a 1 :b 2 :c 3)) '(:a 1) - - ; array - (first (into-array [])) nil - (first (into-array [1])) 1 - (first (into-array [1 2 3])) 1 - (first (to-array [nil])) nil - (first (to-array [1 nil])) 1 - (first (to-array [nil 2])) nil )) - - -(deftest test-next - (is (thrown? IllegalArgumentException (next))) - (is (thrown? IllegalArgumentException (next true))) - (is (thrown? IllegalArgumentException (next false))) - (is (thrown? IllegalArgumentException (next 1))) - (is (thrown? IllegalArgumentException (next 1 2))) - (is (thrown? IllegalArgumentException (next \a))) - (is (thrown? IllegalArgumentException (next 's))) - (is (thrown? IllegalArgumentException (next :k))) - (are [x y] (= x y) - (next nil) nil - - ; string - (next "") nil - (next "a") nil - (next "abc") '(\b \c) - - ; list - (next ()) nil - (next '(1)) nil - (next '(1 2 3)) '(2 3) - - (next '(nil)) nil - (next '(1 nil)) '(nil) - (next '(1 ())) '(()) - (next '(nil 2)) '(2) - (next '(())) nil - (next '(() nil)) '(nil) - (next '(() 2 nil)) '(2 nil) - - ; vector - (next []) nil - (next [1]) nil - (next [1 2 3]) [2 3] - - (next [nil]) nil - (next [1 nil]) [nil] - (next [1 []]) [[]] - (next [nil 2]) [2] - (next [[]]) nil - (next [[] nil]) [nil] - (next [[] 2 nil]) [2 nil] - - ; set - (next #{}) nil - (next #{1}) nil - (next (sorted-set 1 2 3)) '(2 3) - - (next #{nil}) nil - (next (sorted-set 1 nil)) '(1) - (next (sorted-set nil 2)) '(2) - (next #{#{}}) nil - (next (sorted-set #{} nil)) '(#{}) - ;(next (sorted-set #{} 2 nil)) #{} - - ; map - (next {}) nil - (next (sorted-map :a 1)) nil - (next (sorted-map :a 1 :b 2 :c 3)) '((:b 2) (:c 3)) - - ; array - (next (into-array [])) nil - (next (into-array [1])) nil - (next (into-array [1 2 3])) '(2 3) - - (next (to-array [nil])) nil - (next (to-array [1 nil])) '(nil) - ;(next (to-array [1 (into-array [])])) (list (into-array [])) - (next (to-array [nil 2])) '(2) - (next (to-array [(into-array [])])) nil - (next (to-array [(into-array []) nil])) '(nil) - (next (to-array [(into-array []) 2 nil])) '(2 nil) )) - - -(deftest test-last - (are [x y] (= x y) - (last nil) nil - - ; list - (last ()) nil - (last '(1)) 1 - (last '(1 2 3)) 3 - - (last '(nil)) nil - (last '(1 nil)) nil - (last '(nil 2)) 2 - (last '(())) () - (last '(() nil)) nil - (last '(() 2 nil)) nil - - ; vector - (last []) nil - (last [1]) 1 - (last [1 2 3]) 3 - - (last [nil]) nil - (last [1 nil]) nil - (last [nil 2]) 2 - (last [[]]) [] - (last [[] nil]) nil - (last [[] 2 nil]) nil - - ; set - (last #{}) nil - (last #{1}) 1 - (last (sorted-set 1 2 3)) 3 - - (last #{nil}) nil - (last (sorted-set 1 nil)) 1 - (last (sorted-set nil 2)) 2 - (last #{#{}}) #{} - (last (sorted-set #{} nil)) #{} - ;(last (sorted-set #{} 2 nil)) nil - - ; map - (last {}) nil - (last (sorted-map :a 1)) [:a 1] - (last (sorted-map :a 1 :b 2 :c 3)) [:c 3] - - ; string - (last "") nil - (last "a") \a - (last "abc") \c - - ; array - (last (into-array [])) nil - (last (into-array [1])) 1 - (last (into-array [1 2 3])) 3 - (last (to-array [nil])) nil - (last (to-array [1 nil])) nil - (last (to-array [nil 2])) 2 )) - - -;; (ffirst coll) = (first (first coll)) -;; -(deftest test-ffirst - (is (thrown? IllegalArgumentException (ffirst))) - (are [x y] (= x y) - (ffirst nil) nil - - (ffirst ()) nil - (ffirst '((1 2) (3 4))) 1 - - (ffirst []) nil - (ffirst [[1 2] [3 4]]) 1 - - (ffirst {}) nil - (ffirst {:a 1}) :a - - (ffirst #{}) nil - (ffirst #{[1 2]}) 1 )) - - -;; (fnext coll) = (first (next coll)) = (second coll) -;; -(deftest test-fnext - (is (thrown? IllegalArgumentException (fnext))) - (are [x y] (= x y) - (fnext nil) nil - - (fnext ()) nil - (fnext '(1)) nil - (fnext '(1 2 3 4)) 2 - - (fnext []) nil - (fnext [1]) nil - (fnext [1 2 3 4]) 2 - - (fnext {}) nil - (fnext (sorted-map :a 1)) nil - (fnext (sorted-map :a 1 :b 2)) [:b 2] - - (fnext #{}) nil - (fnext #{1}) nil - (fnext (sorted-set 1 2 3 4)) 2 )) - - -;; (nfirst coll) = (next (first coll)) -;; -(deftest test-nfirst - (is (thrown? IllegalArgumentException (nfirst))) - (are [x y] (= x y) - (nfirst nil) nil - - (nfirst ()) nil - (nfirst '((1 2 3) (4 5 6))) '(2 3) - - (nfirst []) nil - (nfirst [[1 2 3] [4 5 6]]) '(2 3) - - (nfirst {}) nil - (nfirst {:a 1}) '(1) - - (nfirst #{}) nil - (nfirst #{[1 2]}) '(2) )) - - -;; (nnext coll) = (next (next coll)) -;; -(deftest test-nnext - (is (thrown? IllegalArgumentException (nnext))) - (are [x y] (= x y) - (nnext nil) nil - - (nnext ()) nil - (nnext '(1)) nil - (nnext '(1 2)) nil - (nnext '(1 2 3 4)) '(3 4) - - (nnext []) nil - (nnext [1]) nil - (nnext [1 2]) nil - (nnext [1 2 3 4]) '(3 4) - - (nnext {}) nil - (nnext (sorted-map :a 1)) nil - (nnext (sorted-map :a 1 :b 2)) nil - (nnext (sorted-map :a 1 :b 2 :c 3 :d 4)) '([:c 3] [:d 4]) - - (nnext #{}) nil - (nnext #{1}) nil - (nnext (sorted-set 1 2)) nil - (nnext (sorted-set 1 2 3 4)) '(3 4) )) - - -(deftest test-nth - ; maps, sets are not supported - (is (thrown? UnsupportedOperationException (nth {} 0))) - (is (thrown? UnsupportedOperationException (nth {:a 1 :b 2} 0))) - (is (thrown? UnsupportedOperationException (nth #{} 0))) - (is (thrown? UnsupportedOperationException (nth #{1 2 3} 0))) - - ; out of bounds - (is (thrown? IndexOutOfBoundsException (nth '() 0))) - (is (thrown? IndexOutOfBoundsException (nth '(1 2 3) 5))) - (is (thrown? IndexOutOfBoundsException (nth '() -1))) - (is (thrown? IndexOutOfBoundsException (nth '(1 2 3) -1))) - - (is (thrown? IndexOutOfBoundsException (nth [] 0))) - (is (thrown? IndexOutOfBoundsException (nth [1 2 3] 5))) - (is (thrown? IndexOutOfBoundsException (nth [] -1))) - (is (thrown? IndexOutOfBoundsException (nth [1 2 3] -1))) ; ??? - - (is (thrown? IndexOutOfBoundsException (nth (into-array []) 0))) - (is (thrown? IndexOutOfBoundsException (nth (into-array [1 2 3]) 5))) - (is (thrown? IndexOutOfBoundsException (nth (into-array []) -1))) - (is (thrown? IndexOutOfBoundsException (nth (into-array [1 2 3]) -1))) - - (is (thrown? StringIndexOutOfBoundsException (nth "" 0))) - (is (thrown? StringIndexOutOfBoundsException (nth "abc" 5))) - (is (thrown? StringIndexOutOfBoundsException (nth "" -1))) - (is (thrown? StringIndexOutOfBoundsException (nth "abc" -1))) - - (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) 0))) - (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) 5))) - (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) -1))) ; ??? - (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) -1))) ; ??? - - (are [x y] (= x y) - (nth '(1) 0) 1 - (nth '(1 2 3) 0) 1 - (nth '(1 2 3 4 5) 1) 2 - (nth '(1 2 3 4 5) 4) 5 - (nth '(1 2 3) 5 :not-found) :not-found - - (nth [1] 0) 1 - (nth [1 2 3] 0) 1 - (nth [1 2 3 4 5] 1) 2 - (nth [1 2 3 4 5] 4) 5 - (nth [1 2 3] 5 :not-found) :not-found - - (nth (into-array [1]) 0) 1 - (nth (into-array [1 2 3]) 0) 1 - (nth (into-array [1 2 3 4 5]) 1) 2 - (nth (into-array [1 2 3 4 5]) 4) 5 - (nth (into-array [1 2 3]) 5 :not-found) :not-found - - (nth "a" 0) \a - (nth "abc" 0) \a - (nth "abcde" 1) \b - (nth "abcde" 4) \e - (nth "abc" 5 :not-found) :not-found - - (nth (java.util.ArrayList. [1]) 0) 1 - (nth (java.util.ArrayList. [1 2 3]) 0) 1 - (nth (java.util.ArrayList. [1 2 3 4 5]) 1) 2 - (nth (java.util.ArrayList. [1 2 3 4 5]) 4) 5 - (nth (java.util.ArrayList. [1 2 3]) 5 :not-found) :not-found ) - - ; regex Matchers - (let [m (re-matcher #"(a)(b)" "ababaa")] - (re-find m) ; => ["ab" "a" "b"] - (are [x y] (= x y) - (nth m 0) "ab" - (nth m 1) "a" - (nth m 2) "b" - (nth m 3 :not-found) :not-found - (nth m -1 :not-found) :not-found ) - (is (thrown? IndexOutOfBoundsException (nth m 3))) - (is (thrown? IndexOutOfBoundsException (nth m -1)))) - - (let [m (re-matcher #"c" "ababaa")] - (re-find m) ; => nil - (are [x y] (= x y) - (nth m 0 :not-found) :not-found - (nth m 2 :not-found) :not-found - (nth m -1 :not-found) :not-found ) - (is (thrown? IllegalStateException (nth m 0))) - (is (thrown? IllegalStateException (nth m 2))) - (is (thrown? IllegalStateException (nth m -1))))) - - -; distinct was broken for nil & false: -; fixed in rev 1278: -; http://code.google.com/p/clojure/source/detail?r=1278 -; -(deftest test-distinct - (are [x y] (= x y) - (distinct ()) () - (distinct '(1)) '(1) - (distinct '(1 2 3)) '(1 2 3) - (distinct '(1 2 3 1 1 1)) '(1 2 3) - (distinct '(1 1 1 2)) '(1 2) - (distinct '(1 2 1 2)) '(1 2) - - (distinct []) () - (distinct [1]) '(1) - (distinct [1 2 3]) '(1 2 3) - (distinct [1 2 3 1 2 2 1 1]) '(1 2 3) - (distinct [1 1 1 2]) '(1 2) - (distinct [1 2 1 2]) '(1 2) - - (distinct "") () - (distinct "a") '(\a) - (distinct "abc") '(\a \b \c) - (distinct "abcabab") '(\a \b \c) - (distinct "aaab") '(\a \b) - (distinct "abab") '(\a \b) ) - - (are [x] (= (distinct [x x]) [x]) - nil - false true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - () '(1 2) - [] [1 2] - {} {:a 1 :b 2} - #{} #{1 2} )) - - -(deftest test-interpose - (are [x y] (= x y) - (interpose 0 []) () - (interpose 0 [1]) '(1) - (interpose 0 [1 2]) '(1 0 2) - (interpose 0 [1 2 3]) '(1 0 2 0 3) )) - - -(deftest test-interleave - (are [x y] (= x y) - (interleave [1 2] [3 4]) '(1 3 2 4) - - (interleave [1] [3 4]) '(1 3) - (interleave [1 2] [3]) '(1 3) - - (interleave [] [3 4]) () - (interleave [1 2] []) () - (interleave [] []) () )) - - -(deftest test-zipmap - (are [x y] (= x y) - (zipmap [:a :b] [1 2]) {:a 1 :b 2} - - (zipmap [:a] [1 2]) {:a 1} - (zipmap [:a :b] [1]) {:a 1} - - (zipmap [] [1 2]) {} - (zipmap [:a :b] []) {} - (zipmap [] []) {} )) - - -(deftest test-concat - (are [x y] (= x y) - (concat) () - - (concat []) () - (concat [1 2]) '(1 2) - - (concat [1 2] [3 4]) '(1 2 3 4) - (concat [] [3 4]) '(3 4) - (concat [1 2] []) '(1 2) - (concat [] []) () - - (concat [1 2] [3 4] [5 6]) '(1 2 3 4 5 6) )) - - -(deftest test-cycle - (are [x y] (= x y) - (cycle []) () - - (take 3 (cycle [1])) '(1 1 1) - (take 5 (cycle [1 2 3])) '(1 2 3 1 2) - - (take 3 (cycle [nil])) '(nil nil nil) )) - - -(deftest test-partition - (are [x y] (= x y) - (partition 2 [1 2 3]) '((1 2)) - (partition 2 [1 2 3 4]) '((1 2) (3 4)) - (partition 2 []) () - - (partition 2 3 [1 2 3 4 5 6 7]) '((1 2) (4 5)) - (partition 2 3 [1 2 3 4 5 6 7 8]) '((1 2) (4 5) (7 8)) - (partition 2 3 []) () - - (partition 1 []) () - (partition 1 [1 2 3]) '((1) (2) (3)) - - (partition 5 [1 2 3]) () - -; (partition 0 [1 2 3]) (repeat nil) ; infinite sequence of nil - (partition -1 [1 2 3]) () - (partition -2 [1 2 3]) () )) - - -(deftest test-reverse - (are [x y] (= x y) - (reverse nil) () ; since SVN 1294 - (reverse []) () - (reverse [1]) '(1) - (reverse [1 2 3]) '(3 2 1) )) - - -(deftest test-take - (are [x y] (= x y) - (take 1 [1 2 3 4 5]) '(1) - (take 3 [1 2 3 4 5]) '(1 2 3) - (take 5 [1 2 3 4 5]) '(1 2 3 4 5) - (take 9 [1 2 3 4 5]) '(1 2 3 4 5) - - (take 0 [1 2 3 4 5]) () - (take -1 [1 2 3 4 5]) () - (take -2 [1 2 3 4 5]) () )) - - -(deftest test-drop - (are [x y] (= x y) - (drop 1 [1 2 3 4 5]) '(2 3 4 5) - (drop 3 [1 2 3 4 5]) '(4 5) - (drop 5 [1 2 3 4 5]) () - (drop 9 [1 2 3 4 5]) () - - (drop 0 [1 2 3 4 5]) '(1 2 3 4 5) - (drop -1 [1 2 3 4 5]) '(1 2 3 4 5) - (drop -2 [1 2 3 4 5]) '(1 2 3 4 5) )) - - -(deftest test-take-nth - (are [x y] (= x y) - (take-nth 1 [1 2 3 4 5]) '(1 2 3 4 5) - (take-nth 2 [1 2 3 4 5]) '(1 3 5) - (take-nth 3 [1 2 3 4 5]) '(1 4) - (take-nth 4 [1 2 3 4 5]) '(1 5) - (take-nth 5 [1 2 3 4 5]) '(1) - (take-nth 9 [1 2 3 4 5]) '(1) - - ; infinite seq of 1s = (repeat 1) - ;(take-nth 0 [1 2 3 4 5]) - ;(take-nth -1 [1 2 3 4 5]) - ;(take-nth -2 [1 2 3 4 5]) - )) - - -(deftest test-take-while - (are [x y] (= x y) - (take-while pos? []) () - (take-while pos? [1 2 3 4]) '(1 2 3 4) - (take-while pos? [1 2 3 -1]) '(1 2 3) - (take-while pos? [1 -1 2 3]) '(1) - (take-while pos? [-1 1 2 3]) () - (take-while pos? [-1 -2 -3]) () )) - - -(deftest test-drop-while - (are [x y] (= x y) - (drop-while pos? []) () - (drop-while pos? [1 2 3 4]) () - (drop-while pos? [1 2 3 -1]) '(-1) - (drop-while pos? [1 -1 2 3]) '(-1 2 3) - (drop-while pos? [-1 1 2 3]) '(-1 1 2 3) - (drop-while pos? [-1 -2 -3]) '(-1 -2 -3) )) - - -(deftest test-butlast - (are [x y] (= x y) - (butlast []) nil - (butlast [1]) nil - (butlast [1 2 3]) '(1 2) )) - - -(deftest test-drop-last - (are [x y] (= x y) - ; as butlast - (drop-last []) () - (drop-last [1]) () - (drop-last [1 2 3]) '(1 2) - - ; as butlast, but lazy - (drop-last 1 []) () - (drop-last 1 [1]) () - (drop-last 1 [1 2 3]) '(1 2) - - (drop-last 2 []) () - (drop-last 2 [1]) () - (drop-last 2 [1 2 3]) '(1) - - (drop-last 5 []) () - (drop-last 5 [1]) () - (drop-last 5 [1 2 3]) () - - (drop-last 0 []) () - (drop-last 0 [1]) '(1) - (drop-last 0 [1 2 3]) '(1 2 3) - - (drop-last -1 []) () - (drop-last -1 [1]) '(1) - (drop-last -1 [1 2 3]) '(1 2 3) - - (drop-last -2 []) () - (drop-last -2 [1]) '(1) - (drop-last -2 [1 2 3]) '(1 2 3) )) - - -(deftest test-split-at - (is (vector? (split-at 2 []))) - (is (vector? (split-at 2 [1 2 3]))) - - (are [x y] (= x y) - (split-at 2 []) [() ()] - (split-at 2 [1 2 3 4 5]) [(list 1 2) (list 3 4 5)] - - (split-at 5 [1 2 3]) [(list 1 2 3) ()] - (split-at 0 [1 2 3]) [() (list 1 2 3)] - (split-at -1 [1 2 3]) [() (list 1 2 3)] - (split-at -5 [1 2 3]) [() (list 1 2 3)] )) - - -(deftest test-split-with - (is (vector? (split-with pos? []))) - (is (vector? (split-with pos? [1 2 -1 0 3 4]))) - - (are [x y] (= x y) - (split-with pos? []) [() ()] - (split-with pos? [1 2 -1 0 3 4]) [(list 1 2) (list -1 0 3 4)] - - (split-with pos? [-1 2 3 4 5]) [() (list -1 2 3 4 5)] - (split-with number? [1 -2 "abc" \x]) [(list 1 -2) (list "abc" \x)] )) - - -(deftest test-repeat - (is (thrown? IllegalArgumentException (repeat))) - - ; infinite sequence => use take - (are [x y] (= x y) - (take 0 (repeat 7)) () - (take 1 (repeat 7)) '(7) - (take 2 (repeat 7)) '(7 7) - (take 5 (repeat 7)) '(7 7 7 7 7) ) - - ; limited sequence - (are [x y] (= x y) - (repeat 0 7) () - (repeat 1 7) '(7) - (repeat 2 7) '(7 7) - (repeat 5 7) '(7 7 7 7 7) - - (repeat -1 7) () - (repeat -3 7) () ) - - ; test different data types - (are [x] (= (repeat 3 x) (list x x x)) - nil - false true - 0 42 - 0.0 3.14 - 2/3 - 0M 1M - \c - "" "abc" - 'sym - :kw - () '(1 2) - [] [1 2] - {} {:a 1 :b 2} - #{} #{1 2} )) - - -(deftest test-range - (are [x y] (= x y) - (range 0) () ; exclusive end! - (range 1) '(0) - (range 5) '(0 1 2 3 4) - - (range -1) () - (range -3) () - - (range 2.5) '(0 1 2) - (range 7/3) '(0 1 2) - - (range 0 3) '(0 1 2) - (range 0 1) '(0) - (range 0 0) () - (range 0 -3) () - - (range 3 6) '(3 4 5) - (range 3 4) '(3) - (range 3 3) () - (range 3 1) () - (range 3 0) () - (range 3 -2) () - - (range -2 5) '(-2 -1 0 1 2 3 4) - (range -2 0) '(-2 -1) - (range -2 -1) '(-2) - (range -2 -2) () - (range -2 -5) () - - (range 3 9 0) () - (range 3 9 1) '(3 4 5 6 7 8) - (range 3 9 2) '(3 5 7) - (range 3 9 3) '(3 6) - (range 3 9 10) '(3) - (range 3 9 -1) () )) - - -(deftest test-empty? - (are [x] (empty? x) - nil - () - (lazy-seq nil) ; => () - [] - {} - #{} - "" - (into-array []) ) - - (are [x] (not (empty? x)) - '(1 2) - (lazy-seq [1 2]) - [1 2] - {:a 1 :b 2} - #{1 2} - "abc" - (into-array [1 2]) )) - - -(deftest test-every? - ; always true for nil or empty coll/seq - (are [x] (= (every? pos? x) true) - nil - () [] {} #{} - (lazy-seq []) - (into-array []) ) - - (are [x y] (= x y) - true (every? pos? [1]) - true (every? pos? [1 2]) - true (every? pos? [1 2 3 4 5]) - - false (every? pos? [-1]) - false (every? pos? [-1 -2]) - false (every? pos? [-1 -2 3]) - false (every? pos? [-1 2]) - false (every? pos? [1 -2]) - false (every? pos? [1 2 -3]) - false (every? pos? [1 2 -3 4]) ) - - (are [x y] (= x y) - true (every? #{:a} [:a :a]) -;! false (every? #{:a} [:a :b]) ; Issue 68: every? returns nil instead of false -;! false (every? #{:a} [:b :b]) ; http://code.google.com/p/clojure/issues/detail?id=68 - )) - - -(deftest test-not-every? - ; always false for nil or empty coll/seq - (are [x] (= (not-every? pos? x) false) - nil - () [] {} #{} - (lazy-seq []) - (into-array []) ) - - (are [x y] (= x y) - false (not-every? pos? [1]) - false (not-every? pos? [1 2]) - false (not-every? pos? [1 2 3 4 5]) - - true (not-every? pos? [-1]) - true (not-every? pos? [-1 -2]) - true (not-every? pos? [-1 -2 3]) - true (not-every? pos? [-1 2]) - true (not-every? pos? [1 -2]) - true (not-every? pos? [1 2 -3]) - true (not-every? pos? [1 2 -3 4]) ) - - (are [x y] (= x y) - false (not-every? #{:a} [:a :a]) - true (not-every? #{:a} [:a :b]) - true (not-every? #{:a} [:b :b]) )) - - -(deftest test-not-any? - ; always true for nil or empty coll/seq - (are [x] (= (not-any? pos? x) true) - nil - () [] {} #{} - (lazy-seq []) - (into-array []) ) - - (are [x y] (= x y) - false (not-any? pos? [1]) - false (not-any? pos? [1 2]) - false (not-any? pos? [1 2 3 4 5]) - - true (not-any? pos? [-1]) - true (not-any? pos? [-1 -2]) - - false (not-any? pos? [-1 -2 3]) - false (not-any? pos? [-1 2]) - false (not-any? pos? [1 -2]) - false (not-any? pos? [1 2 -3]) - false (not-any? pos? [1 2 -3 4]) ) - - (are [x y] (= x y) - false (not-any? #{:a} [:a :a]) - false (not-any? #{:a} [:a :b]) - true (not-any? #{:a} [:b :b]) )) - - -(deftest test-some - ;; always nil for nil or empty coll/seq - (are [x] (= (some pos? x) nil) - nil - () [] {} #{} - (lazy-seq []) - (into-array [])) - - (are [x y] (= x y) - nil (some nil nil) - - true (some pos? [1]) - true (some pos? [1 2]) - - nil (some pos? [-1]) - nil (some pos? [-1 -2]) - true (some pos? [-1 2]) - true (some pos? [1 -2]) - - :a (some #{:a} [:a :a]) - :a (some #{:a} [:b :a]) - nil (some #{:a} [:b :b]) - - :a (some #{:a} '(:a :b)) - :a (some #{:a} #{:a :b}) - )) - -(deftest test-flatten-present - (are [expected nested-val] (= (flatten nested-val) expected) - ;simple literals - [] nil - [] 1 - [] 'test - [] :keyword - [] 1/2 - [] #"[\r\n]" - [] true - [] false - ;vectors - [1 2 3 4 5] [[1 2] [3 4 [5]]] - [1 2 3 4 5] [1 2 3 4 5] - [#{1 2} 3 4 5] [#{1 2} 3 4 5] - ;sets - [] #{} - [] #{#{1 2} 3 4 5} - [] #{1 2 3 4 5} - [] #{#{1 2} 3 4 5} - ;lists - [] '() - [1 2 3 4 5] `(1 2 3 4 5) - ;maps - [] {:a 1 :b 2} - [:a 1 :b 2] (seq {:a 1 :b 2}) - [] {[:a :b] 1 :c 2} - [:a :b 1 :c 2] (seq {[:a :b] 1 :c 2}) - [:a 1 2 :b 3] (seq {:a [1 2] :b 3}) - ;Strings - [] "12345" - [\1 \2 \3 \4 \5] (seq "12345") - ;fns - [] count - [count even? odd?] [count even? odd?])) - -(deftest test-group-by - (is (= (group-by even? [1 2 3 4 5]) - {false [1 3 5], true [2 4]}))) - -(deftest test-partition-by - (are [test-seq] (= (partition-by (comp even? count) test-seq) - [["a"] ["bb" "cccc" "dd"] ["eee" "f"] ["" "hh"]]) - ["a" "bb" "cccc" "dd" "eee" "f" "" "hh"] - '("a" "bb" "cccc" "dd" "eee" "f" "" "hh")) - (is (=(partition-by #{\a \e \i \o \u} "abcdefghijklm") - [[\a] [\b \c \d] [\e] [\f \g \h] [\i] [\j \k \l \m]]))) - -(deftest test-frequencies - (are [expected test-seq] (= (frequencies test-seq) expected) - {\p 2, \s 4, \i 4, \m 1} "mississippi" - {1 4 2 2 3 1} [1 1 1 1 2 2 3] - {1 4 2 2 3 1} '(1 1 1 1 2 2 3))) - -(deftest test-reductions - (is (= (reductions + nil) - [0])) - (is (= (reductions + [1 2 3 4 5]) - [1 3 6 10 15])) - (is (= (reductions + 10 [1 2 3 4 5]) - [10 11 13 16 20 25]))) - -(deftest test-rand-nth-invariants - (let [elt (rand-nth [:a :b :c :d])] - (is (#{:a :b :c :d} elt)))) - -(deftest test-partition-all - (is (= (partition-all 4 [1 2 3 4 5 6 7 8 9]) - [[1 2 3 4] [5 6 7 8] [9]])) - (is (= (partition-all 4 2 [1 2 3 4 5 6 7 8 9]) - [[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]]))) - -(deftest test-shuffle-invariants - (is (= (count (shuffle [1 2 3 4])) 4)) - (let [shuffled-seq (shuffle [1 2 3 4])] - (is (every? #{1 2 3 4} shuffled-seq)))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/serialization.clj --- a/src/clojure/test_clojure/serialization.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,158 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;; Author: Chas Emerick -;; cemerick@snowtide.com - -(ns clojure.test-clojure.serialization - (:use clojure.test) - (:import (java.io ObjectOutputStream ObjectInputStream - ByteArrayOutputStream ByteArrayInputStream))) - -(defn- serialize - "Serializes a single object, returning a byte array." - [v] - (with-open [bout (ByteArrayOutputStream.) - oos (ObjectOutputStream. bout)] - (.writeObject oos v) - (.flush oos) - (.toByteArray bout))) - -(defn- deserialize - "Deserializes and returns a single object from the given byte array." - [bytes] - (with-open [ois (-> bytes ByteArrayInputStream. ObjectInputStream.)] - (.readObject ois))) - -(defrecord SerializationRecord [a b c]) -(defstruct SerializationStruct :a :b :c) - -(defn- build-via-transient - [coll] - (persistent! - (reduce conj! (transient coll) (map vec (partition 2 (range 1000)))))) - -(defn- roundtrip - [v] - (let [rt (-> v serialize deserialize) - rt-seq (-> v seq serialize deserialize)] - (and (= v rt) - (= (seq v) (seq rt)) - (= (seq v) rt-seq)))) - -(deftest sequable-serialization - (are [val] (roundtrip val) - ; lists and related - (list) - (apply list (range 10)) - (cons 0 nil) - (clojure.lang.Cons. 0 nil) - - ; vectors - [] - (into [] (range 10)) - (into [] (range 25)) - (into [] (range 100)) - (into [] (range 500)) - (into [] (range 1000)) - - ; maps - {} - {:a 5 :b 0} - (apply array-map (range 100)) - (apply hash-map (range 100)) - - ; sets - #{} - #{'a 'b 'c} - (set (range 10)) - (set (range 25)) - (set (range 100)) - (set (range 500)) - (set (range 1000)) - (sorted-set) - (sorted-set 'a 'b 'c) - (apply sorted-set (reverse (range 10))) - (apply sorted-set (reverse (range 25))) - (apply sorted-set (reverse (range 100))) - (apply sorted-set (reverse (range 500))) - (apply sorted-set (reverse (range 1000))) - - ; queues - clojure.lang.PersistentQueue/EMPTY - (into clojure.lang.PersistentQueue/EMPTY (range 50)) - - ; lazy seqs - (lazy-seq nil) - (lazy-seq (range 50)) - - ; transient / persistent! round-trip - (build-via-transient []) - (build-via-transient {}) - (build-via-transient #{}) - - ; array-seqs - (seq (make-array Object 10)) - (seq (make-array Boolean/TYPE 10)) - (seq (make-array Byte/TYPE 10)) - (seq (make-array Character/TYPE 10)) - (seq (make-array Double/TYPE 10)) - (seq (make-array Float/TYPE 10)) - (seq (make-array Integer/TYPE 10)) - (seq (make-array Long/TYPE 10)) - - ; "records" - (SerializationRecord. 0 :foo (range 20)) - (struct SerializationStruct 0 :foo (range 20)) - - ; misc seqs - (seq "s11n") - (range 50) - (rseq (apply sorted-set (reverse (range 100)))))) - -(deftest misc-serialization - (are [v] (= v (-> v serialize deserialize)) - 25/3 - :keyword - ::namespaced-keyword - 'symbol)) - -(deftest interned-serializations - (are [v] (identical? v (-> v serialize deserialize)) - clojure.lang.RT/DEFAULT_COMPARATOR - - ; namespaces just get deserialized back into the same-named ns in the present runtime - ; (they're referred to by defrecord instances) - *ns*)) - -(deftest function-serialization - (let [capture 5] - (are [f] (= capture ((-> f serialize deserialize))) - (constantly 5) - (fn [] 5) - #(do 5) - (constantly capture) - (fn [] capture) - #(do capture)))) - -(deftest check-unserializable-objects - (are [t] (thrown? java.io.NotSerializableException (serialize t)) - ;; transients - (transient []) - (transient {}) - (transient #{}) - - ;; reference types - (atom nil) - (ref nil) - (agent nil) - #'+ - - ;; stateful seqs - (enumeration-seq (java.util.Collections/enumeration (range 50))) - (iterator-seq (.iterator (range 50))))) \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/special.clj --- a/src/clojure/test_clojure/special.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka - -;; -;; Test special forms, macros and metadata -;; - -(ns clojure.test-clojure.special - (:use clojure.test)) - -; http://clojure.org/special_forms - -; let, letfn -; quote -; var -; fn - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/string.clj --- a/src/clojure/test_clojure/string.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,120 +0,0 @@ -(ns clojure.test-clojure.string - (:require [clojure.string :as s]) - (:use clojure.test)) - -(deftest t-split - (is (= ["a" "b"] (s/split "a-b" #"-"))) - (is (= ["a" "b-c"] (s/split "a-b-c" #"-" 2))) - (is (vector? (s/split "abc" #"-")))) - -(deftest t-reverse - (is (= "tab" (s/reverse "bat")))) - -(deftest t-replace - (is (= "faabar" (s/replace "foobar" \o \a))) - (is (= "barbarbar" (s/replace "foobarfoo" "foo" "bar"))) - (is (= "FOObarFOO" (s/replace "foobarfoo" #"foo" s/upper-case)))) - -(deftest t-replace-first - (is (= "barbarfoo" (s/replace-first "foobarfoo" "foo" "bar"))) - (is (= "barbarfoo" (s/replace-first "foobarfoo" #"foo" "bar"))) - (is (= "z.ology" (s/replace-first "zoology" \o \.))) - (is (= "FOObarfoo" (s/replace-first "foobarfoo" #"foo" s/upper-case)))) - -(deftest t-join - (are [x coll] (= x (s/join coll)) - "" nil - "" [] - "1" [1] - "12" [1 2]) - (are [x sep coll] (= x (s/join sep coll)) - "1,2,3" \, [1 2 3] - "" \, [] - "1" \, [1] - "1 and-a 2 and-a 3" " and-a " [1 2 3])) - -(deftest t-trim-newline - (is (= "foo" (s/trim-newline "foo\n"))) - (is (= "foo" (s/trim-newline "foo\r\n"))) - (is (= "foo" (s/trim-newline "foo"))) - (is (= "" (s/trim-newline "")))) - -(deftest t-capitalize - (is (= "Foobar" (s/capitalize "foobar"))) - (is (= "Foobar" (s/capitalize "FOOBAR")))) - -(deftest t-triml - (is (= "foo " (s/triml " foo "))) - (is (= "" (s/triml " ")))) - -(deftest t-trimr - (is (= " foo" (s/trimr " foo "))) - (is (= "" (s/trimr " ")))) - -(deftest t-trim - (is (= "foo" (s/trim " foo \r\n")))) - -(deftest t-upper-case - (is (= "FOOBAR" (s/upper-case "Foobar")))) - -(deftest t-lower-case - (is (= "foobar" (s/lower-case "FooBar")))) - -(deftest nil-handling - (are [f args] (thrown? NullPointerException (apply f args)) - s/reverse [nil] - s/replace [nil #"foo" "bar"] - s/replace-first [nil #"foo" "bar"] - s/capitalize [nil] - s/upper-case [nil] - s/lower-case [nil] - s/split [nil #"-"] - s/split [nil #"-" 1] - s/trim [nil] - s/triml [nil] - s/trimr [nil] - s/trim-newline [nil])) - -(deftest char-sequence-handling - (are [result f args] (let [[^CharSequence s & more] args] - (= result (apply f (StringBuffer. s) more))) - "paz" s/reverse ["zap"] - "foo:bar" s/replace ["foo-bar" \- \:] - "ABC" s/replace ["abc" #"\w" s/upper-case] - "faa" s/replace ["foo" #"o" (StringBuffer. "a")] - "baz::quux" s/replace-first ["baz--quux" #"--" "::"] - "baz::quux" s/replace-first ["baz--quux" (StringBuffer. "--") (StringBuffer. "::")] - "zim-zam" s/replace-first ["zim zam" #" " (StringBuffer. "-")] - "Pow" s/capitalize ["POW"] - "BOOM" s/upper-case ["boom"] - "whimper" s/lower-case ["whimPER"] - ["foo" "bar"] s/split ["foo-bar" #"-"] - "calvino" s/trim [" calvino "] - "calvino " s/triml [" calvino "] - " calvino" s/trimr [" calvino "] - "the end" s/trim-newline ["the end\r\n\r\r\n"] - true s/blank? [" "] - ["a" "b"] s/split-lines ["a\nb"] - "fa la la" s/escape ["fo lo lo" {\o \a}])) - -(deftest t-escape - (is (= "<foo&bar>" - (s/escape "" {\& "&" \< "<" \> ">"}))) - (is (= " \\\"foo\\\" " - (s/escape " \"foo\" " {\" "\\\""}))) - (is (= "faabor" - (s/escape "foobar" {\a \o, \o \a})))) - -(deftest t-blank - (is (s/blank? nil)) - (is (s/blank? "")) - (is (s/blank? " ")) - (is (s/blank? " \t \n \r ")) - (is (not (s/blank? " foo ")))) - -(deftest t-split-lines - (let [result (s/split-lines "one\ntwo\r\nthree")] - (is (= ["one" "two" "three"] result)) - (is (vector? result))) - (is (= (list "foo") (s/split-lines "foo")))) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/test.clj --- a/src/clojure/test_clojure/test.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,115 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;;; test_clojure/test.clj: unit tests for test.clj - -;; by Stuart Sierra -;; January 16, 2009 - -;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for -;; contributions and suggestions. - - -(ns clojure.test-clojure.test - (:use clojure.test)) - -(deftest can-test-symbol - (let [x true] - (is x "Should pass")) - (let [x false] - (is x "Should fail"))) - -(deftest can-test-boolean - (is true "Should pass") - (is false "Should fail")) - -(deftest can-test-nil - (is nil "Should fail")) - -(deftest can-test-= - (is (= 2 (+ 1 1)) "Should pass") - (is (= 3 (+ 2 2)) "Should fail")) - -(deftest can-test-instance - (is (instance? Integer (+ 2 2)) "Should pass") - (is (instance? Float (+ 1 1)) "Should fail")) - -(deftest can-test-thrown - (is (thrown? ArithmeticException (/ 1 0)) "Should pass") - ;; No exception is thrown: - (is (thrown? Exception (+ 1 1)) "Should fail") - ;; Wrong class of exception is thrown: - (is (thrown? ArithmeticException (throw (RuntimeException.))) "Should error")) - -(deftest can-test-thrown-with-msg - (is (thrown-with-msg? ArithmeticException #"Divide by zero" (/ 1 0)) "Should pass") - ;; Wrong message string: - (is (thrown-with-msg? ArithmeticException #"Something else" (/ 1 0)) "Should fail") - ;; No exception is thrown: - (is (thrown? Exception (+ 1 1)) "Should fail") - ;; Wrong class of exception is thrown: - (is (thrown-with-msg? IllegalArgumentException #"Divide by zero" (/ 1 0)) "Should error")) - -(deftest can-catch-unexpected-exceptions - (is (= 1 (throw (Exception.))) "Should error")) - -(deftest can-test-method-call - (is (.startsWith "abc" "a") "Should pass") - (is (.startsWith "abc" "d") "Should fail")) - -(deftest can-test-anonymous-fn - (is (#(.startsWith % "a") "abc") "Should pass") - (is (#(.startsWith % "d") "abc") "Should fail")) - -(deftest can-test-regexps - (is (re-matches #"^ab.*$" "abbabba") "Should pass") - (is (re-matches #"^cd.*$" "abbabba") "Should fail") - (is (re-find #"ab" "abbabba") "Should pass") - (is (re-find #"cd" "abbabba") "Should fail")) - -(deftest #^{:has-meta true} can-add-metadata-to-tests - (is (:has-meta (meta #'can-add-metadata-to-tests)) "Should pass")) - -;; still have to declare the symbol before testing unbound symbols -(declare does-not-exist) - -(deftest can-test-unbound-symbol - (is (= nil does-not-exist) "Should error")) - -(deftest can-test-unbound-function - (is (does-not-exist) "Should error")) - - -;; Here, we create an alternate version of test/report, that -;; compares the event with the message, then calls the original -;; 'report' with modified arguments. - -(declare original-report) - -(defn custom-report [data] - (let [event (:type data) - msg (:message data) - expected (:expected data) - actual (:actual data) - passed (cond - (= event :fail) (= msg "Should fail") - (= event :pass) (= msg "Should pass") - (= event :error) (= msg "Should error") - :else true)] - (if passed - (original-report {:type :pass, :message msg, - :expected expected, :actual actual}) - (original-report {:type :fail, :message (str msg " but got " event) - :expected expected, :actual actual})))) - -;; test-ns-hook will be used by test/test-ns to run tests in this -;; namespace. -(defn test-ns-hook [] - (binding [original-report report - report custom-report] - (test-all-vars (find-ns 'clojure.test-clojure.test)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/test_fixtures.clj --- a/src/clojure/test_clojure/test_fixtures.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,50 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. -; -;;; test_fixtures.clj: unit tests for fixtures in test.clj - -;; by Stuart Sierra -;; March 28, 2009 - -(ns clojure.test-clojure.test-fixtures - (:use clojure.test)) - -(declare *a* *b* *c* *d*) - -(def *n* 0) - -(defn fixture-a [f] - (binding [*a* 3] (f))) - -(defn fixture-b [f] - (binding [*b* 5] (f))) - -(defn fixture-c [f] - (binding [*c* 7] (f))) - -(defn fixture-d [f] - (binding [*d* 11] (f))) - -(defn inc-n-fixture [f] - (binding [*n* (inc *n*)] (f))) - -(use-fixtures :once fixture-a fixture-b) - -(use-fixtures :each fixture-c fixture-d inc-n-fixture) -(use-fixtures :each fixture-c fixture-d inc-n-fixture) - -(deftest can-use-once-fixtures - (is (= 3 *a*)) - (is (= 5 *b*))) - -(deftest can-use-each-fixtures - (is (= 7 *c*)) - (is (= 11 *d*))) - -(deftest use-fixtures-replaces - (is (= *n* 1))) \ No newline at end of file diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/transients.clj --- a/src/clojure/test_clojure/transients.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -(ns clojure.test-clojure.transients - (:use clojure.test)) - -(deftest popping-off - (testing "across a node boundary" - (are [n] - (let [v (-> (range n) vec)] - (= (subvec v 0 (- n 2)) (-> v transient pop! pop! persistent!))) - 33 (+ 32 (inc (* 32 32))) (+ 32 (inc (* 32 32 32))))) - (testing "off the end" - (is (thrown-with-msg? IllegalStateException #"Can't pop empty vector" - (-> [] transient pop!))))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/vars.clj --- a/src/clojure/test_clojure/vars.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Frantisek Sodomka, Stephen C. Gilardi - - -(ns clojure.test-clojure.vars - (:use clojure.test)) - -; http://clojure.org/vars - -; def -; defn defn- defonce - -; declare intern binding find-var var - -(def a) -(deftest test-binding - (are [x y] (= x y) - (eval `(binding [a 4] a)) 4 ; regression in Clojure SVN r1370 - )) - -; with-local-vars var-get var-set alter-var-root [var? (predicates.clj)] -; with-in-str with-out-str -; with-open -; with-precision - -(deftest test-with-precision - (are [x y] (= x y) - (with-precision 4 (+ 3.5555555M 1)) 4.556M - (with-precision 6 (+ 3.5555555M 1)) 4.55556M - (with-precision 6 :rounding CEILING (+ 3.5555555M 1)) 4.55556M - (with-precision 6 :rounding FLOOR (+ 3.5555555M 1)) 4.55555M - (with-precision 6 :rounding HALF_UP (+ 3.5555555M 1)) 4.55556M - (with-precision 6 :rounding HALF_DOWN (+ 3.5555555M 1)) 4.55556M - (with-precision 6 :rounding HALF_EVEN (+ 3.5555555M 1)) 4.55556M - (with-precision 6 :rounding UP (+ 3.5555555M 1)) 4.55556M - (with-precision 6 :rounding DOWN (+ 3.5555555M 1)) 4.55555M - (with-precision 6 :rounding UNNECESSARY (+ 3.5555M 1)) 4.5555M)) - -(deftest test-settable-math-context - (is (= - (clojure.main/with-bindings - (set! *math-context* (java.math.MathContext. 8)) - (+ 3.55555555555555M 1)) - 4.5555556M))) - -; set-validator get-validator - -; doc find-doc test - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/test_clojure/vectors.clj --- a/src/clojure/test_clojure/vectors.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,304 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -; Author: Stuart Halloway, Daniel Solano Gómez - -(ns clojure.test-clojure.vectors - (:use clojure.test)) - -(deftest test-reversed-vec - (let [r (range 6) - v (into (vector-of :int) r) - reversed (.rseq v)] - (testing "returns the right impl" - (is (= clojure.lang.APersistentVector$RSeq (class reversed)))) - (testing "RSeq methods" - (is (= [5 4 3 2 1 0] reversed)) - (is (= 5 (.index reversed))) - (is (= 5 (.first reversed))) - (is (= [4 3 2 1 0] (.next reversed))) - (is (= [3 2 1 0] (.. reversed next next))) - (is (= 6 (.count reversed)))) - (testing "clojure calling through" - (is (= 5 (first reversed))) - (is (= 5 (nth reversed 0)))) - (testing "empty reverses to nil" - (is (nil? (.. v empty rseq)))))) - -(deftest test-vecseq - (let [r (range 100) - vs (into (vector-of :int) r) - vs-1 (next vs) - vs-32 (.chunkedNext (seq vs))] - (testing "=" - (are [a b] (= a b) - vs vs - vs-1 vs-1 - vs-32 vs-32) - (are [a b] (not= a b) - vs vs-1 - vs-1 vs - vs vs-32 - vs-32 vs)) - (testing "IPersistentCollection.empty" - (are [a] (identical? clojure.lang.PersistentList/EMPTY (.empty (seq a))) - vs vs-1 vs-32)) - (testing "IPersistentCollection.cons" - (are [result input] (= result (.cons input :foo)) - [:foo 1] (seq (into (vector-of :int) [1])))) - (testing "IPersistentCollection.count" - (are [ct s] (= ct (.count (seq s))) - 100 vs - 99 vs-1 - 68 vs-32) - ;; can't manufacture this scenario: ASeq defers to Counted, but - ;; LazySeq doesn't, so Counted never gets checked on reified seq below - #_(testing "hops to counted when available" - (is (= 200 - (.count (concat - (seq vs) - (reify clojure.lang.ISeq - (seq [this] this) - clojure.lang.Counted - (count [_] 100)))))))) - (testing "IPersistentCollection.equiv" - (are [a b] (true? (.equiv a b)) - vs vs - vs-1 vs-1 - vs-32 vs-32 - vs r) - (are [a b] (false? (.equiv a b)) - vs vs-1 - vs-1 vs - vs vs-32 - vs-32 vs - vs nil)))) - -(deftest test-vec-compare - (let [nums (range 1 100) - ; randomly replaces a single item with the given value - rand-replace (fn[val] - (let [r (rand-int 99)] - (concat (take r nums) [val] (drop (inc r) nums)))) - ; all num sequences in map - num-seqs {:standard nums - :empty '() - ; different lengths - :longer (concat nums [100]) - :shorter (drop-last nums) - ; greater by value - :first-greater (concat [100] (next nums)) - :last-greater (concat (drop-last nums) [100]) - :rand-greater-1 (rand-replace 100) - :rand-greater-2 (rand-replace 100) - :rand-greater-3 (rand-replace 100) - ; lesser by value - :first-lesser (concat [0] (next nums)) - :last-lesser (concat (drop-last nums) [0]) - :rand-lesser-1 (rand-replace 0) - :rand-lesser-2 (rand-replace 0) - :rand-lesser-3 (rand-replace 0)} - ; a way to create compare values based on num-seqs - create-vals (fn[base-val] - (zipmap (keys num-seqs) - (map #(into base-val %1) (vals num-seqs)))) - ; Vecs made of int primitives - int-vecs (create-vals (vector-of :int)) - ; Vecs made of long primitives - long-vecs (create-vals (vector-of :long)) - ; standard boxing vectors - regular-vecs (create-vals []) - ; the standard int Vec for comparisons - int-vec (:standard int-vecs)] - (testing "compare" - (testing "identical" - (is (= 0 (compare int-vec int-vec)))) - (testing "equivalent" - (are [x y] (= 0 (compare x y)) - ; standard - int-vec (:standard long-vecs) - (:standard long-vecs) int-vec - int-vec (:standard regular-vecs) - (:standard regular-vecs) int-vec - ; empty - (:empty int-vecs) (:empty long-vecs) - (:empty long-vecs) (:empty int-vecs))) - (testing "lesser" - (are [x] (= -1 (compare int-vec x)) - (:longer int-vecs) - (:longer long-vecs) - (:longer regular-vecs) - (:first-greater int-vecs) - (:first-greater long-vecs) - (:first-greater regular-vecs) - (:last-greater int-vecs) - (:last-greater long-vecs) - (:last-greater regular-vecs) - (:rand-greater-1 int-vecs) - (:rand-greater-1 long-vecs) - (:rand-greater-1 regular-vecs) - (:rand-greater-2 int-vecs) - (:rand-greater-2 long-vecs) - (:rand-greater-2 regular-vecs) - (:rand-greater-3 int-vecs) - (:rand-greater-3 long-vecs) - (:rand-greater-3 regular-vecs)) - (are [x] (= -1 (compare x int-vec)) - nil - (:empty int-vecs) - (:empty long-vecs) - (:empty regular-vecs) - (:shorter int-vecs) - (:shorter long-vecs) - (:shorter regular-vecs) - (:first-lesser int-vecs) - (:first-lesser long-vecs) - (:first-lesser regular-vecs) - (:last-lesser int-vecs) - (:last-lesser long-vecs) - (:last-lesser regular-vecs) - (:rand-lesser-1 int-vecs) - (:rand-lesser-1 long-vecs) - (:rand-lesser-1 regular-vecs) - (:rand-lesser-2 int-vecs) - (:rand-lesser-2 long-vecs) - (:rand-lesser-2 regular-vecs) - (:rand-lesser-3 int-vecs) - (:rand-lesser-3 long-vecs) - (:rand-lesser-3 regular-vecs))) - (testing "greater" - (are [x] (= 1 (compare int-vec x)) - nil - (:empty int-vecs) - (:empty long-vecs) - (:empty regular-vecs) - (:shorter int-vecs) - (:shorter long-vecs) - (:shorter regular-vecs) - (:first-lesser int-vecs) - (:first-lesser long-vecs) - (:first-lesser regular-vecs) - (:last-lesser int-vecs) - (:last-lesser long-vecs) - (:last-lesser regular-vecs) - (:rand-lesser-1 int-vecs) - (:rand-lesser-1 long-vecs) - (:rand-lesser-1 regular-vecs) - (:rand-lesser-2 int-vecs) - (:rand-lesser-2 long-vecs) - (:rand-lesser-2 regular-vecs) - (:rand-lesser-3 int-vecs) - (:rand-lesser-3 long-vecs) - (:rand-lesser-3 regular-vecs)) - (are [x] (= 1 (compare x int-vec)) - (:longer int-vecs) - (:longer long-vecs) - (:longer regular-vecs) - (:first-greater int-vecs) - (:first-greater long-vecs) - (:first-greater regular-vecs) - (:last-greater int-vecs) - (:last-greater long-vecs) - (:last-greater regular-vecs) - (:rand-greater-1 int-vecs) - (:rand-greater-1 long-vecs) - (:rand-greater-1 regular-vecs) - (:rand-greater-2 int-vecs) - (:rand-greater-2 long-vecs) - (:rand-greater-2 regular-vecs) - (:rand-greater-3 int-vecs) - (:rand-greater-3 long-vecs) - (:rand-greater-3 regular-vecs)))) - (testing "Comparable.compareTo" - (testing "incompatible" - (is (thrown? NullPointerException (.compareTo int-vec nil))) - (are [x] (thrown? ClassCastException (.compareTo int-vec x)) - '() - {} - #{} - (sorted-set) - (sorted-map) - nums - 1)) - (testing "identical" - (is (= 0 (.compareTo int-vec int-vec)))) - (testing "equivalent" - (are [x] (= 0 (.compareTo int-vec x)) - (:standard long-vecs) - (:standard regular-vecs))) - (testing "lesser" - (are [x] (= -1 (.compareTo int-vec x)) - (:longer int-vecs) - (:longer long-vecs) - (:longer regular-vecs) - (:first-greater int-vecs) - (:first-greater long-vecs) - (:first-greater regular-vecs) - (:last-greater int-vecs) - (:last-greater long-vecs) - (:last-greater regular-vecs) - (:rand-greater-1 int-vecs) - (:rand-greater-1 long-vecs) - (:rand-greater-1 regular-vecs) - (:rand-greater-2 int-vecs) - (:rand-greater-2 long-vecs) - (:rand-greater-2 regular-vecs) - (:rand-greater-3 int-vecs) - (:rand-greater-3 long-vecs) - (:rand-greater-3 regular-vecs))) - (testing "greater" - (are [x] (= 1 (.compareTo int-vec x)) - (:empty int-vecs) - (:empty long-vecs) - (:empty regular-vecs) - (:shorter int-vecs) - (:shorter long-vecs) - (:shorter regular-vecs) - (:first-lesser int-vecs) - (:first-lesser long-vecs) - (:first-lesser regular-vecs) - (:last-lesser int-vecs) - (:last-lesser long-vecs) - (:last-lesser regular-vecs) - (:rand-lesser-1 int-vecs) - (:rand-lesser-1 long-vecs) - (:rand-lesser-1 regular-vecs) - (:rand-lesser-2 int-vecs) - (:rand-lesser-2 long-vecs) - (:rand-lesser-2 regular-vecs) - (:rand-lesser-3 int-vecs) - (:rand-lesser-3 long-vecs) - (:rand-lesser-3 regular-vecs)))))) - -(deftest test-vec-associative - (let [empty-v (vector-of :long) - v (into empty-v (range 1 6))] - (testing "Associative.containsKey" - (are [x] (.containsKey v x) - 0 1 2 3 4) - (are [x] (not (.containsKey v x)) - -1 -100 nil [] "" #"" #{} 5 100) - (are [x] (not (.containsKey empty-v x)) - 0 1)) - (testing "contains?" - (are [x] (contains? v x) - 0 2 4) - (are [x] (not (contains? v x)) - -1 -100 nil "" 5 100) - (are [x] (not (contains? empty-v x)) - 0 1)) - (testing "Associative.entryAt" - (are [idx val] (= (clojure.lang.MapEntry. idx val) - (.entryAt v idx)) - 0 1 - 2 3 - 4 5) - (are [idx] (nil? (.entryAt v idx)) - -5 -1 5 10 nil "") - (are [idx] (nil? (.entryAt empty-v idx)) - 0 1)))) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/walk.clj --- a/src/clojure/walk.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,132 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;;; walk.clj - generic tree walker with replacement - -;; by Stuart Sierra -;; December 15, 2008 - -;; CHANGE LOG: -;; -;; * December 15, 2008: replaced 'walk' with 'prewalk' & 'postwalk' -;; -;; * December 9, 2008: first version - - -(ns - ^{:author "Stuart Sierra", - :doc "This file defines a generic tree walker for Clojure data -structures. It takes any data structure (list, vector, map, set, -seq), calls a function on every element, and uses the return value -of the function in place of the original. This makes it fairly -easy to write recursive search-and-replace functions, as shown in -the examples. - -Note: \"walk\" supports all Clojure data structures EXCEPT maps -created with sorted-map-by. There is no (obvious) way to retrieve -the sorting function."} - clojure.walk) - -(defn walk - "Traverses form, an arbitrary data structure. inner and outer are - functions. Applies inner to each element of form, building up a - data structure of the same type, then applies outer to the result. - Recognizes all Clojure data structures except sorted-map-by. - Consumes seqs as with doall." - {:added "1.1"} - [inner outer form] - (cond - (list? form) (outer (apply list (map inner form))) - (seq? form) (outer (doall (map inner form))) - (vector? form) (outer (vec (map inner form))) - (map? form) (outer (into (if (sorted? form) (sorted-map) {}) - (map inner form))) - (set? form) (outer (into (if (sorted? form) (sorted-set) #{}) - (map inner form))) - :else (outer form))) - -(defn postwalk - "Performs a depth-first, post-order traversal of form. Calls f on - each sub-form, uses f's return value in place of the original. - Recognizes all Clojure data structures except sorted-map-by. - Consumes seqs as with doall." - {:added "1.1"} - [f form] - (walk (partial postwalk f) f form)) - -(defn prewalk - "Like postwalk, but does pre-order traversal." - {:added "1.1"} - [f form] - (walk (partial prewalk f) identity (f form))) - - -;; Note: I wanted to write: -;; -;; (defn walk -;; [f form] -;; (let [pf (partial walk f)] -;; (if (coll? form) -;; (f (into (empty form) (map pf form))) -;; (f form)))) -;; -;; but this throws a ClassCastException when applied to a map. - - -(defn postwalk-demo - "Demonstrates the behavior of postwalk by printing each form as it is - walked. Returns form." - {:added "1.1"} - [form] - (postwalk (fn [x] (print "Walked: ") (prn x) x) form)) - -(defn prewalk-demo - "Demonstrates the behavior of prewalk by printing each form as it is - walked. Returns form." - {:added "1.1"} - [form] - (prewalk (fn [x] (print "Walked: ") (prn x) x) form)) - -(defn keywordize-keys - "Recursively transforms all map keys from strings to keywords." - {:added "1.1"} - [m] - (let [f (fn [[k v]] (if (string? k) [(keyword k) v] [k v]))] - ;; only apply to maps - (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) - -(defn stringify-keys - "Recursively transforms all map keys from keywords to strings." - {:added "1.1"} - [m] - (let [f (fn [[k v]] (if (keyword? k) [(name k) v] [k v]))] - ;; only apply to maps - (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) - -(defn prewalk-replace - "Recursively transforms form by replacing keys in smap with their - values. Like clojure/replace but works on any data structure. Does - replacement at the root of the tree first." - {:added "1.1"} - [smap form] - (prewalk (fn [x] (if (contains? smap x) (smap x) x)) form)) - -(defn postwalk-replace - "Recursively transforms form by replacing keys in smap with their - values. Like clojure/replace but works on any data structure. Does - replacement at the leaves of the tree first." - {:added "1.1"} - [smap form] - (postwalk (fn [x] (if (contains? smap x) (smap x) x)) form)) - -(defn macroexpand-all - "Recursively performs all possible macroexpansions in form." - {:added "1.1"} - [form] - (prewalk (fn [x] (if (seq? x) (macroexpand x) x)) form)) - diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/xml.clj --- a/src/clojure/xml.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,118 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns ^{:doc "XML reading/writing." - :author "Rich Hickey"} - clojure.xml - (:import (org.xml.sax ContentHandler Attributes SAXException) - (javax.xml.parsers SAXParser SAXParserFactory))) - -(def *stack*) -(def *current*) -(def *state*) ; :element :chars :between -(def *sb*) - -(defstruct element :tag :attrs :content) - -(def tag (accessor element :tag)) -(def attrs (accessor element :attrs)) -(def content (accessor element :content)) - -(def content-handler - (let [push-content (fn [e c] - (assoc e :content (conj (or (:content e) []) c))) - push-chars (fn [] - (when (and (= *state* :chars) - (some (complement #(Character/isWhitespace (char %))) (str *sb*))) - (set! *current* (push-content *current* (str *sb*)))))] - (new clojure.lang.XMLHandler - (proxy [ContentHandler] [] - (startElement [uri local-name q-name ^Attributes atts] - (let [attrs (fn [ret i] - (if (neg? i) - ret - (recur (assoc ret - (clojure.lang.Keyword/intern (symbol (.getQName atts i))) - (.getValue atts (int i))) - (dec i)))) - e (struct element - (. clojure.lang.Keyword (intern (symbol q-name))) - (when (pos? (.getLength atts)) - (attrs {} (dec (.getLength atts)))))] - (push-chars) - (set! *stack* (conj *stack* *current*)) - (set! *current* e) - (set! *state* :element)) - nil) - (endElement [uri local-name q-name] - (push-chars) - (set! *current* (push-content (peek *stack*) *current*)) - (set! *stack* (pop *stack*)) - (set! *state* :between) - nil) - (characters [^chars ch start length] - (when-not (= *state* :chars) - (set! *sb* (new StringBuilder))) - (let [^StringBuilder sb *sb*] - (.append sb ch (int start) (int length)) - (set! *state* :chars)) - nil) - (setDocumentLocator [locator]) - (startDocument []) - (endDocument []) - (startPrefixMapping [prefix uri]) - (endPrefixMapping [prefix]) - (ignorableWhitespace [ch start length]) - (processingInstruction [target data]) - (skippedEntity [name]) - )))) - -(defn startparse-sax [s ch] - (.. SAXParserFactory (newInstance) (newSAXParser) (parse s ch))) - -(defn parse - "Parses and loads the source s, which can be a File, InputStream or - String naming a URI. Returns a tree of the xml/element struct-map, - which has the keys :tag, :attrs, and :content. and accessor fns tag, - attrs, and content. Other parsers can be supplied by passing - startparse, a fn taking a source and a ContentHandler and returning - a parser" - {:added "1.0"} - ([s] (parse s startparse-sax)) - ([s startparse] - (binding [*stack* nil - *current* (struct element) - *state* :between - *sb* nil] - (startparse s content-handler) - ((:content *current*) 0)))) - -(defn emit-element [e] - (if (instance? String e) - (println e) - (do - (print (str "<" (name (:tag e)))) - (when (:attrs e) - (doseq [attr (:attrs e)] - (print (str " " (name (key attr)) "='" (val attr)"'")))) - (if (:content e) - (do - (println ">") - (doseq [c (:content e)] - (emit-element c)) - (println (str ""))) - (println "/>"))))) - -(defn emit [x] - (println "") - (emit-element x)) - -;(export '(tag attrs content parse element emit emit-element)) - -;(load-file "/Users/rich/dev/clojure/src/xml.clj") -;(def x (xml/parse "http://arstechnica.com/journals.rssx")) diff -r ef7dbbd6452c -r f952052e37b7 src/clojure/zip.clj --- a/src/clojure/zip.clj Sat Aug 21 06:25:44 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,318 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -;functional hierarchical zipper, with navigation, editing and enumeration -;see Huet - -(ns ^{:doc "Functional hierarchical zipper, with navigation, editing, - and enumeration. See Huet" - :author "Rich Hickey"} - clojure.zip - (:refer-clojure :exclude (replace remove next))) - -(defn zipper - "Creates a new zipper structure. - - branch? is a fn that, given a node, returns true if can have - children, even if it currently doesn't. - - children is a fn that, given a branch node, returns a seq of its - children. - - make-node is a fn that, given an existing node and a seq of - children, returns a new branch node with the supplied children. - root is the root node." - {:added "1.0"} - [branch? children make-node root] - ^{:zip/branch? branch? :zip/children children :zip/make-node make-node} - [root nil]) - -(defn seq-zip - "Returns a zipper for nested sequences, given a root sequence" - {:added "1.0"} - [root] - (zipper seq? - identity - (fn [node children] (with-meta children (meta node))) - root)) - -(defn vector-zip - "Returns a zipper for nested vectors, given a root vector" - {:added "1.0"} - [root] - (zipper vector? - seq - (fn [node children] (with-meta (vec children) (meta node))) - root)) - -(defn xml-zip - "Returns a zipper for xml elements (as from xml/parse), - given a root element" - {:added "1.0"} - [root] - (zipper (complement string?) - (comp seq :content) - (fn [node children] - (assoc node :content (and children (apply vector children)))) - root)) - -(defn node - "Returns the node at loc" - {:added "1.0"} - [loc] (loc 0)) - -(defn branch? - "Returns true if the node at loc is a branch" - {:added "1.0"} - [loc] - ((:zip/branch? (meta loc)) (node loc))) - -(defn children - "Returns a seq of the children of node at loc, which must be a branch" - {:added "1.0"} - [loc] - (if (branch? loc) - ((:zip/children (meta loc)) (node loc)) - (throw (Exception. "called children on a leaf node")))) - -(defn make-node - "Returns a new branch node, given an existing node and new - children. The loc is only used to supply the constructor." - {:added "1.0"} - [loc node children] - ((:zip/make-node (meta loc)) node children)) - -(defn path - "Returns a seq of nodes leading to this loc" - {:added "1.0"} - [loc] - (:pnodes (loc 1))) - -(defn lefts - "Returns a seq of the left siblings of this loc" - {:added "1.0"} - [loc] - (seq (:l (loc 1)))) - -(defn rights - "Returns a seq of the right siblings of this loc" - {:added "1.0"} - [loc] - (:r (loc 1))) - - -(defn down - "Returns the loc of the leftmost child of the node at this loc, or - nil if no children" - {:added "1.0"} - [loc] - (when (branch? loc) - (let [[node path] loc - [c & cnext :as cs] (children loc)] - (when cs - (with-meta [c {:l [] - :pnodes (if path (conj (:pnodes path) node) [node]) - :ppath path - :r cnext}] (meta loc)))))) - -(defn up - "Returns the loc of the parent of the node at this loc, or nil if at - the top" - {:added "1.0"} - [loc] - (let [[node {l :l, ppath :ppath, pnodes :pnodes r :r, changed? :changed?, :as path}] loc] - (when pnodes - (let [pnode (peek pnodes)] - (with-meta (if changed? - [(make-node loc pnode (concat l (cons node r))) - (and ppath (assoc ppath :changed? true))] - [pnode ppath]) - (meta loc)))))) - -(defn root - "zips all the way up and returns the root node, reflecting any - changes." - {:added "1.0"} - [loc] - (if (= :end (loc 1)) - (node loc) - (let [p (up loc)] - (if p - (recur p) - (node loc))))) - -(defn right - "Returns the loc of the right sibling of the node at this loc, or nil" - {:added "1.0"} - [loc] - (let [[node {l :l [r & rnext :as rs] :r :as path}] loc] - (when (and path rs) - (with-meta [r (assoc path :l (conj l node) :r rnext)] (meta loc))))) - -(defn rightmost - "Returns the loc of the rightmost sibling of the node at this loc, or self" - {:added "1.0"} - [loc] - (let [[node {l :l r :r :as path}] loc] - (if (and path r) - (with-meta [(last r) (assoc path :l (apply conj l node (butlast r)) :r nil)] (meta loc)) - loc))) - -(defn left - "Returns the loc of the left sibling of the node at this loc, or nil" - {:added "1.0"} - [loc] - (let [[node {l :l r :r :as path}] loc] - (when (and path (seq l)) - (with-meta [(peek l) (assoc path :l (pop l) :r (cons node r))] (meta loc))))) - -(defn leftmost - "Returns the loc of the leftmost sibling of the node at this loc, or self" - {:added "1.0"} - [loc] - (let [[node {l :l r :r :as path}] loc] - (if (and path (seq l)) - (with-meta [(first l) (assoc path :l [] :r (concat (rest l) [node] r))] (meta loc)) - loc))) - -(defn insert-left - "Inserts the item as the left sibling of the node at this loc, - without moving" - {:added "1.0"} - [loc item] - (let [[node {l :l :as path}] loc] - (if (nil? path) - (throw (new Exception "Insert at top")) - (with-meta [node (assoc path :l (conj l item) :changed? true)] (meta loc))))) - -(defn insert-right - "Inserts the item as the right sibling of the node at this loc, - without moving" - {:added "1.0"} - [loc item] - (let [[node {r :r :as path}] loc] - (if (nil? path) - (throw (new Exception "Insert at top")) - (with-meta [node (assoc path :r (cons item r) :changed? true)] (meta loc))))) - -(defn replace - "Replaces the node at this loc, without moving" - {:added "1.0"} - [loc node] - (let [[_ path] loc] - (with-meta [node (assoc path :changed? true)] (meta loc)))) - -(defn edit - "Replaces the node at this loc with the value of (f node args)" - {:added "1.0"} - [loc f & args] - (replace loc (apply f (node loc) args))) - -(defn insert-child - "Inserts the item as the leftmost child of the node at this loc, - without moving" - {:added "1.0"} - [loc item] - (replace loc (make-node loc (node loc) (cons item (children loc))))) - -(defn append-child - "Inserts the item as the rightmost child of the node at this loc, - without moving" - {:added "1.0"} - [loc item] - (replace loc (make-node loc (node loc) (concat (children loc) [item])))) - -(defn next - "Moves to the next loc in the hierarchy, depth-first. When reaching - the end, returns a distinguished loc detectable via end?. If already - at the end, stays there." - {:added "1.0"} - [loc] - (if (= :end (loc 1)) - loc - (or - (and (branch? loc) (down loc)) - (right loc) - (loop [p loc] - (if (up p) - (or (right (up p)) (recur (up p))) - [(node p) :end]))))) - -(defn prev - "Moves to the previous loc in the hierarchy, depth-first. If already - at the root, returns nil." - {:added "1.0"} - [loc] - (if-let [lloc (left loc)] - (loop [loc lloc] - (if-let [child (and (branch? loc) (down loc))] - (recur (rightmost child)) - loc)) - (up loc))) - -(defn end? - "Returns true if loc represents the end of a depth-first walk" - {:added "1.0"} - [loc] - (= :end (loc 1))) - -(defn remove - "Removes the node at loc, returning the loc that would have preceded - it in a depth-first walk." - {:added "1.0"} - [loc] - (let [[node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc] - (if (nil? path) - (throw (new Exception "Remove at top")) - (if (pos? (count l)) - (loop [loc (with-meta [(peek l) (assoc path :l (pop l) :changed? true)] (meta loc))] - (if-let [child (and (branch? loc) (down loc))] - (recur (rightmost child)) - loc)) - (with-meta [(make-node loc (peek pnodes) rs) - (and ppath (assoc ppath :changed? true))] - (meta loc)))))) - -(comment - -(load-file "/Users/rich/dev/clojure/src/zip.clj") -(refer 'zip) -(def data '[[a * b] + [c * d]]) -(def dz (vector-zip data)) - -(right (down (right (right (down dz))))) -(lefts (right (down (right (right (down dz)))))) -(rights (right (down (right (right (down dz)))))) -(up (up (right (down (right (right (down dz))))))) -(path (right (down (right (right (down dz)))))) - -(-> dz down right right down right) -(-> dz down right right down right (replace '/) root) -(-> dz next next (edit str) next next next (replace '/) root) -(-> dz next next next next next next next next next remove root) -(-> dz next next next next next next next next next remove (insert-right 'e) root) -(-> dz next next next next next next next next next remove up (append-child 'e) root) - -(end? (-> dz next next next next next next next next next remove next)) - -(-> dz next remove next remove root) - -(loop [loc dz] - (if (end? loc) - (root loc) - (recur (next (if (= '* (node loc)) - (replace loc '/) - loc))))) - -(loop [loc dz] - (if (end? loc) - (root loc) - (recur (next (if (= '* (node loc)) - (remove loc) - loc))))) -) diff -r ef7dbbd6452c -r f952052e37b7 src/laser/rasterize.clj --- a/src/laser/rasterize.clj Sat Aug 21 06:25:44 2010 -0400 +++ b/src/laser/rasterize.clj Tue Aug 24 19:06:45 2010 -0400 @@ -13,14 +13,14 @@ (import '(java.io BufferedReader InputStreamReader)) (import '(java.awt.image BufferedImage)) -(use 'clojure.contrib.str-utils) -(use 'clojure.contrib.seq-utils) -(use 'clojure.contrib.combinatorics) -(use 'clojure.contrib.duck-streams) +;(use 'clojure.contrib.str-utils) +;(use 'clojure.contrib.seq-utils) +;(use 'clojure.contrib.combinatorics) +;(use 'clojure.contrib.duck-streams) -(use 'clojure.contrib.repl-utils) +;(use 'clojure.contrib.repl-utils) -(set! *print-length* 20) +;(set! *print-length* 20) @@ -77,7 +77,7 @@ (def white {:r 255, :g 255, :b 255}) (def black {:r 0, :g 0, :b 0}) -(def expt #(Math/pow %1 %2)) + (defn rgb-euclidian [{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ] @@ -205,34 +205,40 @@ ; (println prevoius) ; (println range-start) (if (<= new-n (+ prevoius 1)) - (do ;(println "join") + (do ;(println "join") ;(println (butlast collection)) - (conj (apply vector (butlast collection)) (vector range-start new-n))) - (conj collection (vector new-n new-n))))) + (conj (apply vector (butlast collection)) + (vector range-start new-n))) + (conj collection (vector new-n new-n))))) base - (map first row)))) + (map first row)))) + (defn row->gmask [[x-dpi y-dpi] forward? row] +; (println forward?) + (let [start (float (* (/ x-dpi) (first (first + (if forward? + (reverse row) row)))))] - (let [start (float (* (/ x-dpi) (first (first row))))] - - (let [preamble (if forward? - (str + (let [preamble (if-not forward? (format "0 0 0 %.3f\n" start) - (format "0 0 1 %.3f\n" start))) + (format "0 0 1 %.3f\n" start)) body - (for [[x y] (gather-row row)] + (for [[x y] + (if forward? + (reverse (gather-row row)) + (gather-row row))] (let [x (float (* x (/ x-dpi))) y (float (* y (/ x-dpi)))] - (if forward? + (if-not forward? (str (format "0 0 1 %.3f\n" x) (format "0 1 1 %.3f\n" y)) - (str (format "0 0 0 %.3f\n" x) - (format "0 1 0 %.3f\n" y)))))] + (str (format "0 0 0 %.3f\n" y) + (format "0 1 0 %.3f\n" x)))))] (str preamble (str-join "" body))))) @@ -251,9 +257,10 @@ (str "1 0 0 0\n" (str-join "" (map (fn [[index row]] - (row->gmask dpi (odd? index) row)) + (row->gmask dpi (even? index) row)) (indexed (make-rows pic)))))) + ;; 1 0 0 0 ;; 0 0 1 2.881 ;; 0 0 0 2.881 @@ -302,7 +309,26 @@ (spit "/home/r/kevin/out.gmask" (generate-gmask image)) image)) - + + +(defn update-state [] +(def sing "/home/r/lasercutter/graster/signer4laser2x1.png") + +(def pic (frame-hash (let [image (ImagePlus. sing)] + (.rotate (.getChannelProcessor image) 180) + image))) + +(def pic (b&w pic))) + + + + + + + + + + ;;;; testing @@ -339,6 +365,6 @@ (.start (Thread. (fn [] - (with-bindings {#'clojure.core/*out* temp} + (with-bindings {#'*out* temp} (Thread/sleep 5000) (println "hi"))))))) diff -r ef7dbbd6452c -r f952052e37b7 src/laser/rubyisms.clj --- a/src/laser/rubyisms.clj Sat Aug 21 06:25:44 2010 -0400 +++ b/src/laser/rubyisms.clj Tue Aug 24 19:06:45 2010 -0400 @@ -6,6 +6,9 @@ ])) + + + (defmacro unless [boolean & forms] `(if (not ~boolean) ~@forms))