diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,5 @@ + +Don Stewart +Sean Seefried +Andre Pang + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,111 @@ + +------------------------------------------------------------------------ + hs-plugins +------------------------------------------------------------------------ + +Compiler and tool support for compiling and loading, and evaluating +Haskell at runtime. + +The library provides a convenient interface to GHC's runtime loader +and linker, letting you load compiled Haskell code. + +It also provides a `make' system for compiling plugin source +automagically and for combining the user's .hs file with a stub of +standard declarations and syntax, saving the user from having to write +standard code themselves. + +It provides an `eval' function, for generating new, well-typed, compiled +code from a Haskell source string. + +It also provides a new variation of printf for Haskell-- a runtime +generated, dynamically-typed printf. + +Read the documentation in doc/ for more. + +------------------------------------------------------------------------ + +BUILDING: + $ chmod +x Setup.lhs configure + $ ./Setup.lhs configure --prefix=/usr/local + $ ./Setup.lhs build + $ ./Setup.lhs install + +------------------------------------------------------------------------ + +DEPENDENCIES: + +* Requires GHC >= 6.4 +* Requires Cabal + +------------------------------------------------------------------------ + +* Optional: + If you are doing a lot of `merge'-related operations, and require + an extended haskell parser, you can compile hs-plugins to use + HSX, Niklas Broberg's Haskell parser library, available at: + + darcs get http://www.cs.chalmers.se/~d00nibro/haskell-src-exts + + To get hs-plugins to use HSX, use: + + $ mv plugins.cabal.hsx plugins.cabal + $ ./Setup.lhs configure --enable-hsx + + Make sure to install HSX first though :) + +------------------------------------------------------------------------ + +* On cygwin/windows you (a) make sure the cygwin "find" is before the + windows "find" on your PATH, and (b) to give the windows-style path + (e.g., "c:/cygwin/usr/local") in the ./configure --prefix=foo/bar + step + +* 'plugs' requires a working readline library. + +* If you wish to use TH in plugins, or to run load()-programs in GHCi, + you require a patch to GHC's linker, that was committed into ghc + 6.3, and ghc 6.2 -stable branch, and is available from 6.2.2 onwards. + +* If you need to regenerate ./configure you need >= autoreconf-2.53 + +* The documentation relies on haddock, latex, dvips, tex2page: + + $ cd doc && make + +------------------------------------------------------------------------ + +EXAMPLES: + +Have a look in the testsuite/ directory for many examples of how to +arrange your code. + +LICENSE: + +This library is distributed under the terms of the LGPL. The runtime +loader code is based on code written by André Pang, and others, and is +distributed under the BSD-style Glasgow University license. + +PORTABILITY: + +Requires GHC 6.4 or greater, though most testing has be done on 6.4. +The dynamic loader requires a functional GHCi implementation. + +---------------------+-------------------------------------------------- + Platform | Works Should work* Unknown Won't work +---------------------+-------------------------------------------------- +i386-*-linux | X +i386-*-freebsd | X +i386-*-openbsd | X +powerpc-apple-darwin | X +powerpc-*-linux | X +sparc-*-solaris2 | X +ia64-*-linux | # +i386-*-solaris2 | X +sparc-*-linux | X +sparc-*-openbsd | X +i386-*-netbsd | X +amd64-*-openbsd | X +mips64-sgi-irix | X +---------------------+-------------------------------------------------- + +# .hi file parsing is currently broken diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,26 @@ +For 1.0 +---------- + ++ broken on mac. +symbols with suspiciously many _ chars + ++ Add verbose versions of the load functions, to avoid -DDEBUG + ++ mention that you need .o archives, not .a ones. Use Cabal, ghc-pkg -u + or ld -r --whole-archive + ++ hs-plugins doesn't know to look for packages in the user packages, +only in the global packages + ++ version numbers in package loads are annyoing + ++ .hi file parser is broken on Itanium, again. + ++ build way=p and way='' + +Cabal +-------- + +What we'd like is a cabalMake version of make, so rather than just +compiling simple plugins, we let cabalMake rebuild whole Haskell apps -- +like Yi! diff --git a/docs/Makefile b/docs/Makefile new file mode 100644 --- /dev/null +++ b/docs/Makefile @@ -0,0 +1,31 @@ +# Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons +# LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html) + +.PHONY: build clean html + +SRC = hs-plugins + +build: $(SRC).ps html + +$(SRC).ps: $(SRC).dvi + dvips -f $(SRC).dvi > $@ + +html: $(SRC).tex + tex2page $(SRC) + tex2page $(SRC) + sed -f munge.sed < $(SRC)/$(SRC).html > tmp.out + mv tmp.out $(SRC)/$(SRC).html + cp $(SRC)/$(SRC).html $(SRC)/index.html + tar czf $(SRC).html.tar.gz $(SRC) + mv $(SRC).html.tar.gz $(SRC)/ + +$(SRC).dvi: $(SRC).tex + latex $(SRC).tex && latex $(SRC).tex + +CLEANS= *.{ps,dvi,aux,log} *~ hs-plugins *-Z-* *.toc + +clean: + rm -rf $(CLEANS) + +all: doc + diff --git a/docs/haskell.sty b/docs/haskell.sty new file mode 100644 --- /dev/null +++ b/docs/haskell.sty @@ -0,0 +1,452 @@ +%%% This is a LaTeX2e style file. +%%% +%%% It supports setting functional languages like Haskell. +%%% +%%% Manuel M. T. Chakravarty [1998..2000] +%%% +%%% $Id: haskell.sty,v 1.2 2004/05/16 08:20:09 dons Exp $ +%%% +%%% This file is free software; you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation; either version 2 of the License, or +%%% (at your option) any later version. +%%% +%%% This file is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% Acknowledegments ========================================================== +%%% +%%% Thanks to Gabriele Keller for beta testing and +%%% code contributions. Thanks to the LaTeX3 project for improving the LaTeX +%%% sources (which helped me writing this code). Furthermore, I am grateful +%%% to Martin Erwig for feedback and +%%% suggestions, and to Conal Elliott for pointing out +%%% a tricky bug. +%%% +%%% TODO ====================================================================== +%%% +%%% B ~ bug; F ~ feature +%%% +%%% * F: Along the lines of the discussion with Martin Erwig add support for +%%% keywords etc (see the emails) +%%% +%%% * B: If we have as input +%%% +%%% \ +%%% +%%% there won't be a `\hsap' inserted!! (Can this be solved by using +%%% \obeylines in \<...\>?) +%%% +%%% * B: A \relax is needed after a & if it immediately followed by a \hsbody{} +%%% (See TeXbook, S.240) +%%% +%%% * F: Implement a \hstext{...} as \(\text{...}\). +%%% +%%% * We would like hswhere* etc that are like haskell* (\hsalign already +%%% supports this, ie, there is a \hsalign*). +%%% +%%% * Star-Versions of if, let etc that use a single line layout (maybe not +%%% with star, because of the above). +%%% +%%% * Support for enforcing and prohibiting breaks in `haskell' displays. +%%% +%%% * Comments in a let-in should be aligned in the same way for the bindings +%%% and the body. +%%% +%%% * It would be nice to have different styles (indentation after in of +%%% let-in or not) etc; either to be set with a package option or in the +%%% preamble (the latter probably makes more sense). +%%% +%%% * Literate programming facility: Variant of the `haskell' env (maybe +%%% `hschunk', which is named and can be used in other chunks). But maybe +%%% it is not necessary to provide a chunk-based reordering mechanism, +%%% because most of the Haskell stuff can be in any order anyway... +%%% Important is to provide a way to define visually pleasing layout +%%% together with the raw Haskell form for program output. (Maybe `haskell*' +%%% as Haskell env that outputs its contents?) +%%% + +%% Initialization +%% ============== + +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{haskell}[2000/10/05 v1.0e Chilli's Haskell Style] + + +%% Parameters +%% ========== + +\newskip\hsmargin +\hsmargin\leftmargini + + +%% Main macros and environments +%% ============================ + +% applications +% +\newcommand{\hsap}{% % application by juxtaposition + \unskip\mskip 4mu plus 1mu} % only the last \hsap counts + +% commands to start and stop setting spaces as \hsap +% +{\obeyspaces\gdef\@hsSpaceToApp{\obeyspaces\let =\hsap}} % spaces matter!!! +{\obeyspaces\gdef\@hsNormalSpace{\let =\space}} + +% commands to start and stop treating numbers specially, ie, we don't want +% them to be affected by font changing commands in Haskell contexts as this +% would give italic numerals; the trick is to redefine their math code such +% that they go into math class 0 and thus don't change families (cf. `The +% TeXbook', Chapter 17, pp152) +% +\newcommand{\@hsRmNumbers}{% + \mathcode`0="0030 + \mathcode`1="0031 + \mathcode`2="0032 + \mathcode`3="0033 + \mathcode`4="0034 + \mathcode`5="0035 + \mathcode`6="0036 + \mathcode`7="0037 + \mathcode`8="0038 + \mathcode`9="0039 + } +\newcommand{\@hsNormalNumbers}{% + \mathcode`0="7030 + \mathcode`1="7031 + \mathcode`2="7032 + \mathcode`3="7033 + \mathcode`4="7034 + \mathcode`5="7035 + \mathcode`6="7036 + \mathcode`7="7037 + \mathcode`8="7038 + \mathcode`9="7039 + } + +% Save the bindings of the standard math commands +% +% This is somewhat subtle as we want to able to enter the original math mode +% within Haskell mode and we have to ensure that the different opening +% commands are matched by the correct versions of the closing commands. +% +\let\@hsmathorg=\( +\let\@hsmathendorg=\) +\let\hs@crorg=\\ +\newcommand{\@hsmath}{% + \relax\hbox\bgroup + \@hsNormalSpace + \@hsNormalNumbers + \let\(=\@hsmathorgx + \let\)=\@hsmathend + \def\\{\hs@crorg}% + \@hsmathorg + } +\newcommand{\@hsmathend}{% + \@hsmathendorg + \egroup + } +\newcommand{\@hsmathorgx}{% + \relax\@hsmathorg + \let\)=\@hsmathendorg + } + +%% Typesetting of Haskell +%% ====================== + +% Inline Haskell phrases are delimited by `\<' and `\>'. +% +% Note: `\>' is only locally redefined. +% +\newcommand{\<}{% + \@hsmathorg + \mathit\bgroup + \@hsSpaceToApp + \@hsRmNumbers + \let\>=\@endhs + \let\(=\@hsmath + \def\\{\cr} % for Haskell alignments + } +\newcommand{\@endhs}{% + \egroup + \@hsmathendorg + } + +% Displayed Haskell (environment `haskell' and `haskell*') +% +% There are two kind of preambles for \halign: \hs@preambleNorm is for +% `amsmath' style alignments and \hs@preambleStar for `equation' style +% alignments (but with an unbound number of columns to its right) +% +% We need #### to get a ## in the \edef building the \halign command. +% +% first the preambles (also used in \hs@align below): +% +\def\hs@preambleNorm{% + \noexpand\<####\unskip\noexpand\>\hfil&&\noexpand% + \<{}####\unskip\noexpand\>\hfil} +\def\hs@preambleStar{% + \noexpand\<####\unskip\noexpand\>\hfil&\hfil\noexpand% + \<{}####\unskip{}\noexpand\>\hfil&&\noexpand\<{}####\noexpand\>\hfil} +% +% the environments: +% +\newenvironment{haskell}{% + \@haskell\hs@preambleNorm}{% + \@endhaskell + } +\newenvironment{haskell*}{% + \@haskell\hs@preambleStar}{% + \@endhaskell + } +% +% auxiliary definition getting the preamble as its first argument and starting +% the environment: +% +\def\@haskell#1{% + \bgroup + \vspace\abovedisplayskip + \let\(=\@hsmath % Important when `\(' occurs after `&'! + \edef\@preamble{% + \halign\bgroup\hskip\hsmargin#1\cr} + \@preamble + } +% +% Auxiliary definition ending environment: +% +\def\@endhaskell{% + \crcr\egroup + \vspace\belowdisplayskip + \egroup\noindent\ignorespaces\global\@ignoretrue% + } + +% single line comment and keyword style +% +\newcommand{\hscom}[1]{% + \relax\(\quad\textnormal{--- #1}\)} +\newcommand{\hskwd}[1]{% + \mathbf{#1}} + +% informal description +% +\newcommand{\hsinf}[1]{% + \(\langle\textnormal{#1}\rangle\)} + +% literals and some special symbols +% +\newcommand{\hschar}[1]{\textrm'\mathrm{#1}\textrm'} % character literals +\newcommand{\hsstr}[1]{"\mathrm{#1}"} % strings literals +\newcommand{\hsfrom}{\leftarrow} % <- + +% aligned subphrases +% +% check for an optional star and combine prefix (in #1) with one of the two +% preambles (with star means to center the material between the first and +% second &) +% +\def\hs@align#1{% + \@ifstar + {\hs@align@pre{#1\hs@preambleStar}}% + {\hs@align@pre{#1\hs@preambleNorm}}% + } +% +% test for optional argument; #1: preamble +% +\def\hs@align@pre#1{% + \@testopt{\hs@align@prealign#1}t} +% +% got all arguments, now for the real code; #1: preamble; #2: alignment; +% #3: body (the material set by the \halign) +% +\def\hs@align@prealign#1[#2]#3{% + \relax\( + \edef\@preamble{% + \halign\bgroup#1\cr} + \if #2t\vtop \else \if#2b\vbox \else \vcenter \fi\fi + \bgroup% + \@preamble + #3% + \crcr\egroup% + \egroup\) + } +% +% user-level command: alignment without a prefix +% +\newcommand{\hsalign}{% + \relax + \hs@align\relax% + } + +% subphrase breaking the surrounding alignment being flushed left +% +\newcommand{\hsnoalign}[1]{% + \noalign{% + \hs@align{\hskip\hsmargin}{#1}% + }% + } + +% body expression breaking the surrounding alignment +% +% * setting \hsmargin to 0pt within the preamble (and _after_ it is used in +% the preamble) is crucial, as we want \hsmargin only to be applied in +% _outermost_ alignments +% +\newcommand{\hsbody}[1]{% + {}\\ + \noalign{% + \hs@align{\hskip\hsmargin\quad\hsmargin0pt}{#1}% + }% + } + + +%% Defining commands for use in the Haskell mode +%% ============================================= +%% +%% We use some of the low-level machinery defined in LaTeX's source file +%% `ltdefns.dtx'. +%% +%% \hscommand is similar to \newcommand, but there is no *-version. +%% +%% We use our own definitions here to insert a strategic `\relax' (see below) +%% and to obey spaces within the bodies of Haskell definitions. + +\newcommand{\hscommand}[1]{\@testopt{\hs@newcommand#1}0} +\def\hs@newcommand#1[#2]{% + \obeyspaces % spaces count in Haskell macros + \@ifnextchar [{\hs@xargdef#1[#2]}% + {\hs@argdef#1[#2]}} + +% All this trouble only to be able to add the `\relax' into the expansion +% process. If we don't that, commands without optional arguments when +% invoked after an alignment character & don't work properly (actually, the +% \obeyspaces doesn't work). I am sure that has to do with the scanning for +% \omit etc in \halign (TeXbook, p240), but I don't understand yet why it +% is problematic in this case. +% +% Furthermore, we switch off \obeyspaces in the end. +% +\long\def\hs@argdef#1[#2]#3{% + \@ifdefinable#1{% + \expandafter\def\expandafter#1\expandafter{% + \relax % in order to stop token expansion after & + \csname\string#1\expandafter\endcsname}% + \expandafter\@yargdef + \csname\string#1\endcsname + \@ne + {#2}% + {#3}}% + \catcode`\ =10% % stop obeying spaces now + } + +% Switch off \obeyspaces in the end. +% +\long\def\hs@xargdef#1[#2][#3]#4{% + \@ifdefinable#1{% + \expandafter\def\expandafter#1\expandafter{% + \expandafter + \@protected@testopt + \expandafter + #1% + \csname\string#1\expandafter\endcsname + {#3}}% + \expandafter\@yargdef + \csname\string#1\endcsname + \tw@ + {#2}% + {#4}}% + \catcode`\ =10% % stop obeying spaces now + } + + +%% Abbreviations +%% ============= + +% infix operators +% +\newcommand{\hsapp}{\mathbin{+\mkern-7mu+}} +\newcommand{\hsifix}[1]{\mathbin{\string`#1\string`}} + +% let expression +% +\hscommand{\hslet}[3][t]{% + \hsalign[#1]{% + \hskwd{let}\\ + \quad\hsalign{#2}\\ + \hskwd{in}\\ + #3 + }% + } + +% if expression +% +\hscommand{\hsif}[4][t]{% + \hsalign[#1]{% + \hskwd{if} #2 \hskwd{then}\\ + \quad\hsalign{#3}\\ + \hskwd{else}\\ + \quad\hsalign{#4}% + }% + } + +% case expression +% +\hscommand{\hscase}[3][t]{% + \hsalign[#1]{% + \hskwd{case} #2 \hskwd{of}\\ + \quad\hsalign{#3}% + }% + } + +% where clause +% +% * it is important to take the \quad into the preamble, so that nested +% \noaligns can break it +% +\hscommand{\hswhere}[1]{% + \hsbody{% + \hskwd{where}\\ + \hs@align{\quad}{#1}% + }% + } + +% do expression +% +\hscommand{\hsdo}[2][t]{% + \hsalign[#1]{% + \hskwd{do}\\ + \quad\hsalign{#2}\\ + }% + } + + +%% Extensions for Distributed Haskell (Goffin) +%% =========================================== +%% +%% These definitions may change in the future. + +\hscommand{\hsunif}{\mathbin{:=:}} +\hscommand{\hsalias}{\mathrel{\sim}} +\hscommand{\hsoutof}{\twoheadleftarrow} +\hscommand{\hsinto}{\twoheadrightarrow} +\hscommand{\hsparc}{\binampersand} +\hscommand{\hsseq}{\Longrightarrow} +\hscommand{\hsex}[2]{{\hskwd{ex} #1 \hskwd{in} #2}} + +\hscommand{\hsexin}[3][t]{% + \hsalign[#1]{% + \hskwd{ex} #2 \hskwd{in}\\ + \quad\hsalign{#3}\\ + }% + } + +\hscommand{\hschoice}[2][t]{% + \hsalign[#1]{% + \hskwd{choice}\\ + \quad\hsalign{#2}\\ + }% + } + + diff --git a/docs/hs-plugins.1 b/docs/hs-plugins.1 new file mode 100644 --- /dev/null +++ b/docs/hs-plugins.1 @@ -0,0 +1,36 @@ +.TH HS-PLUGINS 1 2005-12-27 "hs-plugins version 1.0" "User Manual" + +.SH NAME +hs-plugins \- dynamic linker library for Haskell + +.SH DESCRIPTION +.ds c \fIhs-plugins\fP +\*c is a library for loading code written in Haskell into an +application at runtime, in the form of plugins. It also provides a +mechanism for (re-)compiling Haskell source at runtime. Thirdly, a +combination of runtime compilation and dynamic loading provides a set +of eval functions. Values exported by plugins are transparently +available to Haskell host applications, and bindings exist to use +Haskell plugins from at least C and Objective C programs. hs-plugins +requires GHC 6.4 or later. + +.SH DOCUMENTATION +The hs-plugins user manual is distributed in html format, and may be +found at + +.SH BUGS +Bug reports, and any other feedback, should be sent to +Don Stewart +.SH COPYRIGHT +Copyright \(co 2003-2005 Don Stewart +.PP +The hs-plugins library modules are distributed under the terms of the +LGPL. +.SH "SEE ALSO" +.BR dlopen (3) + +.SH AUTHOR + +This manual page was written by Don Stewart, based on the man page for +cpphs (written by Ian Lynagh). + diff --git a/docs/hs-plugins.hdir b/docs/hs-plugins.hdir new file mode 100644 --- /dev/null +++ b/docs/hs-plugins.hdir @@ -0,0 +1,1 @@ +hs-plugins diff --git a/docs/hs-plugins.tex b/docs/hs-plugins.tex new file mode 100644 --- /dev/null +++ b/docs/hs-plugins.tex @@ -0,0 +1,1804 @@ +\documentclass{article} + +\usepackage{url} +\usepackage{tex2page} + +% typeset math as ascii +\htmlmathstyle{no-in-text-image no-display-image} + +% something other than | +\verbescapechar\& + +\cssblock +h1 {font-size: 16pt} +h2 {font-size: 15pt} +\endcssblock + +% color of verbatim elements +\cssblock +.verbatim {color: grey20} + +.scheme .variable {color: grey20} +.scheme .keyword {color: navy} +.scheme .builtin {color: maroon} +\endcssblock + +% add some extra keywords +\scmkeyword{as case class data default deriving do else hiding if} +\scmkeyword{import in infix infixl infixr instance let module newtype} +\scmkeyword{of qualified then type where forall \\ } +\scmbuiltin{: :: = -> <- @ ~ => - >>= >> } + +\newcommand{\code}[1]{{\texttt{#1}}} +\newcommand{\hsplugins}{{\texttt{hs-plugins}}} + +\title{hs-plugins\\ + Dynamically Loaded Haskell Modules} + +\author{\urlh{http://www.cse.unsw.edu.au/~dons}{Don Stewart}} + +\begin{document} + +\maketitle + +\medskip +% +{\htmlonly \textbf{Download \endhtmlonly +\urlh{ftp://ftp.cse.unsw.edu.au/pub/users/dons/hs-plugins/hs-plugins-1.0.tar.gz} + {version 1.0}} +% +\medskip + +\hsplugins{} is a library for loading code written in Haskell into an +application at runtime, in the form of plugins. It also provides a +mechanism for (re-)compiling Haskell source at runtime. Thirdly, a +combination of runtime compilation and dynamic loading provides a set of +\code{eval} functions-- a form of runtime metaprogramming. Values +exported by Haskell plugins are transparently available to Haskell host +applications, and bindings exist to use Haskell dynamically in C, Perl +and Objective C programs. \hsplugins{} requires GHC 6.4 or later. + +\medskip + +% grr. double spaced. + +\tableofcontents + +\newpage + +\section{Download} + +\begin{itemize} + +\item +Download the latest stable release:\\ +\url{ftp://ftp.cse.unsw.edu.au/pub/users/dons/hs-plugins/hs-plugins-1.0.tar.gz} + +\item +Darcs repository of the latest code:\\ +\url{darcs get http://www.cse.unsw.edu.au/~dons/code/hs-plugins} + +\item +A tarball of the document you are reading:\\ +\url{http://www.cse.unsw.edu.au/~dons/hs-plugins/hs-plugins.html.tar.gz} + +\item +A postscript version of the document you are reading:\\ +\url{http://www.cse.unsw.edu.au/~dons/hs-plugins/hs-plugins.ps.gz} + +\item +Papers: +\begin{itemize} +\item A paper on interesting uses of \hsplugins{} to enable Haskell to be used +as an application extension language:\\ +\url{http://www.cse.unsw.edu.au/~dons/papers/PSSC04.html} + +\item +A paper on dynamic applications in Haskell, utilizing \hsplugins{}:\\ +\url{http://www.cse.unsw.edu.au/~dons/papers/SC05.html} +\end{itemize} + +\end{itemize} + +It is known to run on \code{i386-\{linux,freebsd,openbsd\}}, +\code{sparc-solaris2}, \code{powerpc-\{macosx,linux\}} and flavours of +Windows. + +\section{History} + +\begin{itemize} + \item Jan 2006, v1.0 + \begin{itemize} + \item Cabalised build system + \item Behave better on 64 bit platforms + \item Haddock documentation of the API. + \item A couple of bug fixes + \end{itemize} + + \item June 2005, v0.9.10 + \begin{itemize} + \item Support for GHC 6.4, with help from Sean + Seefried for the package.conf parser. + \item Ported to Windows of various flavours thanks to Vivian McPhail and Shelarcy + \item Removed posix and unix dependencies + \item Now uses HSX parser, thanks to Niklas Broberg + \item Extended load interface, thanks to Lemmih + \item Source now in a darcs repository + \item Supports building with GNU make -jN + \item Simplified module hierarchy, moved under System.* namespace + \item pdynload clarifications, thanks to Alistair Bayley + \item Miscellaneous bug fixes + \end{itemize} + + \item February 2005, v0.9.8 + \begin{itemize} + \item Fix bug in .hi parsing. + \item Add reloading of packages. + \item Fix bug in canonical module names + (fixing problems with "Foo.o" and "./Foo.o" + \item Fix for hierarchical names, don't guess them, + read them from the .hi file. + \item Add new varients of load. + \item Fix bug in makeAll, such that dependent module + changes were not noticed. + \item Add varient of eval:\code{ unsafeEval\_}, returing + Either. + \item Better, bigger testsuite. + \item Better api. + \end{itemize} + + \item September 2004. + \begin{itemize} + \item makeAll + \item Better return type for make. + \end{itemize} + + \item Mid August 2004, v0.9.6 release. + \begin{itemize} + \item More portable, thanks to debugging by Niklas Broberg. + \item Other small fixes to the interfaces. + \item Provides a runtime-generated printf. + \end{itemize} + + \item Mid July 2004, added new pdynload strategy. + + \item Mid-June 2004, v0.9.5 release. + \begin{itemize} + \item dynamic typing is working + + \item static typing of interfaces is working + + \item Adds \code{eval}, and \code{hs\_eval} + + \item bugs fixed. + \end{itemize} + + \item Early-June 2004, v0.9.4 release. + \begin{itemize} + + \item Adds a .hi file parser. We use this to work out + plugin dependencies directly, meaning no more + \code{.dep} files or \code{ghcp}. + + \item It also adds a package.conf parser, meaning we + can properly handle packages that either aren't stored + in the normal location, don't have a canonical name, + or are found using a -package-conf argument. Thanks to + Sean for this work. + + \item the interface to load() has changed to allow a + list of package.conf files to search for packages. + + \item the interace to make() has changed, so that you + can get back any stderr output produced during plugin + compilation. + + \item It solves a bug whereby a package that is + required by another package would not be loaded unless + the plugin itself depended on this indirect package. + + \item more stable, more examples. + \end{itemize} + + \item May 2004, v0.9.3 released, adding support for dependency + conflict resolution between multiple plugins. Several plugins with + shared dependencies can now be safely loaded at once. --prefix is now + respected in ./configure. Thanks to Sean for this patch. + + \item v0.9.2 change licence to LGPL + + \item v0.9.1 expand on the documentation + + \item v0.9 released, initial source release + +\end{itemize} + +\section{Acknowledgements} + +\begin{itemize} + +\item Andr\'e Pang's \code{runtime\_loader} was the inspiration and basis +of the dynamic loader (\url{http://www.algorithm.com.au}). +\hsplugins{} has benefited from many discussions with him, +particularly to do with dependency checking and dynamic typing, and +bug reports. Andr\'e wrote an objective C binding to hs-plugins, and +helped with the design of eval(). He also fixed GHC so we could load +the dynamic loader dynamically. + +\item Sean Seefried (\url{http://www.cse.unsw.edu.au/~sseefried}) was +the first user of \hsplugins{} and his code and feedback have helped +make the library much more useful and powerful. + +\item Manuel Chakravarty's \code{take} system provided the basis for +\code{make}, and helped with several issues to do with safety of +plugins, apis and the applications that use them. +Manuel also helped with the design of eval(), and on how to +successfully evaluate polymorphic functions using rank-N types. + +\item Simon Marlow helped with several issues to do with linking and +loading static and dynamic code, and provided many useful suggestions. + +\item Hampus Ram's dynamic loader +(\url{http://www.dtek.chalmers.se/~d00ram/dynamic/}) provided the +design of the state maintained by the loader, and for thread safety +issues relating to this. + +\item Shae Erisson provided several insights into more powerful uses +of the library. Thanks to everyone on \#haskell who provided +discussion about the library. + +\item Malcolm Wallace's \code{hmake} provided some useful insights in +how to compile Haskell source in a way that makes it appear like an +interpreter, used in the interactive environment: \code{plugs}. + +\item Niklas Broberg helped a lot by testing, and providing feedback for +the new make and load API. Thanks Niklas. + +\item Finally, thanks to everyone who has worked on GHC and its +libraries: for GHCi, the .hi interface parser, the package system, and +all the other code the \hsplugins{} depends on. + +\end{itemize} + +\newpage + +\section{Overview} + +\hsplugins{} is a library for compiling and loading Haskell code into a +program at runtime. It allows you to write Haskell code (which may +be spread over multiple modules), and have an application (implemented in +any language with a Haskell FFI binding, including Haskell) load and use +your code at runtime. + +\hsplugins{} provides 3 major features: +% +\begin{itemize} + \item a dynamic loader, + \item a compilation manager, and + \item a Haskell evaluator +\end{itemize} + +The \emph{dynamic loader} loads objects into the address space of an +application, along with any dependencies the plugin may have. The +loader is a binding to the GHC runtime system's dynamic linker, which +does single object loading. GHC also performs the necessary linking of +new objects into the running process. On top of the GHC loader is a +Haskell layer that arranges for module and package dependencies to be +found prior to loading individual modules. + +The \emph{compilation manager} is a \code{make}-like system for +compiling Haskell source code into a form suitable for loading. While +plugins are normally thought of as strictly object code, there are a +variety of scenarios where it is desirable to be able to inspect the +source code of a plugin, or to be able to recompile a plugin at runtime. +The compilation manager fills this role. It is particularly useful in +the implementation of \code{eval}. + +The \emph{evaluator}, \code{eval}, utilizes the loader and compilation +manager. When passed a string containing a Haskell expression, it +compiles the string to object code, loads the result, and returns a +Haskell value representing the compiled string to the caller. It can be +considered a Haskell interpreter, implemented as a library, and can be +used to embed Haskell evaluation facilities in an application. + +\section{Dynamic Loader} + +The interface to the \hsplugins{} library can be divided into a number +of sections representing the functional units of the library. +Additionally, depending on the level of trust the application places +in the plugins, a variety of additional checks can be made on the +plugin as it is loaded. The levels of type safety possible are +summarised at the end of Section \ref{sec:compilation-manger} section. +The dynamic loader is available by using \code{-package plugins}. + +\subsection*{Interface} +% +\begin{quote} +\scm{ +import System.Plugins + +load :: FilePath + -> [FilePath] + -> [PackageConf] + -> Symbol + -> IO (LoadStatus a) +} + +\scm{ +load_ :: FilePath + -> [FilePath] + -> Symbol + -> IO (LoadStatus a) +} + +\scm{ +data LoadStatus a + = LoadSuccess Module a + | LoadFailure Errors +} +\end{quote} +% +Example: +% +\begin{quote} +\scm{ +do mv <- load "Plugin.o" ["api"] [] "resource" + case mv of + LoadFailure msg -> print msg + LoadSuccess _ v -> return v +} +\end{quote} +% +This is the basic interface to the dynamic loader. Load the object file +specified by the first argument into the address space (the library will +preload any module or package dependencies). The second argument is an +include path to any additional objects to load (possibly the API of the +plugin). The third argument is a list of paths to any user-defined +\code{package.conf} files, specifying packages unknown to the GHC +package system. \code{Symbol} is a string specifying the symbol name you +wish to lookup. \code{load} returns a \code{LoadStatus} value representing +failure, or an abstract representation of the module (for calls to +\code{unload} or \code{reload}) with the symbol as a Haskell value. The +value returned must be given an explicit type signature, or provided +with appropriate type constraints such that GHC can determine the +expected type returned by \code{load}. + +\code{load\_} is provided for the common situation where no user-defined +package.conf files are required. + +\begin{quote} +\scm{ +dynload :: Typeable a + => FilePath + -> [FilePath] + -> [PackageConf] + -> Symbol + -> IO (LoadStatus a) +} +\end{quote} +% +Example: +% +\begin{quote} +\scm{ +do mv <- dynload "Plugin.o" ["api"] ["plugins.conf.inplace"] "resource" + case mv of + LoadFailure msg -> print msg + LoadSuccess _ v -> putStrLn v +} +\end{quote} +% +\code{dynload} is a safer form of \code{load}. It uses dynamic types +to perform a check on the value returned by \code{load} at runtime, to +ensure that it has the type the application expects it to have. + +In order to use \code{dynload}, the symbol the plugin exports must be +of type \code{AltData.Dynamic:Dynamic}. (See the \code{AltData} library +distributed with \hsplugins{}, and the \hsplugins{} +\code{examples/dynload} directory. References to \code{Typeable} and +\code{Dynamic} refer to the \hsplugins{} reimplementation of these +libraries. \code{AltData.Dynamic} is used at the moment, as there is a +limitation in the existing Data.Dynamic library in the presence of +dynamic loading). + +The value wrapped up in the \code{Dynamic} must be an instance of +\code{AltData.Typeable}. If the value exported by the plugin \emph{is} +of type \code{Dynamic}, and the value wrapped by the \code{Dynamic} +does not match the type expected of it by the application, +\code{dynload} will return \code{Nothing}, indicating that the plugin +is not typesafe with respect to the application. If the value passes +the typecheck, \code{dynload} will return \code{LoadSuccess}. If the value +exported by the plugin is \emph{not} of type \code{Dynamic}, +\code{dynload} will crash---this is a limitation of the existing +\code{Dynamic} library, it can only type-check \code{Dynamic} values. +Additionally, Data.Dynamic is limited to monomorphic types, or must be +wrapped inside a rank-N type to hide the polymorphism from the +typechecker. This is a bit cumbersome. An alternative typesafe +\code{load} is available via the \code{pdynload} interface, which is +able to enforce the type of the plugin using GHC's type inference +mechanism, and is not restricted in its expressiveness (at the cost of +greater load times): + +\begin{quote} +\scm{ +pdynload :: FilePath + -> [FilePath] + -> [PackageConf] + -> Type + -> Symbol + -> IO (LoadStatus a) +} + +\scm{ +pdynload_ :: FilePath + -> [FilePath] + -> [PackageConf] + -> [Arg] + -> Type + -> Symbol + -> IO (LoadStatus a) +} +\end{quote} +% +Example: +% +\begin{quote} +\scm{ +do v <- pdynload "Plugin.o" ["api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ a -> putStrLn "yay!" + _ -> putStrLn "type error" +} +\end{quote} +% +\code{pdynload} is a replacement for \code{dynload}, which provides a +solution to the various problems caused by the existing dynamics +library in Haskell. Rather than use normal dynamics, which constrain +us to monomorphic types only (or rank-N types), it instead uses GHC's +type inference to unify the plugin's export value with that provided +by the api (via its .hi file). It is a form of \emph{staged type inference} +for module interfaces, allowing plugins to use any type definable in Haskell. +\code{pdynload} is like \code{dynload}, but requires a new \code{Type} +argument. This can be considered a type annotation on the value the plugin +should be constrained to. + +Prior to loading the object, \code{pdynload} generates a tiny Haskell +source file containing, for example: +% +\begin{quote} +\scm{ +module APITypeConstraint where +import qualified API +import qualified Plugin + +_ = Plugin.resource :: API.Interface +} +\end{quote} +% +It then calls GHC's type checker on this file, which runs the full +Haskell type inference machinery. If the file typecheckes, then the +plugin type is correct, and the plugin is safe to load, otherwise it +is an error. + +Because we use the full Haskell type checker, we can have a form of +dynamic typechecking, on any type expressable in Haskell. A plugin's +value may, for example, have class constraints -- something not +checkable using the standard Dyanmic type. The cost is that +\code{pdynload} is roughly 46\% slower than an unchecked load. + +The type of the plugin's resource field must be equivalent to the +\code{Type}. There are some restrictions on the arguments that may be +passed to pdynload. Currently, we require: + \begin{itemize} + \item The object name has the suffix (.o) removed and this + becomes a qualified module name in the generated type-checker + input file. + + \item The type name must be a single fully-qualified + type-identifier, as the module name is stripped off (i.e. + everything up to the last ".") and used as a qualified import. + This means that you can't use, for example, \code{"Int -> + String"} as a type (type synonyms are fine, though). + +\end{itemize} + +For example, \code{pdynload "API2.o" ["./"] [] "API.PluginAPI" +"doAction"} generates: + +\begin{quote} +\scm{ +module where +import qualified API -- comes from API.PluginAPI argument +import qualified API2 -- comes from API2.o argument +_ = API2.doAction :: API.PluginAPI +} +\end{quote} + +\begin{quote} +\scm{ +unload :: Module -> IO () +} + +\scm{ +unloadAll :: Module -> IO () +} +\end{quote} + +Unload an object, \emph{but not its dependencies} from the address +space. \code{unloadAll} performs cascading unloading of a module +\emph{and} its dependencies. + +\begin{quote} +\scm{ +reload :: Module -> Symbol -> IO (LoadStatus a) +} +\end{quote} + +Unload, and then reload a module that must have been previously +loaded. Doesn't reload the dependencies. \code{reload} is useful in +conjunction with \code{make}---a call to \code{reload} can be +performed if \code{make} has recompiled the plugin source. + +Additionally, some support is provided to manipulation of +libraries of Haskell modules (usually known as packages): + +\begin{quote} +\scm{ +loadPackage :: String -> IO () + +unloadPackage :: String -> IO () + +loadPackageWith :: String -> [PackageConf] -> IO () +} +\end{quote} + +\code{loadPackage} explcitly pulls in a library (which must be visible +in the current package namespace. \code{unloadPackage} unloads it. +\code{loadPackageWith} behaves like \code{loadPackage}, but you are able +to supply extra package.confs to augment the library search path. + +Examples: +\begin{quote} +\scm{ +do loadPackageWith "yi" ["yi.conf"] + unloadPackage "yi-0.1" +} +\end{quote} + +\newpage + +\section{Compilation Manager} + +The compilation manager is the system by which Haskell source code is +compiled to object code suitable for loading. + +\subsection*{Interface} + +\begin{quote} +\scm{ +import System.Plugins + +make :: FilePath + -> [Arg] + -> IO MakeStatus + +makeAll :: FilePath + -> [Arg] + -> IO MakeStatus + +recompileAll :: Module + -> [Arg] + -> IO MakeStatus + +data MakeStatus + = MakeSuccess MakeCode FilePath + | MakeFailure Errors + +data MakeCode = ReComp | NotReq +} +\end{quote} + +Compile a Haskell source file to an object file, with any arguments +specified in the argument list passed through to GHC. Returns the +build status. + +\code{make} generates a GHC \code{.hi} file containing a list of +package and objects that the source depends on. Subsequent calls to +\code{load} will use this interface file to load module and library +dependencies prior to loading the object itself. \code{makeAll} also +recursively compiles any dependencies it can find using GHC's +\code{--make} flag. + +\code{recompileAll} is like \code{makeAll}, but rather than relying on +\code{ghc --make}, we explicitly check a module's dependencies. + +\begin{quote} +\scm{ +merge :: FilePath -> FilePath -> IO MergeStatus + +mergeTo :: FilePath -> FilePath -> FilePath -> IO MergeStatus + +mergeToDir :: FilePath -> FilePath -> FilePath -> IO MergeStatus + +data MergeStatus + = MergeSuccess MergeCode Args FilePath + | MergeFailure Errors + +type MergeCode = MakeCode +} +\end{quote} + +The merging operation is extremely useful for providing extra default +syntax. An EDSL user then need not worry about declaring module names, +or having required imports. In this way, the stub file can also be +used to provide syntax declarations that would be inconvenient to +require of the plugin author. \code{merge} will include any import and +export declarations written in the stub, as well as any module name, +so that plugin author's need not worry about this compulsory syntax. +Additionally, if a plugin requires some non-standard library, which +must be provided as a \code{-package} flag to GHC, they may specify +this using the non-standard \code{GLOBALOPTIONS} pragma. Options +specified in the source this way will be added to the command line. +This is useful for users who wish to use GHC flags that cannot be +specified using the conventional \code{OPTIONS} pragma. The merging +operation uses the HSX parser library to parse Haskell source files. + +\code{mergeTo} behaves like \code{merge}, but we can specify the file in +which to place output. \code{mergeToDir} lets you specify a directory in +which to place merged files. + +\begin{quote} +\scm{ +makeWith :: FilePath + -> FilePath + -> [Arg] + -> IO MakeStatus +} +\end{quote} + +This is a variety of \code{make} that first calls \code{merge} to +combine the plugin source with a syntax stub. The result is then +compiled. This is the preferred interface to EDSL authors who wish to +add extra syntax to a user's source. It is important to note that the +module and types from the second file argument are used to override +any of those that appear in the first argument. For example, consider +the following source files: + +\begin{quote} +\scm{ +module A where + +a :: Integer +a = 1 +} +\end{quote} + +\begin{quote} +\scm{ +module B where + +a :: Int +} +\end{quote} + +Calling \code{makeWith "A" "B" []} will merge the module name and types +from module B into module A, generating a third file: + +\begin{quote} +\scm{ +{-# LINE 1 "A.hs" #-} +module MxYz123 where + +{-# LINE 3 "B.hs" #-} +a :: Int +{-# LINE 4 "A.hs" #-} +a = 1 +} +\end{quote} + +Leading to the desired result that we can ignore user-supplied module +names and types. Knowing the module name, in particular, is important +for dynamic loading, which requires the module name be known when +searching for symbols. + +\begin{quote} +\scm{ +hasChanged :: Module -> IO Bool +} +\end{quote} + +\code{hasChanged} returns \code{True} if the module or any of its +dependencies have older object files than source files. Defaults to +\code{True} if some files couldn't be located. + +\subsection*{Levels of Safety} + +The normal dynamic loader, using \code{load} on object files only, +places full trust in the author of the plugin to provide a type-safe +object file, containing valid code. This can be mitigated somewhat via +the use of \code{make} to ensure that the plugin is at least Haskell +code that is well-typed internally (if we trust GHC to compile it +correctly). + +If we trust the user to provide an interface of \code{Dynamic} type, we +can check the plugin type at runtime, but the plugin's value must be +\code{Typeable}, which restricts it to be a monomorphic type (or to +using rank-N tricks). + +The greatest safety can be obtained by using \code{pdynload}, at the +cost of increased load times. \code{pdynload} essentially performs full +type inference on the plugin interface at runtime. The type safety of +the plugin, using \code{pdynload}, is then as safe as if the plugin was +statically compiled into the application. It does not provide any +\emph{further} safety than exists in static compilation. For example, it +does not preclude the use of (evil) \code{unsafeCoerce\#} to defeat +type-checking, either statically or at runtime. An extensive discussion +of type safe plugin loading is available in the \hsplugins{} paper +\urlh{http://www.cse.unsw.edu.au/~dons/hs-plugins/paper}{here}. + +\newpage + +\section{Eval.Haskell} + +\code{eval}, and its siblings, provide a mechanism to compile and run +Haskell code at runtime, in the form of a String. The general framework +is that the string is used to create a plugin source file, which is +compiled and loaded, and type checked against its use. The resulting +value is returned to the caller. It resembles a runtime metaprogramming +\code{run} operator for closed code fragments. + +\subsection*{Interface} + +\begin{quote} +\scm{ +import System.Eval.Haskell + +eval :: Typeable a => String -> [Import] -> IO (Maybe a) + +eval_ :: Typeable a => + String -- code to compile + -> [Import] -- any imports + -> [String] -- extra ghc flags + -> [FilePath] -- extra package.conf files + -> [FilePath] -- include search paths + -> IO (Either [String] (Maybe a)) +} +\end{quote} + +\code{eval} takes a string, and a list of import module names, and +returns a \code{Maybe} value. \code{Nothing} means the code did not +compile, or did not typecheck at its splice point. \code{Just v} gives +you \code{v}, the result of evaluating your code. It is interesting to +note that \code{eval} has the type of an interpreter. The +\code{Typeable} constraint is used to type check the evaluated code when +it is loaded, using \code{dynload}. As usual, \code{eval\_} is a +version of \code{eval} that lets you pass extra flags to ghc and to the +dynamic loader. + +The existing \code{Data.Dynamic} library requires that only monomorphic +values are \code{Typeable}, so in order to evaluate polymorphic +functions you need to wrap them up using rank-N types. Some examples: +% +\begin{quote} +\scm{ +import System.Eval.Haskell + +main = do i <- eval "1 + 6 :: Int" [] :: IO (Maybe Int) + if isJust i then putStrLn (show (fromJust i)) else return () +} +\end{quote} + +When executed this program calls \code{eval} to compile and load the +simple arithmetic expression, returning the result, which is +displayed. If the value loaded is not of type \code{Int}, +\code{dynload} will throw an exception. + +The following example, due to Manuel Chakravarty, shows how to +evaluate a polymorphic function. Polymorphic values are not easily +made dynamically typeable, but this example shows how to do it. The +module \code{Poly} is imported as the second argument, providing the +type of the polymorphic function: +% +\begin{quote} +\scm{ +import Poly +import System.Eval.Haskell + +main = do m_f <- eval "Fn (\\x y -> x == y)" ["Poly"] + when (isJust m_f) $ do + let (Fn f) = fromJust m_f + putStrLn $ show (f True True) + putStrLn $ show (f 1 2) +} +\end{quote} +% +And the type of \code{Fn}: +% +\begin{quote} +\scm{ +{-# OPTIONS -fglasgow-exts #-} +module Poly where + +import AltData.Typeable + +data Fn = Fn {fn :: forall t. Eq t => t -> t -> Bool} + +instance Typeable Fn where + typeOf _ = mkAppTy (mkTyCon "Poly.Fn") [] +} +\end{quote} +% +When executed, this program produces: +% +\begin{quote} +\begin{verbatim} +$ ./a.out +True +False +\end{verbatim} +\end{quote} + +We thus get dynamically typeable polymorphic functions. + +\begin{quote} +\scm{ +unsafeEval :: String -> [Import] -> IO (Maybe a) + +unsafeEval_ :: String + -> [Import] + -> [String] + -> [FilePath] + -> IO (Either [String] a) +} +\end{quote} + +Wrapping up polymorphic values can be annoying, so we provide a +\code{unsafeEval} function for people who like to live on the edge, +which dispenses with dynamic typing, relying instead on the +application to provide the correct type annotation on the call to +\code{eval}. If the type loaded by \code{eval} is wrong, +\code{unsafeEval} will crash. However, its lets us remove some +restrictions on what types can be evaluated, which can be useful. + +{unsafeEval\_} lets the application have full control over the import +environment and load flags to the eval call, which is useful for +applications that wish to script themselves, and require specific +modules and packages to be in scope in the eval-generated module. + +This example maps a \code{toUpper} over a list: +% +\begin{quote} +\scm{ +import Eval.Haskell + +main = do s <- unsafeEval "map toUpper \"haskell\"" ["Data.Char"] + when (isJust s) $ putStrLn (fromJust s) +} +\end{quote} + +And here we evaluate a lambda abstraction, applying the result to +construct a tuple. Note the type information that must be supplied in +order for Haskell to type the usage of \code{fn}: +% +\begin{quote} +\scm{ +import System.Eval.Haskell + +main = do fn <- unsafeEval "(\\(x::Int) -> (x,x))" [] :: IO (Maybe (Int -> (Int,Int))) + when (isJust fn) $ putStrLn $ show $ (fromJust fn) 7 +} +\end{quote} +\subsection{Utilities for use with eval} +\code{hs-plugins} proves the following utilities for use with \code{eval}: +\begin{itemize} +\item +\code{mkHsValues} is a helper function for converting \code{Data.Map}s +of names and values into Haskell code. It relies on the assumption +that the passed values' Show instances produce valid Haskell +literals (this is true for all prelude types). It's type is as follows: +\begin{quote} +\scm{ +mkHsValues :: (Show a) => Data.Map String a -> String +} +\end{quote} +\end{itemize} +% \subsection{Foreign Eval} +% +% A preliminary binding to \code{eval} has been implemented to allow C +% (and Objective C) programs access to the evaluator. Foreign bindings +% to the compilation manager and dynamic loader are yet to be +% implemented, but shouldn't be too hard. An foreign binding to a +% Haskell module that wraps up calls to \code{make} and \code{load} +% would be fairly trivial. +% +% At the moment we have an ad-hoc binding to \code{eval}, so that C +% programmers who know the type of value that will be returned by +% Haskell can call the appropriate hook into the evaluator. If they get +% the type wrong, a nullPtr will be returned (so calling Haskell is +% still typesafe). The foreign bindings to \code{eval} all return +% \code{NULL} if an error occurred, otherwise a pointer to the value is +% returned. +% +% \begin{quote} +% \scm{ +% foreign export ccall hs_eval_b :: CString -> IO (Ptr CInt) +% +% foreign export ccall hs_eval_c :: CString -> IO (Ptr CChar) +% +% foreign export ccall hs_eval_i :: CString -> IO (Ptr CInt) +% +% foreign export ccall hs_eval_s :: CString -> IO CString +% } +% \end{quote} +% +% An example C program for compiling and evaluating Haskell code at +% runtime follows. This program calculates a fibonacci number, returning +% it as a \code{CString} to the C program: +% % +% \begin{quote} +% \begin{verbatim} +% #include "EvalHaskell.h" +% #include +% +% int main(int argc, char *argv[]) +% { +% char *p; +% hs_init(&argc, &argv); +% p = hs_eval_s("show $ let fibs = 1:1:zipWith (+) fibs (tail fibs) in fibs !! 20"); +% if (p != NULL) +% printf("%s\n",p); +% else +% printf("error in code\n"); +% hs_exit(); +% return 0; +% } +% \end{verbatim} +% \end{quote} +% + +\section{RTS Binding} + +The low level interface is the binding to GHC's Linker.c. Therefore, +\hsplugins{} only works on platforms with a working GHCi. This library +is based on code from André Pang's runtime loader. The low level +interface is as follows: + +\begin{itemize} + \item \code{initLinker} \em start the linker up + \item \code{loadObject} \em load a vanilla .o + \item \code{loadPackage} \em load a GHC library and its cbits + \item \code{loadShared } \em load a .so object file + \item \code{resolveObjs} \em and resolve symbols +\end{itemize} + +Additionally, \code{Hi.Parser} provides an interface to a GHC +\code{.hi} file parser. Currently we only parse just the dependency +information, import and export information from \code{.hi} files, but +all the code is there for an application to extract other information +from \code{.hi} files. + +\newpage + +\section{Dynamic Loader Implementation} + +The dynamic loader is the system by which modules, and their +dependencies can be loaded, unloaded or reloaded at runtime, and +through which we access the functions we need. + +At its lowest level, the \hsplugins{} loader is a binding to the GHC +runtime loader and linker. This layer is a direct reimplementation of +Andre Pang's \code{runtime\_loader} (barely any code changed). The +code at this level can only load single modules, or packages/archives +(which are just objects too). Any dependency resolution must be +performed by hand. + +On top of Andre's interface is a more convenient interface through +which user's should interact with the dynamic loader. The most +significant extension to Andre's work is the automatic calculation and +loading of a plugin's package or module dependencies via .hi file +information. It also handles initialisation of the loader, and +retrieval of values from the plugin in a more convenient way. Some +state is also stored in the loader to keep track of which modules and +packages have been loaded, to prevent unnecessary (actually, fatal) +loading of object files and packages already loaded. Thus you can +safely load several plugins at once, that share common dependencies, +without worrying about the dependencies being loaded multiple times. +We also store package.conf information in the state, so we can work +out where a package lives and what it depends on. + +The ability to remember which packages and objects have been loaded is +based on ideas in Hampus Ram's dynamic loader, which has a more +advanced dependency tracking system, with the ability to unload the +dependencies of a plugin. \hsplugins{} doesn't provide ``cascading +unloading''. The advantage \hsplugins{} has over Hampus' loader seems +to be the automatic dependency resolution via vanilla .hi files and +the dynamic recompilation stuff. + +Using \code{load}, any library packages, or any \code{.o} files, that a +plugin depends upon will be automatically loaded prior to loading the +module itself. \code{load} then looks up a symbol from the object file, +and returns the value associated with the symbol as a conventional +Haskell value. It should also be possible to load a GHCi-style \code{.o} +archive of object files this way, although there is currently no way +to extract multple plugin interfaces from a archive of objects. + +The application writer is not required to recalculate dependencies if +the plugin changes, and the plugin author does not need to specify +what dependencies exist, as is required in the lower level interface. +This is achieved by using the dependency information calculated by GHC +itself, stored in .hi files, to work out which modules and packages to +load, and in what order. A plugin in \hsplugins{} is really a pair of +an object file (or archive) and a \code{.hi} file, containing package +and module dependency information. + +The \code{.hi} file is created by GHC when the plugin is compiled, +either by hand or via \code{make}. \code{load} uses a binary parser to +extract the relevant information from the \code{.hi} data. Because the +dependency information is stored in a separate file to the application +that loads the plugin, such information can be recalculated without +having to modify the application. Becaues of this, it was easy to +extend the load to support recompilation of module source, even if +dependencies change, because dependencies are no longer hard-coded +into the application source itself, but are specified by the plugin. + +Assuming we have a plugin exporting some data, ``resource'', with a +record name \code{field :: String}, here is an example call to \code{load}: +% +\begin{quote} +\scm{ +do m_v <- load "Test.o" ["."] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ field v +} +\end{quote} + +This loads the object file \code{Test.o}, and any packages or objects +\code{Test.o} depends on. It resolves undefined symbols, and returns +from the object file the Haskell value named ``resource'', as the +value ``v''. This must be a value exported by the plugin. We then +retrieve the \code{field} component of \code{v}, and print it out. + +This simple usage assumes that the plugin to load is in the same +directory as the application, and that the api defining the interface +between plugin and application is also in the current directory (hence +the ``.'' in the 2nd argument to \code{load}). + +\subsection*{Dynamically Loading the Dynamic Loader} + +It is also possible to load the \code{plugins} or \code{eval} +libraries in GHC. Here, for example, we load the \code{plugs} +interactive environment in GHCi, and evaluated some code. The source to +\code{plugs} is in Appendix +\ref{sec:plugs}. +% +\begin{quote} +\begin{verbatim} +paprika$ ghci -package-conf ../../../plugins.conf.inplace -package eval + ___ ___ _ + / _ \ /\ /\/ __(_) + / /_\// /_/ / / | | GHC Interactive, version 6.3, for Haskell 98. +/ /_\\/ __ / /___| | http://www.haskell.org/ghc/ +\____/\/ /_/\____/|_| Type :? for help. + +Loading package base ... linking ... done. +Loading package altdata ... linking ... done. +Loading package unix ... linking ... done. +Loading package mtl ... linking ... done. +Loading package lang ... linking ... done. +Loading package posix ... linking ... done. +Loading package haskell98 ... linking ... done. +Loading package haskell-src ... linking ... done. +Loading package plugins ... linking ... done. +Loading package eval ... linking ... done. +Prelude> :l Main +Skipping Main ( Main.hs, Main.o ) +Ok, modules loaded: Main. +Prelude Main> main +Loading package readline ... linking ... done. + __ + ____ / /_ ______ ______ + / __ \/ / / / / __ `/ ___/ PLugin User's GHCi System, for Haskell 98 + / /_/ / / /_/ / /_/ (__ ) http://www.cse.unsw.edu.au/~dons/hs-plugins + / .___/_/\__,_/\__, /____/ Type :? for help +/_/ /____/ + +Loading package base ... linking ... done +plugs> map (\x -> x + 1) [0..10] +[1,2,3,4,5,6,7,8,9,10,11] +plugs> :t "haskell" +"haskell" :: [Char] +plugs> :q +*** Exception: exit: ExitSuccess +Prelude Main> :q +Leaving GHCi. +\end{verbatim} +\end{quote} + +\subsection*{Dynamic Typing} + +Support is also provided to unwrap and check the type of dynamically +typed plugin values (those wrapper in a \code{toDyn}) via +\code{dynload}. This is the same as \code{load}, except that instead +of a returning the value it finds, it unwraps a dynamically typed +value, checks the type, and returns the unwrapped value. This is to +provide further trust that the symbol you are retrieving from the +plugin is of the type you think it is, beyond that trust you have by +knowing that the plugin was compiled against a shared API. By using +\code{dynload} it is not enough for an object file to just have the +same symbol name as the function you require, it must also carry the +\code{Data.Dynamic} representation of the type, too. \code{pdynload} +rectifies most of \code{dynload}'s limitations, but at the cost of +additional running time. + +\section{Compilation Manager Implementation} + +Along side the dynamic loader is the compilation manager. This is a +\code{make}-like system for compiling Haskell source, prior to loading +it. \code{make} checks if a source file is newer than its associated +object file. If so, the source is recompiled to an object file, and a +new dependency file is created, in case the dependencies have changed +in the source. This module can then be loaded. The idea is to allow +EDSL authors to write plugins without having to touch a compiler: it +is all transparent. It also allows us to enforce type safety in the +plugin by injecting type constraints into the plugin source, as has +been discussed eariler. + +The effect is much like \emph{hi} (Hmake Interactive), funnily enough. +An application using both \code{make} and \code{load} behaves like a +Haskell interpreter, using \code{eval}. You modify your plugin, and +the application notices the change, recompiles it (possibly issuing +type errors) and then reloads the object file, providing the +application with the latest version of the code. + +An example: +% +\begin{quote} +\scm{ +do status <- make "Plugin.hs" [] + obj <- case status of + MakeSuccess _ o -> return o + MakeFailure e -> mapM_ putStrLn e >> error "failed" + + m_v <- load obj ["api"] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ field v +} +\end{quote} + +\code{make} accepts a source file as an argument, and a (usually empty) +list of GHC flags needed to compile the object file. It then checks to +see if compilation is required, and if so, it calls GHC to compile the +code, with and arguments supplied. If any errors were generated by +GHC, they are returned as the third component of the triple. + +Usually it will be necessary to ensure that GHC can find the plugin +API to compile against. This can be done by either making sure the API +is in the same directory as the plugin, or by adding a \code{-i} flag to +\code{make}'s arguments. If the API is created as a ``package'' with a +package.conf file, \code{make} can be given \code{-package-conf} arguments +to the same effect. + +Normally, \code{make} generates the \code{.o} and \code{.hi} files in +the same directory as the source file. This is not always desirable, +particularly for interpreter-like applications. To solve this, you can +pass \code{[''-odir'', path]} as elements of the arg list to +\code{make}, and it will respect these arguments, generating the +object and interface file in the directory specified. GHC's argument +\code{''-o''} is also respected in a similar manner, so you could also +say \code{[''-o'', obj]} for the same effect. + +\code{make} is entirely optional. All user's have to do to use the +loader on its own is make sure they only load object files that also +have a \code{.hi} file. This will usually be the case if the plugin is +compiled with GHC. + +\subsection*{makeWith} + +\code{makeWith} merges two source files together, using the function +and value declarations from one file, with any syntax in the second, +creating a new third source file. It then compiles this source file +via \code{make}. + +This function exists as a benefit to EDSL authors and is related to +the original motivation for \hsplugins{}, as a .conf file language +library. Configuration files need to be clean and simple, and you +can't rely, or trust, the user to get all the compulsory details +correct. So the solution is to factor out any compulsory syntax, such +as module names, imports, and also to provide a default instance of +the API, and store this code in a separate file provided by the +application writer, not the user. \code{makeWith} then merges +whatever the user has written, with the syntax stub, generating a +complete Haskell plugin source, with the correct module names and +import declarations. We also ensure the plugin only exports a single +interface value while we are here. + +\code{makeWith} thus requires a Haskell parser to parse two source files +and merge the results. We are merging abstract syntax here. This is +implemented using the Language.Haskell parser library. Unfortunately, +this library doesn't implement all of GHC's extensions, so if you wish +to use \code{makeWith} you can only write Haskell source that can be +parsed by this library, which is just H98 and a few extensions. This +is another short coming in the current design that will be overcome +with \code{-package ghc}. Remember, however, for normal uses of +\code{make} and \code{load} you are unrestricted in what Haskell you use. +This is the same restriction present in happy, the Haskell parser, +placed on the code you can provide in the \code{.y} source. + +\code{makeWith} also makes use of line pragmas. If the merged file +fails to compile, the judicious use of line number pragmas ensure that +the user receives errors messages reported with reference to their +source file, and not line number in the merged file. This is a +property of the Language.Haskell parser that we can make use of. + +An example of \code{makeWith}: +% +\begin{quote} +\scm{ +do status <- makeWith "Plugin.in" "Plugin.stub" [] + obj <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess _ o -> return o + m_v <- load obj [apipath] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ field v +} +\end{quote} + +We combine the user's file (\code{Plugin.in}) with a stub of syntax +generating a new, third Haskell file in the default tmpdir. This is +compiled as per usual, producing object and interface files. The +object is then loaded, and we extract the value exported. + +Using \code{makeWith} it is possible to write very simple, clear +Haskell plugins, that appear not to be Haskell at all. It is an easy +way to get EDSL user's writing plugins that are actually Haskell +programs, for .e.g, configuration files. See the examples that come +with the src. + +\newpage + +\section{An Example} + +This is an introductory example. + +\subsection*{API} + +First we need an interface between the application and the plugin. +This module needs to be visible to both the app and the plugin, in the +interest of clear and well-defined interfaces: +% +\begin{quote} +\scm{ +module StringProcAPI (Interface(..), plugin) where + +data Interface = Interface { + stringProcessor :: String -> String +} + +plugin :: Interface +plugin = Interface { stringProcessor = id } +} +\end{quote} + +Here we define \code{Interface} as the inteface signature for the +object passed between plugin and application. We'll use the record +syntax as it looks intuitive in the plugin. We provide a default +instance, the \code{plugin} value, that can be overwritten in the +actual plugin, ensuring sensible behaviour in the absence of any +plugins. The API should theoretically be compiled with \code{-Onot} to +avoid interface details leaking out into the \code{.hi} file. + +\subsection*{The Plugin} + +This is our plugin. Note that the plugin will be compiled entirely +seperately from the application. It must only rely on the API, and +nothing in the application source. +% +\begin{quote} +\scm{ +module StringProcPlugin (resource) where + +import StringProcAPI (plugin) + +resource = plugin { + stringProcessor = reverse +} +} +\end{quote} + +Using the record syntax we overwrite the \code{function} field with our +own value, \code{reverse}. The value \code{resource} is the magic symbol +that must be defined, and which the application will use to find the +data the plugin exports. + +Now, we can make this even easier on the plugin writer by the use of a +``stub'' file. \code{makeWith} lets you merge a plugin source with +another Haskell file, and compiles the result into the actual plugin +object. So the application can provide a stub file containing module +declarations and imports, and a default plugin value. Here is an +application-provided stub, factoring out compulsory syntax and type +declarations from the plugin: +% +\begin{quote} +\scm{ +module StringProcPlugin ( resource ) where + +import StringProcAPI + +resource :: Interface +resource = plugin +} +\end{quote} + +By factoring out compulsory syntax, the plugin author only has to +provide an overriding instance of the \code{resource} field. So all +the plugin actually consists of, is: +% +\begin{quote} +\scm{ +resource = plugin { + stringProcessor = reverse +} +} +\end{quote} + +That is all the code we need! This file may be called anything at all. + +More complex APIs may have more fields, of course. The nice thing +about this arrangement is that the user will write some simple syntax, +which will nonetheless by typechecked safely against the API. Errors +are also reported using line numbers from the source file, not the +stub, which makes things less confusing. + +\subsection*{The Application} + +Now we need to write an application that can use values of the kind +defined in the API, and which can compile and load plugins. The basic +mechanism to compile and load a plugin is as follows: +% +\begin{quote} +\scm{ +do status <- make "StringProcPlugin.hs" [] + obj <- case status of + MakeSuccess _ o -> return o + MakeFailure e -> mapM_ putStrLn e >> error "failed" + + m_v <- load obj ["."] [] "resource" + val <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" +} +\end{quote} +% +This code calls \code{make} to compile the plugin source, yielding +wrapper around a handle to an object file. The object can then be loaded +using \code{load}, and the code associated with the symbol +\code{resource} is retrieved. + +We embed this code in a simple shell-like loop, applying the function +exported by the plugin: +% +\begin{quote} +\scm{ +import System.Plugins +import StringProcessorAPI +import System.Console.Readline +import System.Exit + +source = "Plugin.hs" +stub = "Plugin.stub" +symbol = "resource" + +main = do s <- makeWith source stub [] + o <- case s of + MakeSuccess _ obj -> do + ls <- load obj ["."] [] symbol + case ls of LoadSuccess m v -> return (m,v) + LoadFailure err -> error "load failed" + MakeFailure e -> mapM_ putStrLn e >> error "compile failed" + shell o + +shell o@(m,plugin) = do + s <- readline "> " + cmd <- case s of + Nothing -> exitWith ExitSuccess + Just (':':'q':_) -> exitWith ExitSuccess + Just s -> addHistory s >> return s + + s <- makeWith source stub [] -- maybe recompile the source + o' <- case s of + MakeSuccess ReComp o -> do + ls <- reload m symbol + case ls of LoadSuccess m' v' -> return (m',v') + LoadFailure err -> error "reload failed" + MakeSuccess NotReq _ -> return o + MakeFailure e -> mapM_ putStrLn e >> shell o + eval cmd o' + shell o' + +eval ":?" _ = putStrLn ":?\n:q\n" + +eval s (_,plugin) = let fn = (stringProcessor plugin) in putStrLn (fn s) +} +\end{quote} + +We have to import the hs-plugins library, and the API. The main loop +proceeds by compiling and loading the plugin for the first time, and +then calls \code{shell}, the interpeter loop. This loop lets us apply +the function in the plugin to strings we supply. We have to pass +around the \code{(Module, a)} pair we get back from \code{reload}, so +that we can pass it to \code{eval} to do the real work. The first +\code{eval} case is where we use the record syntax to select the +\code{function} field out of \code{v}, the plugin interface object, +and we apply it to s. Try it out: +% +\begin{quote} +\begin{verbatim} +paprika$ ./a.out +Loading package base ... linking ... done +Loading objects API Plugin ... done +> :? +":?" +":q" +"" +> abcdefg +gfedcba +\end{verbatim} +\end{quote} + +Now, if we edit the plugin while the shell is running, the next time +we type something at the prompt the plugin will be unloaded, +recompiled and reloaded. Because the plugin is really an EDSL, we can +use any Haskell we want, so we'll change the plugin to: +% +\begin{quote} +\scm{ +import Data.Char + +resource = plugin { + stringProcessor = my_fn +} + +my_fn s = map toUpper (reverse s) +} +\end{quote} + +Back to the shell: +% +\begin{quote} +\begin{verbatim} +> abcdefg +Compiling plugin ... done +Reloading Plugin ... done +GFEDCBA +\end{verbatim} +\end{quote} + +And that's it: dynamically recompiled and reload Haskell code! + +\section{Multiple Plugins} + +It is quite easy to load multiple plugins, that all implement the +common plugin API, and that all export the same value (though +implemented differently). This make \hsplugins{} suitable for +applications that wish to allow an arbitrary number of plugins. The +main problem with multiple plugins is that they may share +dependencies, and if \code{load} na\"ively loaded all dependencies +found in the set of \code{.hi} files associated with all the plugins, +the GHC rts would crash. To solve this the \hsplugins{} dynamic loader +maintains state storing a list of what modules and packages have been +loaded already. If \code{load} is called on a module that is already +loaded, or dependencies are attempted to load, that have already been +loaded, the dynamic loader ignores these extra dependencies. This +makes it quite easy to write an application that will allows an +arbitrary number of plugins to be loaded. An example follows. + +\subsection*{Definition} + +First we need to define the API that a plugin must type check against, +in order to be valid. +% +\begin{quote} +\scm{ +module API where + +data Interface = Interface { + valueOf :: String -> String +} + +plugin :: Interface +plugin = Interface { valueOf = id } +} +\end{quote} + +We can then implement a number of plugins that provide values of type +"Interface". We show three plugins that export string manipulation functions: +% +\begin{quote} +\scm{ +module Plugin1 where + +import API +import Data.Char + +resource = plugin { + valueOf = \s -> map toUpper s +} +} +\end{quote} + +\begin{quote} +\scm{ +module Plugin2 where + +import API +import Data.Char + +resource = plugin { + valueOf = \s -> map toLower s +} +} +\end{quote} + +\begin{quote} +\scm{ +module Plugin3 where + +import API + +resource = plugin { + valueOf = reverse +} +} +\end{quote} + +And finally we need to write an application that would use these +plugins. Remember that the application is written without knowledge of +the plugins, and the plugins are written without knowledge of the +application. They are each implemented only in terms of the API, a +shared module and \code{.hi} file. An application needs to make the +API interface available to plugin authors, by distributing the API +object file and \code{.hi} file with the application. +% +\begin{quote} +\scm{ +import System.Plugins +import API + +main = do + let plist = ["Plugin1.o", "Plugin2.o", "Plugin3.o"] + plugins <- mapM (\p -> load p ["."] [] "resource") plist + let functions = map (valueOf . fromLoadSuc) plugins + mapM_ (\f -> putStrLn $ f "haskell is for hackers") functions + +fromLoadSuc (LoadFailure _) = error "load failed" +fromLoadSuc (LoadSuccess _ v) = v + +} +\end{quote} + +This application simply loads all the plugins and retrieves the +functions they export. It then applies each of these functions to a +string, printing the result. We assume for this example that the +plugins are compiled once only, and are not compiled dynamically via +\code{make}. This implies that you have to use \code{GHC} to generate +the \code{.hi} file for each plugin. A sample Makefile to compile the +plugins, and the api: +% +\begin{quote} +\begin{verbatim} +all: + ghc -Onot -c API.hs + ghc -O -c Plugin1.hs + ghc -O -c Plugin2.hs + ghc -O -c Plugin3.hs +\end{verbatim} +\end{quote} + +Ghc creates \code{.hi} files for each plugin, which can be inspected +using the \code{Plugins.BinIface.readBinIface} function. It parses the +\code{.hi} file, generating, roughly, the following: +% +\begin{quote} +\begin{verbatim} +interface "Main" Main +module dependencies: A, B +package dependencies: base, haskell98, lang, unix +\end{verbatim} +\end{quote} + +which says that the plugin depends upon a variety of system packages, +and the modules A and B. All these dependencies must be loaded before +the plugin itself. + +You then need to compile the application against the API, and against +the \hsplugins{} library: +% +\begin{quote} +\begin{verbatim} +ghc -O --make -package plugins Main.hs +\end{verbatim} +\end{quote} + +Running the application produces the following result. Note that the +verbose output can be switched off by compiling \hsplugins{} without +the \code{-DDEBUG} flag. If you look at the \code{.hi} file, using +\code{ghc --show-iface}, you'll see that they all depend on the base +package, and on the API, but the state stored in the dynamic loader +ensures that these shared modules are only loaded once: +% +\begin{quote} +\begin{verbatim} +Loading package base ... linking ... done +Loading object API Plugin1 ... done +Loading object Plugin2 ... done +Loading object Plugin3 ... done + +HASKELL IS FOR HACKERS +haskell is for hackers +srekcah rof si lleksah +\end{verbatim} +\end{quote} + +Archives of plugins can be loaded in one go if they have been linked +into a .o GHCi package, see \code{loadPackage}. + +\newpage + +\appendix + +\section{License} + +This library is distributed under the terms of the LGPL: + +\begin{quote} + +Copyright 2003-5, Don Stewart - \url{http://www.cse.unsw.edu.au/~dons} + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +USA + +\end{quote} + +\section{Portability} + +The library tries to be portable. There are two major points that +limit easy portabilty. The main issue is a dependence on the GHC dynamic +linker. \hsplugins{} is thus limited to platforms to which GHC's dyn +linker has been ported (this is essentially the same as the platforms +that can run GHCi). + +\newpage + +\section{A Haskell Interpreter using Plugins} +% \label{sec:plugs} + +Here is a full length example of a Haskell interpreter/compiler in the +style of Malcolm Wallace's \code{hi}. Rather than compiling the +user's code to an executable, we use \hsplugins{} to instead load an +object file and execute that instead, using the \code{eval} interface. +This cuts out the linking phase from the process, making turnaround at +the prompt around twice as fast as \code{hi}. + +\subsection*{Source of Plugs} + +\begin{quote} +\scm{ +import System.Eval.Haskell +import System.Plugins + +import System.Exit ( ExitCode(..), exitWith ) +import System.IO +import System.Console.Readline ( readline, addHistory ) + +symbol = "resource" + +main = do + putStrLn banner + putStr "Loading package base" >> hFlush stdout + loadPackage "base" + putStr " ... linking ... " >> hFlush stdout + resolveObjs + putStrLn "done" + + shell [] + +shell :: [String] -> IO () +shell imps = do + s <- readline "plugs> " + cmd <- case s of + Nothing -> exitWith ExitSuccess + Just (':':'q':_) -> exitWith ExitSuccess + Just s -> addHistory s >> return s + imps' <- run cmd imps + shell imps' + +run :: String -> [String] -> IO [String] +run "" is = return is +run ":?" is = putStrLn help >> return is + +run ":l" _ = return [] +run (':':'l':' ':m) is = return (m:is) + +run (':':'t':' ':s) is = do + ty <- typeOf s is + when (not $ null ty) (putStrLn $ s ++ " :: " ++ ty) + return is + +run (':':_) is = putStrLn help >> return is + +run s is = do + s <- unsafeEval ("show $ "++s) is + when (isJust s) (putStrLn (fromJust s)) + return is + +banner = "\ +\ __ \n\ +\ ____ / /_ ______ ______ \n\ +\ / __ \\/ / / / / __ `/ ___/ PLugin User's GHCi System, for Haskell 98\n\ +\ / /_/ / / /_/ / /_/ (__ ) http://www.cse.unsw.edu.au/~dons/hs-plugins\n\ +\ / .___/_/\\__,_/\\__, /____/ Type :? for help \n\ +\/_/ /____/ \n" + +help = "\ +\Commands :\n\ +\ evaluate expression\n\ +\ :t show type of expression (monomorphic only)\n\ +\ :l module bring module in to scope\n\ +\ :l clear module list\n\ +\ :quit quit\n\ +\ :? display this list of commands" +} +\end{quote} + +\subsection*{A Transcript} + +And a transcript: +% +\begin{quote} +\begin{verbatim} +$ ./plugs + __ + ____ / /_ ______ ______ + / __ \/ / / / / __ `/ ___/ PLugin User's GHCi System, for Haskell 98 + / /_/ / / /_/ / /_/ (__ ) http://www.cse.unsw.edu.au/~dons/hs-plugins + / .___/_/\__,_/\__, /____/ Type :? for help +/_/ /____/ + +Loading package base ... linking ... done +plugs> 1 +1 +plugs> let x = 1 + 2 in x +3 +plugs> :l Data.List +plugs> case [1,3,2] of x -> sort x +[1,2,3] +plugs> reverse [1,3,2] +[2,3,1] +plugs> map (\x -> (x,2^x)) [1,2,3,4,5,6,7,8,9,10] +[(1,2),(2,4),(3,8),(4,16),(5,32),(6,64),(7,128),(8,256),(9,512),(10,1024)] +plugs> :t "haskell" +"haskell" :: [Char] +plugs> :quit +\end{verbatim} +\end{quote} + +\end{document} diff --git a/docs/munge.sed b/docs/munge.sed new file mode 100644 --- /dev/null +++ b/docs/munge.sed @@ -0,0 +1,16 @@ + +# de-boldify and

-ify the Contents. + +/Contents/ { + :loop + /Go to/ { + b end + } + s,

,, + s,,, + s,,, + s,

,, + n + b loop +} +:end diff --git a/docs/tex2page.sty b/docs/tex2page.sty new file mode 100644 --- /dev/null +++ b/docs/tex2page.sty @@ -0,0 +1,9 @@ +% tex2page.sty +% Dorai Sitaram + +% Loading this file in a LaTeX document +% gives it all the macros of tex2page.tex, +% but via a more LaTeX-convenient filename. + +\input{tex2page} + diff --git a/docs/tex2page.tex b/docs/tex2page.tex new file mode 100644 --- /dev/null +++ b/docs/tex2page.tex @@ -0,0 +1,1381 @@ +% tex2page.tex +% Dorai Sitaram + +% TeX files using these macros +% can be converted by the program +% tex2page into HTML + +\message{version 2003-10-26} % last change + +\let\texonly\relax +\let\endtexonly\relax + +\texonly + +\newcount\evalQauxfilecount +\evalQauxfilecount=0 + +\def\eval{\begingroup + \ifx\evalfortexQport\UNDEFINED + \expandafter\csname newwrite\endcsname + \evalfortexQport + \immediate\openout\evalfortexQport + \jobname.eval4tex + \immediate\write\evalfortexQport + {\string\ifx\string\shipout\string\UNDEFINED + \string\eval{(eval-for-tex-only)}% + \string\else\string\endinput\string\fi}% + \fi + \global\advance\evalQauxfilecount by 1 + \edef\evalQauxfile{\jobname-Z-E-\the\evalQauxfilecount}% + {\immediate\openin0=\evalQauxfile.tex + \ifeof0 \immediate\closein0 + \else \input \evalQauxfile.tex \fi}% + \def\do##1{\catcode`##1=12 }\dospecials + \catcode`\{=1 \catcode`\}=2 + \catcode`\^^M=12 + \newlinechar=`\^^M% + \evalQii} + +\def\evalQii#1{% + \immediate\write\evalfortexQport{\string\eval{#1}}% + \endgroup} + +%\def\verbwritefile#1 {\relax} +%\let\verbwrite\gobbleencl + +\def\verbwritefile{% + \ifx\verbwritefileQport\UNDEFINED + \expandafter\csname newwrite\endcsname\verbwritefileQport + \else\immediate\closeout\verbwritefileQport + \fi + \futurelet\verbwritefileQnext\verbwritefileQcheckchar} + +\def\verbwritefileQcheckchar{% + \ifx\verbwritefileQnext\bgroup + \let\verbwritefileQnext\verbwritefileQbracedfile + \else + \let\verbwritefileQnext\verbwritefileQspacedfile + \fi\verbwritefileQnext} + +\def\verbwritefileQspacedfile#1 {% + \immediate\openout\verbwritefileQport #1 +} + +\def\verbwritefileQbracedfile#1{% + \verbwritefileQspacedfile #1 +} + +\def\verbwrite{% + \ifx\verbwritefileQport\UNDEFINED + \verbwritefile \jobname.txt \fi + \begingroup + \def\do##1{\catcode`##1=12 }\dospecials + \catcode`\{=1 \catcode`\}=2 + \catcode`\^^M=12 \newlinechar=`\^^M% + \futurelet\verbwriteQopeningchar\verbwriteQii} + +\def\verbwriteQii{\ifx\verbwriteQopeningchar\bgroup + \let\verbwriteQiii\verbwriteQbrace\else + \let\verbwriteQiii\verbwriteQnonbrace\fi + \verbwriteQiii} + +\def\verbwriteQbrace#1{\immediate + \write\verbwritefileQport{#1}\endgroup} + +\def\verbwriteQnonbrace#1{% + \catcode`\{12 \catcode`\}12 + \def\verbwriteQnonbraceQii##1#1{% + \immediate\write\verbwritefileQport{##1}\endgroup}% + \verbwriteQnonbraceQii} + +\ifx\loadonlyQevalfortex1% + \let\maybeloadfollowing\endinput +\else + \let\maybeloadfollowing\relax +\fi\maybeloadfollowing + +\ifx\slatexignorecurrentfile\UNDEFINED\relax\fi + +\edef\atcatcodebeforetiip{\the\catcode`\@ } +\catcode`\@11 + +% margins + +\def\sidemargin{\afterassignment\sidemarginQadjustoffset + \hoffset} + +\def\sidemarginQadjustoffset{% + \advance\hoffset -1true in + \advance\hsize -2\hoffset} + +\def\vertmargin{\afterassignment\vertmarginQadjustoffset + \voffset} + +\def\vertmarginQadjustoffset{% + \advance\voffset -1true in + \advance\vsize -2\voffset} + +% + +\def\defcsactive#1{\defnumactive{`#1}} + +\def\defnumactive#1{\catcode#1\active + \begingroup\lccode`\~#1% + \lowercase{\endgroup\def~}} + +% gobblegobblegobble + +\def\gobblegroup{\bgroup + \def\do##1{\catcode`##1=9 }\dospecials + \catcode`\{1 \catcode`\}2 \catcode`\^^M=9 + \gobblegroupI} + +\def\gobblegroupI#1{\egroup} + +\def\gobbleencl{\bgroup + \def\do##1{\catcode`##1=12 }\dospecials + \catcode`\{1 \catcode`\}2 \catcode`\^^M=9 + \futurelet\gobbleenclnext\gobbleenclI} + +\def\gobbleenclI{\ifx\gobbleenclnext\bgroup + \let\gobbleenclnext\gobblegroupI + \else\let\gobbleenclnext\gobbleenclII\fi + \gobbleenclnext} + +\def\gobbleenclII#1{% + \def\gobbleenclIII##1#1{\egroup}% + \gobbleenclIII} + +% \verb +% Usage: \verb{...lines...} or \verb|...lines...| +% In the former case, | can be used as escape char within +% the verbatim text + +\let\verbhook\relax + +\def\verbfont{\tt} +%\hyphenchar\tentt-1 + +\def\verbsetup{\frenchspacing + \def\do##1{\catcode`##1=12 }\dospecials + \catcode`\|=12 % needed? + \verbfont + \edef\verbQoldhyphenchar{\the\hyphenchar\font}% + \hyphenchar\font-1 + \def\verbQendgroup{\hyphenchar\font\verbQoldhyphenchar\endgroup}% +} + +% The current font is cmtt iff fontdimen3 = 0 _and_ +% fontdimen7 != 0 + +\def\checkifusingcmtt{\let\usingcmtt n% + \ifdim\the\fontdimen3\the\font=0.0pt + \ifdim\the\fontdimen7\the\font=0.0pt + \else\let\usingcmtt y\fi\fi} + +% In a nonmonospaced font, - followed by a letter +% is a regular hyphen. Followed by anything else, it is a +% typewriter hyphen. + +\def\variablelengthhyphen{\futurelet\variablelengthhyphenI + \variablelengthhyphenII} + +\def\variablelengthhyphenII{\ifcat\noexpand\variablelengthhyphenI + a-\else{\tt\char`\-}\fi} + +\def\verbavoidligs{% avoid ligatures + \defcsactive\`{\relax\lq}% + \defcsactive\ {\leavevmode\ }% + \defcsactive\^^I{\leavevmode\ \ \ \ \ \ \ \ }% + \defcsactive\^^M{\leavevmode\endgraf}% + \checkifusingcmtt + \ifx\usingcmtt n% + \defcsactive\<{\relax\char`\<}% + \defcsactive\>{\relax\char`\>}% + \defcsactive\-{\variablelengthhyphen}% + \fi} + +\def\verbinsertskip{% + \let\firstpar y% + \defcsactive\^^M{\ifx\firstpar y% + \let\firstpar n% + \verbdisplayskip + \parskip 0pt + \aftergroup\verbdisplayskip + \else\leavevmode\fi\endgraf}% + \verbhook} + +\ifx\verb\UnDeFiNeD\else +% Save LaTeX's \verb away, because +% we'll be defining our own \verb +\let\LaTeXverb\verb +\fi + +%\def\verb{\begingroup +% \verbsetup\verbI} + +\def\verb{\begingroup + \verbsetup\verbavoidligs\verbQcheckstar} + +\def\verbQcheckstar{% + \futurelet\verbQcheckstarQnext\verbQcheckstarQii} + +\def\verbQcheckstarQii{% + \if\verbQcheckstarQnext*% + \let\verbQcheckstarQnext\verbQcheckstarQiii + \else + \let\verbQcheckstarQnext\verbI + \fi + \verbQcheckstarQnext} + +\def\verbQcheckstarQiii#1{% + \defcsactive\ {\relax\char`\ }% + \verbI} + +\def\verbc{\begingroup + \verbsetup\afterassignment\verbcI + \let\verbcII=} + +\def\verbcI{{\verbfont\verbcII}\endgroup} + +\let\E\verbc + +\newcount\verbbracebalancecount + +\def\verblbrace{\char`\{} +\def\verbrbrace{\char`\}} + +\def\verbescapechar#1{% + \def\escapifyverbescapechar{\catcode`#1=0 }} + +\verbescapechar\| + +{\catcode`\[1 \catcode`\]2 +\catcode`\{12 \catcode`\}12 +\gdef\verbI#1[%\verbavoidligs + \verbinsertskip\verbhook + %\edef\verbQoldhyphenchar{\the\hyphenchar\tentt}% + %\hyphenchar\tentt=-1 + %\def\verbQendgroup{\hyphenchar\tentt\verbQoldhyphenchar\endgroup}% + %\let\verbQendgroup\endgroup% + \if#1{\escapifyverbescapechar + \def\{[\char`\{]% + \def\}[\char`\}]% + \def\|[\char`\|]% + \verbbracebalancecount0 + \defcsactive\{[\advance\verbbracebalancecount by 1 + \verblbrace]% + \defcsactive\}[\ifnum\verbbracebalancecount=0 + \let\verbrbracenext\verbQendgroup\else + \advance\verbbracebalancecount by -1 + \let\verbrbracenext\verbrbrace\fi + \verbrbracenext]\else + \defcsactive#1[\verbQendgroup]\fi + \verbII +]] + +\def\verbII{\futurelet\verbIInext\verbIII} + +{\catcode`\^^M\active% +\gdef\verbIII{\ifx\verbIInext^^M\else% + \defcsactive\^^M{\leavevmode\ }\fi}} + +\let\verbdisplayskip\medbreak + +% \verbatiminput FILENAME +% displays contents of file FILENAME verbatim. + +%\def\verbatiminput#1 {{\verbsetup\verbavoidligs\verbhook +% \input #1 }} + +% ^ original \verbatiminput + +\ifx\verbatiminput\UNDEFINED +% LaTeX's (optional) verbatim package defines a \verbatiminput -- +% don't clobber it +\def\verbatiminput{% + \futurelet\verbatiminputQnext\verbatiminputQcheckchar}% +\fi + +\def\verbatiminputQcheckchar{% + \ifx\verbatiminputQnext\bgroup + \let\verbatiminputQnext\verbatiminputQbracedfile + \else + \let\verbatiminputQnext\verbatiminputQspacedfile + \fi\verbatiminputQnext} + +\def\verbatiminputQbracedfile#1{\verbatiminputQdoit{#1}} + +\def\verbatiminputQspacedfile#1 {\verbatiminputQdoit{#1}} + +\def\verbatiminputQdoit#1{{\verbsetup + \verbavoidligs\verbhook + \input #1 }} + + +% \url{URL} becomes +% URL in HTML, and +% URL in DVI. + +% A-VERY-VERY-LONG-URL in a .bib file +% could be split by BibTeX +% across a linebreak, with % before the newline. +% To accommodate this, %-followed-by-newline will +% be ignored in the URL argument of \url and related +% macros. + +\ifx\url\UnDeFiNeD +\def\url{\bgroup\urlsetup\let\dummy=}% +\fi + +\def\urlsetup{\verbsetup\urlfont\verbavoidligs + \catcode`\{1 \catcode`\}2 + \defcsactive\%{\urlpacifybibtex}% + \defcsactive\ {\relax}% + \defcsactive\^^M{\relax}% + \defcsactive\.{\discretionary{}{\char`\.}{\char`\.}}% + \defcsactive\/{\discretionary{\char`\/}{}{\char`\/}}% + \defcsactive\`{\relax\lq}} + +\let\urlfont\relax + +\def\urlpacifybibtex{\futurelet\urlpacifybibtexnext\urlpacifybibtexI} + +\def\urlpacifybibtexI{\ifx\urlpacifybibtexnext^^M% + \else\%\fi} + +% \mailto{ADDRESS} becomes +% ADDRESS in HTML, and +% ADDRESS in DVI. + +\let\mailto\url + +% \urlh{URL}{TEXT} becomes +% TEXT in HTML, and +% TEXT in DVI. + +% If TEXT contains \\, the part after \\ appears in +% the DVI only. If, further, this part contains \1, +% the latter is replaced by a fixed-width representation +% of URL. + +\def\urlh{\bgroup\urlsetup + \afterassignment\urlhI + \gdef\urlhQurlarg} + +\def\urlhI{\egroup + \bgroup + \let\\\relax + \def\1{{\urlsetup\urlhQurlarg}}% + \let\dummy=} + +\def\urlp#1{{#1} \bgroup\urlsetup + \afterassignment\urlpQwrapparens + \gdef\urlpQurlarg} + +\def\urlpQwrapparens{\egroup + {\rm(}{\urlsetup\urlpQurlarg}{\rm)}} + +% \urlhd{URL}{HTML-TEXT}{DVI-TEXT} becomes +% HTML-TEXT in HTML, and +% DVI-TEXT in DVI + +\def\urlhd{\bgroup + \def\do##1{\catcode`##1=12 }\dospecials + \catcode`\{1 \catcode`\}2 + \urlhdQeaturlhtmlargs} + +\def\urlhdQeaturlhtmlargs#1#2{\egroup} + +\ifx\hyperref\UnDeFiNeD +\let\href\urlh +\let\hypertarget\gobblegroup +\let\hyperlink\gobblegroup +\def\hyperref#1#2#3#4{#2\ref{#4}#3} +\fi + +% + +\let\ignorenextinputtimestamp\relax + +% don't let caps disable end-of-sentence spacing + +\def\nocapdot{% +\count255=`\A +\loop +\sfcode\the\count255=1000 +\ifnum\count255<`\Z +\advance\count255 by 1 +\repeat +} + +% + +%\ifx\newenvironment\UnDeFiNeD +\let\htmlonly\iffalse +\let\endhtmlonly\fi +%\else +%\usepackage{comment} +%\excludecomment{htmlonly} +%\fi + +\def\rawhtml{\errmessage{Can't occur outside + \string\htmlonly}} +\def\endrawhtml{\errmessage{Can't occur outside + \string\htmlonly}} + +\let\htmlheadonly\iffalse +\let\endhtmlheadonly\fi + +\let\cssblock\iffalse +\let\endcssblock\fi + +\def\inputcss#1 {\relax} +\let\htmlstylesheet\inputcss +\let\htmladdimg\gobblegroup + +\def\htmlref{\bgroup\aftergroup\gobblegroup\let\dummy=} + +% + +\let\htmlcolophon\gobblegroup +\let\htmlmathstyle\gobblegroup +\let\htmladvancedentities\relax + +% Scheme + +\let\scm\verb +\let\scminput\verbatiminput + +\let\scmwritefile\verbwritefile +\let\scmwrite\verbwrite +\let\scmdribble\scm + +\ifx\slatexversion\UNDEFINED +% SLaTeX compat +\let\scmkeyword\gobblegroup +\let\scmbuiltin\gobblegroup +\let\scmconstant\scmbuiltin +\let\scmvariable\scmbuiltin +\let\setbuiltin\scmbuiltin +\let\setconstant\scmbuiltin +\let\setkeyword\scmkeyword +\let\setvariable\scmvariable +\def\schemedisplay{\begingroup + \verbsetup\verbavoidligs + \verbinsertskip + \schemedisplayI}% +\def\schemeresponse{\begingroup + \verbsetup\verbavoidligs + \verbinsertskip + \schemeresponseI}% +{\catcode`\|0 |catcode`|\12 + |long|gdef|schemedisplayI#1\endschemedisplay{% + #1|endgroup}% + |long|gdef|schemeresponseI#1\endschemeresponse{% + #1|endgroup}}% +\fi + +\let\slatexlikecomments\relax +\let\noslatexlikecomments\relax + +% definitions (useful in reference manuals) + +\ifx\@@line\UnDeFiNeD +\let\@@line\line +\fi + +\def\defun#1{\def\defuntype{#1}% +\medbreak +\@@line\bgroup + \hbox\bgroup + \aftergroup\enddefun + \vrule width .5ex \thinspace + \vrule \enspace + \vbox\bgroup\setbox0=\hbox{\defuntype}% + \advance\hsize-\wd0 + \advance\hsize-1em + \obeylines + \parindent=0pt + \aftergroup\egroup + \strut + \let\dummy=} + +\def\enddefun{\hfil\defuntype\egroup\smallskip} + + +% Images + +\let\imgdef\def + +%\def\imgpreamble{\let\magnificationoutsideimgpreamble\magnification +% \def\magnification{\count255=}} +% +%\def\endimgpreamble{\let\magnification\magnificationoutsideimgpreamble} + + +\let\imgpreamble\iffalse +\let\endimgpreamble\fi + +\let\makehtmlimage\relax + + +% Tally control sequences are cheap count +% registers: they doesn't use up TeX's limited number of +% real count registers. + +% A tally is a macro that expands to the +% number kept track of. Thus \edef\kount{0} defines a +% tally \kount that currently contains 0. + +% \advancetally\kount n increments \kount by n. +% \globaladvancetally increments the global \kount. +% If \kount is not defined, the \[global]advancetally +% macros define it to be 0 before proceeding with the +% incrementation. + +\def\newtally#1{\edef#1{0}} + +\def\advancetallyhelper#1#2#3{% + \ifx#2\UNDEFINED + #1\edef#2{0}\fi + \edef\setcountCCLV{\count255=#2 }% + \setcountCCLV + \advance\count255 by #3 + #1\edef#2{\the\count255 }} + +\def\advancetally{\advancetallyhelper\relax} +\def\globaladvancetally{\advancetallyhelper\global} + +% plain's \beginsection splits pages too easily + +%\def\beginsection#1\par{\sectionhelp{1}{}{#1}} + +\def\beginsection{\vskip-\lastskip + \bigbreak\noindent + \bgroup\bf + \let\par\sectionafterskip} + +\def\beginsectionstar*{\beginsection} + +% plain's \{left,center,right}line can't handle catcode change +% within their argument + +\def\leftline{\@@line\bgroup\bgroup + \aftergroup\leftlinefinish + \let\dummy=} + +\def\leftlinefinish{\hss\egroup} + +\def\centerline{\@@line\bgroup\bgroup + \aftergroup\leftlinefinish + \hss\let\dummy=} + +\def\rightline{\@@line\bgroup\hss\let\dummy=} + +% + +\let\strike\fiverm % can be much better! + +% + +\let\htmlpagebreak\relax + +\let\htmlpagelabel\gobblegroup + +\def\htmlpageref{\errmessage{Can't occur except inside + \string\htmlonly}} + +% Miscellaneous stuff + +%\def\hr{$$\hbox{---}$$} +\def\hr{\medbreak\centerline{---}\medbreak} +%\def\hr{\par\centerline{$*$}\par} +%\def\hr{\smallskip\@@line{\leaders\hbox{~.~}\hfill}\smallskip} + +%Commonplace math that doesn't require image files. (Avoiding $ +%here because $ triggers image-file generation.) + +\let\nohtmlmathimg\relax +\let\nohtmlmathintextimg\relax +\let\nohtmlmathdisplayimg\relax + +\let\htmlimageformat\gobblegroup +\let\htmlimgmagnification\gobblegroup + +\let\externaltitle\gobblegroup + +\def\mathg{$\bgroup\aftergroup\closemathg\let\dummy=} +\def\closemathg{$} + +\let\mathp\mathg + +\def\mathdg{$$\bgroup\aftergroup\closemathdg\let\dummy=} +\def\closemathdg{$$} + +% + + +\let\evalh\gobblegroup +\let\evalq\gobblegroup + +% Backward compatible stuff + +\let\endgifpreamble\endimgpreamble +\let\endhtmlgif\relax +\let\endhtmlimg\relax +\let\gifdef\imgdef +\let\gifpreamble\imgpreamble +%\let\href\urlh +\let\htmlgif\relax +\let\htmlimg\relax +\let\htmlimgformat\htmlimageformat +\let\n\noindent +\let\p\verb +\let\q\scm +\let\schemeeval\eval +\let\scmfile\scmdribble +\let\scmfileonly\scmwrite +\let\scmp\scm +%\let\scmverbatim\scm +\let\scmverbatimfile\scminput +\let\setverbatimescapechar\verbescapechar +%\let\verbatim\verb +\let\verbatimfile\verbatiminput +\let\verbinput\verbatiminput +\let\verbfilename\verbwritefile +\let\scmfilename\scmwritefile + +% uppercase version of \romannumeral + +\def\Romannumeral{\afterassignment\RomannumeralI\count255=} + +\def\RomannumeralI{\uppercase\expandafter{\romannumeral\the\count255 }} + +\def\f{\footnote} + +\ifx\label\UnDeFiNeD +\else +\def\tag#1#2{\@bsphack + \protected@write\@auxout{}% + {\string\newlabel{#1}{{#2}{\thepage}}}% +\@esphack}% +\let\tagref\ref +\fi + +\def\inputexternallabels#1 {\relax} +\def\includeexternallabels#1 {\relax} + +% The rest of the file isn't needed for LaTeX + +\ifx\section\UnDeFiNeD +\let\maybeloadfollowing\relax +\else +\catcode`\@\atcatcodebeforetiip +\let\maybeloadfollowing\endinput +\fi\maybeloadfollowing + +% LaTeX stops loading here! + +% Title + +\newwrite\sectionscratchfileport + +\def\subject{% + \immediate\openout\sectionscratchfileport Z-sec-temp + \begingroup + \def\do##1{\catcode`##1=11 }\dospecials + \catcode`\{=1 \catcode`\}=2 + \subjectI} + +\def\subjectI#1{\endgroup + \immediate\write\sectionscratchfileport {#1}% + \immediate\closeout\sectionscratchfileport + $$\vbox{\bf \def\\{\cr}% + \halign{\hfil##\hfil\cr + \input Z-sec-temp + \cr}}$$% + \medskip} + +\let\title\subject + +% Sections + +\def\tracksectionchangeatlevel#1{% + \expandafter\let\expandafter\thiscount\csname + sectionnumber#1\endcsname + \ifx\thiscount\relax + \expandafter\edef\csname sectionnumber#1\endcsname{0}% + \fi + \expandafter\advancetally + \csname sectionnumber#1\endcsname 1% + \ifx\doingappendix0% + \edef\recentlabel{\csname sectionnumber1\endcsname}% + \else + %\count255=\expandafter\csname sectionnumber1\endcsname + \edef\recentlabel{\char\csname sectionnumber1\endcsname}% + \fi + \count255=0 + \loop + \advance\count255 by 1 + \ifnum\count255=1 + \else\edef\recentlabel{\recentlabel.\csname + sectionnumber\the\count255\endcsname}\fi + \ifnum\count255<#1% + \repeat + \loop + \advance\count255 by 1 + \expandafter\let\expandafter\nextcount\csname + sectionnumber\the\count255\endcsname + \ifx\nextcount\relax + \let\continue0% + \else + \expandafter\edef\csname + sectionnumber\the\count255\endcsname{0}% + \let\continue1\fi + \ifx\continue1% + \repeat} + +% Vanilla section-header look -- change this macro for new look + +\newcount\secnumdepth + +\secnumdepth=10 + +\def\sectiond#1{\count255=#1% + \ifx\usingchapters1\advance\count255 by 1 \fi + \edef\sectiondlvl{\the\count255 }% + \futurelet\sectionnextchar\sectiondispatch} + +\def\sectiondispatch{\ifx\sectionnextchar*% + \def\sectioncontinue{\sectionstar{\sectiondlvl}}\else + \ifnum\sectiondlvl>\secnumdepth + \def\sectioncontinue{\sectionhelp{\sectiondlvl}{}}\else + \tracksectionchangeatlevel{\sectiondlvl} + \def\sectioncontinue{\sectionhelp{\sectiondlvl}% + {\recentlabel\enspace}}\fi\fi + \sectioncontinue} + +\def\sectionstar#1*{\sectionhelp{#1}{}} + + +\def\sectionhelp#1#2{% + \edef\sectiondepth{#1}% + \def\sectionnr{#2}% + \immediate\openout\sectionscratchfileport Z-sec-temp + \begingroup + \def\do##1{\catcode`##1=11 }\dospecials + \catcode`\{=1 \catcode`\}= 2 + \sectionheader} + +\def\sectionheader#1{\endgroup + \immediate\write\sectionscratchfileport {#1}% + \immediate\closeout\sectionscratchfileport + \vskip -\lastskip + \ifnum\sectiondepth>\tocdepth\else + \tocactivate + {\let\folio0% + \edef\temp{\write\tocout + {\string\tocentry{\sectiondepth}{\sectionnr}{#1}{\folio}}}% + \temp}\fi + \vskip1.5\bigskipamount +\goodbreak %??? + \noindent + \hbox{\vtop{\pretolerance 10000 + \raggedright + \noindent\bf\sectionnr + \input Z-sec-temp }}% + \bgroup\let\par\sectionafterskip} + +% \edef\temp{\write\tocout{\string\hskip#1\space em\string\relax\space #2% +% \string\vtop{\string\hsize=.7\string\hsize +% \string\noindent\string\raggedright\space #3}\string\par}}\temp + +\def\sectionafterskip{\egroup\nobreak\par\noindent} + +\def\section{\sectiond1} +\def\subsection{\sectiond2} +\def\subsubsection{\sectiond3} +\def\paragraph{\sectiond4} +\def\subparagraph{\sectiond5} + +\let\usingchapters0 + +\def\chapter{\global\let\usingchapters1% +\futurelet\chapternextchar\chapterdispatch} + +\def\chapterdispatch{\ifx\chapternextchar*% + \let\chaptercontinue\chapterstar\else + \tracksectionchangeatlevel{1}% + \def\chaptercontinue{\chapterhelp{\recentlabel\enspace}}\fi + \chaptercontinue} + +\def\chapterstar*{\chapterhelp{}} + +\def\chapterhelp#1{% + % #1=number #2=heading-text + \def\chapternr{#1}% + \immediate\openout\sectionscratchfileport Z-sec-temp + \begingroup + \def\do##1{\catcode`##1=11 }\dospecials + \catcode`\{=1 \catcode`\}=2 + \chapterheader} + +\def\chapterheader#1{\endgroup + \immediate\write\sectionscratchfileport {#1}% + \immediate\closeout\sectionscratchfileport + \tocactivate + {\let\folio0% + \edef\temp{\write\tocout{\string\tocentry{1}{\chapternr}{#1}{\folio}}}% + \temp}% + \vfill\eject + \null\vskip3em + \noindent + \ifx\chapternr\empty\hbox{~}\else + \ifx\doingappendix0% + \hbox{\bf Chapter \chapternr}\else + \hbox{\bf Appendix \chapternr}\fi\fi + \vskip 1em + \noindent + \hbox{\bf\vtop{%\hsize=.7\hsize + \pretolerance 10000 + \noindent\raggedright\input Z-sec-temp }}% + \bgroup\let\par\chapterafterskip} + +\def\chapterafterskip{\egroup\nobreak\vskip3em \noindent} + +\let\doingappendix=0 + +\def\appendix{\let\doingappendix=1% + \count255=`\A% + \advance\count255 by -1 + \expandafter\edef\csname + sectionnumber1\endcsname{\the\count255 }} + + +% toc + +\let\tocactive0 + +\newcount\tocdepth + +\tocdepth=10 + +\def\tocoutensure{\ifx\tocout\UNDEFINED + \csname newwrite\endcsname\tocout\fi} + +\def\tocactivate{\ifx\tocactive0% + \tocoutensure + \tocsave + \openout\tocout \jobname.toc + \global\let\tocactive1\fi} + +\def\tocspecials{\def\do##1{\catcode`##1=12 }\dospecials} + +\def\tocsave{\openin0=\jobname.toc + \ifeof0 \closein0 \else + \openout\tocout Z-T-\jobname.tex + \let\tocsaved 0% + \loop + \ifeof0 \closeout\tocout + \let\tocsaved1% + \else{\tocspecials + \read0 to \tocsaveline + \edef\temp{\write\tocout{\tocsaveline}}\temp}% + \fi + \ifx\tocsaved0% + \repeat + \fi + \closein0 } + +\def\tocentry#1#2{% + %#1=depth #2=secnum + \ifnum#1=1 + \ifnum\tocdepth>2 + \medbreak\begingroup\bf + \else\begingroup\fi + \else\begingroup\fi + \vtop\bgroup\raggedright + \noindent\hskip #1 em + #2% + \bgroup + \aftergroup\tocentryI + %read section title + \let\dummy=} + +\def\tocentryI#1{% + %#1=page nr + , #1\strut\egroup + \endgroup\par +} + +\def\tableofcontents{% + \ifx\tocactive0% + \openin0 \jobname.toc + \ifeof0 \closein0 \else + \closein0 \input \jobname.toc + \fi + \tocoutensure + \openout\tocout \jobname.toc + \global\let\tocactive1% + \else + \input Z-T-\jobname.tex + \fi} + +% allow {thebibliography} to be used directly +% in (plain-TeX) source document without +% generating it via BibTeX + +\ifx\thebibliography\UnDeFiNeD +\def\thebibliography#1{\vskip-\lastskip + \begingroup + \def\endthebibliography{\endgroup\endgroup}% + \def\input##1 ##2{\relax}% + \setbox0=\hbox{\biblabelcontents{#1}}% + \biblabelwidth=\wd0 + \@readbblfile}% +\fi + +% Cross-references + +% \openxrefout loads all the TAG-VALUE associations in +% \jobname.xrf and then opens \jobname.xrf as an +% output channel that \tag can use + +\def\openxrefout{% + \openin0=\jobname.xrf + \ifeof0 \closein0 + \else \closein0 {\catcode`\\0 \input \jobname.xrf }% + \fi + \expandafter\csname newwrite\endcsname\xrefout + \openout\xrefout=\jobname.xrf +} + +% I'd like to call \openxrefout lazily, but +% unfortunately it produces a bug in MiKTeX. +% So let's call it up front. + +\openxrefout + +% \tag{TAG}{VALUE} associates TAG with VALUE. +% Hereafter, \ref{TAG} will output VALUE. +% \tag stores its associations in \xrefout. +% \tag calls \openxrefout if \jobname.xrf hasn't +% already been opened + +\def\tag#1#2{\ifx\xrefout\UNDEFINED\openxrefout\fi + {\let\folio0% + \edef\temp{% + \write\xrefout{\string\expandafter\string\gdef + \string\csname\space XREF#1\string\endcsname + {#2}\string\relax}}% + \temp}} + +% \tagref{TAG} outputs VALUE, assuming \tag put such +% an association into \xrefout. \tagref calls +% \openxrefout if \jobname.xrf hasn't already +% been opened + +% Later, we will \let \ref = \tagref after making +% sure we aren't in eplain, which uses the ctlseq +% \ref differently + +\def\tagref#1{\ifx\xrefout\UNDEFINED\openxrefout\fi + \expandafter\ifx\csname XREF#1\endcsname\relax + %\message or \write16 ? + \message{\the\inputlineno: Unresolved label `#1'.}?\else + \csname XREF#1\endcsname\fi} + +% \label, as in LaTeX + +\let\recentlabel\relax + +% The sectioning commands +% define \recentlabel so a subsequent call to \label will pick up the +% right label. + +\def\label#1{\tag{#1}{\recentlabel}% + \tag{PAGE#1}{\folio}} + +% \pageref, as in LaTeX + +\def\pageref#1{\ref{PAGE#1}} + +% eplain users see the \ref they are used to. Others +% have \ref = \tagref + +\ifx\eplain\UnDeFiNeD +\let\ref\tagref +\fi + +% + +\ifx\IfFileExists\UnDeFiNeD +\def\IfFileExists#1#2#3{% + \openin0 #1 % + \ifeof0 % + #3% + \else + #2\fi + \closein0 }% +\fi + +\ifx\InputIfFileExists\UnDeFiNeD +\def\InputIfFileExists#1#2#3{% + \IfFileExists{#1}{#2\input #1 }{#3}}% +\fi + +\let\iffileexists\IfFileExists + +% + +% dummy def to let load dvipsnam.def + +\ifx\ProvidesFile\UnDeFiNeD +\def\ProvidesFile#1[#2]{}% +\fi + +% + +% Index generation +% +% Your TeX source contains \index{NAME} to +% signal that NAME should be included in the index. +% Check the makeindex documentation to see the various +% ways NAME can be specified, eg, for subitems, for +% explicitly specifying the alphabetization for a name +% involving TeX control sequences, etc. +% +% The first run of TeX will create \jobname.idx. +% makeindex on \jobname[.idx] will create the sorted +% index \jobname.ind. +% +% Use \inputindex (without arguments) to include this +% sorted index, typically somewhere to the end of your +% document. This will produce the items and subitems. +% It won't produce a section heading however -- you +% will have to typeset one yourself. +% +% Use \printindex instead of \inputindex if you want +% the section heading ``Index'' automatically generated. + +\def\sanitizeidxletters{\def\do##1{\catcode`##1=11 }% + \do\\\do\$\do\&\do\#\do\^\do\_\do\%\do\~% + \do\@\do\"\do\!\do\|\do\-\do\ \do\'} + +\def\index{%\unskip + \ifx\indexout\UNDEFINED + \csname newwrite\endcsname\indexout + \openout\indexout \jobname.idx\fi + \begingroup + \sanitizeidxletters + \indexI} + +\def\indexI#1{\endgroup + \write\indexout{\string\indexentry{#1}{\folio}}% + \ignorespaces} + +% The following index style indents subitems on a +% separate lines + +\def\theindex{\begingroup + \parskip0pt \parindent0pt + \def\indexitem##1{\par\hangindent30pt \hangafter1 + \hskip ##1 }% + \def\item{\indexitem{0em}}% + \def\subitem{\indexitem{2em}}% + \def\subsubitem{\indexitem{4em}}% + \def\see{{\it see} \bgroup\aftergroup\gobblegroup\let\dummy=}% + \let\indexspace\medskip} + +\def\endtheindex{\endgroup} + +% \packindex declares that subitems be bundled into one +% semicolon-separated paragraph + +\def\packindex{% + \def\theindex{\begingroup + \parskip0pt \parindent0pt + \def\item{\par\hangindent20pt \hangafter1 }% + \def\subitem{\unskip; }% + \def\subsubitem{\unskip; }% + \def\see{\bgroup\it see \aftergroup\gobblegroup\let\dummy=}% + \let\indexspace\medskip}} + +\def\inputindex{% + \openin0 \jobname.ind + \ifeof0 \closein0 + \message{\jobname.ind missing.}% + \else\closein0 + \begingroup + \def\begin##1{\csname##1\endcsname}% + \def\end##1{\csname end##1\endcsname}% + \input\jobname.ind + \endgroup\fi} + +\def\printindex{\csname beginsection\endcsname Index\par + \inputindex} + +% + +\def\italiccorrection{\futurelet\italiccorrectionI + \italiccorrectionII} + +\def\italiccorrectionII{% + \if\noexpand\italiccorrectionI,\else + \if\noexpand\italiccorrectionI.\else + \/\fi\fi} + +\def\em{\it\ifmmode\else\aftergroup\italiccorrection\fi} + +%\def\emph{\bgroup\it +% \ifmmode\else\aftergroup\italiccorrection\fi +% \let\dummy=} + +\def\quote{\bgroup\narrower\smallbreak} +\def\endquote{\smallbreak\egroup} + +\def\begin#1{\begingroup + \def\end##1{\csname end#1\endcsname\endgroup}% + \csname #1\endcsname} + +\def\raggedleft{% + \leftskip 0pt plus 1fil + \parfillskip 0pt +} + +\def\r#1{{\accent23 #1}} + + +\ifx\strip@pt\UNDEFINED +\begingroup + \catcode`P 12 \catcode`T 12 + \lowercase{\endgroup + \gdef\strip@pt#1PT{#1}}% +\fi + +% color + +\ifx\color\UnDeFiNeD +% +\ifx\pdfoutput\UnDeFiNeD % PostScript +% +\def\colorCurrentColor{color cmyk 0 0 0 1}% +% +\def\colorRestoreCurrentColor{% +\special{\colorCurrentColor}\egroup\egroup}% +% +\def\colorWithModelrgb#1{\bgroup +\def\colorCurrentColor{color rgb #1}% +\special{\colorCurrentColor}% +\aftergroup\colorRestoreCurrentColor}% +% +\def\colorWithModelRGBaux#1 #2 #3\end{\bgroup +\dimen0=#1pt \divide\dimen0 by 255 +\edef\red{\expandafter\strip@pt\the\dimen0 }% +\dimen0=#2pt \divide\dimen0 by 255 +\edef\green{\expandafter\strip@pt\the\dimen0 }% +\dimen0=#3pt \divide\dimen0 by 255 +\edef\blue{\expandafter\strip@pt\the\dimen0 }% +\def\colorCurrentColor{color rgb \red\space \green\space \blue}% +\special{\colorCurrentColor}% +\aftergroup\colorRestoreCurrentColor +\ignorespaces} +% +\def\colorWithModelcmyk#1{\bgroup +\def\colorCurrentColor{color cmyk #1}% +\special{\colorCurrentColor}% +\aftergroup\colorRestoreCurrentColor}% +% +\def\colorWithModelgray#1{\bgroup +\def\colorCurrentColor{color gray #1}% +\special{\colorCurrentColor}% +\aftergroup\colorRestoreCurrentColor}% +% +\def\colorWithModelnamed#1{\bgroup +\edef\colorCurrentColor{\csname +ColorNamed#1\endcsname}% +\special{\colorCurrentColor}% +\aftergroup\colorRestoreCurrentColor}% +% +\def\definecolorWithModelrgb#1#2{\egroup +\expandafter\def\csname ColorNamed#1\endcsname +{color rgb #2}}% +% +\def\definecolorWithModelcmyk#1#2{\egroup +\expandafter\def\csname ColorNamed#1\endcsname +{color cmyk #2}}% +% +\def\definecolorWithModelgray#1#2{\egroup +\expandafter\def\csname ColorNamed#1\endcsname +{color gray #2}}% +% +\else % PDF +% +\def\colorCurrentColor{0 0 0 1 k}% +% +\def\colorRestoreCurrentColor{% +\pdfliteral{\colorCurrentColor}\egroup\egroup}% +% +\def\colorWithModelrgb#1{\bgroup +\def\colorCurrentColor{#1 rg}% +\pdfliteral{\colorCurrentColor}% +\aftergroup\colorRestoreCurrentColor +\ignorespaces}% +% +\def\colorWithModelRGBaux#1 #2 #3\end{\bgroup +\dimen0=#1pt \divide\dimen0 by 255 +\edef\red{\expandafter\strip@pt\the\dimen0 }% +\dimen0=#2pt \divide\dimen0 by 255 +\edef\green{\expandafter\strip@pt\the\dimen0 }% +\dimen0=#3pt \divide\dimen0 by 255 +\edef\blue{\expandafter\strip@pt\the\dimen0 }% +\def\colorCurrentColor{\red\space \green\space \blue\space rg}% +\pdfliteral{\colorCurrentColor}% +\aftergroup\colorRestoreCurrentColor +\ignorespaces} +% +\def\colorWithModelcmyk#1{\bgroup +\def\colorCurrentColor{#1 k}% +\pdfliteral{\colorCurrentColor}% +\aftergroup\colorRestoreCurrentColor +\ignorespaces}% +% +\def\colorWithModelgray#1{\bgroup +\def\colorCurrentColor{#1 g}% +\pdfliteral{\colorCurrentColor}% +\aftergroup\colorRestoreCurrentColor +\ignorespaces}% +% +\def\colorWithModelnamed#1{\bgroup +\edef\colorCurrentColor{\csname +ColorNamed#1\endcsname}% +\pdfliteral{\colorCurrentColor}% +\aftergroup\colorRestoreCurrentColor +\ignorespaces}% +% +\def\definecolorWithModelrgb#1#2{\egroup +\expandafter\def\csname ColorNamed#1\endcsname +{#2 rg}}% +% +\def\definecolorWithModelcmyk#1#2{\egroup +\expandafter\def\csname ColorNamed#1\endcsname +{#2 k}}% +% +\def\definecolorWithModelgray#1#2{\egroup +\expandafter\def\csname ColorNamed#1\endcsname +{#2 g}}% +% +\fi +% +\def\color{\futurelet\colorQpeekchar\colorQpossiblynamed}% +% +\def\colorQpossiblynamed{\bgroup +\defcsactive\,{ }% +\if\colorQpeekchar[% +\let\colorQproceed\colorQexplicitmodel\else +\let\colorQproceed\colorWithModelnamed\fi +\colorQproceed}% +% +\def\colorQexplicitmodel[#1]{% +\csname colorWithModel#1\endcsname}% +% +\def\colorWithModelRGB#1{% +\colorWithModelRGBaux#1\end}% +% +\def\definecolor#1#2{\bgroup +\defcsactive\,{ }% +\csname definecolorWithModel#2\endcsname{#1}}% +% +% foll lets load texmf/tex/latex/graphics/dvipsnam.def +\def\DefineNamedColor#1{\definecolor}% +% +% these colors are standard in latex +\definecolor{red}{rgb}{1 0 0}% +\definecolor{green}{rgb}{0 1 0}% +\definecolor{blue}{rgb}{0 1 1}% +\definecolor{cyan}{cmyk}{1 0 0 0}% +\definecolor{magenta}{cmyk}{0 1 0 0}% +\definecolor{yellow}{cmyk}{0 0 1 0}% +\definecolor{black}{cmyk}{0 0 0 1}% +\definecolor{white}{rgb}{1 1 1}% +% +\fi + +%the rest of the file isn't needed for eplain? + +\def\itemize{\par\begingroup + \advance\leftskip\parindent + \smallbreak + \def\item{\smallbreak\noindent + \llap{$\bullet$\enspace}\ignorespaces}} + +\def\enditemize{\smallbreak\smallbreak\endgroup\par} + +\newtally\enumeratelevel + +\def\enumerate{\par\begingroup + \advancetally\enumeratelevel1% + \newtally\enumeratenumber + \advance\leftskip\parindent + \smallbreak + \def\item{\smallbreak\noindent + \advancetally\enumeratenumber1% + \ifnum\enumeratelevel=1 + \edef\enumeratemark{\enumeratenumber}\else + \ifnum\enumeratelevel=2 + \count255=\enumeratenumber + \advance\count255 by -1 \advance\count255 by `a + \edef\enumeratemark{\noexpand\char\the\count255 }\else + \ifnum\enumeratelevel=3 + \edef\enumeratemark{\romannumeral\enumeratenumber}\else + \ifnum\enumeratelevel=4 + \count255=\enumeratenumber + \advance\count255 by -1 \advance\count255 by `A + \edef\enumeratemark{\noexpand\char\the\count255 }\else + \edef\enumeratemark{\enumeratenumber}\fi\fi\fi\fi + \edef\recentlabel{\enumeratemark}% needed? + \llap{\enumeratemark.\enspace}\ignorespaces}} + +\def\endenumerate{\smallbreak\smallbreak\endgroup\par} + +% Numbered footnotes + +\ifx\plainfootnote\UNDEFINED + \let\plainfootnote\footnote +\fi + +\newtally\footnotenumber + +\def\numfootnote{\globaladvancetally\footnotenumber 1% + \bgroup\csname footnotehook\endcsname + \plainfootnote{$^{\footnotenumber}$}\bgroup + \edef\recentlabel{\footnotenumber}% + \aftergroup\egroup + \let\dummy=} + +\let\f\numfootnote + +\ifx\frac\UnDeFiNeD +\def\frac#1/#2{{#1\over#2}}% +\fi + +% \path is like \verb except that its argument +% can break across lines at `.' and `/'. + +\ifx\path\UnDeFiNeD +\def\path{\begingroup\verbsetup + \pathfont + \defcsactive\.{\discretionary{\char`\.}{}{\char`\.}}% + \defcsactive\/{\discretionary{\char`\/}{}{\char`\/}}% + \verbI}% +\fi + +\let\pathfont\relax + +\catcode`\@\atcatcodebeforetiip + +\endtexonly + +% end of file diff --git a/plugins.cabal b/plugins.cabal --- a/plugins.cabal +++ b/plugins.cabal @@ -1,5 +1,5 @@ name: plugins -version: 1.2 +version: 1.3 homepage: http://code.haskell.org/~dons/code/hs-plugins synopsis: Dynamic linking for Haskell and C objects description: Dynamic linking and runtime evaluation of Haskell, @@ -10,7 +10,7 @@ category: System license: BSD3 License-file: LICENSE -author: Don Stewart +author: Don Stewart 2004-2008 maintainer: Don Stewart cabal-version: >= 1.2 build-type: Configure diff --git a/scripts/Setup-with-ghc.lhs b/scripts/Setup-with-ghc.lhs new file mode 100644 --- /dev/null +++ b/scripts/Setup-with-ghc.lhs @@ -0,0 +1,20 @@ +#!/usr/bin/env runhaskell +> module Main where +> import Distribution.Simple +> import Distribution.Setup ( ConfigFlags (..) ) +> import System.Directory ( findExecutable ) +> +> main :: IO () +> main = defaultMainWithHooks (defaultUserHooks { postConf = defaultPostConf }) +> where defaultPostConf args flags lbi {- xx -} +> = do args' <- fmap (args++) (configToArgs flags) +> (postConf defaultUserHooks) args' flags lbi {- xx -} +> +> -- need to pass with-ghc arg onto ./configure for non-standard ghcs +> configToArgs :: ConfigFlags -> IO [String] +> configToArgs (ConfigFlags { configHcPath = Just hcPath }) +> = do exec <- findExecutable hcPath +> case exec of +> Just realPath -> return ["--with-ghc="++realPath] +> Nothing -> return ["--with-ghc="++hcPath] +> configToArgs _ = return [] diff --git a/scripts/mkrelease.sh b/scripts/mkrelease.sh new file mode 100644 --- /dev/null +++ b/scripts/mkrelease.sh @@ -0,0 +1,11 @@ +#!/bin/sh + +cd /tmp +rm -rf hs-plugins-0.9.10* + +darcs get --partial --set-scripts-executable /home/dons/hs-plugins +cd hs-plugins +rm -rf _darcs +cd .. +mv hs-plugins hs-plugins-0.9.10 +tar czf hs-plugins-0.9.10.tar.gz hs-plugins-0.9.10 diff --git a/scripts/openbsd-port/Makefile b/scripts/openbsd-port/Makefile new file mode 100644 --- /dev/null +++ b/scripts/openbsd-port/Makefile @@ -0,0 +1,21 @@ +# $OpenBSD$ + +COMMENT= "dynamic link library for Haskell" + +V= 0.9.10 +DISTNAME= hs-plugins-${V} +CATEGORIES= devel +MAINTAINER= Don Stewart +HOMEPAGE= http://www.cse.unsw.edu.au/~dons/hs-plugins/ +MASTER_SITES= ${HOMEPAGE} + +MODULES= ghc +CONFIGURE_STYLE= gnu dest + +# LGPL +PERMIT_PACKAGE_CDROM= Yes +PERMIT_PACKAGE_FTP= Yes +PERMIT_DISTFILES_CDROM= Yes +PERMIT_DISTFILES_FTP= Yes + +.include diff --git a/scripts/openbsd-port/distinfo b/scripts/openbsd-port/distinfo new file mode 100644 --- /dev/null +++ b/scripts/openbsd-port/distinfo @@ -0,0 +1,3 @@ +MD5 (hs-plugins-0.9.4.tar.gz) = 120f38ca532b187ee52798f5c36cc920 +RMD160 (hs-plugins-0.9.4.tar.gz) = 219eaf70e4bc0f1abc8a782d1bbd64ad2c5f8e86 +SHA1 (hs-plugins-0.9.4.tar.gz) = ad38b9f4e5b90c1361c6c96bd94e2a9270ad3d78 diff --git a/scripts/openbsd-port/pkg/DESCR b/scripts/openbsd-port/pkg/DESCR new file mode 100644 --- /dev/null +++ b/scripts/openbsd-port/pkg/DESCR @@ -0,0 +1,6 @@ +hs-plugins is a library for dynamic loading and compilation of Haskell +code. It provides typesafe "plugins" for Haskell. The interface is +general enough that it can be used to create conventional plugins, +hmake-like Haskell interpreters embedded in applications, or to script +an application with Haskell (or a Haskell EDSL) as the extension +language. diff --git a/scripts/openbsd-port/pkg/PLIST b/scripts/openbsd-port/pkg/PLIST new file mode 100644 --- /dev/null +++ b/scripts/openbsd-port/pkg/PLIST @@ -0,0 +1,28 @@ +@comment $OpenBSD$ +lib/hs-plugins/imports/Plugins.hi +lib/hs-plugins/imports/Plugins/BinIface.hi +lib/hs-plugins/imports/Plugins/Binary.hi +lib/hs-plugins/imports/Plugins/Consts.hi +lib/hs-plugins/imports/Plugins/Env.hi +lib/hs-plugins/imports/Plugins/FastMutInt.hi +lib/hs-plugins/imports/Plugins/FastString.hi +lib/hs-plugins/imports/Plugins/Iface.hi +lib/hs-plugins/imports/Plugins/Load.hi +lib/hs-plugins/imports/Plugins/Make.hi +lib/hs-plugins/imports/Plugins/Package.hi +lib/hs-plugins/imports/Plugins/ParsePkgConfLite.hi +lib/hs-plugins/imports/Plugins/Parser.hi +lib/hs-plugins/imports/Plugins/PrimPacked.hi +lib/hs-plugins/imports/Plugins/Utils.hi +lib/hs-plugins/include/hschooks.h +lib/hs-plugins/libHSplugins.a +lib/hs-plugins/libHSplugins_cbits.a +lib/hs-plugins/plugins.conf.in +@dirrm lib/hs-plugins/include +@dirrm lib/hs-plugins/imports/Plugins +@dirrm lib/hs-plugins/imports +@dirrm lib/hs-plugins +@exec /bin/cat %D/lib/hs-plugins/plugins.conf.in | /usr/bin/env PREFIX=%D %D/bin/ghc-pkg -u +@exec /bin/rm -f %D/lib/ghc-6.2.1/package.conf.old +@unexec %D/bin/ghc-pkg -r plugins +@unexec /bin/rm -f %D/lib/ghc-6.2.1/package.conf.old diff --git a/src/System/Plugins/Env.hs b/src/System/Plugins/Env.hs --- a/src/System/Plugins/Env.hs +++ b/src/System/Plugins/Env.hs @@ -61,13 +61,14 @@ import Data.IORef ( writeIORef, readIORef, newIORef, IORef() ) import Data.Maybe ( isJust, isNothing, fromMaybe ) -import Data.List ( isPrefixOf, nub ) +import Data.List ( isPrefixOf, isInfixOf, nub ) import System.IO.Unsafe ( unsafePerformIO ) +import System.IO ( hGetContents ) import System.Directory ( doesFileExist ) +import System.Process ( waitForProcess, runInteractiveCommand ) #if defined(CYGWIN) || defined(__MINGW32__) import Prelude hiding ( catch, ioError ) -import System.Environment ( getEnv ) import System.IO.Error ( catch, ioError, isDoesNotExistError ) #endif @@ -297,9 +298,11 @@ -- grabDefaultPkgConf :: IO PkgEnvs + grabDefaultPkgConf = do - pkgs <- readPackageConf $ ghcLibraryPath sysPkgConf - return $ union [] pkgs + pkg_confs <- get_ghc_configs + packages <- mapM readPackageConf pkg_confs + return $ foldl union [] packages -- -- parse a source file, expanding any $libdir we see. @@ -514,3 +517,26 @@ () :: FilePath -> FilePath -> FilePath [] b = b a b = a ++ "/" ++ b + +------------------------------------------------------------------------- +-- +-- 'run_cmd' executes command and returns it's standard output +-- as 'String' + +run_cmd :: String -> IO String +run_cmd cmd = do (_hI, hO, _hE, hProcess) <- runInteractiveCommand cmd + output <- hGetContents hO + _exitCode <- waitForProcess hProcess + return output +-- +-- 'get_ghc_configs' returns list of strings of packages.conf files in system + +get_ghc_configs :: IO [String] +get_ghc_configs = do ghc_out <- run_cmd "ghc-pkg list" + let configs = map (reverse.strip_trash.reverse) $ + filter (isInfixOf sysPkgConf) $ lines ghc_out + return configs + -- | strip ":\r?" from string head + where strip_trash [] = [] + strip_trash xs@(x:xs') | x `elem` ":\r" = strip_trash xs' + | otherwise = xs diff --git a/src/System/Plugins/Load.hs b/src/System/Plugins/Load.hs --- a/src/System/Plugins/Load.hs +++ b/src/System/Plugins/Load.hs @@ -661,7 +661,7 @@ -- now, try to generate a path to the actual .o file -- fix up hierachical names let mods_ = map (\s -> (s, map (\c -> - if c == '.' then '/' else c) $ decode s)) ds' + if c == '.' then '/' else c) $ s)) ds' -- construct a list of possible dependent modules to load let mods = concatMap (\p -> @@ -691,7 +691,7 @@ #if DEBUG when (not (null ps')) $ putStrLn "done" putStr "Loading object" - mapM_ (\(m,_) -> putStr (" "++(decode m)) >> hFlush stdout) mods'' + mapM_ (\(m,_) -> putStr (" "++ m) >> hFlush stdout) mods'' #endif moduleDeps <- mapM (\(hi,m) -> loadObject m (Object hi)) mods'' return (hiface,moduleDeps) diff --git a/src/System/Plugins/ParsePkgConfCabal.y_in b/src/System/Plugins/ParsePkgConfCabal.y_in new file mode 100644 --- /dev/null +++ b/src/System/Plugins/ParsePkgConfCabal.y_in @@ -0,0 +1,218 @@ +-- +-- Copyright (C) 2005 Sean Seefried - http://www.cse.unsw.edu.au/~sseefried +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- You should have received a copy of the GNU Lesser General Public +-- License along with this library; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +-- USA +-- + +-- +-- Taken (apart from the most minor of alterations) from +-- ghc/utils/ghc-pkg/ParsePkgConfLite.hs from GHC 6.2.2 source tree +-- and then modified to mimic the behaviour of the parser within +-- ghc/compiler/main/ParsePkgConf.y in GHC 6.4, without importing +-- heavy-weight infrastructure from the GHC source tree such as module +-- FastString, Lexer, etc. +-- +-- (c) Copyright 2002, The University Court of the University of Glasgow. +-- + +{ +{-# OPTIONS -w #-} + +module System.Plugins.ParsePkgConfCabal ( + parsePkgConf, parseOnePkgConf + ) where + +import Distribution.InstalledPackageInfo +import Distribution.Package +import Distribution.Version + +import Data.Char ( isSpace, isAlpha, isAlphaNum, isUpper, isDigit ) +import Data.List ( break ) + +} + +%token + '{' { ITocurly } + '}' { ITccurly } + '[' { ITobrack } + ']' { ITcbrack } + ',' { ITcomma } + '=' { ITequal } + VARID { ITvarid $$ } + CONID { ITconid $$ } + STRING { ITstring $$ } + INT { ITinteger $$ } + +%name parse pkgconf +%name parseOne pkg +%tokentype { Token } +%% + +pkgconf :: { [ PackageConfig ] } + : '[' ']' { [] } + | '[' pkgs ']' { reverse $2 } + +pkgs :: { [ PackageConfig ] } + : pkg { [ $1 ] } + | pkgs ',' pkg { $3 : $1 } + +pkg :: { PackageConfig } + : CONID '{' fields '}' { $3 defaultPackageConfig } + +fields :: { PackageConfig -> PackageConfig } + : field { \p -> $1 p } + | fields ',' field { \p -> $1 ($3 p) } + +field :: { PackageConfig -> PackageConfig } + : VARID '=' pkgid + {\p -> case $1 of + "package" -> p {package = $3} + _ -> error "unknown key in config file" } + + | VARID '=' STRING { id } + -- we aren't interested in the string fields, they're all + -- boring (copyright, maintainer etc.) + + | VARID '=' CONID + { case $1 of { + "exposed" -> + case $3 of { + "True" -> (\p -> p {exposed=True}); + "False" -> (\p -> p {exposed=False}); + _ -> error "exposed must be either True or False" }; + "license" -> id; -- not interested + _ -> error "unknown constructor" } + } + + | VARID '=' CONID STRING { id } + -- another case of license + + | VARID '=' strlist + {\p -> case $1 of + "exposedModules" -> p{exposedModules = $3} + "hiddenModules" -> p{hiddenModules = $3} + "importDirs" -> p{importDirs = $3} + "libraryDirs" -> p{libraryDirs = $3} + "hsLibraries" -> p{hsLibraries = $3} + "extraLibraries" -> p{extraLibraries = $3} + "includeDirs" -> p{includeDirs = $3} + "includes" -> p{includes = $3} + "hugsOptions" -> p{hugsOptions = $3} + "ccOptions" -> p{ccOptions = $3} + "ldOptions" -> p{ldOptions = $3} + "frameworkDirs" -> p{frameworkDirs = $3} + "frameworks" -> p{frameworks = $3} + "haddockInterfaces" -> p{haddockInterfaces = $3} + "haddockHTMLs" -> p{haddockHTMLs = $3} + "depends" -> p{depends = []} + -- empty list only, non-empty handled below + other -> p + } + | VARID '=' pkgidlist + { case $1 of + "depends" -> (\p -> p{depends = $3}) + _other -> error "unknown key in config file" + } + + +pkgid :: { PackageIdentifier } + : CONID '{' VARID '=' STRING ',' VARID '=' version '}' + { PackageIdentifier{ pkgName = $5, + pkgVersion = $9 } } + +version :: { Version } + : CONID '{' VARID '=' intlist ',' VARID '=' strlist '}' + { Version{ versionBranch=$5, versionTags=$9 } } + +pkgidlist :: { [PackageIdentifier] } + : '[' pkgids ']' { $2 } + -- empty list case is covered by strlist, to avoid conflicts + +pkgids :: { [PackageIdentifier] } + : pkgid { [ $1 ] } + | pkgid ',' pkgids { $1 : $3 } + +intlist :: { [Int] } + : '[' ']' { [] } + | '[' ints ']' { $2 } + +ints :: { [Int] } + : INT { [ fromIntegral $1 ] } + | INT ',' ints { fromIntegral $1 : $3 } + +strlist :: { [String] } + : '[' ']' { [] } + | '[' strs ']' { reverse $2 } + +strs :: { [String] } + : STRING { [ $1 ] } + | strs ',' STRING { $3 : $1 } + +{ + +type PackageConfig = InstalledPackageInfo + +defaultPackageConfig = emptyInstalledPackageInfo + +data Token + = ITocurly + | ITccurly + | ITobrack + | ITcbrack + | ITcomma + | ITequal + | ITvarid String + | ITconid String + | ITstring String + | ITinteger Int + +lexer :: String -> [Token] + +lexer [] = [] +lexer ('{':cs) = ITocurly : lexer cs +lexer ('}':cs) = ITccurly : lexer cs +lexer ('[':cs) = ITobrack : lexer cs +lexer (']':cs) = ITcbrack : lexer cs +lexer (',':cs) = ITcomma : lexer cs +lexer ('=':cs) = ITequal : lexer cs +lexer ('"':cs) = lexString cs "" +lexer (c:cs) + | isSpace c = lexer cs + | isAlpha c = lexID (c:cs) + | isDigit c = lexInt (c:cs) +lexer _ = error ( "Unexpected token") + +lexID cs = (if isUpper (head cs) then ITconid else ITvarid) id : lexer rest + where + (id,rest) = break (\c -> c /= '_' && not (isAlphaNum c)) cs + +lexInt cs = let (intStr, rest) = span isDigit cs + in ITinteger (read intStr) : lexer rest + + +lexString ('"':cs) s = ITstring (reverse s) : lexer cs +lexString ('\\':c:cs) s = lexString cs (c:s) +lexString (c:cs) s = lexString cs (c:s) + +happyError _ = error "Couldn't parse package configuration." + +parsePkgConf :: String -> [PackageConfig] +parsePkgConf = parse . lexer + +parseOnePkgConf :: String -> PackageConfig +parseOnePkgConf = parseOne . lexer + +} diff --git a/src/System/Plugins/ParsePkgConfLite.hs b/src/System/Plugins/ParsePkgConfLite.hs new file mode 100644 --- /dev/null +++ b/src/System/Plugins/ParsePkgConfLite.hs @@ -0,0 +1,616 @@ +{-# OPTIONS -fglasgow-exts #-} +{-# OPTIONS -w #-} + +module System.Plugins.ParsePkgConfLite ( + parsePkgConf, parseOnePkgConf + ) where + +import System.Plugins.Package ( PackageConfig(..), defaultPackageConfig ) + +import Char ( isSpace, isAlpha, isAlphaNum, isUpper ) +import List ( break ) +import Array +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif + +-- parser produced by Happy Version 1.15 + +newtype HappyAbsSyn = HappyAbsSyn (() -> ()) +happyIn5 :: ([ PackageConfig ]) -> (HappyAbsSyn ) +happyIn5 x = unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn ) -> ([ PackageConfig ]) +happyOut5 x = unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: ([ PackageConfig ]) -> (HappyAbsSyn ) +happyIn6 x = unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn ) -> ([ PackageConfig ]) +happyOut6 x = unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: (PackageConfig) -> (HappyAbsSyn ) +happyIn7 x = unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn ) -> (PackageConfig) +happyOut7 x = unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: (PackageConfig -> PackageConfig) -> (HappyAbsSyn ) +happyIn8 x = unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn ) -> (PackageConfig -> PackageConfig) +happyOut8 x = unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: (PackageConfig -> PackageConfig) -> (HappyAbsSyn ) +happyIn9 x = unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn ) -> (PackageConfig -> PackageConfig) +happyOut9 x = unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: ([String]) -> (HappyAbsSyn ) +happyIn10 x = unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn ) -> ([String]) +happyOut10 x = unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: ([String]) -> (HappyAbsSyn ) +happyIn11 x = unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn ) -> ([String]) +happyOut11 x = unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: (Bool) -> (HappyAbsSyn ) +happyIn12 x = unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn ) -> (Bool) +happyOut12 x = unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyInTok :: Token -> (HappyAbsSyn ) +happyInTok x = unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> Token +happyOutTok x = unsafeCoerce# x +{-# INLINE happyOutTok #-} + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x1f\x00\x1e\x00\x1d\x00\x1b\x00\x1a\x00\x1c\x00\x19\x00\x01\x00\x0e\x00\x00\x00\x00\x00\x17\x00\x08\x00\x00\x00\x16\x00\x00\x00\x13\x00\x00\x00\xfe\xff\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x18\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\xfd\xff\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xfd\xff\x00\x00\x00\x00\xf8\xff\x00\x00\xfc\xff\x00\x00\xfa\xff\x00\x00\xf9\xff\x00\x00\xf7\xff\xf4\xff\xf5\xff\x00\x00\xef\xff\xf6\xff\x00\x00\xf3\xff\xf1\xff\xf2\xff\x00\x00\xf0\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x03\x00\x05\x00\x04\x00\x07\x00\x04\x00\x08\x00\x09\x00\x09\x00\x08\x00\x02\x00\x01\x00\x02\x00\x05\x00\x03\x00\x04\x00\x04\x00\x05\x00\x04\x00\x05\x00\x04\x00\x06\x00\x02\x00\x02\x00\x00\x00\x07\x00\x09\x00\x08\x00\x06\x00\x01\x00\x07\x00\x04\x00\x03\x00\xff\xff\x03\x00\x0a\x00\x0a\x00\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x19\x00\x16\x00\x1d\x00\x17\x00\x0b\x00\x1a\x00\x1b\x00\x1e\x00\x06\x00\x14\x00\x08\x00\x09\x00\x15\x00\x0c\x00\x0d\x00\x1f\x00\x20\x00\x10\x00\x11\x00\x15\x00\x1b\x00\x11\x00\x04\x00\x06\x00\x0f\x00\x21\x00\x06\x00\x13\x00\x0c\x00\x0f\x00\x0b\x00\x04\x00\x00\x00\x08\x00\xff\xff\xff\xff\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = array (2, 16) [ + (2 , happyReduce_2), + (3 , happyReduce_3), + (4 , happyReduce_4), + (5 , happyReduce_5), + (6 , happyReduce_6), + (7 , happyReduce_7), + (8 , happyReduce_8), + (9 , happyReduce_9), + (10 , happyReduce_10), + (11 , happyReduce_11), + (12 , happyReduce_12), + (13 , happyReduce_13), + (14 , happyReduce_14), + (15 , happyReduce_15), + (16 , happyReduce_16) + ] + +happy_n_terms = 11 :: Int +happy_n_nonterms = 8 :: Int + +happyReduce_2 = happySpecReduce_2 0# happyReduction_2 +happyReduction_2 happy_x_2 + happy_x_1 + = happyIn5 + ([] + ) + +happyReduce_3 = happySpecReduce_3 0# happyReduction_3 +happyReduction_3 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn5 + (reverse happy_var_2 + )} + +happyReduce_4 = happySpecReduce_1 1# happyReduction_4 +happyReduction_4 happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + happyIn6 + ([ happy_var_1 ] + )} + +happyReduce_5 = happySpecReduce_3 1# happyReduction_5 +happyReduction_5 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut7 happy_x_3 of { happy_var_3 -> + happyIn6 + (happy_var_3 : happy_var_1 + )}} + +happyReduce_6 = happyReduce 4# 2# happyReduction_6 +happyReduction_6 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_3 of { happy_var_3 -> + happyIn7 + (happy_var_3 defaultPackageConfig + ) `HappyStk` happyRest} + +happyReduce_7 = happySpecReduce_1 3# happyReduction_7 +happyReduction_7 happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + happyIn8 + (\p -> happy_var_1 p + )} + +happyReduce_8 = happySpecReduce_3 3# happyReduction_8 +happyReduction_8 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn8 + (\p -> happy_var_1 (happy_var_3 p) + )}} + +happyReduce_9 = happySpecReduce_3 4# happyReduction_9 +happyReduction_9 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { (ITvarid happy_var_1) -> + case happyOutTok happy_x_3 of { (ITstring happy_var_3) -> + happyIn9 + (\p -> case happy_var_1 of + "name" -> p{name = happy_var_3} + _ -> error "unknown key in config file" + )}} + +happyReduce_10 = happySpecReduce_3 4# happyReduction_10 +happyReduction_10 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { (ITvarid happy_var_1) -> + case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn9 + (\p -> case happy_var_1 of { + "auto" -> p{auto = happy_var_3}; + _ -> p } + )}} + +happyReduce_11 = happySpecReduce_3 4# happyReduction_11 +happyReduction_11 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { (ITvarid happy_var_1) -> + case happyOut10 happy_x_3 of { happy_var_3 -> + happyIn9 + (\p -> case happy_var_1 of + "import_dirs" -> p{import_dirs = happy_var_3} + "library_dirs" -> p{library_dirs = happy_var_3} + "hs_libraries" -> p{hs_libraries = happy_var_3} + "extra_libraries" -> p{extra_libraries = happy_var_3} + "include_dirs" -> p{include_dirs = happy_var_3} + "c_includes" -> p{c_includes = happy_var_3} + "package_deps" -> p{package_deps = happy_var_3} + "extra_ghc_opts" -> p{extra_ghc_opts = happy_var_3} + "extra_cc_opts" -> p{extra_cc_opts = happy_var_3} + "extra_ld_opts" -> p{extra_ld_opts = happy_var_3} + "framework_dirs" -> p{framework_dirs = happy_var_3} + "extra_frameworks"-> p{extra_frameworks= happy_var_3} + _other -> p + )}} + +happyReduce_12 = happySpecReduce_2 5# happyReduction_12 +happyReduction_12 happy_x_2 + happy_x_1 + = happyIn10 + ([] + ) + +happyReduce_13 = happySpecReduce_3 5# happyReduction_13 +happyReduction_13 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut11 happy_x_2 of { happy_var_2 -> + happyIn10 + (reverse happy_var_2 + )} + +happyReduce_14 = happySpecReduce_1 6# happyReduction_14 +happyReduction_14 happy_x_1 + = case happyOutTok happy_x_1 of { (ITstring happy_var_1) -> + happyIn11 + ([ happy_var_1 ] + )} + +happyReduce_15 = happySpecReduce_3 6# happyReduction_15 +happyReduction_15 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_3 of { (ITstring happy_var_3) -> + happyIn11 + (happy_var_3 : happy_var_1 + )}} + +happyReduce_16 = happySpecReduce_1 7# happyReduction_16 +happyReduction_16 happy_x_1 + = case happyOutTok happy_x_1 of { (ITconid happy_var_1) -> + happyIn12 + ( case happy_var_1 of { + "True" -> True; + "False" -> False; + _ -> error ("unknown constructor in config file: " ++ happy_var_1) } + )} + +happyNewToken action sts stk [] = + happyDoAction 10# (error "reading EOF!") action sts stk [] + +happyNewToken action sts stk (tk:tks) = + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + ITocurly -> cont 1#; + ITccurly -> cont 2#; + ITobrack -> cont 3#; + ITcbrack -> cont 4#; + ITcomma -> cont 5#; + ITequal -> cont 6#; + ITvarid happy_dollar_dollar -> cont 7#; + ITconid happy_dollar_dollar -> cont 8#; + ITstring happy_dollar_dollar -> cont 9#; + _ -> happyError' (tk:tks) + } + +happyError_ tk tks = happyError' (tk:tks) + +newtype HappyIdentity a = HappyIdentity a +happyIdentity = HappyIdentity +happyRunIdentity (HappyIdentity a) = a + +instance Monad HappyIdentity where + return = HappyIdentity + (HappyIdentity p) >>= q = q p + +happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b +happyThen = (>>=) +happyReturn :: () => a -> HappyIdentity a +happyReturn = (return) +happyThen1 m k tks = (>>=) m (\a -> k a tks) +happyReturn1 :: () => a -> b -> HappyIdentity a +happyReturn1 = \a tks -> (return) a +happyError' :: () => [Token] -> HappyIdentity a +happyError' = HappyIdentity . happyError + +parse tks = happyRunIdentity happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut5 x)) + +parseOne tks = happyRunIdentity happySomeParser where + happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut7 x)) + +happySeq = happyDontSeq + +data Token + = ITocurly + | ITccurly + | ITobrack + | ITcbrack + | ITcomma + | ITequal + | ITvarid String + | ITconid String + | ITstring String + +lexer :: String -> [Token] + +lexer [] = [] +lexer ('{':cs) = ITocurly : lexer cs +lexer ('}':cs) = ITccurly : lexer cs +lexer ('[':cs) = ITobrack : lexer cs +lexer (']':cs) = ITcbrack : lexer cs +lexer (',':cs) = ITcomma : lexer cs +lexer ('=':cs) = ITequal : lexer cs +lexer ('"':cs) = lexString cs "" +lexer (c:cs) + | isSpace c = lexer cs + | isAlpha c = lexID (c:cs) where +lexer _ = error "Unexpected token" + +lexID cs = (if isUpper (head cs) then ITconid else ITvarid) id : lexer rest + where + (id,rest) = break (\c -> c /= '_' && not (isAlphaNum c)) cs + +lexString ('"':cs) s = ITstring (reverse s) : lexer cs +lexString ('\\':c:cs) s = lexString cs (c:s) +lexString (c:cs) s = lexString cs (c:s) + +happyError _ = error "Couldn't parse package configuration." + +parsePkgConf :: String -> [PackageConfig] +parsePkgConf = parse . lexer + +parseOnePkgConf :: String -> PackageConfig +parseOnePkgConf = parseOne . lexer +{-# LINE 1 "GenericTemplate.hs" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "GenericTemplate.hs" #-} +-- $Id$ + + +{-# LINE 28 "GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Int# Happy_IntList + + + + + + +{-# LINE 49 "GenericTemplate.hs" #-} + + +{-# LINE 59 "GenericTemplate.hs" #-} + + + + + + + + + + +infixr 9 `HappyStk` +data HappyStk a = HappyStk a (HappyStk a) + +----------------------------------------------------------------------------- +-- starting the parse + +happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll + +----------------------------------------------------------------------------- +-- Accepting the parse + +-- If the current token is 0#, it means we've just accepted a partial +-- parse (a %partial parser). We must ignore the saved token on the top of +-- the stack in this case. +happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = + happyReturn1 ans +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + + + +happyDoAction i tk st + = {- nothing -} + + + case action of + 0# -> {- nothing -} + happyFail i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | (n <# (0# :: Int#)) -> {- nothing -} + + (happyReduceArr ! rule) i tk st + where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) + n -> {- nothing -} + + + happyShift new_state i tk st + where new_state = (n -# (1# :: Int#)) + where off = indexShortOffAddr happyActOffsets st + off_i = (off +# i) + check = if (off_i >=# (0# :: Int#)) + then (indexShortOffAddr happyCheck off_i ==# i) + else False + action | check = indexShortOffAddr happyTable off_i + | otherwise = indexShortOffAddr happyDefActions st + + + + + + + + + + + +indexShortOffAddr (HappyA# arr) off = +#if __GLASGOW_HASKELL__ > 500 + narrow16Int# i +#elif __GLASGOW_HASKELL__ == 500 + intToInt16# i +#else + (i `iShiftL#` 16#) `iShiftRA#` 16# +#endif + where +#if __GLASGOW_HASKELL__ >= 503 + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) +#else + i = word2Int# ((high `shiftL#` 8#) `or#` low) +#endif + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# + + + + + +data HappyAddr = HappyA# Addr# + + + + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + +{-# LINE 170 "GenericTemplate.hs" #-} + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k -# (1# :: Int#)) sts of + sts1@((HappyCons (st1@(action)) (_))) -> + let r = fn stk in -- it doesn't hurt to always seq here... + happyDoSeq r (happyGoto nt j tk st1 sts1 r) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + happyThen1 (fn stk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) + drop_stk = happyDropStk k stk + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off +# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (0# is the error token) + +-- parse error if we are in recovery and we fail again +happyFail 0# tk old_st _ stk = +-- trace "failing" $ + happyError_ tk + +{- We don't need state discarding for our restricted implementation of + "error". In fact, it can cause some bogus parses, so I've disabled it + for now --SDM + +-- discard a state +happyFail 0# tk old_st (HappyCons ((action)) (sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) = +-- trace ("discarding state, depth " ++ show (length stk)) $ + happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) +-} + +-- Enter error recovery: generate an error token, +-- save the old token and carry on. +happyFail i tk (action) sts stk = +-- trace "entering error recovery" $ + happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk) + +-- Internal happy errors: + +notHappyAtAll = error "Internal Happy error\n" + +----------------------------------------------------------------------------- +-- Hack to get the typechecker to accept our action functions + + +happyTcHack :: Int# -> a -> a +happyTcHack x y = y +{-# INLINE happyTcHack #-} + + +----------------------------------------------------------------------------- +-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq +-- otherwise it emits +-- happySeq = happyDontSeq + +happyDoSeq, happyDontSeq :: a -> b -> b +happyDoSeq a b = a `seq` b +happyDontSeq a b = b + +----------------------------------------------------------------------------- +-- Don't inline any functions from the template. GHC has a nasty habit +-- of deciding to inline happyGoto everywhere, which increases the size of +-- the generated parser quite a bit. + + +{-# NOINLINE happyDoAction #-} +{-# NOINLINE happyTable #-} +{-# NOINLINE happyCheck #-} +{-# NOINLINE happyActOffsets #-} +{-# NOINLINE happyGotoOffsets #-} +{-# NOINLINE happyDefActions #-} + +{-# NOINLINE happyShift #-} +{-# NOINLINE happySpecReduce_0 #-} +{-# NOINLINE happySpecReduce_1 #-} +{-# NOINLINE happySpecReduce_2 #-} +{-# NOINLINE happySpecReduce_3 #-} +{-# NOINLINE happyReduce #-} +{-# NOINLINE happyMonadReduce #-} +{-# NOINLINE happyGoto #-} +{-# NOINLINE happyFail #-} + +-- end of Happy Template. diff --git a/src/System/Plugins/ParsePkgConfLite.y b/src/System/Plugins/ParsePkgConfLite.y new file mode 100644 --- /dev/null +++ b/src/System/Plugins/ParsePkgConfLite.y @@ -0,0 +1,159 @@ +-- +-- Copyright (C) 2004 Sean Seefried - http://www.cse.unsw.edu.au/~sseefried +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- You should have received a copy of the GNU Lesser General Public +-- License along with this library; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +-- USA +-- + +-- +-- Taken (apart from the most minor of alterations) from +-- ghc/utils/ghc-pkg/ParsePkgConfLite.hs: +-- +-- (c) Copyright 2002, The University Court of the University of Glasgow. +-- + +{ + +{-# OPTIONS -w #-} + +module System.Plugins.ParsePkgConfLite ( + parsePkgConf, parseOnePkgConf + ) where + +import System.Plugins.Package ( PackageConfig(..), defaultPackageConfig ) + +import Char ( isSpace, isAlpha, isAlphaNum, isUpper ) +import List ( break ) + +} + +%token + '{' { ITocurly } + '}' { ITccurly } + '[' { ITobrack } + ']' { ITcbrack } + ',' { ITcomma } + '=' { ITequal } + VARID { ITvarid $$ } + CONID { ITconid $$ } + STRING { ITstring $$ } + +%name parse pkgconf +%name parseOne pkg +%tokentype { Token } +%% + +pkgconf :: { [ PackageConfig ] } + : '[' ']' { [] } + | '[' pkgs ']' { reverse $2 } + +pkgs :: { [ PackageConfig ] } + : pkg { [ $1 ] } + | pkgs ',' pkg { $3 : $1 } + +pkg :: { PackageConfig } + : CONID '{' fields '}' { $3 defaultPackageConfig } + +fields :: { PackageConfig -> PackageConfig } + : field { \p -> $1 p } + | fields ',' field { \p -> $1 ($3 p) } + +field :: { PackageConfig -> PackageConfig } + : VARID '=' STRING + {\p -> case $1 of + "name" -> p{name = $3} + _ -> error "unknown key in config file" } + + | VARID '=' bool + {\p -> case $1 of { + "auto" -> p{auto = $3}; + _ -> p } } + + | VARID '=' strlist + {\p -> case $1 of + "import_dirs" -> p{import_dirs = $3} + "library_dirs" -> p{library_dirs = $3} + "hs_libraries" -> p{hs_libraries = $3} + "extra_libraries" -> p{extra_libraries = $3} + "include_dirs" -> p{include_dirs = $3} + "c_includes" -> p{c_includes = $3} + "package_deps" -> p{package_deps = $3} + "extra_ghc_opts" -> p{extra_ghc_opts = $3} + "extra_cc_opts" -> p{extra_cc_opts = $3} + "extra_ld_opts" -> p{extra_ld_opts = $3} + "framework_dirs" -> p{framework_dirs = $3} + "extra_frameworks"-> p{extra_frameworks= $3} + _other -> p + } + +strlist :: { [String] } + : '[' ']' { [] } + | '[' strs ']' { reverse $2 } + +strs :: { [String] } + : STRING { [ $1 ] } + | strs ',' STRING { $3 : $1 } + +bool :: { Bool } + : CONID {% case $1 of { + "True" -> True; + "False" -> False; + _ -> error ("unknown constructor in config file: " ++ $1) } } + +{ + +data Token + = ITocurly + | ITccurly + | ITobrack + | ITcbrack + | ITcomma + | ITequal + | ITvarid String + | ITconid String + | ITstring String + +lexer :: String -> [Token] + +lexer [] = [] +lexer ('{':cs) = ITocurly : lexer cs +lexer ('}':cs) = ITccurly : lexer cs +lexer ('[':cs) = ITobrack : lexer cs +lexer (']':cs) = ITcbrack : lexer cs +lexer (',':cs) = ITcomma : lexer cs +lexer ('=':cs) = ITequal : lexer cs +lexer ('"':cs) = lexString cs "" +lexer (c:cs) + | isSpace c = lexer cs + | isAlpha c = lexID (c:cs) where +lexer _ = error "Unexpected token" + +lexID cs = (if isUpper (head cs) then ITconid else ITvarid) id : lexer rest + where + (id,rest) = break (\c -> c /= '_' && not (isAlphaNum c)) cs + +lexString ('"':cs) s = ITstring (reverse s) : lexer cs +lexString ('\\':c:cs) s = lexString cs (c:s) +lexString (c:cs) s = lexString cs (c:s) + +happyError _ = error "Couldn't parse package configuration." + +parsePkgConf :: String -> [PackageConfig] +parsePkgConf = parse . lexer + +parseOnePkgConf :: String -> PackageConfig +parseOnePkgConf = parseOne . lexer + +} diff --git a/testsuite/README b/testsuite/README new file mode 100644 --- /dev/null +++ b/testsuite/README @@ -0,0 +1,17 @@ +These examples illustrate the various uses of hs-plugins. + +conf a configuration file edsl using plugins +dynload dynamically typed load +eval runtime evaluation of haskell strings, from Haskell and C +hmake the 'plugs' haskell interpreter +iface test the interface file parser +load load a plugin +make build a Haskell file +makewith merge and build a Haskell file +multi load multiple plugins at once +objc load Haskell plugins into object C programs +pkgconf test package.conf parsing +popen test popen +reload reload a plugin when it changes +shell a simple string filter +unload test unloading of plugins diff --git a/testsuite/TIMINGS b/testsuite/TIMINGS new file mode 100644 --- /dev/null +++ b/testsuite/TIMINGS @@ -0,0 +1,45 @@ +Method: + * "pdynload" + comes from pdynload/small + * "load + ghc" + comes from pdynload/null, with lines 13-14 + uncommented from prog/Main.hs + * "dynload" + from dynload/simple + * "load, no check" + from pdynload/null, with lines 13-14 of prog/Main.hs + commented out + +For example, to run the "pdynload" test: + $ cd pdynload/small + $ make + $ make check # to prime caches, etc. + $ time make check + $ time make check + $ time make check # run 'time make check' until value converges + +The converged value is entered into the "Raw" timings, and then the +scaled timing is calculated for each machine. These scaled values were +then averaged over the number of machines, yielding the final +"Average" scores -- the average over a number of machines and os. + +Raw timing: +pdynload load+ghc dynload load, no check + +0.33 0.25 0.22 0.21 -- P4 2.6 , OpenBSD +0.38 0.31 0.29 0.27 -- P4 2.66, Linux +0.84 0.77 0.64 0.55 -- Quad P4 2.4, Linux +0.76 0.60 0.52 0.50 -- AMD 1.1G, Linux +0.95 0.83 0.75 0.72 -- G5 2.0G, Mac OS X + -- Quad Itanium 1,Linux + +Scaled: +1.57 1.19 1.05 1 +1.40 1.15 1.07 +1.52 1.4 1.16 +1.52 1.2 1.04 +1.32 1.15 1.04 + +Average: +=1.46 = 1.218 = 1.07 + diff --git a/testsuite/build.mk b/testsuite/build.mk new file mode 100644 --- /dev/null +++ b/testsuite/build.mk @@ -0,0 +1,40 @@ +# how to build the default projects + +include $(TOP)/config.mk +include $(TOP)/testsuite/check.mk + +BIN= prog/Main +OBJ= prog/Main.o +SRC= prog/Main.hs + +BINDIR= prog +REALBIN= ./Main + +API_OBJ= api/API.o + +INCLUDES= -i$(TOP)/testsuite/$(TEST)/api +GHCFLAGS= -Onot -cpp -fglasgow-exts + +.SUFFIXES : .o .hs .hi .lhs .hc .s + +all: $(BIN) + +$(BIN) : $(PRIOR_OBJS) $(API_OBJ) $(SRC) $(EXTRA_OBJS) + @rm -f $@ + @$(GHC) --make -o $@ $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) $(API) $(SRC) + +# Standard suffix rules +.o.hi: + @: +.hs.o: + @$(GHC) $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) -c $< + +clean: + find . -name '*~' -exec rm {} \; + rm -rf *.{o,hi,dep} + rm -rf */*.{hi,o,old} */Main + rm -rf */*core + rm -rf */*.a + rm -rf */package.conf + rm -rf *.a + diff --git a/testsuite/check.mk b/testsuite/check.mk new file mode 100644 --- /dev/null +++ b/testsuite/check.mk @@ -0,0 +1,24 @@ +include $(TOP)/config.mk + +check: $(BIN) + @(cd $(BINDIR) ;\ + expected="expected" ;\ + if [ -f "expected" -o -f "expected.$(GLASGOW_HASKELL)" ] ;\ + then \ + actual_out="/tmp/hs-plugins-actual.out.$$$$" ;\ + diff_out="/tmp/hs-plugins.diff.$$$$" ;\ + $(REALBIN) > $$actual_out 2>&1 || true ;\ + if [ -f "expected.$(GLASGOW_HASKELL)" ] ; then \ + expected="expected.$(GLASGOW_HASKELL)" ;\ + fi ;\ + diff -u $$expected $$actual_out > $$diff_out || true ;\ + if [ -s "$$diff_out" ] ; then \ + echo "failed with:" ;\ + cat "$$diff_out" | sed '1,3d' ;\ + else \ + echo "ok." ;\ + fi ;\ + rm $$actual_out $$diff_out ;\ + else \ + $(REALBIN) 2>&1 || true ;\ + fi) diff --git a/testsuite/conf/simple/Mailrc.conf b/testsuite/conf/simple/Mailrc.conf new file mode 100644 --- /dev/null +++ b/testsuite/conf/simple/Mailrc.conf @@ -0,0 +1,11 @@ +import System.Directory + +resource = mail { +-- editor = do b <- doesFileExist "/usr/bin/emacs" +-- return $ if b then "emacs" else "vi" , + editor = do b <- doesFileExist "/bin/sh" + return "sh", + + attribution = \name -> "Today, "++name++" wrote :" +} + diff --git a/testsuite/conf/simple/Mailrc.stub b/testsuite/conf/simple/Mailrc.stub new file mode 100644 --- /dev/null +++ b/testsuite/conf/simple/Mailrc.stub @@ -0,0 +1,28 @@ +module Mailrc ( resource ) where + +import API + +resource :: Interface +resource = mail + + + + + + + + + + + + + + + + + + + + + + diff --git a/testsuite/conf/simple/Makefile b/testsuite/conf/simple/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/conf/simple/Makefile @@ -0,0 +1,4 @@ +TEST= conf/simple + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/conf/simple/api/API.hs b/testsuite/conf/simple/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/conf/simple/api/API.hs @@ -0,0 +1,27 @@ +-- +-- the configuration file interface. +-- + +module API where + +data Color = Black | Grey | Green | Cyan | Yellow | Magenta | Red + +data Interface = Interface { + editor :: IO String, + attribution :: String -> String, + header_color :: Color, + colorize :: [String], + include :: Bool + } + +-- Default settings +mail :: Interface +mail = Interface { + editor = return "vi", + + attribution = (\user -> user ++ " wrote:"), + header_color = Grey, + colorize = [], + include = True + } + diff --git a/testsuite/conf/simple/prog/Main.hs b/testsuite/conf/simple/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/conf/simple/prog/Main.hs @@ -0,0 +1,22 @@ + +import System.Plugins +import API + +conf = "../Mailrc.conf" +stub = "../Mailrc.stub" +apipath = "../api" + +main = do + status <- makeWith conf stub ["-i"++apipath] + o <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess _ o -> return o + status <- load o [apipath] [] "resource" + v <- case status of + LoadFailure err -> mapM_ putStrLn err >> error "no" + LoadSuccess _ v -> return v + + user_editor <- editor v + putStrLn user_editor + makeCleaner o + diff --git a/testsuite/conf/simple/prog/expected b/testsuite/conf/simple/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/conf/simple/prog/expected @@ -0,0 +1,1 @@ +sh diff --git a/testsuite/dynload/io/Makefile b/testsuite/dynload/io/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/dynload/io/Makefile @@ -0,0 +1,6 @@ +TEST=dynload/io + +EXTRA_OBJS=TestIO.o + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/dynload/io/TestIO.hs b/testsuite/dynload/io/TestIO.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/io/TestIO.hs @@ -0,0 +1,86 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +-- +-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons +-- LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html) +-- + +module TestIO ( resource_dyn ) where + +import API +import AltData.Dynamic + +import System.IO +import System.Posix.Types ( ProcessID, Fd ) +import System.Posix.Process ( forkProcess, executeFile, getProcessID ) +import System.Posix.IO ( createPipe, stdInput, + stdOutput, fdToHandle, closeFd, dupTo ) + +resource_dyn :: Dynamic +resource_dyn = toDyn resource + +resource :: TestIO +resource = testio { field = date } + + +-- +-- call a shell command , returning it's output +-- +date :: IO String +date = do (hdl,_,_) <- catch (popen "/bin/date") (\_->error "popen failed") + hGetLine hdl + +------------------------------------------------------------------------ +-- +-- my implementation of $val = `cmd`; (if this was perl) +-- +-- provide similar functionality to popen(3), +-- along with bidirectional ipc via pipes +-- return's the pid of the child process +-- +-- there are two different forkProcess functions. the pre-620 was a +-- unix-fork style function, and the modern function has semantics more +-- like the Awkward-Squad paper. We provide implementations of popen +-- using both versions, depending on which GHC the user wants to try. +-- + +popen :: FilePath -> IO (Handle, Handle, ProcessID) +popen cmd = do + (pr, pw) <- createPipe + (cr, cw) <- createPipe + + -- parent -- + let parent = do closeFd cw + closeFd pr + -- child -- + let child = do closeFd pw + closeFd cr + exec cmd (pr,cw) + error "exec cmd failed!" -- typing only + +-- if the parser front end understood cpp, this would work +-- #if __GLASGOW_HASKELL__ >= 601 + pid <- forkProcess child -- fork child + parent -- and run parent code +-- #else +-- p <- forkProcess +-- pid <- case p of +-- Just pid -> parent >> return pid +-- Nothing -> child +-- #endif + + hcr <- fdToHandle cr + hpw <- fdToHandle pw + + return (hcr,hpw,pid) + +-- +-- execve cmd in the child process, dup'ing the file descriptors passed +-- as arguments to become the child's stdin and stdout. +-- +exec :: FilePath -> (Fd,Fd) -> IO () +exec cmd (pr,cw) = do + dupTo pr stdInput + dupTo cw stdOutput + executeFile cmd False [] Nothing + +------------------------------------------------------------------------ diff --git a/testsuite/dynload/io/api/API.hs b/testsuite/dynload/io/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/io/api/API.hs @@ -0,0 +1,19 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import AltData.Typeable + +data TestIO = TestIO { + field :: IO String + } + +instance Typeable TestIO where +#if __GLASGOW_HASKELL__ >= 603 + typeOf i = mkTyConApp (mkTyCon "API.TestIO") [] +#else + typeOf i = mkAppTy (mkTyCon "API.TestIO") [] +#endif + +testio :: TestIO +testio = TestIO { field = return "default value" } diff --git a/testsuite/dynload/io/prog/Main.hs b/testsuite/dynload/io/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/io/prog/Main.hs @@ -0,0 +1,12 @@ + +import System.Plugins +import API + +main = do + m_v <- dynload "../TestIO.o" ["../api"] + [] "resource_dyn" + case m_v of + LoadFailure _ -> error "couldn't compile" + LoadSuccess _ v -> do + s <- field v + if s /= [] then print True else print False diff --git a/testsuite/dynload/io/prog/expected b/testsuite/dynload/io/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/dynload/io/prog/expected @@ -0,0 +1,1 @@ +True diff --git a/testsuite/dynload/poly/Makefile b/testsuite/dynload/poly/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/dynload/poly/Makefile @@ -0,0 +1,4 @@ +TEST=dynload/poly +EXTRA_OBJS=Plugin.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/dynload/poly/Plugin.hs b/testsuite/dynload/poly/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/poly/Plugin.hs @@ -0,0 +1,12 @@ +module Plugin where + +import API +import AltData.Dynamic + +my_fun = plugin { + equals = \x y -> (x /= y) -- a strange equals function :) + } + +resource_dyn :: Dynamic +resource_dyn = toDyn my_fun + diff --git a/testsuite/dynload/poly/api/API.hs b/testsuite/dynload/poly/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/poly/api/API.hs @@ -0,0 +1,24 @@ +{-# OPTIONS -cpp #-} + +module API where + +import AltData.Typeable + +data Interface = Interface { + equals :: forall t. Eq t => t -> t -> Bool + } + +-- +-- see how it hides the internal type.. but to compile GHC still checks +-- the type. +-- +instance Typeable Interface where +#if __GLASGOW_HASKELL__ >= 603 + typeOf i = mkTyConApp (mkTyCon "API.Interface") [] +#else + typeOf i = mkAppTy (mkTyCon "API.Interface") [] +#endif + +plugin :: Interface +plugin = Interface { equals = (==) } + diff --git a/testsuite/dynload/poly/prog/Main.hs b/testsuite/dynload/poly/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/poly/prog/Main.hs @@ -0,0 +1,17 @@ +{-# OPTIONS -cpp #-} + +#include "../../../../config.h" + +import System.Plugins +import API + +main = do + m_v <- dynload "../Plugin.o" ["../api"] + [] + "resource_dyn" + case m_v of + LoadFailure _ -> error "didn't compile" + LoadSuccess _ (Interface eq) -> do + putStrLn $ show $ 1 `eq` 2 + putStrLn $ show $ 'a' `eq` 'b' + diff --git a/testsuite/dynload/poly/prog/expected b/testsuite/dynload/poly/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/dynload/poly/prog/expected @@ -0,0 +1,2 @@ +True +True diff --git a/testsuite/dynload/should_fail/Makefile b/testsuite/dynload/should_fail/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail/Makefile @@ -0,0 +1,4 @@ +TEST= dynload/should_fail +EXTRA_OBJS=Plugin.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/dynload/should_fail/Plugin.hs b/testsuite/dynload/should_fail/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail/Plugin.hs @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} +module Plugin where + +import API +import AltData.Dynamic + +v :: Int +v = 0xdeadbeef + +resource_dyn :: Dynamic +resource_dyn = toDyn v + diff --git a/testsuite/dynload/should_fail/api/API.hs b/testsuite/dynload/should_fail/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail/api/API.hs @@ -0,0 +1,20 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import AltData.Typeable + +data Interface = Interface { + function :: String + } + +instance Typeable Interface where +#if __GLASGOW_HASKELL__ >= 603 + typeOf i = mkTyConApp (mkTyCon "API.Interface") [] +#else + typeOf i = mkAppTy (mkTyCon "API.Interface") [] +#endif + +plugin :: Interface +plugin = Interface { function = "goodbye" } + diff --git a/testsuite/dynload/should_fail/prog/Main.hs b/testsuite/dynload/should_fail/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail/prog/Main.hs @@ -0,0 +1,14 @@ + +import System.Plugins +import API + +main = do + m_v <- dynload "../Plugin.o" + ["../api"] + [] + "resource_dyn" + + case m_v of + LoadFailure _ -> putStrLn "didn't compile" + LoadSuccess _ v -> putStrLn $ function v + diff --git a/testsuite/dynload/should_fail/prog/expected b/testsuite/dynload/should_fail/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail/prog/expected @@ -0,0 +1,4 @@ +Couldn't match `API.Interface' against `Int' + Expected type: API.Interface + Inferred type: Int +didn't compile diff --git a/testsuite/dynload/should_fail_1/Makefile b/testsuite/dynload/should_fail_1/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_1/Makefile @@ -0,0 +1,4 @@ +TEST= dynload/should_fail_1 +EXTRA_OBJS=Plugin.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/dynload/should_fail_1/Plugin.hs b/testsuite/dynload/should_fail_1/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_1/Plugin.hs @@ -0,0 +1,15 @@ +-- +-- trying to be really mean. +-- + +module Plugin where + +import API +import AltData.Dynamic + +v :: Int -> Int +v = \x -> 0xdeadbeef + +resource_dyn :: Dynamic +resource_dyn = toDyn v + diff --git a/testsuite/dynload/should_fail_1/api/API.hs b/testsuite/dynload/should_fail_1/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_1/api/API.hs @@ -0,0 +1,20 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import AltData.Typeable + +data Interface = Interface { + function :: String + } + +instance Typeable Interface where +#if __GLASGOW_HASKELL__ >= 603 + typeOf i = mkTyConApp (mkTyCon "API.Interface") [] +#else + typeOf i = mkAppTy (mkTyCon "API.Interface") [] +#endif + +plugin :: Interface +plugin = Interface { function = "goodbye" } + diff --git a/testsuite/dynload/should_fail_1/prog/Main.hs b/testsuite/dynload/should_fail_1/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_1/prog/Main.hs @@ -0,0 +1,11 @@ + +import System.Plugins +import API + +main = do + m_v <- dynload "../Plugin.o" ["../api"] + [] "resource_dyn" + case m_v of + LoadFailure _ -> putStrLn "didn't compile" + LoadSuccess _ v -> putStrLn $ (function v) + diff --git a/testsuite/dynload/should_fail_1/prog/expected b/testsuite/dynload/should_fail_1/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_1/prog/expected @@ -0,0 +1,4 @@ +Couldn't match `API.Interface' against `Int -> Int' + Expected type: API.Interface + Inferred type: Int -> Int +didn't compile diff --git a/testsuite/dynload/should_fail_2/Makefile b/testsuite/dynload/should_fail_2/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_2/Makefile @@ -0,0 +1,4 @@ +TEST= dynload/should_fail_2 + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/dynload/should_fail_2/Plugin.in b/testsuite/dynload/should_fail_2/Plugin.in new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_2/Plugin.in @@ -0,0 +1,19 @@ +-- +-- the plugin doesn't even make the resource_dyn a Dynamic. +-- +-- let's hope that makeWith strips out the invalid declarations +-- + +{-# OPTIONS -fglasgow-exts #-} + +module Plugin where + +import API +import AltData.Typeable +import GHC.Base + +v :: Int +v = 0xdeadbeef + +resource_dyn = (typeOf v, unsafeCoerce v) + diff --git a/testsuite/dynload/should_fail_2/Plugin.stub b/testsuite/dynload/should_fail_2/Plugin.stub new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_2/Plugin.stub @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} + +module Plugin ( resource_dyn ) where + +import API +import AltData.Dynamic + +resource = plugin + +resource_dyn :: Dynamic +resource_dyn = toDyn resource + diff --git a/testsuite/dynload/should_fail_2/api/API.hs b/testsuite/dynload/should_fail_2/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_2/api/API.hs @@ -0,0 +1,22 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import AltData.Typeable +import GHC.Base + +data Interface = Interface { + function :: String + } + +instance Typeable Interface where +#if __GLASGOW_HASKELL__ >= 603 + typeOf i = mkTyConApp (mkTyCon "API.Interface") [] +#else + typeOf i = mkAppTy (mkTyCon "API.Interface") [] +#endif + +plugin :: Interface +plugin = Interface { function = "goodbye" } + +unsafeCoerce = unsafeCoerce# diff --git a/testsuite/dynload/should_fail_2/prog/Main.hs b/testsuite/dynload/should_fail_2/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_2/prog/Main.hs @@ -0,0 +1,19 @@ + +import System.Plugins +import API + +conf = "../Plugin.in" +stub = "../Plugin.stub" + +main = do + status <- makeWith conf stub ["-i../api", "-i../../../../src/altdata/"] + case status of + MakeFailure e -> mapM_ putStrLn e >> putStrLn "failed" + MakeSuccess _ o -> do { + ; m_v <- dynload o ["../api"] [] "resource_dyn" + ; makeCleaner o + ; case m_v of + LoadFailure _ -> putStrLn "didn't load" + LoadSuccess _ v -> putStrLn $ (function v) + } + diff --git a/testsuite/dynload/should_fail_2/prog/expected b/testsuite/dynload/should_fail_2/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_2/prog/expected @@ -0,0 +1,8 @@ + +../Plugin.in:18: + Couldn't match `Dynamic' against `(t, t1)' + Expected type: Dynamic + Inferred type: (t, t1) + In the definition of `resource_dyn': + resource_dyn = (typeOf v, unsafeCoerce v) +failed diff --git a/testsuite/dynload/should_fail_2/prog/expected.604 b/testsuite/dynload/should_fail_2/prog/expected.604 new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_2/prog/expected.604 @@ -0,0 +1,7 @@ + +../Plugin.in:18:15: + Couldn't match `Dynamic' against `(a, b)' + Expected type: Dynamic + Inferred type: (a, b) + In the definition of `resource_dyn': resource_dyn = (typeOf v, unsafeCoerce v) +failed diff --git a/testsuite/dynload/should_fail_2/prog/expected.605 b/testsuite/dynload/should_fail_2/prog/expected.605 new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_2/prog/expected.605 @@ -0,0 +1,7 @@ + +../Plugin.in:18:15: + Couldn't match `Dynamic' against `(a, b)' + Expected type: Dynamic + Inferred type: (a, b) + In the definition of `resource_dyn': resource_dyn = (typeOf v, unsafeCoerce v) +failed diff --git a/testsuite/dynload/should_fail_3/Makefile b/testsuite/dynload/should_fail_3/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_3/Makefile @@ -0,0 +1,4 @@ +TEST= dynload/should_fail_3 + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/dynload/should_fail_3/Plugin.in b/testsuite/dynload/should_fail_3/Plugin.in new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_3/Plugin.in @@ -0,0 +1,19 @@ +-- +-- the plugin doesn't even make the resource_dyn a Dynamic. +-- let's hope that makeWith strips out the invalid declarations +-- + +{-# OPTIONS -fglasgow-exts #-} + +module Plugin where + +import API + +import AltData.Typeable +import GHC.Base + +v :: Int +v = 0xdeadbeef + +resource_dyn = (typeOf plugin, unsafeCoerce v) + diff --git a/testsuite/dynload/should_fail_3/Plugin.stub b/testsuite/dynload/should_fail_3/Plugin.stub new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_3/Plugin.stub @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} + +module Plugin ( resource_dyn ) where + +import API +import AltData.Dynamic + +resource = plugin + +resource_dyn :: Dynamic +resource_dyn = toDyn resource + diff --git a/testsuite/dynload/should_fail_3/api/API.hs b/testsuite/dynload/should_fail_3/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_3/api/API.hs @@ -0,0 +1,22 @@ +{-# OPTIONS -cpp -fglasgow-exts #-} + +module API where + +import AltData.Typeable +import GHC.Base + +data Interface = Interface { + function :: String + } + +instance Typeable Interface where +#if __GLASGOW_HASKELL__ >= 603 + typeOf _ = mkTyConApp (mkTyCon "API.Interface") [] +#else + typeOf _ = mkAppTy (mkTyCon "API.Interface") [] +#endif + +plugin :: Interface +plugin = Interface { function = "goodbye" } + +unsafeCoerce = unsafeCoerce# diff --git a/testsuite/dynload/should_fail_3/prog/Main.hs b/testsuite/dynload/should_fail_3/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_3/prog/Main.hs @@ -0,0 +1,18 @@ + +import System.Plugins +import API + +conf = "../Plugin.in" +stub = "../Plugin.stub" + +main = do + status <- makeWith conf stub ["-i../api", "-i../../../../src/altdata"] + o <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess _ o -> return o + m_v <- dynload o ["../api"] [] "resource_dyn" + case m_v of + LoadFailure _ -> error "didn't compile" + LoadSuccess _ v -> do putStrLn $ (function v) + makeCleaner o + diff --git a/testsuite/dynload/should_fail_3/prog/expected b/testsuite/dynload/should_fail_3/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_3/prog/expected @@ -0,0 +1,9 @@ + +../Plugin.in:18: + Couldn't match `Dynamic' against `(t, t1)' + Expected type: Dynamic + Inferred type: (t, t1) + In the definition of `resource_dyn': + resource_dyn = (typeOf plugin, unsafeCoerce v) + +Fail: failed diff --git a/testsuite/dynload/should_fail_3/prog/expected.604 b/testsuite/dynload/should_fail_3/prog/expected.604 new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_3/prog/expected.604 @@ -0,0 +1,8 @@ + +../Plugin.in:18:15: + Couldn't match `Dynamic' against `(a, b)' + Expected type: Dynamic + Inferred type: (a, b) + In the definition of `resource_dyn': + resource_dyn = (typeOf plugin, unsafeCoerce v) +a.out: failed diff --git a/testsuite/dynload/should_fail_3/prog/expected.605 b/testsuite/dynload/should_fail_3/prog/expected.605 new file mode 100644 --- /dev/null +++ b/testsuite/dynload/should_fail_3/prog/expected.605 @@ -0,0 +1,8 @@ + +../Plugin.in:18:15: + Couldn't match `Dynamic' against `(a, b)' + Expected type: Dynamic + Inferred type: (a, b) + In the definition of `resource_dyn': + resource_dyn = (typeOf plugin, unsafeCoerce v) +a.out: failed diff --git a/testsuite/dynload/simple/Makefile b/testsuite/dynload/simple/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/dynload/simple/Makefile @@ -0,0 +1,4 @@ +TEST=dynload/simple +EXTRA_OBJS=Plugin.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/dynload/simple/Plugin.hs b/testsuite/dynload/simple/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/simple/Plugin.hs @@ -0,0 +1,11 @@ +{-# OPTIONS -fglasgow-exts #-} +module Plugin where + +import API +import AltData.Dynamic + +my_fun = plugin { function = "plugin says \"hello\"" } + +resource_dyn :: Dynamic +resource_dyn = toDyn my_fun + diff --git a/testsuite/dynload/simple/api/API.hs b/testsuite/dynload/simple/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/simple/api/API.hs @@ -0,0 +1,20 @@ +{-# OPTIONS -cpp #-} + +module API where + +import AltData.Typeable + +data Interface = Interface { + function :: String + } + +instance Typeable Interface where +#if __GLASGOW_HASKELL__ >= 603 + typeOf i = mkTyConApp (mkTyCon "API.Interface") [] +#else + typeOf i = mkAppTy (mkTyCon "API.Interface") [] +#endif + +plugin :: Interface +plugin = Interface { function = "goodbye" } + diff --git a/testsuite/dynload/simple/prog/Main.hs b/testsuite/dynload/simple/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/dynload/simple/prog/Main.hs @@ -0,0 +1,15 @@ +{-# OPTIONS -cpp #-} + +#include "../../../../config.h" + +import System.Plugins +import API + +main = do + m_v <- dynload "../Plugin.o" ["../api"] + [] + "resource_dyn" + case m_v of + LoadFailure _ -> error "didn't compile" + LoadSuccess _ v -> putStrLn $ (function v) + diff --git a/testsuite/dynload/simple/prog/expected b/testsuite/dynload/simple/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/dynload/simple/prog/expected @@ -0,0 +1,1 @@ +plugin says "hello" diff --git a/testsuite/eval.mk b/testsuite/eval.mk new file mode 100644 --- /dev/null +++ b/testsuite/eval.mk @@ -0,0 +1,25 @@ +include $(TOP)/config.mk +include $(TOP)/testsuite/check.mk + +BIN=Main +SRC=Main.hs + +BINDIR= "." +REALBIN= ./$(BIN) + +.SUFFIXES : .o .hs .hi .lhs .hc .s + +all: $(BIN) + +$(BIN): $(SRC) $(OBJS) + @rm -f $@ + @$(GHC) --make -fglasgow-exts $(GHCFLAGS) $(PKGFLAGS) $(EXTRAFLAGS) $(SRC) + +# Standard suffix rules +.o.hi: + @: +.hs.o: + @$(GHC) $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) -c $< + +clean: + @rm -rf *.hi *.o *~ $(BIN) diff --git a/testsuite/eval/eval1/Main.hs b/testsuite/eval/eval1/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval1/Main.hs @@ -0,0 +1,5 @@ + +import System.Eval.Haskell + +main = do i <- eval "1 + 6 :: Int" [] :: IO (Maybe Int) + if isJust i then putStrLn $ show (fromJust i) else return () diff --git a/testsuite/eval/eval1/Makefile b/testsuite/eval/eval1/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval1/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/eval/eval1/expected b/testsuite/eval/eval1/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval1/expected @@ -0,0 +1,1 @@ +7 diff --git a/testsuite/eval/eval2/Main.hs b/testsuite/eval/eval2/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval2/Main.hs @@ -0,0 +1,6 @@ +import System.Eval.Haskell + +main = do m_s <- eval "map toUpper \"haskell\"" ["Data.Char"] + case m_s of + Nothing -> putStrLn "typechecking failed" + Just s -> putStrLn s diff --git a/testsuite/eval/eval2/Makefile b/testsuite/eval/eval2/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval2/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/eval/eval2/expected b/testsuite/eval/eval2/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval2/expected @@ -0,0 +1,1 @@ +HASKELL diff --git a/testsuite/eval/eval3/Main.hs b/testsuite/eval/eval3/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval3/Main.hs @@ -0,0 +1,38 @@ +{-# OPTIONS -cpp #-} +-- +-- Should evaluate to '3', unless something goes wrong. +-- +-- Not so bad to use AltData, as it is already derived for all the basic +-- types. Then, just replace deriving Typeable, with hand-derived +-- instance of Typeable (see hs-plugins/testsuite/eval/eval_fn1/Poly.hs +-- +-- + +#include "../../../config.h" + +import System.Eval +import Data.Dynamic + +main = do + a <- return $ toDyn (3::Integer) + + -- so, we try to compile a function that takes a dyn. + -- looks like with GHC 6.4, we need to make sure the package.confs work: + m_b <- unsafeEval_ "\\dyn -> fromDyn dyn (7 :: Integer)" + ["Data.Dynamic"] + [ ] + [ ] + [] + + case m_b of + Left s -> mapM_ putStrLn s + Right b -> putStrLn $ show (b a :: Integer) -- now apply it + +{- +-- should work, but doesn't. type check fails +-- (due to static vs dynamic typing issue) + + m_b <- unsafeEval_ "\\dyn -> fromMaybe (7 :: Int) (fromDynamic dyn)" + ["Data.Dynamic","Data.Maybe"] [] [] +-} + diff --git a/testsuite/eval/eval3/Makefile b/testsuite/eval/eval3/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval3/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/eval/eval3/expected b/testsuite/eval/eval3/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval3/expected @@ -0,0 +1,1 @@ +3 diff --git a/testsuite/eval/eval_/Main.hs b/testsuite/eval/eval_/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval_/Main.hs @@ -0,0 +1,9 @@ + +import System.Eval.Haskell + +main = do i <- eval_ "Just (7 :: Int)" + ["Data.Maybe"] + ["-fglasgow-exts"] + [] + [] :: IO (Either [String] (Maybe (Maybe Int))) + print i diff --git a/testsuite/eval/eval_/Makefile b/testsuite/eval/eval_/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval_/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/eval/eval_/expected b/testsuite/eval/eval_/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval_/expected @@ -0,0 +1,1 @@ +Right (Just (Just 7)) diff --git a/testsuite/eval/eval_fn/Main.hs b/testsuite/eval/eval_fn/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval_fn/Main.hs @@ -0,0 +1,10 @@ +-- +-- lambda abstraction! +-- +-- +-- needs unsafeEval because eval has a broken Dynamic check +-- +import System.Eval.Haskell + +main = do fn <- unsafeEval "(\\x -> (x,x::Int))" [] :: IO (Maybe (Int -> (Int,Int))) + when (isJust fn) $ putStrLn $ show $ (fromJust fn) 7 diff --git a/testsuite/eval/eval_fn/Makefile b/testsuite/eval/eval_fn/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval_fn/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/eval/eval_fn/expected b/testsuite/eval/eval_fn/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval_fn/expected @@ -0,0 +1,1 @@ +(7,7) diff --git a/testsuite/eval/eval_fn1/Main.hs b/testsuite/eval/eval_fn1/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval_fn1/Main.hs @@ -0,0 +1,15 @@ +{-# OPTIONS -fglasgow-exts #-} +-- +-- polymorphic eval! +-- + +module Main where + +import Poly +import System.Eval.Haskell + +main = do m_f <- eval "Fn (\\x y -> x == y)" ["Poly"] + when (isJust m_f) $ do + let (Fn f) = fromJust m_f + putStrLn $ show (f True True) + putStrLn $ show (f 1 2) diff --git a/testsuite/eval/eval_fn1/Makefile b/testsuite/eval/eval_fn1/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval_fn1/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/eval/eval_fn1/Poly.hs b/testsuite/eval/eval_fn1/Poly.hs new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval_fn1/Poly.hs @@ -0,0 +1,16 @@ +{-# OPTIONS -cpp -fglasgow-exts #-} +module Poly where + +import AltData.Typeable + +data Fn = Fn {fn :: forall t. Eq t => t -> t -> Bool} + +-- +-- ignore type inside the Fn... is this correct? +-- +instance Typeable Fn where +#if __GLASGOW_HASKELL__ >= 603 + typeOf _ = mkTyConApp (mkTyCon "Poly.Fn") [] +#else + typeOf _ = mkAppTy (mkTyCon "Poly.Fn") [] +#endif diff --git a/testsuite/eval/eval_fn1/expected b/testsuite/eval/eval_fn1/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/eval_fn1/expected @@ -0,0 +1,2 @@ +True +False diff --git a/testsuite/eval/foreign_eval/Makefile b/testsuite/eval/foreign_eval/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_eval/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../foreign.mk diff --git a/testsuite/eval/foreign_eval/README b/testsuite/eval/foreign_eval/README new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_eval/README @@ -0,0 +1,1 @@ +run a string of Haskell code from a C program. diff --git a/testsuite/eval/foreign_eval/dont_test b/testsuite/eval/foreign_eval/dont_test new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_eval/dont_test diff --git a/testsuite/eval/foreign_eval/expected b/testsuite/eval/foreign_eval/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_eval/expected @@ -0,0 +1,1 @@ +10946 diff --git a/testsuite/eval/foreign_eval/main.c b/testsuite/eval/foreign_eval/main.c new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_eval/main.c @@ -0,0 +1,16 @@ +#include + +#include "EvalHaskell.h" + +int main(int argc, char *argv[]) +{ + int *p; + hs_init(&argc, &argv); + p = hs_eval_i("let fibs = 1:1:zipWith (+) fibs (tail fibs) in fibs !! 20 :: Int"); + if (p == NULL) + printf("failed!\n"); + else + printf("%d\n",*p); + hs_exit(); + return 0; +} diff --git a/testsuite/eval/foreign_eval1/Makefile b/testsuite/eval/foreign_eval1/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_eval1/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../foreign.mk diff --git a/testsuite/eval/foreign_eval1/dont_test b/testsuite/eval/foreign_eval1/dont_test new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_eval1/dont_test diff --git a/testsuite/eval/foreign_eval1/expected b/testsuite/eval/foreign_eval1/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_eval1/expected @@ -0,0 +1,1 @@ +10946 diff --git a/testsuite/eval/foreign_eval1/main.c b/testsuite/eval/foreign_eval1/main.c new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_eval1/main.c @@ -0,0 +1,16 @@ +#include + +#include "EvalHaskell.h" + +int main(int argc, char *argv[]) +{ + char *p; + hs_init(&argc, &argv); + p = hs_eval_s("show $ let fibs = 1:1:zipWith (+) fibs (tail fibs) in fibs !! 20"); + if (p == NULL) + printf("failed!\n"); + else + printf("%s\n",p); + hs_exit(); + return 0; +} diff --git a/testsuite/eval/foreign_should_fail/Makefile b/testsuite/eval/foreign_should_fail/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../foreign.mk diff --git a/testsuite/eval/foreign_should_fail/dont_test b/testsuite/eval/foreign_should_fail/dont_test new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail/dont_test diff --git a/testsuite/eval/foreign_should_fail/expected b/testsuite/eval/foreign_should_fail/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail/expected @@ -0,0 +1,2 @@ +:1: parse error on input `in' +failed! diff --git a/testsuite/eval/foreign_should_fail/expected.604 b/testsuite/eval/foreign_should_fail/expected.604 new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail/expected.604 @@ -0,0 +1,1 @@ +failed! diff --git a/testsuite/eval/foreign_should_fail/expected.605 b/testsuite/eval/foreign_should_fail/expected.605 new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail/expected.605 @@ -0,0 +1,1 @@ +failed! diff --git a/testsuite/eval/foreign_should_fail/main.c b/testsuite/eval/foreign_should_fail/main.c new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail/main.c @@ -0,0 +1,16 @@ +#include + +#include "EvalHaskell.h" + +int main(int argc, char *argv[]) +{ + int *p; + hs_init(&argc, &argv); + p = hs_eval_i("show $ case 1 + 2 in{-wrong-} x -> x"); + if (p == NULL) + printf("failed!\n"); + else + printf("%d\n",*p); + hs_exit(); + return 0; +} diff --git a/testsuite/eval/foreign_should_fail_illtyped/Makefile b/testsuite/eval/foreign_should_fail_illtyped/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail_illtyped/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../foreign.mk diff --git a/testsuite/eval/foreign_should_fail_illtyped/dont_test b/testsuite/eval/foreign_should_fail_illtyped/dont_test new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail_illtyped/dont_test diff --git a/testsuite/eval/foreign_should_fail_illtyped/expected b/testsuite/eval/foreign_should_fail_illtyped/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail_illtyped/expected @@ -0,0 +1,4 @@ +Couldn't match `Int' against `[Char]' + Expected type: Int + Inferred type: [Char] +failed! diff --git a/testsuite/eval/foreign_should_fail_illtyped/expected.604 b/testsuite/eval/foreign_should_fail_illtyped/expected.604 new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail_illtyped/expected.604 @@ -0,0 +1,1 @@ +failed! diff --git a/testsuite/eval/foreign_should_fail_illtyped/expected.605 b/testsuite/eval/foreign_should_fail_illtyped/expected.605 new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail_illtyped/expected.605 @@ -0,0 +1,1 @@ +failed! diff --git a/testsuite/eval/foreign_should_fail_illtyped/main.c b/testsuite/eval/foreign_should_fail_illtyped/main.c new file mode 100644 --- /dev/null +++ b/testsuite/eval/foreign_should_fail_illtyped/main.c @@ -0,0 +1,16 @@ +#include + +#include "EvalHaskell.h" + +int main(int argc, char *argv[]) +{ + int *p; + hs_init(&argc, &argv); + p = hs_eval_i("\"an ill-typed string\""); + if (p == NULL) + printf("failed!\n"); + else + printf("%d\n",*p); + hs_exit(); + return 0; +} diff --git a/testsuite/eval/unsafeidir/Main.hs b/testsuite/eval/unsafeidir/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/eval/unsafeidir/Main.hs @@ -0,0 +1,16 @@ + +import System.Plugins.Make +import System.Eval.Haskell + +main = do make "a/Extra.hs" [] + + i <- unsafeEval_ "show (Just (1 + 6 :: Int)) ++ extra" + ["Data.Maybe", "Extra"] + ["-ia"] -- no make flags + [] -- no package.confs + ["a"] -- include paths to load from + :: IO (Either [String] String) + + case i of + Right i -> putStrLn $ show i + Left es -> mapM_ putStrLn es diff --git a/testsuite/eval/unsafeidir/Makefile b/testsuite/eval/unsafeidir/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/eval/unsafeidir/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/eval/unsafeidir/a/Extra.hs b/testsuite/eval/unsafeidir/a/Extra.hs new file mode 100644 --- /dev/null +++ b/testsuite/eval/unsafeidir/a/Extra.hs @@ -0,0 +1,3 @@ +module Extra where + +extra = "an extra value" diff --git a/testsuite/eval/unsafeidir/expected b/testsuite/eval/unsafeidir/expected new file mode 100644 --- /dev/null +++ b/testsuite/eval/unsafeidir/expected @@ -0,0 +1,1 @@ +"Just 7an extra value" diff --git a/testsuite/foreign.mk b/testsuite/foreign.mk new file mode 100644 --- /dev/null +++ b/testsuite/foreign.mk @@ -0,0 +1,22 @@ +include $(TOP)/config.mk +include $(TOP)/testsuite/check.mk + + +INCLUDES= -I$(TOP) + +# compile with GHC to save us setting all the necessary include and +# lib flags. use ghc -v to find out what these are if you wish to go +# via gcc. +BIN=./Main +SRC=main.c + +BINDIR= "." +REALBIN= $(BIN) + +all: $(BIN) + +$(BIN): $(SRC) + $(GHC) -package plugins $(INCLUDES) $(PKGFLAGS) $(SRC) + +clean: + rm -rf *.hi *.o *~ $(BIN) diff --git a/testsuite/hier/hier1/Makefile b/testsuite/hier/hier1/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier1/Makefile @@ -0,0 +1,8 @@ +TEST= hier/hier1 + +EXTRA_OBJS=Plugin.o +PRIOR_OBJS=Modules/Flags.o +EXTRAFLAGS= + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/hier/hier1/Modules/Flags.hs b/testsuite/hier/hier1/Modules/Flags.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier1/Modules/Flags.hs @@ -0,0 +1,15 @@ +-- +-- A simple module +-- + +module Modules.Flags where + + +data FlagRec = FlagRec { + f1 :: Int, + f2 :: Int +} + + +foo :: FlagRec -> Int +foo x = f1 x diff --git a/testsuite/hier/hier1/Modules/Makefile b/testsuite/hier/hier1/Modules/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier1/Modules/Makefile @@ -0,0 +1,6 @@ + +all: + ghc -O -c Flags.hs + +clean: + rm -f *.hi *.o diff --git a/testsuite/hier/hier1/Plugin.hs b/testsuite/hier/hier1/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier1/Plugin.hs @@ -0,0 +1,14 @@ +-- +-- Plugin +-- + +module Plugin where + +import API +import Modules.Flags as Flags + + +resource = plugin { + dbFunc = (\x -> Flags.f1 x) +} + diff --git a/testsuite/hier/hier1/api/API.hs b/testsuite/hier/hier1/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier1/api/API.hs @@ -0,0 +1,16 @@ +-- +-- API for plugin test +-- + +module API where + +import Modules.Flags as Flags + +data Interface = Interface { + dbFunc :: Flags.FlagRec -> Int +} + + +plugin :: Interface +plugin = Interface { dbFunc = (\x -> 1) } + diff --git a/testsuite/hier/hier1/prog/Main.hs b/testsuite/hier/hier1/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier1/prog/Main.hs @@ -0,0 +1,21 @@ +-- +-- Test multiple plugins +-- + + +module Main where + +import System.Plugins +import API +import Modules.Flags as Flags + + +rec = Flags.FlagRec { Flags.f1 = 4, Flags.f2 = 10 } + + +main = do + status <- load "../Plugin.o" ["../api",".."] [] "resource" + case status of + LoadFailure _ -> error "load failed" + LoadSuccess _ v -> do let func = dbFunc v + print (func rec) diff --git a/testsuite/hier/hier1/prog/expected b/testsuite/hier/hier1/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier1/prog/expected @@ -0,0 +1,1 @@ +4 diff --git a/testsuite/hier/hier2/A/B/C/Module.hs b/testsuite/hier/hier2/A/B/C/Module.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier2/A/B/C/Module.hs @@ -0,0 +1,8 @@ +-- +-- A simple module +-- + +module A.B.C.Module where + +symbol = "You found me" + diff --git a/testsuite/hier/hier2/A/Makefile b/testsuite/hier/hier2/A/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier2/A/Makefile @@ -0,0 +1,7 @@ + +all: + ghc -c B/C/Module.hs + + +clean: + rm -f B/C/*.hi B/C/*.o diff --git a/testsuite/hier/hier2/Makefile b/testsuite/hier/hier2/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier2/Makefile @@ -0,0 +1,7 @@ +TEST= hier/hier2 + +PRIOR_OBJS=A/B/C/Module.o +EXTRAFLAGS= + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/hier/hier2/api/API.hs b/testsuite/hier/hier2/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier2/api/API.hs @@ -0,0 +1,4 @@ +module API where + +-- just a dummy for the build system + diff --git a/testsuite/hier/hier2/prog/Main.hs b/testsuite/hier/hier2/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier2/prog/Main.hs @@ -0,0 +1,15 @@ +-- +-- Test if we can load a module with a hierarchical name from some weird +-- path. Tests our the module name handling in the .hi file parser. +-- + + +module Main where + +import System.Plugins + +main = do + status <- load "../A/B/C/Module.o" [".."] [] "symbol" + case status of + LoadFailure ers -> mapM_ putStrLn ers + LoadSuccess _ v -> print (v :: String) diff --git a/testsuite/hier/hier2/prog/expected b/testsuite/hier/hier2/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier2/prog/expected @@ -0,0 +1,1 @@ +"You found me" diff --git a/testsuite/hier/hier3/Main.hs b/testsuite/hier/hier3/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier3/Main.hs @@ -0,0 +1,25 @@ +module Main where + +import System.Plugins + +main = do + + makeAll "One.hs" [] + + load2 "Two.o" + + load2 "./Two.o" -- shouldn't load + load2 "../hier3/Two.o" -- shouldn't load + load2 "././././Two.o" -- shouldn't load + + -- and this one pulls in "../hier3/Two.o" as a dep + y <- load "One.o" ["../hier3"] [] "resource" + case y of + LoadSuccess _ s -> putStrLn $ "One plugin: " ++ s + LoadFailure _ -> putStrLn "Failure: y" + +load2 f = do + x <- load f [".", "../hier3", ""] [] "resource" -- depend on One.o + case x of + LoadSuccess _ s -> putStrLn $ "Two plugin: " ++ s + LoadFailure _ -> putStrLn "Failure: x" diff --git a/testsuite/hier/hier3/Makefile b/testsuite/hier/hier3/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier3/Makefile @@ -0,0 +1,7 @@ +TEST= hier/hier3 + +EXTRA_OBJS=One.o Two.o +EXTRAFLAGS= + +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/hier/hier3/One.hs b/testsuite/hier/hier3/One.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier3/One.hs @@ -0,0 +1,7 @@ + +module One where + +import qualified Two + +resource = "This is the sub-plugin of (" ++ Two.resource ++ ")" + diff --git a/testsuite/hier/hier3/Two.hs b/testsuite/hier/hier3/Two.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier3/Two.hs @@ -0,0 +1,4 @@ +module Two where + +resource = "This is the top plugin" + diff --git a/testsuite/hier/hier3/expected b/testsuite/hier/hier3/expected new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier3/expected @@ -0,0 +1,5 @@ +Two plugin: This is the top plugin +Two plugin: This is the top plugin +Two plugin: This is the top plugin +Two plugin: This is the top plugin +One plugin: This is the sub-plugin of (This is the top plugin) diff --git a/testsuite/hier/hier4/A.hs b/testsuite/hier/hier4/A.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier4/A.hs @@ -0,0 +1,11 @@ + +-- now, the question is: is it possible to not depend on a module or +-- package, but nonetheless have an orphan to it? this could cause +-- problems.... + +module A where + +import B + +u :: Int +u = undefined diff --git a/testsuite/hier/hier4/B.hs b/testsuite/hier/hier4/B.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier4/B.hs @@ -0,0 +1,4 @@ +module B where + +import C () -- instances, to make available to those who use B + diff --git a/testsuite/hier/hier4/C.hs b/testsuite/hier/hier4/C.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier4/C.hs @@ -0,0 +1,12 @@ + +-- try to construct an orphan module == an instance decl-only module, +-- that uses classes and types not defined in this module + +module C (C) where + +import D + +instance C a => D (T a) where + +class C a where + diff --git a/testsuite/hier/hier4/D.hs b/testsuite/hier/hier4/D.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier4/D.hs @@ -0,0 +1,6 @@ + +module D where + +class D a where + +data T a = T diff --git a/testsuite/hier/hier4/Main.hs b/testsuite/hier/hier4/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier4/Main.hs @@ -0,0 +1,12 @@ +module Main where + +import System.Plugins + +main = do + + makeAll "A.hs" [] + + y <- load "A.o" ["."] [] "u" + case y of + LoadSuccess _ _ -> putStrLn $ "YES" + LoadFailure e -> mapM_ putStrLn e diff --git a/testsuite/hier/hier4/Makefile b/testsuite/hier/hier4/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier4/Makefile @@ -0,0 +1,4 @@ +TEST= hier/hier4 + +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/hier/hier4/expected b/testsuite/hier/hier4/expected new file mode 100644 --- /dev/null +++ b/testsuite/hier/hier4/expected @@ -0,0 +1,1 @@ +YES diff --git a/testsuite/iface/null/A.hs b/testsuite/iface/null/A.hs new file mode 100644 --- /dev/null +++ b/testsuite/iface/null/A.hs @@ -0,0 +1,1 @@ +module A where diff --git a/testsuite/iface/null/B.hs b/testsuite/iface/null/B.hs new file mode 100644 --- /dev/null +++ b/testsuite/iface/null/B.hs @@ -0,0 +1,1 @@ +module B where diff --git a/testsuite/iface/null/Main.hs b/testsuite/iface/null/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/iface/null/Main.hs @@ -0,0 +1,9 @@ +module Main ( main ) where + +import Language.Hi.Parser + +import A +import B + +main = do iface <- readIface "Main.hi" + putStrLn (showIface iface) diff --git a/testsuite/iface/null/Makefile b/testsuite/iface/null/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/iface/null/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/iface/null/expected b/testsuite/iface/null/expected new file mode 100644 --- /dev/null +++ b/testsuite/iface/null/expected @@ -0,0 +1,4 @@ +interface "main" Main +module dependencies: A, B +package dependencies: base, plugins-1.0 + diff --git a/testsuite/iface/null/expected.604 b/testsuite/iface/null/expected.604 new file mode 100644 --- /dev/null +++ b/testsuite/iface/null/expected.604 @@ -0,0 +1,5 @@ +interface "unknown" Main +module dependencies: A, B +package dependencies: base-1.0, plugins-1.0 +import B +import A diff --git a/testsuite/iface/null/expected.605 b/testsuite/iface/null/expected.605 new file mode 100644 --- /dev/null +++ b/testsuite/iface/null/expected.605 @@ -0,0 +1,5 @@ +interface "unknown" Main +module dependencies: A, B +package dependencies: base-1.0, plugins-1.0 +import B +import A diff --git a/testsuite/load/io/Makefile b/testsuite/load/io/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/load/io/Makefile @@ -0,0 +1,6 @@ +TEST= load/io + +EXTRA_OBJS=TestIO.o + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/load/io/TestIO.hs b/testsuite/load/io/TestIO.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/io/TestIO.hs @@ -0,0 +1,88 @@ +{-# OPTIONS -cpp #-} +-- +-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons +-- LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html) +-- + +module TestIO ( resource, resource_dyn ) where + +import API +import Data.Dynamic + +import Distribution.Package +import Language.Haskell.Parser +import Network.HxWeb + +import System.IO +import System.Posix.Types ( ProcessID, Fd ) +import System.Posix.Process ( forkProcess, executeFile, getProcessID ) +import System.Posix.IO ( createPipe, stdInput, + stdOutput, fdToHandle, closeFd, dupTo ) + +resource = testio { field = date } + +resource_dyn :: Dynamic +resource_dyn = toDyn resource + +-- +-- call a shell command , returning it's output +-- +date :: IO String +date = do (hdl,_,_) <- catch (popen "/bin/date") (\_->error "popen failed") + hGetLine hdl + +------------------------------------------------------------------------ +-- +-- my implementation of $val = `cmd`; (if this was perl) +-- +-- provide similar functionality to popen(3), +-- along with bidirectional ipc via pipes +-- return's the pid of the child process +-- +-- there are two different forkProcess functions. the pre-620 was a +-- unix-fork style function, and the modern function has semantics more +-- like the Awkward-Squad paper. We provide implementations of popen +-- using both versions, depending on which GHC the user wants to try. +-- + +popen :: FilePath -> IO (Handle, Handle, ProcessID) +popen cmd = do + (pr, pw) <- createPipe + (cr, cw) <- createPipe + + -- parent -- + let parent = do closeFd cw + closeFd pr + -- child -- + let child = do closeFd pw + closeFd cr + exec cmd (pr,cw) + error "exec cmd failed!" -- typing only + +-- if the parser front end understood cpp, this would work +-- #if __GLASGOW_HASKELL__ >= 601 + pid <- forkProcess child -- fork child + parent -- and run parent code +-- #else +-- p <- forkProcess +-- pid <- case p of +-- Just pid -> parent >> return pid +-- Nothing -> child +-- #endif + + hcr <- fdToHandle cr + hpw <- fdToHandle pw + + return (hcr,hpw,pid) + +-- +-- execve cmd in the child process, dup'ing the file descriptors passed +-- as arguments to become the child's stdin and stdout. +-- +exec :: FilePath -> (Fd,Fd) -> IO () +exec cmd (pr,cw) = do + dupTo pr stdInput + dupTo cw stdOutput + executeFile cmd False [] Nothing + +------------------------------------------------------------------------ diff --git a/testsuite/load/io/api/API.hs b/testsuite/load/io/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/io/api/API.hs @@ -0,0 +1,16 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import Data.Dynamic + +data TestIO = TestIO { + field :: IO String + } + deriving (Typeable, Show) + +instance Show (IO String) where + show _ = "<>" + +testio :: TestIO +testio = TestIO { field = return "default value" } diff --git a/testsuite/load/io/prog/Main.hs b/testsuite/load/io/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/io/prog/Main.hs @@ -0,0 +1,15 @@ +{-# OPTIONS -cpp #-} + +#include "../../../../config.h" + +import System.Plugins +import API + +main :: IO () +main = do + m_v <- load "../TestIO.o" ["../api"] [] "resource" + v <- case m_v of + LoadFailure _ -> error "load failed" + LoadSuccess _ v -> return v + s <- field v + if null s then print False else print True diff --git a/testsuite/load/io/prog/expected b/testsuite/load/io/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/load/io/prog/expected @@ -0,0 +1,1 @@ +True diff --git a/testsuite/load/load_0/Makefile b/testsuite/load/load_0/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/load/load_0/Makefile @@ -0,0 +1,6 @@ +TEST= load/load_0 + +EXTRA_OBJS=Test.o + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/load/load_0/Test.hs b/testsuite/load/load_0/Test.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/load_0/Test.hs @@ -0,0 +1,6 @@ + +module Test where + +import API + +resource = test { field = "success" } diff --git a/testsuite/load/load_0/api/API.hs b/testsuite/load/load_0/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/load_0/api/API.hs @@ -0,0 +1,8 @@ +module API where + +data Test = Test { + field :: String + } + +test :: Test +test = Test { field = "default value" } diff --git a/testsuite/load/load_0/prog/Main.hs b/testsuite/load/load_0/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/load_0/prog/Main.hs @@ -0,0 +1,11 @@ + +import System.Plugins +import API + +main = do + m_v <- load_ "../Test.o" ["../api"] "resource" + v <- case m_v of + LoadFailure _ -> error "load failed" + LoadSuccess _ v -> return v + let s = field v + print s diff --git a/testsuite/load/load_0/prog/expected b/testsuite/load/load_0/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/load/load_0/prog/expected @@ -0,0 +1,1 @@ +"success" diff --git a/testsuite/load/loadpkg/Main.hs b/testsuite/load/loadpkg/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/loadpkg/Main.hs @@ -0,0 +1,4 @@ + +import System.Plugins + +main = loadPackageWith "posix" [] diff --git a/testsuite/load/loadpkg/Makefile b/testsuite/load/loadpkg/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/load/loadpkg/Makefile @@ -0,0 +1,4 @@ +TEST= load/loadpkg + +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/load/loadpkg/expected b/testsuite/load/loadpkg/expected new file mode 100644 --- /dev/null +++ b/testsuite/load/loadpkg/expected diff --git a/testsuite/load/null/Makefile b/testsuite/load/null/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/load/null/Makefile @@ -0,0 +1,4 @@ +TEST= load/null +EXTRA_OBJS=Null.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/load/null/Null.hs b/testsuite/load/null/Null.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/null/Null.hs @@ -0,0 +1,11 @@ +module Null ( resource, resource_dyn ) where + +import API +import Data.Dynamic +import Prelude hiding (null) + +resource = null + +-- ! this has to be special: it can't be overridden by the user. +resource_dyn :: Dynamic +resource_dyn = toDyn resource diff --git a/testsuite/load/null/api/API.hs b/testsuite/load/null/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/null/api/API.hs @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import Data.Dynamic + +data Null = Null { a, b :: Int } + deriving (Typeable, Show) + +null :: Null +null = Null { a = 42 , b = 1 } + diff --git a/testsuite/load/null/prog/Main.hs b/testsuite/load/null/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/null/prog/Main.hs @@ -0,0 +1,17 @@ +{-# OPTIONS -cpp #-} + +#include "../../../../config.h" + +import System.Plugins +import API + +-- an example where we just want to load an object and run it + +main = do + let includes = [TOP ++ "/testsuite/load/null/api"] + m_v <- load "../Null.o" includes [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + + putStrLn ( show (a v) ) diff --git a/testsuite/load/null/prog/expected b/testsuite/load/null/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/load/null/prog/expected @@ -0,0 +1,1 @@ +42 diff --git a/testsuite/load/thiemann0/Makefile b/testsuite/load/thiemann0/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann0/Makefile @@ -0,0 +1,6 @@ +TEST= load/thiemann0 + +#EXTRA_OBJS=Test.o + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/load/thiemann0/Test.hs b/testsuite/load/thiemann0/Test.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann0/Test.hs @@ -0,0 +1,11 @@ + +-- P.Thiemann reports that 'import Char' leads to undefined symbol for +-- __stginit_Char_. + +module Test where + +import API +import Char + +resource = test { field = map toUpper "success" } + diff --git a/testsuite/load/thiemann0/api/API.hs b/testsuite/load/thiemann0/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann0/api/API.hs @@ -0,0 +1,8 @@ +module API where + +data Test = Test { + field :: String + } + +test :: Test +test = Test { field = "default value" } diff --git a/testsuite/load/thiemann0/prog/Main.hs b/testsuite/load/thiemann0/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann0/prog/Main.hs @@ -0,0 +1,16 @@ + +import System.Plugins +import API + +main = do + status <- make "../Test.hs" ["-i../api"] + obj <- case status of + MakeSuccess _ o -> return o + MakeFailure e -> mapM_ putStrLn e >> error "failed" + + m_v <- load_ obj ["../api"] "resource" + v <- case m_v of + LoadFailure _ -> error "load failed" + LoadSuccess _ v -> return v + let s = field v + print s diff --git a/testsuite/load/thiemann0/prog/expected b/testsuite/load/thiemann0/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann0/prog/expected @@ -0,0 +1,1 @@ +"SUCCESS" diff --git a/testsuite/load/thiemann2/C.hs b/testsuite/load/thiemann2/C.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann2/C.hs @@ -0,0 +1,6 @@ +module C where + +import API +import qualified A + +resource = let Test s = A.resource in Test { field = s } diff --git a/testsuite/load/thiemann2/Makefile b/testsuite/load/thiemann2/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann2/Makefile @@ -0,0 +1,6 @@ +TEST= load/thiemann2 +EXTRAFLAGS+=-iprog + +TOP=../../.. +include ../../build.mk + diff --git a/testsuite/load/thiemann2/api/API.hs b/testsuite/load/thiemann2/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann2/api/API.hs @@ -0,0 +1,8 @@ +module API where + +data Test = Test { + field :: String + } + +test :: Test +test = Test { field = "default value" } diff --git a/testsuite/load/thiemann2/prog/A.hs b/testsuite/load/thiemann2/prog/A.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann2/prog/A.hs @@ -0,0 +1,8 @@ +module A where + +import API + +import qualified B + +resource = Test { field = B.resource } + diff --git a/testsuite/load/thiemann2/prog/B.hs b/testsuite/load/thiemann2/prog/B.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann2/prog/B.hs @@ -0,0 +1,3 @@ +module B where + +resource = "i'm in b" diff --git a/testsuite/load/thiemann2/prog/Main.hs b/testsuite/load/thiemann2/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann2/prog/Main.hs @@ -0,0 +1,20 @@ + +import System.Plugins +import API + +import A + +main = do + -- compile C (A and B are already compiled) + status <- makeAll "../C.hs" ["-i../api"] + obj <- case status of + MakeSuccess _ o -> return o + MakeFailure e -> mapM_ putStrLn e >> error "failed" + + -- should load C + m_v <- load_ obj ["../api","."] "resource" + v <- case m_v of + LoadFailure _ -> error "load failed" + LoadSuccess _ v -> return v + let s = field v + print s diff --git a/testsuite/load/thiemann2/prog/expected b/testsuite/load/thiemann2/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/load/thiemann2/prog/expected @@ -0,0 +1,1 @@ +"i'm in b" diff --git a/testsuite/load/unloadpkg/Main.hs b/testsuite/load/unloadpkg/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/load/unloadpkg/Main.hs @@ -0,0 +1,6 @@ + +import System.Plugins + +main = do loadPackage "posix" + unloadPackage "posix" + loadPackage "posix" diff --git a/testsuite/load/unloadpkg/Makefile b/testsuite/load/unloadpkg/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/load/unloadpkg/Makefile @@ -0,0 +1,4 @@ +TEST= load/unloadpkg + +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/load/unloadpkg/expected b/testsuite/load/unloadpkg/expected new file mode 100644 --- /dev/null +++ b/testsuite/load/unloadpkg/expected diff --git a/testsuite/loadCLib/null/Makefile b/testsuite/loadCLib/null/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/loadCLib/null/Makefile @@ -0,0 +1,4 @@ +TEST= loadCLib/null +EXTRA_OBJS=Null.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/loadCLib/null/Null.hs b/testsuite/loadCLib/null/Null.hs new file mode 100644 --- /dev/null +++ b/testsuite/loadCLib/null/Null.hs @@ -0,0 +1,12 @@ +module Null ( resource ) where + +import API +import Data.Dynamic +import Prelude hiding (null) +import Graphics.Rendering.OpenGL + +resource = null + +-- ! this has to be special: it can't be overridden by the user. +resource_dyn :: Dynamic +resource_dyn = toDyn resource diff --git a/testsuite/loadCLib/null/api/API.hs b/testsuite/loadCLib/null/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/loadCLib/null/api/API.hs @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import Data.Dynamic + +data Null = Null { a, b :: Int } + deriving (Typeable, Show) + +null :: Null +null = Null { a = 42 , b = 1 } + diff --git a/testsuite/loadCLib/null/prog/Main.hs b/testsuite/loadCLib/null/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/loadCLib/null/prog/Main.hs @@ -0,0 +1,11 @@ + +import System.Plugins +import API + +-- an example where we just want to load an object and run it + +main = do + m_v <- load_ "../Null.o" ["../api",".."] "resource" + case m_v of + LoadFailure err -> error (unlines err) + LoadSuccess m v -> do putStrLn ( show (a v) ) ; unload m diff --git a/testsuite/loadCLib/null/prog/expected b/testsuite/loadCLib/null/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/loadCLib/null/prog/expected @@ -0,0 +1,1 @@ +42 diff --git a/testsuite/make/makeall001/A.hs b/testsuite/make/makeall001/A.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/makeall001/A.hs @@ -0,0 +1,3 @@ +module A where + +a = "a" diff --git a/testsuite/make/makeall001/B.hs b/testsuite/make/makeall001/B.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/makeall001/B.hs @@ -0,0 +1,3 @@ +module B where + +b = "b" diff --git a/testsuite/make/makeall001/C.hs b/testsuite/make/makeall001/C.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/makeall001/C.hs @@ -0,0 +1,3 @@ +module C where + +c = "c" diff --git a/testsuite/make/makeall001/Makefile b/testsuite/make/makeall001/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/make/makeall001/Makefile @@ -0,0 +1,3 @@ +TEST= make/makeall001 +TOP=../../.. +include ../../build.mk diff --git a/testsuite/make/makeall001/Tiny.hs b/testsuite/make/makeall001/Tiny.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/makeall001/Tiny.hs @@ -0,0 +1,13 @@ +module Tiny ( resource ) where + +import API + +import A +import B +import C + +resource = tiny { + + field = a ++ b ++ c + +} diff --git a/testsuite/make/makeall001/api/API.hs b/testsuite/make/makeall001/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/makeall001/api/API.hs @@ -0,0 +1,13 @@ +{-# OPTIONS -fglasgow-exts #-} +-- ^ needed to derive Typeable + +module API where + +import Data.Dynamic + +data Tiny = Tiny { field :: String } + deriving (Typeable, Show) + +tiny :: Tiny +tiny = Tiny { field = "default value" } + diff --git a/testsuite/make/makeall001/prog/Main.hs b/testsuite/make/makeall001/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/makeall001/prog/Main.hs @@ -0,0 +1,18 @@ + +-- little more complex. use the path to the obj file we get back from +-- 'make'. load() uses this to find the .hi file + +import System.Plugins +import API + +main = do + status <- makeAll "../Tiny.hs" ["-i../api"] + o <- case status of + MakeSuccess _ o -> return o + MakeFailure e -> mapM_ putStrLn e >> error "failed" + m_v <- load o [".."] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ field v + diff --git a/testsuite/make/makeall001/prog/expected b/testsuite/make/makeall001/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/make/makeall001/prog/expected @@ -0,0 +1,1 @@ +abc diff --git a/testsuite/make/null/Makefile b/testsuite/make/null/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/make/null/Makefile @@ -0,0 +1,4 @@ +TEST= make/null + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/make/null/Null.hs b/testsuite/make/null/Null.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/null/Null.hs @@ -0,0 +1,11 @@ +module Null ( resource, resource_dyn ) where + +import API +import Data.Dynamic +import Prelude hiding (null) + +resource = null + +-- ! this has to be special: it can't be overridden by the user. +resource_dyn :: Dynamic +resource_dyn = toDyn resource diff --git a/testsuite/make/null/api/API.hs b/testsuite/make/null/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/null/api/API.hs @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import Data.Dynamic + +data Null = Null { a, b :: Int } + deriving (Typeable, Show) + +null :: Null +null = Null { a = 42 , b = 1 } + diff --git a/testsuite/make/null/prog/Main.hs b/testsuite/make/null/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/null/prog/Main.hs @@ -0,0 +1,13 @@ + +-- an example where we want to compile and load a file + +import System.Plugins +import API + +main = do + make "../Null.hs" ["-i../api"] + m_v <- load "../Null.o" ["../api"] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn ( show (a v) ) diff --git a/testsuite/make/null/prog/expected b/testsuite/make/null/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/make/null/prog/expected @@ -0,0 +1,1 @@ +42 diff --git a/testsuite/make/o/Makefile b/testsuite/make/o/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/make/o/Makefile @@ -0,0 +1,3 @@ +TEST=make/o +TOP =../../.. +include ../../build.mk diff --git a/testsuite/make/o/Plugin.hs b/testsuite/make/o/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/o/Plugin.hs @@ -0,0 +1,7 @@ +module Plugin ( resource ) where + +import API + +resource = plugin { + field = "hello out there" +} diff --git a/testsuite/make/o/api/API.hs b/testsuite/make/o/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/o/api/API.hs @@ -0,0 +1,8 @@ +module API where + +data Interface = Interface { + field :: String +} + +plugin :: Interface +plugin = Interface { field = undefined } diff --git a/testsuite/make/o/prog/Main.hs b/testsuite/make/o/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/o/prog/Main.hs @@ -0,0 +1,28 @@ +import System.Plugins +import API + +import System.Directory + +-- note: the name of the original *source* module is used to find +-- symbols in the *object* file. load works out what the source file +-- name was by looking at the object file name, i.e. it assumes they +-- have the same name. so, if you are going to store objects in a +-- tmpdir, you should make a tmp directory, and store them inside that, +-- rather than mkstemp'ing the name of the object file yourself. +-- +-- this should go away once we can read .hi files. + +main = do +#if __GLASGOW_HASKELL__ >= 604 + tmpDir <- getTemporaryDirectory +#else + let tmpDir = "/tmp" +#endif + make "../Plugin.hs" [ "-i../api", "-o", (tmpDir ++ "/Plugin.o") ] + m_v <- load (tmpDir ++ "/Plugin.o") ["../api"] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ field v + + mapM_ removeFile [ (tmpDir ++ "/Plugin.hi"), (tmpDir ++ "/Plugin.o") ] diff --git a/testsuite/make/o/prog/expected b/testsuite/make/o/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/make/o/prog/expected @@ -0,0 +1,1 @@ +hello out there diff --git a/testsuite/make/odir/Makefile b/testsuite/make/odir/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/make/odir/Makefile @@ -0,0 +1,3 @@ +TEST= make/odir +TOP=../../.. +include ../../build.mk diff --git a/testsuite/make/odir/Plugin.hs b/testsuite/make/odir/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/odir/Plugin.hs @@ -0,0 +1,7 @@ +module Plugin ( resource ) where + +import API + +resource = plugin { + field = "hello out there" +} diff --git a/testsuite/make/odir/api/API.hs b/testsuite/make/odir/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/odir/api/API.hs @@ -0,0 +1,8 @@ +module API where + +data Interface = Interface { + field :: String +} + +plugin :: Interface +plugin = Interface { field = undefined } diff --git a/testsuite/make/odir/prog/Main.hs b/testsuite/make/odir/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/odir/prog/Main.hs @@ -0,0 +1,21 @@ +import System.Plugins +import API +import System.Directory + +main = do +#if __GLASGOW_HASKELL__ >= 604 + tmpDir <- getTemporaryDirectory +#else + let tmpDir = "/tmp" +#endif + status <- make "../Plugin.hs" [ "-i../api", "-odir", tmpDir ] + o <- case status of + MakeSuccess _ o -> return o + MakeFailure e -> mapM_ putStrLn e >> error "didn't compile" + m_v <- load o ["../api"] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ field v + mapM_ removeFile [(tmpDir ++ "/Plugin.hi"), (tmpDir ++ "/Plugin.o") ] + diff --git a/testsuite/make/odir/prog/expected b/testsuite/make/odir/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/make/odir/prog/expected @@ -0,0 +1,1 @@ +hello out there diff --git a/testsuite/make/remake001/Bar.hs b/testsuite/make/remake001/Bar.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/remake001/Bar.hs @@ -0,0 +1,3 @@ +module Bar where + +bar = undefined diff --git a/testsuite/make/remake001/Foo.hs b/testsuite/make/remake001/Foo.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/remake001/Foo.hs @@ -0,0 +1,3 @@ +module Foo where + +foo = undefined diff --git a/testsuite/make/remake001/Main.hs b/testsuite/make/remake001/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/remake001/Main.hs @@ -0,0 +1,36 @@ +-- +-- expected output: +-- $ ./a.out +-- True +-- False +-- True +-- False +-- + +import System.Plugins +import System.Directory + +main = do + status <- make "Foo.hs" [] -- should make + print status + + status <- make "Foo.hs" [] -- shouldn't make + print status + + status <- merge "Foo.hs" "Bar.hs" + case status of + MergeFailure e -> error $ show e + MergeSuccess _ _ fp -> do { + + ;status <- make fp [] -- should make + ;() <- case status of + MakeSuccess c _ -> print c + MakeFailure e -> error $ show e + + ;status <- make fp [] -- shouldn't make + ;case status of + MakeSuccess c _ -> print c + MakeFailure e -> error $ show e + ;removeFile "Foo.o" + } + diff --git a/testsuite/make/remake001/Makefile b/testsuite/make/remake001/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/make/remake001/Makefile @@ -0,0 +1,4 @@ +TEST= merge/remake001 + +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/make/remake001/expected b/testsuite/make/remake001/expected new file mode 100644 --- /dev/null +++ b/testsuite/make/remake001/expected @@ -0,0 +1,4 @@ +MakeSuccess ReComp "Foo.o" +MakeSuccess NotReq "Foo.o" +ReComp +NotReq diff --git a/testsuite/make/remake001_should_fail/Bar.hs b/testsuite/make/remake001_should_fail/Bar.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/remake001_should_fail/Bar.hs @@ -0,0 +1,3 @@ +module Bar where + +bar = undef {- error -} diff --git a/testsuite/make/remake001_should_fail/Foo.hs b/testsuite/make/remake001_should_fail/Foo.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/remake001_should_fail/Foo.hs @@ -0,0 +1,3 @@ +module Foo where + +foo = undefined diff --git a/testsuite/make/remake001_should_fail/Main.hs b/testsuite/make/remake001_should_fail/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/remake001_should_fail/Main.hs @@ -0,0 +1,31 @@ + +import System.Plugins + +import System.Directory + +main = do + status <- make "Foo.hs" [] -- should make + print status + + status <- make "Foo.hs" [] -- shouldn't make + print status + + status <- merge "Foo.hs" "Bar.hs" + case status of + MergeFailure e -> error $ show e + MergeSuccess _ _ fp -> do { + + ;status <- make fp [] -- should make + ;() <- case status of + MakeSuccess c _ -> print c + MakeFailure _ -> print "make failure" + + ;status <- make fp [] -- shouldn't make + ;case status of + MakeSuccess c _ -> print c + MakeFailure _ -> print "make failure" + + ;removeFile "Foo.o" -- make test deterministic + } + + diff --git a/testsuite/make/remake001_should_fail/Makefile b/testsuite/make/remake001_should_fail/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/make/remake001_should_fail/Makefile @@ -0,0 +1,4 @@ +TEST= make/remake001_should_fail + +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/make/remake001_should_fail/expected b/testsuite/make/remake001_should_fail/expected new file mode 100644 --- /dev/null +++ b/testsuite/make/remake001_should_fail/expected @@ -0,0 +1,4 @@ +MakeSuccess ReComp "Foo.o" +MakeSuccess NotReq "Foo.o" +"make failure" +"make failure" diff --git a/testsuite/make/simple/Makefile b/testsuite/make/simple/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/make/simple/Makefile @@ -0,0 +1,3 @@ +TEST= make/simple +TOP=../../.. +include ../../build.mk diff --git a/testsuite/make/simple/Tiny.hs b/testsuite/make/simple/Tiny.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/simple/Tiny.hs @@ -0,0 +1,14 @@ +module Tiny ( resource, resource_dyn ) where + +import API +import Data.Dynamic + +resource = tiny { + + field = "hello strange world" + +} + +resource_dyn :: Dynamic +resource_dyn = toDyn resource + diff --git a/testsuite/make/simple/api/API.hs b/testsuite/make/simple/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/simple/api/API.hs @@ -0,0 +1,13 @@ +{-# OPTIONS -fglasgow-exts #-} +-- ^ needed to derive Typeable + +module API where + +import Data.Dynamic + +data Tiny = Tiny { field :: String } + deriving (Typeable, Show) + +tiny :: Tiny +tiny = Tiny { field = "default value" } + diff --git a/testsuite/make/simple/prog/Main.hs b/testsuite/make/simple/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/make/simple/prog/Main.hs @@ -0,0 +1,19 @@ + +-- little more complex. use the path to the obj file we get back from +-- 'make'. load() uses this to find the .hi file + +import System.Plugins +import API + +main = do + status <- make "../Tiny.hs" ["-i../api"] + o <- case status of + MakeSuccess _ o -> return o + MakeFailure e -> mapM_ putStrLn e >> error "failed" + + m_v <- load o ["../api"] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ field v + diff --git a/testsuite/make/simple/prog/expected b/testsuite/make/simple/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/make/simple/prog/expected @@ -0,0 +1,1 @@ +hello strange world diff --git a/testsuite/makewith/global_pragma/Makefile b/testsuite/makewith/global_pragma/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/makewith/global_pragma/Makefile @@ -0,0 +1,5 @@ + +TEST=makewith/global_pragma + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/makewith/global_pragma/Plugin.hs b/testsuite/makewith/global_pragma/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/global_pragma/Plugin.hs @@ -0,0 +1,17 @@ +{-# GLOBALOPTIONS -package mtl #-} + +module M ( resource ) where + +import API +import System.IO.Unsafe +import System.Process +import System.IO + +resource = tiny { field = date } + +date :: String +date = unsafePerformIO $ do + (_,outh,_,proc) <- runInteractiveProcess "echo" ["hello"] Nothing Nothing + waitForProcess proc + s <- hGetContents outh + return s diff --git a/testsuite/makewith/global_pragma/api/API.hs b/testsuite/makewith/global_pragma/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/global_pragma/api/API.hs @@ -0,0 +1,8 @@ + +module API where + +data Tiny = Tiny { field :: String } + +tiny :: Tiny +tiny = Tiny { field = "default value" } + diff --git a/testsuite/makewith/global_pragma/prog/Main.hs b/testsuite/makewith/global_pragma/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/global_pragma/prog/Main.hs @@ -0,0 +1,19 @@ + +import System.Plugins +import API + +conf = "../Plugin.hs" +apipath = "../api" + +main = do + status <- makeWith conf conf ["-i"++apipath] + o <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "compile failed" + MakeSuccess _ o -> return o + m_v <- load o [apipath] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + LoadFailure ers -> mapM_ putStrLn ers >> error "load failed" + putStr $ field v + makeCleaner o + diff --git a/testsuite/makewith/global_pragma/prog/expected b/testsuite/makewith/global_pragma/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/makewith/global_pragma/prog/expected @@ -0,0 +1,1 @@ +hello diff --git a/testsuite/makewith/io/Makefile b/testsuite/makewith/io/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/makewith/io/Makefile @@ -0,0 +1,4 @@ +TEST=makewith/io + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/makewith/io/README b/testsuite/makewith/io/README new file mode 100644 --- /dev/null +++ b/testsuite/makewith/io/README @@ -0,0 +1,2 @@ +An example using IO monad fields in the .conf file. + diff --git a/testsuite/makewith/io/TestIO.stub b/testsuite/makewith/io/TestIO.stub new file mode 100644 --- /dev/null +++ b/testsuite/makewith/io/TestIO.stub @@ -0,0 +1,10 @@ + +module TestIO ( resource, resource_dyn ) where + +import API +import Data.Dynamic + +resource = testio + +resource_dyn :: Dynamic +resource_dyn = toDyn resource diff --git a/testsuite/makewith/io/api/API.hs b/testsuite/makewith/io/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/io/api/API.hs @@ -0,0 +1,16 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import Data.Dynamic + +data TestIO = TestIO { + field :: IO String + } + deriving (Typeable, Show) + +instance Show (IO String) where + show _ = "<>" + +testio :: TestIO +testio = TestIO { field = return "default value" } diff --git a/testsuite/makewith/io/prog/Main.hs b/testsuite/makewith/io/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/io/prog/Main.hs @@ -0,0 +1,21 @@ + +import System.Plugins +import API + +conf = "../TestIO.conf" +stub = "../TestIO.stub" +apipath = "../api" + +main = do + status <- makeWith conf stub ["-i"++apipath] + o <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess _ o -> return o + m_v <- load o [apipath] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + s <- field v + + makeCleaner o + if null s then print False else print True diff --git a/testsuite/makewith/io/prog/expected b/testsuite/makewith/io/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/makewith/io/prog/expected @@ -0,0 +1,6 @@ +merge failed: + +parse error in ../TestIO.conf +line: 17, col: 1 + +Main: failed diff --git a/testsuite/makewith/merge00/Bar.hs b/testsuite/makewith/merge00/Bar.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/merge00/Bar.hs @@ -0,0 +1,3 @@ +module Bar where + +resource :: Int diff --git a/testsuite/makewith/merge00/Foo.hs b/testsuite/makewith/merge00/Foo.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/merge00/Foo.hs @@ -0,0 +1,4 @@ +module Foo where + +resource :: Integer +resource = 0xBAD diff --git a/testsuite/makewith/merge00/Main.hs b/testsuite/makewith/merge00/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/merge00/Main.hs @@ -0,0 +1,38 @@ + +import System.Plugins + +import System.Directory + +a = "Foo.hs" -- uesr code +b = "Bar.hs" -- trusted code. Result is "Bar.o" + +main = do + status <- merge a b + f <- case status of + MergeFailure e -> error "merge failure" + MergeSuccess _ _ f -> return f + + status <- merge a b + f' <- case status of + MergeFailure e -> error "merge failure" + MergeSuccess ReComp _ f -> error "unnec. merge" + MergeSuccess NotReq _ f -> return f + + print ( f == f' ) + + status <- make f' [] + o <- case status of + MakeFailure e -> error "make failed" + MakeSuccess _ o -> return o + + m_v <- load o [] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ show $ (v :: Int) + + removeFile o + return () + + makeCleaner f + diff --git a/testsuite/makewith/merge00/Makefile b/testsuite/makewith/merge00/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/makewith/merge00/Makefile @@ -0,0 +1,4 @@ +TEST=makewith/merge00 + +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/makewith/merge00/expected b/testsuite/makewith/merge00/expected new file mode 100644 --- /dev/null +++ b/testsuite/makewith/merge00/expected @@ -0,0 +1,2 @@ +True +2989 diff --git a/testsuite/makewith/mergeto0/Bar.hs b/testsuite/makewith/mergeto0/Bar.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/mergeto0/Bar.hs @@ -0,0 +1,3 @@ +module Bar where + +resource :: Int diff --git a/testsuite/makewith/mergeto0/Foo.hs b/testsuite/makewith/mergeto0/Foo.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/mergeto0/Foo.hs @@ -0,0 +1,4 @@ +module Foo where + +resource :: Integer +resource = 0xBAD diff --git a/testsuite/makewith/mergeto0/Main.hs b/testsuite/makewith/mergeto0/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/mergeto0/Main.hs @@ -0,0 +1,37 @@ + +import System.Plugins + +import System.Directory + +a = "Foo.hs" -- uesr code +b = "Bar.hs" -- trusted code. Result is "Bar.o" +c = "Out.hs" + +main = do + status <- mergeTo a b c + f <- case status of + MergeFailure e -> error "mergeto failure" + MergeSuccess _ _ f -> return f + print $ f == c + + status <- mergeTo a b c + f' <- case status of + MergeFailure e -> error "mergeto failure" + MergeSuccess ReComp _ f -> error "unnec. mergeto" + MergeSuccess NotReq _ f -> return f -- good, not req + + print $ f == f' && f == c + + status <- make f' [] + o <- case status of + MakeFailure e -> error "make failed" + MakeSuccess _ o -> return o + + m_v <- load o [] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ show $ (v :: Int) + + makeCleaner c + diff --git a/testsuite/makewith/mergeto0/Makefile b/testsuite/makewith/mergeto0/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/makewith/mergeto0/Makefile @@ -0,0 +1,4 @@ +TEST=makewith/mergeto0 + +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/makewith/mergeto0/expected b/testsuite/makewith/mergeto0/expected new file mode 100644 --- /dev/null +++ b/testsuite/makewith/mergeto0/expected @@ -0,0 +1,3 @@ +True +True +2989 diff --git a/testsuite/makewith/module_name/Bar.hs b/testsuite/makewith/module_name/Bar.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/module_name/Bar.hs @@ -0,0 +1,3 @@ +module Bar where + +resource :: Int diff --git a/testsuite/makewith/module_name/Foo.hs b/testsuite/makewith/module_name/Foo.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/module_name/Foo.hs @@ -0,0 +1,4 @@ +module Foo where + +resource :: Integer +resource = 1 diff --git a/testsuite/makewith/module_name/Main.hs b/testsuite/makewith/module_name/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/module_name/Main.hs @@ -0,0 +1,33 @@ + +import System.Plugins + +import System.Directory + +a = "Foo.hs" -- uesr code +b = "Bar.hs" -- trusted code. Result is "Bar.o" + +main = do + status <- makeWith a b [] + s <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess n s -> print n >> return s + + status <- makeWith a b [] + s' <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess n s -> print n >> return s + + status <- makeWith a b [] + s'' <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess n s -> print n >> return s + + print $ (s == s') && (s' == s'') + + m_v <- load s [] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ show $ (v :: Int) + + makeCleaner s'' diff --git a/testsuite/makewith/module_name/Makefile b/testsuite/makewith/module_name/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/makewith/module_name/Makefile @@ -0,0 +1,4 @@ +TEST=makewith/module_name + +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/makewith/module_name/expected b/testsuite/makewith/module_name/expected new file mode 100644 --- /dev/null +++ b/testsuite/makewith/module_name/expected @@ -0,0 +1,5 @@ +ReComp +NotReq +NotReq +True +1 diff --git a/testsuite/makewith/multi_make/Bar.hs b/testsuite/makewith/multi_make/Bar.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/multi_make/Bar.hs @@ -0,0 +1,4 @@ +module Bar where + +resource :: Int +resource = 2 diff --git a/testsuite/makewith/multi_make/Foo.hs b/testsuite/makewith/multi_make/Foo.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/multi_make/Foo.hs @@ -0,0 +1,4 @@ +module Foo where + +resource :: Integer +resource = 1 diff --git a/testsuite/makewith/multi_make/Main.hs b/testsuite/makewith/multi_make/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/multi_make/Main.hs @@ -0,0 +1,37 @@ + +import System.Plugins + +import System.Directory + +a = "Foo.hs" -- user code +b = "Bar.hs" -- more user code +z = "Stub.hs" -- and a stub + +main = do + status <- makeWith a z [] + s <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess n s -> print n >> return s + + status <- makeWith b z [] + s' <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess n s -> print n >> return s + + -- shouldn't need to remerge (a,z) + status <- makeWith a z [] + t <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess n s -> print n >> return s + + -- shouldn't need to remerge (b,z) + status <- makeWith b z [] + t' <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess n s -> print n >> return s + + print $ s /= s' -- test we got unique modules + print $ t /= t' -- test we got unique modules + + mapM_ makeCleaner [s,s'] + diff --git a/testsuite/makewith/multi_make/Makefile b/testsuite/makewith/multi_make/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/makewith/multi_make/Makefile @@ -0,0 +1,4 @@ +TEST=makewith/multi_make + +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/makewith/multi_make/Stub.hs b/testsuite/makewith/multi_make/Stub.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/multi_make/Stub.hs @@ -0,0 +1,4 @@ +module Stub where + +resource :: Int + diff --git a/testsuite/makewith/multi_make/expected b/testsuite/makewith/multi_make/expected new file mode 100644 --- /dev/null +++ b/testsuite/makewith/multi_make/expected @@ -0,0 +1,6 @@ +ReComp +ReComp +NotReq +NotReq +True +True diff --git a/testsuite/makewith/should_fail_0/Makefile b/testsuite/makewith/should_fail_0/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/makewith/should_fail_0/Makefile @@ -0,0 +1,4 @@ +TEST=makewith/should_fail_0 + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/makewith/should_fail_0/Plugin.in b/testsuite/makewith/should_fail_0/Plugin.in new file mode 100644 --- /dev/null +++ b/testsuite/makewith/should_fail_0/Plugin.in @@ -0,0 +1,3 @@ +module Plugin where + +resource = 0xBAD :: Int diff --git a/testsuite/makewith/should_fail_0/Plugin.stub b/testsuite/makewith/should_fail_0/Plugin.stub new file mode 100644 --- /dev/null +++ b/testsuite/makewith/should_fail_0/Plugin.stub @@ -0,0 +1,6 @@ +module Plugin ( resource ) where + +import API + +resource :: Interface +resource = plugin diff --git a/testsuite/makewith/should_fail_0/api/API.hs b/testsuite/makewith/should_fail_0/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/should_fail_0/api/API.hs @@ -0,0 +1,10 @@ + +module API where + +data Interface = Interface { + function :: String + } + +plugin :: Interface +plugin = Interface { function = "goodbye" } + diff --git a/testsuite/makewith/should_fail_0/prog/Main.hs b/testsuite/makewith/should_fail_0/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/should_fail_0/prog/Main.hs @@ -0,0 +1,19 @@ + +import System.Plugins +import API + +conf = "../Plugin.in" +stub = "../Plugin.stub" + +main = do + status <- makeWith conf stub ["-i../api"] + case status of + MakeFailure e -> putStrLn "make failed" + MakeSuccess _ o -> do + m_v <- load o ["../api"] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ (function v) + makeCleaner o + diff --git a/testsuite/makewith/should_fail_0/prog/expected b/testsuite/makewith/should_fail_0/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/makewith/should_fail_0/prog/expected @@ -0,0 +1,1 @@ +make failed diff --git a/testsuite/makewith/tiny/Makefile b/testsuite/makewith/tiny/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/makewith/tiny/Makefile @@ -0,0 +1,5 @@ + +TEST=makewith/tiny + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/makewith/tiny/Tiny.conf b/testsuite/makewith/tiny/Tiny.conf new file mode 100644 --- /dev/null +++ b/testsuite/makewith/tiny/Tiny.conf @@ -0,0 +1,8 @@ +resource = tiny { + + field = "hello strange world" + +} + + + diff --git a/testsuite/makewith/tiny/Tiny.stub b/testsuite/makewith/tiny/Tiny.stub new file mode 100644 --- /dev/null +++ b/testsuite/makewith/tiny/Tiny.stub @@ -0,0 +1,31 @@ +module Tiny ( resource, resource_dyn ) where + +import API +import Data.Dynamic + +resource = tiny + +resource_dyn :: Dynamic +resource_dyn = toDyn resource + + + + + + + + + + + + + + + + + + + + + + diff --git a/testsuite/makewith/tiny/api/API.hs b/testsuite/makewith/tiny/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/tiny/api/API.hs @@ -0,0 +1,13 @@ +{-# OPTIONS -fglasgow-exts #-} +-- ^ needed to derive Typeable + +module API where + +import Data.Dynamic + +data Tiny = Tiny { field :: String } + deriving (Typeable, Show) + +tiny :: Tiny +tiny = Tiny { field = "default value" } + diff --git a/testsuite/makewith/tiny/prog/Main.hs b/testsuite/makewith/tiny/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/tiny/prog/Main.hs @@ -0,0 +1,21 @@ + +import System.Plugins +import API +import Data.Either + +conf = "../Tiny.conf" +stub = "../Tiny.stub" +apipath = "../api" + +main = do + status <- makeWith conf stub ["-i"++apipath] + o <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess _ o -> return o + m_v <- load o [apipath] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn $ field v + makeCleaner o + diff --git a/testsuite/makewith/tiny/prog/expected b/testsuite/makewith/tiny/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/makewith/tiny/prog/expected @@ -0,0 +1,1 @@ +hello strange world diff --git a/testsuite/makewith/unsafeio/Makefile b/testsuite/makewith/unsafeio/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/makewith/unsafeio/Makefile @@ -0,0 +1,5 @@ + +TEST=makewith/unsafeio + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/makewith/unsafeio/README b/testsuite/makewith/unsafeio/README new file mode 100644 --- /dev/null +++ b/testsuite/makewith/unsafeio/README @@ -0,0 +1,3 @@ +hmm. on 6.3 we need to add 'mtl' to a package dependency, other +HSlang complains of a missing symbol. Is this a bug in the +package.conf for HSlang? diff --git a/testsuite/makewith/unsafeio/Unsafe.stub b/testsuite/makewith/unsafeio/Unsafe.stub new file mode 100644 --- /dev/null +++ b/testsuite/makewith/unsafeio/Unsafe.stub @@ -0,0 +1,13 @@ + +module Unsafe ( resource, resource_dyn ) where + +import API +import Data.Dynamic + +resource = unsafe + +-- +-- special +-- +resource_dyn :: Dynamic +resource_dyn = toDyn resource diff --git a/testsuite/makewith/unsafeio/api/API.hs b/testsuite/makewith/unsafeio/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/unsafeio/api/API.hs @@ -0,0 +1,13 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import Data.Dynamic + +data Unsafe = Unsafe { + field :: String + } + deriving (Typeable, Show) + +unsafe :: Unsafe +unsafe = Unsafe { field = "default value" } diff --git a/testsuite/makewith/unsafeio/prog/Main.hs b/testsuite/makewith/unsafeio/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/makewith/unsafeio/prog/Main.hs @@ -0,0 +1,20 @@ +import System.Plugins +import API +import Data.Either + +conf = "../Unsafe.conf" +stub = "../Unsafe.stub" +apipath = "../api" + +main = do + status <- makeWith conf stub ["-i"++apipath] + o <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed" + MakeSuccess _ o -> return o + m_v <- load o [apipath] [] "resource" + v <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + let s = field v + makeCleaner o + if null s then print False else print True diff --git a/testsuite/makewith/unsafeio/prog/README b/testsuite/makewith/unsafeio/prog/README new file mode 100644 --- /dev/null +++ b/testsuite/makewith/unsafeio/prog/README @@ -0,0 +1,8 @@ +this is an example of an application that uses the HSConf library to +dynamically load compiled conf files. + +We use the .conf file in the parent directory, and communicate with +the plugin via the API in the api_package/ directory. + +The plugin is a .o file +The api is a GHC package archive diff --git a/testsuite/makewith/unsafeio/prog/expected b/testsuite/makewith/unsafeio/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/makewith/unsafeio/prog/expected @@ -0,0 +1,6 @@ +merge failed: + +parse error in ../Unsafe.conf +line: 13, col: 1 + +Main: failed diff --git a/testsuite/misc/mkstemps/Main.hs b/testsuite/misc/mkstemps/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/misc/mkstemps/Main.hs @@ -0,0 +1,69 @@ + +import System.MkTemp + +import Data.Maybe + +import System.IO +import System.Directory + +main = do + createDirectory "t" + + ------------------------------------------------------------------------ + -- Try mkstemp with simple template + -- + ts <- mapM (\_ -> mkstemp "t/t.X" ) [0..(26+26)] -- 1+26+26 files + () <- if (not $ all isJust ts) + then putStrLn $ "mkstemp couldn't create all expected files" + else putStrLn $ "created "++(show $ length $ catMaybes ts)++" files" + closeAll ts + + -- next one shouldn't be possible + t <- mkstemp "t/t.X" + () <- if (not $ isNothing t) + then putStrLn $ "shouldn't have been able to create this file" + else putStrLn $ "correctly ran out of permutations" + closeAll [t] + + rmAll (t:ts) + + ------------------------------------------------------------------------ + -- Try again with large tmp + -- + ts <- mapM (\_->do v <- mkstemp "t/t.XXXXXXXXXX" + case v of Just (t,h) -> hClose h >> return v + _ -> return v ) [1..10000] + + () <- if (not $ all isJust ts) + then putStrLn $ "mkstemp couldn't create all expected files" + else putStrLn $ "mkstemp: created "++(show $ length $ catMaybes ts)++" files" + rmAll ts + + ------------------------------------------------------------------------ + -- test mkstemps + -- + ts <- mapM (\_->do v <- mkstemps "t/t.XXXXXXXXXX.hs" 3 + case v of Just (t,h) -> hClose h >> return v + _ -> return v ) [1..2000] + () <- if (not $ all isJust ts) + then putStrLn $ "mkstemps couldn't create all expected files" + else putStrLn $ "mkstemps: created "++(show $ length $ catMaybes ts)++" files" + rmAll ts + + ------------------------------------------------------------------------ + -- mkdtemp + -- + ts <- mapM (\_ -> mkdtemp "t/XXXXXXXXXX") [1..2000] + () <- if (not $ all isJust ts) + then putStrLn $ "mkdtemp: couldn't create all expected directories" + else putStrLn $ "mkdtemp: created "++(show $ length $ catMaybes ts)++" directories" + rmAllDirs ts + + ------------------------------------------------------------------------ + + removeDirectory "t" + + where + closeAll ts = mapM_ hClose $ map snd $ catMaybes ts + rmAll ts = mapM_ removeFile $ map fst $ catMaybes ts + rmAllDirs ts = mapM_ removeDirectory $ catMaybes ts diff --git a/testsuite/misc/mkstemps/Makefile b/testsuite/misc/mkstemps/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/misc/mkstemps/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/misc/mkstemps/expected b/testsuite/misc/mkstemps/expected new file mode 100644 --- /dev/null +++ b/testsuite/misc/mkstemps/expected @@ -0,0 +1,5 @@ +created 53 files +correctly ran out of permutations +mkstemp: created 10000 files +mkstemps: created 2000 files +mkdtemp: created 2000 directories diff --git a/testsuite/multi/3plugins/Makefile b/testsuite/multi/3plugins/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/multi/3plugins/Makefile @@ -0,0 +1,6 @@ +TEST= multi/3plugins + +EXTRA_OBJS=Plugin1.o Plugin2.o Plugin3.o + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/multi/3plugins/Plugin1.hs b/testsuite/multi/3plugins/Plugin1.hs new file mode 100644 --- /dev/null +++ b/testsuite/multi/3plugins/Plugin1.hs @@ -0,0 +1,8 @@ +module Plugin1 where + +import API +import Data.Char + +resource = plugin { + valueOf = map toUpper +} diff --git a/testsuite/multi/3plugins/Plugin2.hs b/testsuite/multi/3plugins/Plugin2.hs new file mode 100644 --- /dev/null +++ b/testsuite/multi/3plugins/Plugin2.hs @@ -0,0 +1,9 @@ +module Plugin2 where + +import API +import Data.Char + +resource = plugin { + valueOf = \s -> show $ map ord s +} + diff --git a/testsuite/multi/3plugins/Plugin3.hs b/testsuite/multi/3plugins/Plugin3.hs new file mode 100644 --- /dev/null +++ b/testsuite/multi/3plugins/Plugin3.hs @@ -0,0 +1,7 @@ +module Plugin3 where + +import API + +resource = plugin { + valueOf = reverse +} diff --git a/testsuite/multi/3plugins/api/API.hs b/testsuite/multi/3plugins/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/multi/3plugins/api/API.hs @@ -0,0 +1,9 @@ +module API where + +data Interface = Interface { + valueOf :: String -> String +} + +plugin :: Interface +plugin = Interface { valueOf = id } + diff --git a/testsuite/multi/3plugins/prog/Main.hs b/testsuite/multi/3plugins/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/multi/3plugins/prog/Main.hs @@ -0,0 +1,13 @@ +import System.Plugins +import API + +main = do + let plist = ["../Plugin1.o", "../Plugin2.o", "../Plugin3.o"] + plugins <- mapM (\p -> load p ["../api"] [] "resource") plist + let functions = map (valueOf . fromLoadSuc) plugins + + -- apply the function from each plugin in turn + mapM_ (\f -> putStrLn $ f "haskell is for hackers") functions + +fromLoadSuc (LoadFailure _) = error "load failed" +fromLoadSuc (LoadSuccess _ v) = v diff --git a/testsuite/multi/3plugins/prog/expected b/testsuite/multi/3plugins/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/multi/3plugins/prog/expected @@ -0,0 +1,3 @@ +HASKELL IS FOR HACKERS +[104,97,115,107,101,108,108,32,105,115,32,102,111,114,32,104,97,99,107,101,114,115] +srekcah rof si lleksah diff --git a/testsuite/objc/expression_parser/ArithmeticExpressionParser.hs b/testsuite/objc/expression_parser/ArithmeticExpressionParser.hs new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/ArithmeticExpressionParser.hs @@ -0,0 +1,30 @@ +module ArithmeticExpressionParser where + +import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec.Expr + +resource :: String -> IO String +resource text = do + parsedText <- mapM parseString (lines text) + return (unlines parsedText) + +parseString s = do + case (parse expr "" s) of + Left err -> return ("Error " ++ show err) + Right num -> return (show num) + +expr :: Parser Integer +expr = buildExpressionParser table factor "expression" + +table = [ [op "*" (*) AssocLeft, op "/" div AssocLeft] + , [op "+" (+) AssocLeft, op "-" (-) AssocLeft] ] + where + op s f assoc = Infix (do { string s; return f }) assoc + +factor = do { char '('; x <- expr; char ')'; return x } + <|> number + "simple expression" + +number :: Parser Integer +number = do { ds <- many1 digit; return (read ds) } "number" + diff --git a/testsuite/objc/expression_parser/English.lproj/Credits.rtf b/testsuite/objc/expression_parser/English.lproj/Credits.rtf new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/English.lproj/Credits.rtf @@ -0,0 +1,29 @@ +{\rtf0\ansi{\fonttbl\f0\fswiss Helvetica;} +{\colortbl;\red255\green255\blue255;} +\paperw9840\paperh8400 +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\ql\qnatural + +\f0\b\fs24 \cf0 Engineering: +\b0 \ + Some people\ +\ + +\b Human Interface Design: +\b0 \ + Some other people\ +\ + +\b Testing: +\b0 \ + Hopefully not nobody\ +\ + +\b Documentation: +\b0 \ + Whoever\ +\ + +\b With special thanks to: +\b0 \ + Mom\ +} diff --git a/testsuite/objc/expression_parser/English.lproj/InfoPlist.strings b/testsuite/objc/expression_parser/English.lproj/InfoPlist.strings new file mode 100644 Binary files /dev/null and b/testsuite/objc/expression_parser/English.lproj/InfoPlist.strings differ diff --git a/testsuite/objc/expression_parser/English.lproj/MainMenu.nib/classes.nib b/testsuite/objc/expression_parser/English.lproj/MainMenu.nib/classes.nib new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/English.lproj/MainMenu.nib/classes.nib @@ -0,0 +1,4 @@ +{ + IBClasses = ({CLASS = FirstResponder; LANGUAGE = ObjC; SUPERCLASS = NSObject; }); + IBVersion = 1; +} diff --git a/testsuite/objc/expression_parser/English.lproj/MainMenu.nib/info.nib b/testsuite/objc/expression_parser/English.lproj/MainMenu.nib/info.nib new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/English.lproj/MainMenu.nib/info.nib @@ -0,0 +1,21 @@ + + + + + IBDocumentLocation + 116 123 356 240 0 0 1600 1178 + IBEditorPositions + + 29 + 117 405 318 44 0 0 1600 1178 + + IBFramework Version + 328.0 + IBOpenObjects + + 29 + + IBSystem Version + 7B8 + + diff --git a/testsuite/objc/expression_parser/English.lproj/MainMenu.nib/objects.nib b/testsuite/objc/expression_parser/English.lproj/MainMenu.nib/objects.nib new file mode 100644 Binary files /dev/null and b/testsuite/objc/expression_parser/English.lproj/MainMenu.nib/objects.nib differ diff --git a/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/classes.nib b/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/classes.nib new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/classes.nib @@ -0,0 +1,13 @@ +{ + IBClasses = ( + {CLASS = FirstResponder; LANGUAGE = ObjC; SUPERCLASS = NSObject; }, + { + ACTIONS = {chooseParser = id; evaluateExpression = id; }; + CLASS = MyDocument; + LANGUAGE = ObjC; + OUTLETS = {evaluation = id; expressionEntry = id; parser = id; }; + SUPERCLASS = NSDocument; + } + ); + IBVersion = 1; +} diff --git a/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/info.nib b/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/info.nib new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/info.nib @@ -0,0 +1,16 @@ + + + + + IBDocumentLocation + 79 43 356 240 0 0 1280 832 + IBFramework Version + 349.0 + IBOpenObjects + + 21 + + IBSystem Version + 7F44 + + diff --git a/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/keyedobjects.nib b/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/keyedobjects.nib new file mode 100644 Binary files /dev/null and b/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/keyedobjects.nib differ diff --git a/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/objects.nib b/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/objects.nib new file mode 100644 Binary files /dev/null and b/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/objects.nib differ diff --git a/testsuite/objc/expression_parser/Info.plist b/testsuite/objc/expression_parser/Info.plist new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/Info.plist @@ -0,0 +1,47 @@ + + + + + CFBundleDevelopmentRegion + English + CFBundleDocumentTypes + + + CFBundleTypeExtensions + + ???? + + CFBundleTypeIconFile + + CFBundleTypeName + DocumentType + CFBundleTypeOSTypes + + ???? + + CFBundleTypeRole + Editor + NSDocumentClass + MyDocument + + + CFBundleExecutable + PluginExpressionParser + CFBundleIconFile + + CFBundleIdentifier + com.apple.yourCocoaDocApp + CFBundleInfoDictionaryVersion + 6.0 + CFBundlePackageType + APPL + CFBundleSignature + ???? + CFBundleVersion + 0.1 + NSMainNibFile + MainMenu + NSPrincipalClass + NSApplication + + diff --git a/testsuite/objc/expression_parser/KeyValueParser.hs b/testsuite/objc/expression_parser/KeyValueParser.hs new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/KeyValueParser.hs @@ -0,0 +1,33 @@ +module KeyValueParser where + +import Text.ParserCombinators.Parsec + +parseKeyValue = do + key <- parseKey + char '=' + value <- parseValue + return (key, value) + +parseKey = many1 letter + +parseValue = + do + openQuote <- char '"' <|> char '\'' + value <- many1 letter + char openQuote + return value + <|> + do + value <- many1 letter + return value + +parseString s = do + case (parse parseKeyValue "" s) of + Left err -> return ("Error " ++ show err) + Right (key, value) -> return ("Key: " ++ key ++ ", Value: " ++ value) + +resource :: String -> IO String +resource text = do + parsedText <- mapM parseString (lines text) + return (unlines parsedText) + diff --git a/testsuite/objc/expression_parser/Makefile b/testsuite/objc/expression_parser/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/Makefile @@ -0,0 +1,67 @@ +APP_DIR = build/PluginExpressionParser.app +APP_CONTENTS_DIR = $(APP_DIR)/Contents +APP_ARCH_EXEC_DIR = $(APP_CONTENTS_DIR)/MacOS +APP_RESOURCES_DIR = $(APP_CONTENTS_DIR)/Resources +EXECUTABLE = $(APP_ARCH_EXEC_DIR)/PluginExpressionParser + +OBJECT_FILES = main.o MyDocument.o PluginEvalAux.o +BUILD_OBJECT_FILES = $(addprefix build/,$(OBJECT_FILES)) \ + build/PluginEvalAux_stub.o + +HOST = $(shell uname) + +ifeq ($(HOST),Darwin) +default: app +else +default: no_app +endif + +app: $(APP_CONTENTS_DIR) $(APP_RESOURCES_DIR) $(EXECUTABLE) + +# + +$(EXECUTABLE): $(APP_ARCH_EXEC_DIR) $(BUILD_OBJECT_FILES) + ghc \ + -o "$(EXECUTABLE)" \ + -framework Cocoa \ + -package-conf ../../../plugins.conf.inplace \ + -package plugins \ + -no-hs-main \ + $(BUILD_OBJECT_FILES) + +build/MyDocument.o: MyDocument.m MyDocument.h + gcc -c -o "$@" -Wall -I`ghc --print-libdir`/include "$<" + +build/main.o: main.m + gcc -c -o "$@" -Wall -I`ghc --print-libdir`/include "$<" + +build/PluginEvalAux.o: PluginEvalAux.hs + ghc --make \ + -package-conf ../../../plugins.conf.inplace \ + -package plugins \ + -odir build/ \ + -hidir build/ \ + "$<" + +# + +$(APP_DIR): + mkdir -p "$@" + +$(APP_ARCH_EXEC_DIR): $(APP_DIR) + mkdir -p "$@" + +$(APP_CONTENTS_DIR): $(APP_DIR) Info.plist + mkdir -p "$(APP_CONTENTS_DIR)" + cp Info.plist "$@" + echo -n 'APPL????' > "$@"/PkgInfo + +$(APP_RESOURCES_DIR): $(APP_DIR) English.lproj + mkdir -p "$(APP_RESOURCES_DIR)" + cp -R English.lproj "$@" + +# + +clean: + -rm -rf build *_stub.? + diff --git a/testsuite/objc/expression_parser/MyDocument.h b/testsuite/objc/expression_parser/MyDocument.h new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/MyDocument.h @@ -0,0 +1,16 @@ +/* MyDocument */ + +#import + +#include "RunHaskell.h" + +@interface MyDocument : NSDocument +{ + IBOutlet id evaluation; + IBOutlet id expressionEntry; + IBOutlet id parser; +} +- (IBAction)chooseParser:(id)sender; +- (IBAction)evaluateExpression:(id)sender; + +@end diff --git a/testsuite/objc/expression_parser/MyDocument.m b/testsuite/objc/expression_parser/MyDocument.m new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/MyDocument.m @@ -0,0 +1,52 @@ +#import "MyDocument.h" + +@implementation MyDocument + +- (NSString *)windowNibName { + return @"MyDocument"; +} + +- (NSData *)dataRepresentationOfType:(NSString *)type { + return nil; +} + +- (BOOL)loadDataRepresentation:(NSData *)data ofType:(NSString *)type { + return NO; +} + + +- (IBAction)chooseParser:(id)sender +{ + int result; + NSArray *fileTypes = [NSArray arrayWithObject:@"hs"]; + NSOpenPanel *oPanel = [NSOpenPanel openPanel]; + + result = [oPanel runModalForDirectory:nil file:nil types:fileTypes]; + if (result == NSOKButton) + { + NSArray *filesToOpen = [oPanel filenames]; + [parser setStringValue:[filesToOpen objectAtIndex:0]]; + } +} + +- (IBAction)evaluateExpression:(id)sender +{ + NSLog(@"evaluateExpression"); + NSString *filePathNSS = [parser stringValue]; + char *filePath = [filePathNSS cString]; + + NSString *expressionNSS = [[expressionEntry textStorage] string]; + char *expression = [expressionNSS cString]; + + NSLog (@"filePath:%s expression:%s", filePath, expression); + + char *result = evalhaskell_CString(filePath, expression); + NSString *resultNSS = [NSString stringWithCString:result]; + NSAttributedString *resultNSAS = [[NSAttributedString alloc] + initWithString:resultNSS + attributes:nil]; + [[evaluation textStorage] setAttributedString:resultNSAS]; + +} + +@end diff --git a/testsuite/objc/expression_parser/PluginEvalAux.hs b/testsuite/objc/expression_parser/PluginEvalAux.hs new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/PluginEvalAux.hs @@ -0,0 +1,43 @@ +{-# OPTIONS -fglasgow-exts -fffi #-} + +module PluginEvalAux where + +import System.Plugins.Make +import System.Plugins.Load +import System.Plugins.Utils + +import Foreign.C +import Control.Exception ( evaluate ) +import System.IO +import System.Directory ( renameFile, removeFile ) + +symbol = "resource" + +evalWithStringResult :: FilePath -> String -> IO String +evalWithStringResult srcFile s = do + status <- make srcFile ["-Onot"] + case status of + MakeFailure err -> putStrLn "error occured" >> return (show err) + MakeSuccess _ obj -> load' obj + where + load' obj = do + loadResult <- load obj [] [] symbol + case loadResult of + LoadFailure errs -> putStrLn "load error" >> return (show errs) + LoadSuccess m (rsrc :: String -> IO String) -> do + v' <- rsrc s + unload m + mapM_ removeFile [ obj, replaceSuffix obj ".hi" ] + return v' + +foreign export ccall evalhaskell_CString :: CString -> CString -> IO CString + +evalhaskell_CString :: CString -> CString -> IO CString +evalhaskell_CString filePathCS sCS = do + s <- peekCString sCS + filePath <- peekCString filePathCS + retval <- evalWithStringResult filePath s + newCString retval + +-- vi:sw=2 sts=2 + diff --git a/testsuite/objc/expression_parser/PluginExpressionParser.xcode/project.pbxproj b/testsuite/objc/expression_parser/PluginExpressionParser.xcode/project.pbxproj new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/PluginExpressionParser.xcode/project.pbxproj @@ -0,0 +1,602 @@ +// !$*UTF8*$! +{ + archiveVersion = 1; + classes = { + }; + objectVersion = 39; + objects = { + 089C165FFE840EACC02AAC07 = { + children = ( + 089C1660FE840EACC02AAC07, + ); + isa = PBXVariantGroup; + name = InfoPlist.strings; + refType = 4; + sourceTree = ""; + }; + 089C1660FE840EACC02AAC07 = { + fileEncoding = 10; + isa = PBXFileReference; + lastKnownFileType = text.plist.strings; + name = English; + path = English.lproj/InfoPlist.strings; + refType = 4; + sourceTree = ""; + }; +//080 +//081 +//082 +//083 +//084 +//100 +//101 +//102 +//103 +//104 + 1058C7A6FEA54F5311CA2CBB = { + children = ( + 1058C7A7FEA54F5311CA2CBB, + ); + isa = PBXGroup; + name = "Linked Frameworks"; + refType = 4; + sourceTree = ""; + }; + 1058C7A7FEA54F5311CA2CBB = { + fallbackIsa = PBXFileReference; + isa = PBXFrameworkReference; + lastKnownFileType = wrapper.framework; + name = Cocoa.framework; + path = /System/Library/Frameworks/Cocoa.framework; + refType = 0; + sourceTree = ""; + }; + 1058C7A8FEA54F5311CA2CBB = { + children = ( + 2A37F4C5FDCFA73011CA2CEA, + 2A37F4C4FDCFA73011CA2CEA, + ); + isa = PBXGroup; + name = "Other Frameworks"; + refType = 4; + sourceTree = ""; + }; +//100 +//101 +//102 +//103 +//104 +//190 +//191 +//192 +//193 +//194 + 19C28FB0FE9D524F11CA2CBB = { + children = ( + 8D15AC370486D014006FF6A4, + ); + isa = PBXGroup; + name = Products; + refType = 4; + sourceTree = ""; + }; +//190 +//191 +//192 +//193 +//194 +//2A0 +//2A1 +//2A2 +//2A3 +//2A4 + 2A37F4A9FDCFA73011CA2CEA = { + buildSettings = { + }; + buildStyles = ( + 4A9504D0FFE6A4CB11CA0CBA, + 4A9504D1FFE6A4CB11CA0CBA, + ); + hasScannedForEncodings = 1; + isa = PBXProject; + mainGroup = 2A37F4AAFDCFA73011CA2CEA; + projectDirPath = ""; + targets = ( + 8D15AC270486D014006FF6A4, + 7B5F81A4067389B000AC9FA4, + ); + }; + 2A37F4AAFDCFA73011CA2CEA = { + children = ( + 7B5F81A1067383A700AC9FA4, + 7B5F81980673839D00AC9FA4, + 2A37F4ABFDCFA73011CA2CEA, + 2A37F4AFFDCFA73011CA2CEA, + 2A37F4B8FDCFA73011CA2CEA, + 2A37F4C3FDCFA73011CA2CEA, + 19C28FB0FE9D524F11CA2CBB, + ); + isa = PBXGroup; + name = PluginExpressionParser; + path = ""; + refType = 4; + sourceTree = ""; + }; + 2A37F4ABFDCFA73011CA2CEA = { + children = ( + 2A37F4AEFDCFA73011CA2CEA, + 2A37F4ACFDCFA73011CA2CEA, + ); + isa = PBXGroup; + name = Classes; + path = ""; + refType = 4; + sourceTree = ""; + }; + 2A37F4ACFDCFA73011CA2CEA = { + fileEncoding = 30; + isa = PBXFileReference; + lastKnownFileType = sourcecode.c.objc; + path = MyDocument.m; + refType = 4; + sourceTree = ""; + }; + 2A37F4AEFDCFA73011CA2CEA = { + fileEncoding = 30; + isa = PBXFileReference; + lastKnownFileType = sourcecode.c.h; + path = MyDocument.h; + refType = 4; + sourceTree = ""; + }; + 2A37F4AFFDCFA73011CA2CEA = { + children = ( + 7B5F81990673839D00AC9FA4, + 32DBCF750370BD2300C91783, + 7B5F819506737AAC00AC9FA4, + 2A37F4B0FDCFA73011CA2CEA, + ); + isa = PBXGroup; + name = "Other Sources"; + path = ""; + refType = 4; + sourceTree = ""; + }; + 2A37F4B0FDCFA73011CA2CEA = { + fileEncoding = 30; + isa = PBXFileReference; + lastKnownFileType = sourcecode.c.objc; + path = main.m; + refType = 4; + sourceTree = ""; + }; + 2A37F4B4FDCFA73011CA2CEA = { + children = ( + 2A37F4B5FDCFA73011CA2CEA, + ); + isa = PBXVariantGroup; + name = MyDocument.nib; + path = ""; + refType = 4; + sourceTree = ""; + }; + 2A37F4B5FDCFA73011CA2CEA = { + isa = PBXFileReference; + lastKnownFileType = wrapper.nib; + name = English; + path = English.lproj/MyDocument.nib; + refType = 4; + sourceTree = ""; + }; + 2A37F4B6FDCFA73011CA2CEA = { + children = ( + 2A37F4B7FDCFA73011CA2CEA, + ); + isa = PBXVariantGroup; + name = MainMenu.nib; + path = ""; + refType = 4; + sourceTree = ""; + }; + 2A37F4B7FDCFA73011CA2CEA = { + isa = PBXFileReference; + lastKnownFileType = wrapper.nib; + name = English; + path = English.lproj/MainMenu.nib; + refType = 4; + sourceTree = ""; + }; + 2A37F4B8FDCFA73011CA2CEA = { + children = ( + 2A37F4B9FDCFA73011CA2CEA, + 2A37F4B6FDCFA73011CA2CEA, + 2A37F4B4FDCFA73011CA2CEA, + 8D15AC360486D014006FF6A4, + 089C165FFE840EACC02AAC07, + ); + isa = PBXGroup; + name = Resources; + path = ""; + refType = 4; + sourceTree = ""; + }; + 2A37F4B9FDCFA73011CA2CEA = { + children = ( + 2A37F4BAFDCFA73011CA2CEA, + ); + isa = PBXVariantGroup; + name = Credits.rtf; + path = ""; + refType = 4; + sourceTree = ""; + }; + 2A37F4BAFDCFA73011CA2CEA = { + isa = PBXFileReference; + lastKnownFileType = text.rtf; + name = English; + path = English.lproj/Credits.rtf; + refType = 4; + sourceTree = ""; + }; + 2A37F4C3FDCFA73011CA2CEA = { + children = ( + 1058C7A6FEA54F5311CA2CBB, + 1058C7A8FEA54F5311CA2CBB, + ); + isa = PBXGroup; + name = Frameworks; + path = ""; + refType = 4; + sourceTree = ""; + }; + 2A37F4C4FDCFA73011CA2CEA = { + fallbackIsa = PBXFileReference; + isa = PBXFrameworkReference; + lastKnownFileType = wrapper.framework; + name = AppKit.framework; + path = /System/Library/Frameworks/AppKit.framework; + refType = 0; + sourceTree = ""; + }; + 2A37F4C5FDCFA73011CA2CEA = { + fallbackIsa = PBXFileReference; + isa = PBXFrameworkReference; + lastKnownFileType = wrapper.framework; + name = Foundation.framework; + path = /System/Library/Frameworks/Foundation.framework; + refType = 0; + sourceTree = ""; + }; +//2A0 +//2A1 +//2A2 +//2A3 +//2A4 +//320 +//321 +//322 +//323 +//324 + 32DBCF750370BD2300C91783 = { + fileEncoding = 4; + isa = PBXFileReference; + lastKnownFileType = sourcecode.c.h; + path = PluginExpressionParser_Prefix.pch; + refType = 4; + sourceTree = ""; + }; +//320 +//321 +//322 +//323 +//324 +//4A0 +//4A1 +//4A2 +//4A3 +//4A4 + 4A9504D0FFE6A4CB11CA0CBA = { + buildRules = ( + ); + buildSettings = { + COPY_PHASE_STRIP = NO; + DEBUGGING_SYMBOLS = YES; + GCC_DYNAMIC_NO_PIC = NO; + GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_GENERATE_DEBUGGING_SYMBOLS = YES; + GCC_OPTIMIZATION_LEVEL = 0; + OPTIMIZATION_CFLAGS = "-O0"; + ZERO_LINK = YES; + }; + isa = PBXBuildStyle; + name = Development; + }; + 4A9504D1FFE6A4CB11CA0CBA = { + buildRules = ( + ); + buildSettings = { + COPY_PHASE_STRIP = YES; + GCC_ENABLE_FIX_AND_CONTINUE = NO; + ZERO_LINK = NO; + }; + isa = PBXBuildStyle; + name = Deployment; + }; +//4A0 +//4A1 +//4A2 +//4A3 +//4A4 +//7B0 +//7B1 +//7B2 +//7B3 +//7B4 + 7B5F819506737AAC00AC9FA4 = { + fileEncoding = 30; + isa = PBXFileReference; + lastKnownFileType = sourcecode.c.h; + path = RunHaskell.h; + refType = 4; + sourceTree = ""; + }; + 7B5F819606737AAC00AC9FA4 = { + fileRef = 7B5F819506737AAC00AC9FA4; + isa = PBXBuildFile; + settings = { + }; + }; + 7B5F81970673839D00AC9FA4 = { + fileEncoding = 30; + isa = PBXFileReference; + lastKnownFileType = sourcecode.haskell; + path = KeyValueParser.hs; + refType = 4; + sourceTree = ""; + }; + 7B5F81980673839D00AC9FA4 = { + fileEncoding = 30; + isa = PBXFileReference; + lastKnownFileType = sourcecode.make; + path = Makefile; + refType = 4; + sourceTree = ""; + }; + 7B5F81990673839D00AC9FA4 = { + fileEncoding = 30; + isa = PBXFileReference; + lastKnownFileType = sourcecode.haskell; + path = PluginEvalAux.hs; + refType = 4; + sourceTree = ""; + }; + 7B5F819A0673839D00AC9FA4 = { + fileRef = 7B5F81970673839D00AC9FA4; + isa = PBXBuildFile; + settings = { + }; + }; + 7B5F819B0673839D00AC9FA4 = { + fileRef = 7B5F81980673839D00AC9FA4; + isa = PBXBuildFile; + settings = { + }; + }; + 7B5F819C0673839D00AC9FA4 = { + fileRef = 7B5F81990673839D00AC9FA4; + isa = PBXBuildFile; + settings = { + }; + }; + 7B5F819D067383A400AC9FA4 = { + fileEncoding = 30; + isa = PBXFileReference; + lastKnownFileType = sourcecode.haskell; + path = ArithmeticExpressionParser.hs; + refType = 4; + sourceTree = ""; + }; + 7B5F819E067383A400AC9FA4 = { + fileRef = 7B5F819D067383A400AC9FA4; + isa = PBXBuildFile; + settings = { + }; + }; + 7B5F81A1067383A700AC9FA4 = { + children = ( + 7B5F819D067383A400AC9FA4, + 7B5F81970673839D00AC9FA4, + ); + isa = PBXGroup; + name = Parsers; + refType = 4; + sourceTree = ""; + }; + 7B5F81A4067389B000AC9FA4 = { + buildArgumentsString = "$(ACTION)"; + buildPhases = ( + ); + buildSettings = { + OPTIMIZATION_CFLAGS = ""; + OTHER_CFLAGS = ""; + OTHER_LDFLAGS = ""; + OTHER_REZFLAGS = ""; + PRODUCT_NAME = "PluginExpressionParser (GNU make)"; + SECTORDER_FLAGS = ""; + WARNING_CFLAGS = "-Wmost -Wno-four-char-constants -Wno-unknown-pragmas"; + }; + buildToolPath = /usr/bin/make; + dependencies = ( + ); + isa = PBXLegacyTarget; + name = "PluginExpressionParser (GNU make)"; + passBuildSettingsInEnvironment = 1; + productName = "PluginExpressionParser (GNU make)"; + }; +//7B0 +//7B1 +//7B2 +//7B3 +//7B4 +//8D0 +//8D1 +//8D2 +//8D3 +//8D4 + 8D15AC270486D014006FF6A4 = { + buildPhases = ( + 8D15AC280486D014006FF6A4, + 8D15AC2B0486D014006FF6A4, + 8D15AC300486D014006FF6A4, + 8D15AC330486D014006FF6A4, + ); + buildRules = ( + ); + buildSettings = { + FRAMEWORK_SEARCH_PATHS = ""; + GCC_ENABLE_TRIGRAPHS = NO; + GCC_GENERATE_DEBUGGING_SYMBOLS = NO; + GCC_PRECOMPILE_PREFIX_HEADER = YES; + GCC_PREFIX_HEADER = PluginExpressionParser_Prefix.pch; + GCC_WARN_ABOUT_MISSING_PROTOTYPES = NO; + GCC_WARN_FOUR_CHARACTER_CONSTANTS = NO; + GCC_WARN_UNKNOWN_PRAGMAS = NO; + HEADER_SEARCH_PATHS = ""; + INFOPLIST_FILE = Info.plist; + INSTALL_PATH = "$(HOME)/Applications"; + LIBRARY_SEARCH_PATHS = ""; + OTHER_CFLAGS = ""; + OTHER_LDFLAGS = ""; + PRODUCT_NAME = PluginExpressionParser; + SECTORDER_FLAGS = ""; + WARNING_CFLAGS = "-Wmost -Wno-four-char-constants -Wno-unknown-pragmas"; + WRAPPER_EXTENSION = app; + }; + dependencies = ( + ); + isa = PBXNativeTarget; + name = PluginExpressionParser; + productInstallPath = "$(HOME)/Applications"; + productName = PluginExpressionParser; + productReference = 8D15AC370486D014006FF6A4; + productType = "com.apple.product-type.application"; + }; + 8D15AC280486D014006FF6A4 = { + buildActionMask = 2147483647; + files = ( + 8D15AC290486D014006FF6A4, + 8D15AC2A0486D014006FF6A4, + 7B5F819606737AAC00AC9FA4, + ); + isa = PBXHeadersBuildPhase; + runOnlyForDeploymentPostprocessing = 0; + }; + 8D15AC290486D014006FF6A4 = { + fileRef = 32DBCF750370BD2300C91783; + isa = PBXBuildFile; + settings = { + }; + }; + 8D15AC2A0486D014006FF6A4 = { + fileRef = 2A37F4AEFDCFA73011CA2CEA; + isa = PBXBuildFile; + settings = { + }; + }; + 8D15AC2B0486D014006FF6A4 = { + buildActionMask = 2147483647; + files = ( + 8D15AC2C0486D014006FF6A4, + 8D15AC2D0486D014006FF6A4, + 8D15AC2E0486D014006FF6A4, + 8D15AC2F0486D014006FF6A4, + 7B5F819A0673839D00AC9FA4, + 7B5F819B0673839D00AC9FA4, + 7B5F819C0673839D00AC9FA4, + 7B5F819E067383A400AC9FA4, + ); + isa = PBXResourcesBuildPhase; + runOnlyForDeploymentPostprocessing = 0; + }; + 8D15AC2C0486D014006FF6A4 = { + fileRef = 2A37F4B9FDCFA73011CA2CEA; + isa = PBXBuildFile; + settings = { + }; + }; + 8D15AC2D0486D014006FF6A4 = { + fileRef = 2A37F4B6FDCFA73011CA2CEA; + isa = PBXBuildFile; + settings = { + }; + }; + 8D15AC2E0486D014006FF6A4 = { + fileRef = 2A37F4B4FDCFA73011CA2CEA; + isa = PBXBuildFile; + settings = { + }; + }; + 8D15AC2F0486D014006FF6A4 = { + fileRef = 089C165FFE840EACC02AAC07; + isa = PBXBuildFile; + settings = { + }; + }; + 8D15AC300486D014006FF6A4 = { + buildActionMask = 2147483647; + files = ( + 8D15AC310486D014006FF6A4, + 8D15AC320486D014006FF6A4, + ); + isa = PBXSourcesBuildPhase; + runOnlyForDeploymentPostprocessing = 0; + }; + 8D15AC310486D014006FF6A4 = { + fileRef = 2A37F4ACFDCFA73011CA2CEA; + isa = PBXBuildFile; + settings = { + ATTRIBUTES = ( + ); + }; + }; + 8D15AC320486D014006FF6A4 = { + fileRef = 2A37F4B0FDCFA73011CA2CEA; + isa = PBXBuildFile; + settings = { + ATTRIBUTES = ( + ); + }; + }; + 8D15AC330486D014006FF6A4 = { + buildActionMask = 2147483647; + files = ( + 8D15AC340486D014006FF6A4, + ); + isa = PBXFrameworksBuildPhase; + runOnlyForDeploymentPostprocessing = 0; + }; + 8D15AC340486D014006FF6A4 = { + fileRef = 1058C7A7FEA54F5311CA2CBB; + isa = PBXBuildFile; + settings = { + }; + }; + 8D15AC360486D014006FF6A4 = { + fileEncoding = 4; + isa = PBXFileReference; + lastKnownFileType = text.plist; + path = Info.plist; + refType = 4; + sourceTree = ""; + }; + 8D15AC370486D014006FF6A4 = { + explicitFileType = wrapper.application; + includeInIndex = 0; + isa = PBXFileReference; + path = PluginExpressionParser.app; + refType = 3; + sourceTree = BUILT_PRODUCTS_DIR; + }; + }; + rootObject = 2A37F4A9FDCFA73011CA2CEA; +} diff --git a/testsuite/objc/expression_parser/PluginExpressionParser_Prefix.pch b/testsuite/objc/expression_parser/PluginExpressionParser_Prefix.pch new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/PluginExpressionParser_Prefix.pch @@ -0,0 +1,7 @@ +// +// Prefix header for all source files of the 'PluginExpressionParser' target in the 'PluginExpressionParser' project +// + +#ifdef __OBJC__ + #import +#endif diff --git a/testsuite/objc/expression_parser/README b/testsuite/objc/expression_parser/README new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/README @@ -0,0 +1,6 @@ +This little application is an example of using hs-plugins to embed a Haskell +'interpreter' inside an Objective-C, Cocoa-based program. You will need Mac OS +X for this to be of any use! + +To build it, type 'make', which will build a .app bundle in the build/ directory. Or, 'open *.xcode', and hit the build button in there. + diff --git a/testsuite/objc/expression_parser/RunHaskell.h b/testsuite/objc/expression_parser/RunHaskell.h new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/RunHaskell.h @@ -0,0 +1,4 @@ +#include "HsFFI.h" + +extern HsPtr evalhaskell_CString(HsPtr a1, HsPtr a2); + diff --git a/testsuite/objc/expression_parser/dont_test b/testsuite/objc/expression_parser/dont_test new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/dont_test diff --git a/testsuite/objc/expression_parser/main.m b/testsuite/objc/expression_parser/main.m new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/main.m @@ -0,0 +1,26 @@ +// +// main.m +// PluginExpressionParser +// +// Created by AndrŽ Pang on Mon Jun 07 2004. +// Copyright (c) 2004 __MyCompanyName__. All rights reserved. +// + +#import + +#include "HsFFI.h" + +extern void __stginit_PluginEvalAux (void); + +int main(int argc, char *argv[]) +{ + hs_init(&argc, &argv); + hs_add_root(__stginit_PluginEvalAux); + const char *c_argv = (const char *) argv; + int retval = NSApplicationMain(argc, &c_argv); + hs_exit(); + return retval; +} + +/* vi:sw=4 */ + diff --git a/testsuite/objc/expression_parser/version.plist b/testsuite/objc/expression_parser/version.plist new file mode 100644 --- /dev/null +++ b/testsuite/objc/expression_parser/version.plist @@ -0,0 +1,16 @@ + + + + + BuildVersion + 17 + CFBundleShortVersionString + 0.1 + CFBundleVersion + 0.1 + ProjectName + NibPBTemplates + SourceVersion + 1150000 + + diff --git a/testsuite/pdynload/badint/Makefile b/testsuite/pdynload/badint/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/badint/Makefile @@ -0,0 +1,5 @@ + +TEST=pdynload/badint + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/badint/Plugin.hs b/testsuite/pdynload/badint/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/badint/Plugin.hs @@ -0,0 +1,4 @@ +module Plugin where + +resource :: Num t => t +resource = 0xBAD diff --git a/testsuite/pdynload/badint/api/API.hs b/testsuite/pdynload/badint/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/badint/api/API.hs @@ -0,0 +1,9 @@ +module API where + +data Interface = Interface { + transform :: String -> String + } + +rsrc :: Interface +rsrc = Interface { transform = id } + diff --git a/testsuite/pdynload/badint/prog/Main.hs b/testsuite/pdynload/badint/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/badint/prog/Main.hs @@ -0,0 +1,18 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e-> mapM_ putStrLn e + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ a -> putStrLn $ (transform a) "foo" + _ -> putStrLn "wrong types" + diff --git a/testsuite/pdynload/badint/prog/expected b/testsuite/pdynload/badint/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/badint/prog/expected @@ -0,0 +1,1 @@ +wrong types diff --git a/testsuite/pdynload/bayley1/Load.hs b/testsuite/pdynload/bayley1/Load.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/bayley1/Load.hs @@ -0,0 +1,42 @@ +module Load where + +import API +import System.Plugins + +-- +-- load doesn't seem to behave nicely when using dirname on hier names +-- +-- make, and maybe other places, use dirname to work out various names +-- from paths, which is invalid when hier names are used.. +-- + +testload = do + + s <- make "../Plugin1.hs" ["-i../api"] + o1 <- case s of + MakeSuccess _ o -> return o + MakeFailure e -> mapM_ putStrLn e >> fail "o1" + + s <- make "../Sub/Plugin2.hs" ["-i../api","-hidir.."] -- ! + o2 <- case s of + MakeSuccess _ o -> return o + MakeFailure e -> mapM_ putStrLn e >> fail "o2" + + fc <- pdynload o1 ["..","../api"] [] "API.PluginAPI" "action" + + case fc of + LoadFailure msg -> mapM_ putStrLn msg + LoadSuccess modul proc -> do + let ac :: API.PluginAPI; ac = proc + let s = proc 42 + print s + + -- will reqeust 'Plugin2', but module is actually 'Sub.Plugin2' + print o2 + fc <- pdynload (o2) ["..","../api"] [] "API.PluginAPI" "action" + case fc of + LoadFailure msg -> mapM_ putStrLn msg + LoadSuccess modul proc -> do + let ac :: API.PluginAPI; ac = proc + let s = proc 42 + print s diff --git a/testsuite/pdynload/bayley1/Makefile b/testsuite/pdynload/bayley1/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/bayley1/Makefile @@ -0,0 +1,5 @@ + +TEST=pdynload/bayley1 + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/bayley1/Plugin1.hs b/testsuite/pdynload/bayley1/Plugin1.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/bayley1/Plugin1.hs @@ -0,0 +1,6 @@ +module Plugin1 where + +import qualified API +action :: API.PluginAPI +action i = show i + diff --git a/testsuite/pdynload/bayley1/Sub/Plugin2.hs b/testsuite/pdynload/bayley1/Sub/Plugin2.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/bayley1/Sub/Plugin2.hs @@ -0,0 +1,6 @@ +module Sub.Plugin2 where + +import qualified API +action :: API.PluginAPI +action i = show i + diff --git a/testsuite/pdynload/bayley1/api/API.hs b/testsuite/pdynload/bayley1/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/bayley1/api/API.hs @@ -0,0 +1,6 @@ +module API where + +type PluginAPI = Int -> String +action :: PluginAPI +action i = show i + diff --git a/testsuite/pdynload/bayley1/prog/Main.hs b/testsuite/pdynload/bayley1/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/bayley1/prog/Main.hs @@ -0,0 +1,4 @@ +module Main where +import Load +main = testload + diff --git a/testsuite/pdynload/null/Makefile b/testsuite/pdynload/null/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/null/Makefile @@ -0,0 +1,4 @@ + +TEST= pdynload/null +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/null/Plugin.hs b/testsuite/pdynload/null/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/null/Plugin.hs @@ -0,0 +1,5 @@ +module Plugin where + +import API + +resource = D 1 diff --git a/testsuite/pdynload/null/api/API.hs b/testsuite/pdynload/null/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/null/api/API.hs @@ -0,0 +1,5 @@ + +module API where + +data Num t => Interface t = D t + diff --git a/testsuite/pdynload/null/prog/Main.hs b/testsuite/pdynload/null/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/null/prog/Main.hs @@ -0,0 +1,19 @@ + +import System.Plugins +-- import System.Plugins.Utils +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e-> mapM_ putStrLn e + + where f = do v <- load "../Plugin.o" ["../api"] [] "resource" + -- (i,_) <- exec "ghc" ["--numeric-version"] + -- mapM_ putStrLn i + putStrLn "done." + diff --git a/testsuite/pdynload/null/prog/expected b/testsuite/pdynload/null/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/null/prog/expected @@ -0,0 +1,1 @@ +done. diff --git a/testsuite/pdynload/numclass/Makefile b/testsuite/pdynload/numclass/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/numclass/Makefile @@ -0,0 +1,4 @@ + +TEST= pdynload/numclass +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/numclass/Plugin.hs b/testsuite/pdynload/numclass/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/numclass/Plugin.hs @@ -0,0 +1,5 @@ +module Plugin where + +-- import API + +resource = "error" diff --git a/testsuite/pdynload/numclass/api/API.hs b/testsuite/pdynload/numclass/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/numclass/api/API.hs @@ -0,0 +1,5 @@ + +module API where + +data Num t => Interface t = D t + diff --git a/testsuite/pdynload/numclass/prog/Main.hs b/testsuite/pdynload/numclass/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/numclass/prog/Main.hs @@ -0,0 +1,19 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeFailure _ -> putStrLn "make failed" + MakeSuccess _ _ -> do { + + ;v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface Integer" "resource" + ;case v of + LoadSuccess _ a -> let D i = snd a in putStrLn $ show i + _ -> putStrLn "wrong types" + + } diff --git a/testsuite/pdynload/numclass/prog/expected b/testsuite/pdynload/numclass/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/numclass/prog/expected @@ -0,0 +1,1 @@ +wrong types diff --git a/testsuite/pdynload/poly/Makefile b/testsuite/pdynload/poly/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/poly/Makefile @@ -0,0 +1,5 @@ + +TEST=pdynload/poly + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/poly/Plugin.hs b/testsuite/pdynload/poly/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/poly/Plugin.hs @@ -0,0 +1,9 @@ +module Plugin where + +import Data.Generics.Schemes + +import API + +resource = rsrc { + field = id listify +} diff --git a/testsuite/pdynload/poly/api/API.hs b/testsuite/pdynload/poly/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/poly/api/API.hs @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} +-- a really nasty type: + +module API where + +import Data.Generics + +data Interface = Interface { field :: Typeable r => (r -> Bool) -> GenericQ [r] } + +rsrc :: Interface +rsrc = Interface { field = listify } + diff --git a/testsuite/pdynload/poly/prog/Main.hs b/testsuite/pdynload/poly/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/poly/prog/Main.hs @@ -0,0 +1,17 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> mapM_ putStrLn e + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ a -> putStrLn "loaded .. yay!" + _ -> putStrLn "wrong types" diff --git a/testsuite/pdynload/poly/prog/expected b/testsuite/pdynload/poly/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/poly/prog/expected @@ -0,0 +1,1 @@ +loaded .. yay! diff --git a/testsuite/pdynload/poly1/Makefile b/testsuite/pdynload/poly1/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/poly1/Makefile @@ -0,0 +1,4 @@ +TEST= pdynload/poly1 +EXTRA_OBJS=Plugin.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/poly1/Plugin.hs b/testsuite/pdynload/poly1/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/poly1/Plugin.hs @@ -0,0 +1,5 @@ +module Plugin where + +import API + +resource = plugin { function = (+) } diff --git a/testsuite/pdynload/poly1/api/API.hs b/testsuite/pdynload/poly1/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/poly1/api/API.hs @@ -0,0 +1,9 @@ +module API where + +data Interface = Interface { + function :: (Num a) => a -> a -> a +} + +plugin :: Interface +plugin = Interface { function = error "no function defined" } + diff --git a/testsuite/pdynload/poly1/prog/Main.hs b/testsuite/pdynload/poly1/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/poly1/prog/Main.hs @@ -0,0 +1,18 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> mapM_ putStrLn e + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ a -> let fn = function a in putStrLn $ show $ 1 `fn` 2 + _ -> putStrLn "wrong types" + diff --git a/testsuite/pdynload/poly1/prog/expected b/testsuite/pdynload/poly1/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/poly1/prog/expected @@ -0,0 +1,1 @@ +3 diff --git a/testsuite/pdynload/should_fail0/Makefile b/testsuite/pdynload/should_fail0/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/should_fail0/Makefile @@ -0,0 +1,4 @@ +TEST= pdynload/should_fail0 +EXTRA_OBJS=Plugin.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/should_fail0/Plugin.hs b/testsuite/pdynload/should_fail0/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/should_fail0/Plugin.hs @@ -0,0 +1,9 @@ +module Plugin where + +import API + +resource = 0xBAD :: Int + +-- resource = tiny { +-- field = "hello strange world" +-- } diff --git a/testsuite/pdynload/should_fail0/api/API.hs b/testsuite/pdynload/should_fail0/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/should_fail0/api/API.hs @@ -0,0 +1,13 @@ +{-# OPTIONS -fglasgow-exts #-} +-- ^ needed to derive Typeable + +module API where + +import Data.Dynamic + +data Interface = Interface { field :: String } + deriving (Show) + +rsrc :: Interface +rsrc = Interface { field = "default value" } + diff --git a/testsuite/pdynload/should_fail0/prog/Main.hs b/testsuite/pdynload/should_fail0/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/should_fail0/prog/Main.hs @@ -0,0 +1,18 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> mapM_ putStrLn e + where + f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ a -> putStrLn "loaded .. yay!" + _ -> putStrLn "wrong types" + diff --git a/testsuite/pdynload/should_fail0/prog/expected b/testsuite/pdynload/should_fail0/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/should_fail0/prog/expected @@ -0,0 +1,1 @@ +wrong types diff --git a/testsuite/pdynload/should_fail1/Makefile b/testsuite/pdynload/should_fail1/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/should_fail1/Makefile @@ -0,0 +1,5 @@ +# Missing class constraint... can't do that in Clean + +TEST= pdynload/should_fail1 +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/should_fail1/Plugin.hs b/testsuite/pdynload/should_fail1/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/should_fail1/Plugin.hs @@ -0,0 +1,5 @@ +module Plugin where + +data I = I Int + +resource = I 1 diff --git a/testsuite/pdynload/should_fail1/api/API.hs b/testsuite/pdynload/should_fail1/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/should_fail1/api/API.hs @@ -0,0 +1,8 @@ + +module API where + +newtype Interface = I Int + +rsrc :: Interface +rsrc = I 1 + diff --git a/testsuite/pdynload/should_fail1/prog/Main.hs b/testsuite/pdynload/should_fail1/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/should_fail1/prog/Main.hs @@ -0,0 +1,17 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> mapM_ putStrLn e + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ a -> putStrLn "loaded .. yay!" + _ -> putStrLn "wrong types" diff --git a/testsuite/pdynload/should_fail1/prog/expected b/testsuite/pdynload/should_fail1/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/should_fail1/prog/expected @@ -0,0 +1,1 @@ +wrong types diff --git a/testsuite/pdynload/small/Makefile b/testsuite/pdynload/small/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/small/Makefile @@ -0,0 +1,4 @@ +TEST= pdynload/small +EXTRA_OBJS=Plugin.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/small/Plugin.hs b/testsuite/pdynload/small/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/small/Plugin.hs @@ -0,0 +1,5 @@ +module Plugin where + +import API + +resource = plugin { function = "good" } diff --git a/testsuite/pdynload/small/api/API.hs b/testsuite/pdynload/small/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/small/api/API.hs @@ -0,0 +1,9 @@ +module API where + +data Interface = Interface { + function :: String +} + +plugin :: Interface +plugin = Interface { function = "goodbye" } + diff --git a/testsuite/pdynload/small/prog/Main.hs b/testsuite/pdynload/small/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/small/prog/Main.hs @@ -0,0 +1,18 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> mapM_ putStrLn e + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ a -> putStrLn "loaded .. yay!" + _ -> putStrLn "wrong types" + diff --git a/testsuite/pdynload/small/prog/expected b/testsuite/pdynload/small/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/small/prog/expected @@ -0,0 +1,1 @@ +loaded .. yay! diff --git a/testsuite/pdynload/spj1/Makefile b/testsuite/pdynload/spj1/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj1/Makefile @@ -0,0 +1,5 @@ + +TEST=pdynload/spj1 + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/spj1/Plugin.hs b/testsuite/pdynload/spj1/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj1/Plugin.hs @@ -0,0 +1,17 @@ +module Plugin where + +-- user doesn't import the API +-- and provides a polymorphic value + +-- import API +-- resource :: Interface + +-- +-- should pass type check, and dump core +-- +-- resource :: Num a => a + +-- import API + +resource :: Num a => a +resource = 7 diff --git a/testsuite/pdynload/spj1/api/API.hs b/testsuite/pdynload/spj1/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj1/api/API.hs @@ -0,0 +1,9 @@ + +module API where + +-- data Interface = Interface { field :: Int } + +-- newtype Interface = Interface Int + +type Interface = Int + diff --git a/testsuite/pdynload/spj1/dont_test b/testsuite/pdynload/spj1/dont_test new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj1/dont_test diff --git a/testsuite/pdynload/spj1/prog/Main.hs b/testsuite/pdynload/spj1/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj1/prog/Main.hs @@ -0,0 +1,17 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> mapM_ putStrLn e + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ (a :: Interface) -> print $ a -- will crash + LoadFailure es -> putStrLn $ show es diff --git a/testsuite/pdynload/spj1/prog/expected b/testsuite/pdynload/spj1/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj1/prog/expected diff --git a/testsuite/pdynload/spj2/Makefile b/testsuite/pdynload/spj2/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj2/Makefile @@ -0,0 +1,5 @@ + +TEST=pdynload/spj1 + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/spj2/Plugin.hs b/testsuite/pdynload/spj2/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj2/Plugin.hs @@ -0,0 +1,13 @@ +module Plugin where + +-- user doesn't import the API +-- and provides a polymorphic value + +import API +resource :: Interface + +-- +-- should pass type check, and dump core +-- +-- resource :: Num a => a +resource = 7 diff --git a/testsuite/pdynload/spj2/api/API.hs b/testsuite/pdynload/spj2/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj2/api/API.hs @@ -0,0 +1,6 @@ + +module API where + +-- simple type +type Interface = Int + diff --git a/testsuite/pdynload/spj2/prog/Main.hs b/testsuite/pdynload/spj2/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj2/prog/Main.hs @@ -0,0 +1,17 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> mapM_ putStrLn e + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ (a :: Interface) -> putStrLn $ show a -- will crash + LoadFailure es -> putStrLn $ show es diff --git a/testsuite/pdynload/spj2/prog/expected b/testsuite/pdynload/spj2/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj2/prog/expected @@ -0,0 +1,1 @@ +7 diff --git a/testsuite/pdynload/spj3/Makefile b/testsuite/pdynload/spj3/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj3/Makefile @@ -0,0 +1,3 @@ +TEST= pdynload/spj3 +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/spj3/Plugin.hs b/testsuite/pdynload/spj3/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj3/Plugin.hs @@ -0,0 +1,5 @@ +module Plugin where + +import API + +resource = plugin { function = (+) :: Int -> Int -> Int } diff --git a/testsuite/pdynload/spj3/api/API.hs b/testsuite/pdynload/spj3/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj3/api/API.hs @@ -0,0 +1,9 @@ +module API where + +data Interface = Interface { + function :: (Num a) => a -> a -> a +} + +plugin :: Interface +plugin = Interface { function = error "no function defined" } + diff --git a/testsuite/pdynload/spj3/prog/Main.hs b/testsuite/pdynload/spj3/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj3/prog/Main.hs @@ -0,0 +1,18 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> mapM_ putStrLn e + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ a -> let fn = function a in putStrLn $ show $ 1 `fn` 2 + _ -> putStrLn "wrong types" + diff --git a/testsuite/pdynload/spj3/prog/expected b/testsuite/pdynload/spj3/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj3/prog/expected @@ -0,0 +1,8 @@ + +../Plugin.hs:5: + Cannot unify the type-signature variable `a' with the type `Int' + Expected type: a -> a -> a + Inferred type: Int -> Int -> Int + When checking the type signature of the expression: + (+) :: Int -> Int -> Int + In the `function' field of a record diff --git a/testsuite/pdynload/spj3/prog/expected.604 b/testsuite/pdynload/spj3/prog/expected.604 new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj3/prog/expected.604 @@ -0,0 +1,9 @@ + +../Plugin.hs:5:31: + Couldn't match the rigid variable `a' against `Int' + `a' is bound by the polymorphic type `forall a. (Num a) => a -> a -> a' + at ../Plugin.hs:5:11-56 + Expected type: a -> a -> a + Inferred type: Int -> Int -> Int + In the expression: (+) :: Int -> Int -> Int + In the `function' field of a record diff --git a/testsuite/pdynload/spj3/prog/expected.605 b/testsuite/pdynload/spj3/prog/expected.605 new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj3/prog/expected.605 @@ -0,0 +1,9 @@ + +../Plugin.hs:5:31: + Couldn't match the rigid variable `a' against `Int' + `a' is bound by the polymorphic type `forall a. (Num a) => a -> a -> a' + at ../Plugin.hs:5:11-56 + Expected type: a -> a -> a + Inferred type: Int -> Int -> Int + In the expression: (+) :: Int -> Int -> Int + In the `function' field of a record diff --git a/testsuite/pdynload/spj4/Makefile b/testsuite/pdynload/spj4/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj4/Makefile @@ -0,0 +1,5 @@ + +TEST=pdynload/spj4 + +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/spj4/Plugin.hs b/testsuite/pdynload/spj4/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj4/Plugin.hs @@ -0,0 +1,16 @@ +module Plugin where + +-- user doesn't import the API +-- and provides a polymorphic value + +-- import API +-- resource :: Interface + +-- +-- should pass type check, and dump core +-- +-- resource :: Num a => a + +import API + +resource = Interface { field = 7 :: Num a => a } diff --git a/testsuite/pdynload/spj4/api/API.hs b/testsuite/pdynload/spj4/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj4/api/API.hs @@ -0,0 +1,5 @@ + +module API where + +newtype Interface = Interface { field :: Int } + diff --git a/testsuite/pdynload/spj4/prog/Main.hs b/testsuite/pdynload/spj4/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj4/prog/Main.hs @@ -0,0 +1,17 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> error "there was a type error" + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ (a :: Interface) -> print $ field a -- will crash + LoadFailure es -> mapM_ putStrLn es diff --git a/testsuite/pdynload/spj4/prog/expected b/testsuite/pdynload/spj4/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/spj4/prog/expected @@ -0,0 +1,1 @@ +7 diff --git a/testsuite/pdynload/typealias/Makefile b/testsuite/pdynload/typealias/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/typealias/Makefile @@ -0,0 +1,5 @@ +# Missing class constraint... can't do that in Clean + +TEST= pdynload/typealias +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/typealias/Plugin.hs b/testsuite/pdynload/typealias/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/typealias/Plugin.hs @@ -0,0 +1,3 @@ +module Plugin where + +resource = 1 :: Int diff --git a/testsuite/pdynload/typealias/api/API.hs b/testsuite/pdynload/typealias/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/typealias/api/API.hs @@ -0,0 +1,8 @@ + +module API where + +type Interface = Int + +rsrc :: Interface +rsrc = 1 + diff --git a/testsuite/pdynload/typealias/prog/Main.hs b/testsuite/pdynload/typealias/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/typealias/prog/Main.hs @@ -0,0 +1,19 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> mapM_ putStrLn e + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ a -> putStrLn "loaded .. yay!" + _ -> putStrLn "wrong types" + + diff --git a/testsuite/pdynload/typealias/prog/expected b/testsuite/pdynload/typealias/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/typealias/prog/expected @@ -0,0 +1,1 @@ +loaded .. yay! diff --git a/testsuite/pdynload/univquant/Makefile b/testsuite/pdynload/univquant/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/univquant/Makefile @@ -0,0 +1,4 @@ +TEST= pdynload/univquant +EXTRA_OBJS=Plugin.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/pdynload/univquant/Plugin.hs b/testsuite/pdynload/univquant/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/univquant/Plugin.hs @@ -0,0 +1,8 @@ +module Plugin where + +import API + +resource = plugin { function = my_id } + +my_id :: forall a. a -> a +my_id x = x diff --git a/testsuite/pdynload/univquant/api/API.hs b/testsuite/pdynload/univquant/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/univquant/api/API.hs @@ -0,0 +1,9 @@ +module API where + +data Interface = Interface { + function :: forall a. a -> a +} + +plugin :: Interface +plugin = Interface { function = id } + diff --git a/testsuite/pdynload/univquant/prog/Main.hs b/testsuite/pdynload/univquant/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/univquant/prog/Main.hs @@ -0,0 +1,17 @@ + +import System.Plugins +import API + +src = "../Plugin.hs" +wrap = "../Wrapper.hs" +apipath = "../api" + +main = do status <- make src ["-i"++apipath] + case status of + MakeSuccess _ _ -> f + MakeFailure e -> mapM_ putStrLn e + + where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" + case v of + LoadSuccess _ a -> putStrLn "loaded .. yay!" + _ -> putStrLn "wrong types" diff --git a/testsuite/pdynload/univquant/prog/expected b/testsuite/pdynload/univquant/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/pdynload/univquant/prog/expected @@ -0,0 +1,1 @@ +loaded .. yay! diff --git a/testsuite/pkgconf/null/Makefile b/testsuite/pkgconf/null/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/pkgconf/null/Makefile @@ -0,0 +1,16 @@ +all: + @echo "test disabled" + +#true_api:: +# ( cd api ;\ +# $(GHC) -Onot $(EXTRAFLAGS) -c $(API).hs ;\ +# $(RM) -f libHSapi.a ;\ +# $(AR) cq libHSapi.a API.o ;\ +# $(RANLIB) libHSapi.a ;\ +# $(LD) -r $(LD_X) $(WHOLE_ARCHIVE_FLAG) -o HSapi.o libHSapi.a ;\ +# rm API.o ;\ +# echo [] > package.conf ;\ +# env PREFIX=`pwd` $(GHC_PKG) -f package.conf -u < package.conf.in ) +# $(GHC) -package-conf ${TOP}/plugins.conf.inplace -package plugins \ +# -package-conf api/package.conf -package api \ +# -O $(EXTRAFLAGS) -c Null.hs diff --git a/testsuite/pkgconf/null/Null.hs b/testsuite/pkgconf/null/Null.hs new file mode 100644 --- /dev/null +++ b/testsuite/pkgconf/null/Null.hs @@ -0,0 +1,6 @@ +module Null ( resource ) where + +import API + +resource = plugin { a = 7 } + diff --git a/testsuite/pkgconf/null/api/API.hs b/testsuite/pkgconf/null/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/pkgconf/null/api/API.hs @@ -0,0 +1,10 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +data Null = Null { a, b :: Int } + deriving Show + +plugin :: Null +plugin = Null { a = 42 , b = 1 } + diff --git a/testsuite/pkgconf/null/api/package.conf.in b/testsuite/pkgconf/null/api/package.conf.in new file mode 100644 --- /dev/null +++ b/testsuite/pkgconf/null/api/package.conf.in @@ -0,0 +1,18 @@ +Package { + name = "api", + auto = False, + + import_dirs = [ "${PREFIX}" ], + library_dirs = [ "${PREFIX}" ], + hs_libraries = [ "HSapi" ], + + include_dirs = [], + c_includes = [], + source_dirs = [], + extra_libraries = [], + package_deps = [], + extra_ghc_opts = [], + extra_cc_opts = [], + extra_ld_opts = [] +} + diff --git a/testsuite/pkgconf/null/dont_test b/testsuite/pkgconf/null/dont_test new file mode 100644 --- /dev/null +++ b/testsuite/pkgconf/null/dont_test diff --git a/testsuite/pkgconf/null/prog/Main.hs b/testsuite/pkgconf/null/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/pkgconf/null/prog/Main.hs @@ -0,0 +1,12 @@ +{-# OPTIONS -cpp #-} + +#include "../../../../config.h" + +import System.Plugins +import API + +main = do + let includes = TOP ++ "/testsuite/load/null/api" + (_,v) <- load "../Null.o" ["."] ["../api/package.conf"] "resource" + putStrLn ( show (a v) ) + diff --git a/testsuite/plugs/plugs/Main.hs b/testsuite/plugs/plugs/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/plugs/plugs/Main.hs @@ -0,0 +1,69 @@ +-- +-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons +-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html) +-- + +import System.Eval.Haskell +import System.Plugins.Load + +import System.Exit ( ExitCode(..), exitWith ) +import System.IO +import System.Console.Readline ( readline, addHistory ) + +symbol = "resource" + +main = do + putStrLn banner + putStr "Loading package base" >> hFlush stdout + loadPackage "base" + putStr " ... linking ... " >> hFlush stdout + resolveObjs (return ()) + putStrLn "done" + + shell [] + +shell :: [String] -> IO () +shell imps = do + s <- readline "plugs> " + cmd <- case s of + Nothing -> exitWith ExitSuccess + Just (':':'q':_) -> exitWith ExitSuccess + Just s -> addHistory s >> return s + imps' <- run cmd imps + shell imps' + +run :: String -> [String] -> IO [String] +run "" is = return is +run ":?" is = putStrLn help >> return is + +run ":l" _ = return [] +run (':':'l':' ':m) is = return (m:is) + +run (':':'t':' ':s) is = do + ty <- typeOf s is + when (not $ null ty) (putStrLn $ s ++ " :: " ++ ty) + return is + +run (':':_) is = putStrLn help >> return is + +run s is = do + s <- unsafeEval ("show $ "++s) is + when (isJust s) (putStrLn (fromJust s)) + return is + +banner = "\ +\ __ \n\ +\ ____ / /_ ______ ______ \n\ +\ / __ \\/ / / / / __ `/ ___/ PLugin User's GHCi System, for Haskell 98\n\ +\ / /_/ / / /_/ / /_/ (__ ) http://www.cse.unsw.edu.au/~dons/hs-plugins\n\ +\ / .___/_/\\__,_/\\__, /____/ Type :? for help \n\ +\/_/ /____/ \n" + +help = "\ +\Commands :\n\ +\ evaluate expression\n\ +\ :t show type of expression (monomorphic only)\n\ +\ :l module bring module in to scope\n\ +\ :l clear module list\n\ +\ :quit quit\n\ +\ :? display this list of commands" diff --git a/testsuite/plugs/plugs/Makefile b/testsuite/plugs/plugs/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/plugs/plugs/Makefile @@ -0,0 +1,28 @@ +GHCFLAGS= -O +PKGFLAGS+= -package plugins -package readline + +all: build + +build: + @$(GHC) $(GHCFLAGS) $(PKGFLAGS) $(EXTRAFLAGS) Main.hs -o plugs +check: build + @(if [ -f "expected" ] ;\ + then \ + actual_out="/tmp/hs-plugins-actual.out.$$$$" ;\ + diff_out="/tmp/hs-plugins.diff.$$$$" ;\ + cat test.in | ./plugs > $$actual_out 2>&1 || true ;\ + diff -u expected $$actual_out > $$diff_out || true ;\ + if [ -s "$$diff_out" ] ; then \ + echo "failed with:" ;\ + cat "$$diff_out" | sed '1,3d' ;\ + else \ + echo "ok." ;\ + fi ;\ + rm $$actual_out ;\ + else \ + cat test.in | ./plugs 2>&1 || true ;\ + fi) +clean: + rm -rf *.hi *.o *~ *.dep ./plugs + +include ../../../config.mk diff --git a/testsuite/plugs/plugs/expected b/testsuite/plugs/plugs/expected new file mode 100644 --- /dev/null +++ b/testsuite/plugs/plugs/expected @@ -0,0 +1,9 @@ + __ + ____ / /_ ______ ______ + / __ \/ / / / / __ `/ ___/ PLugin User's GHCi System, for Haskell 98 + / /_/ / / /_/ / /_/ (__ ) http://www.cse.unsw.edu.au/~dons/hs-plugins + / .___/_/\__,_/\__, /____/ Type :? for help +/_/ /____/ + +Loading package base ... linking ... plugs> plugs> done +453973694165307953197296969697410619233826 diff --git a/testsuite/plugs/plugs/test.in b/testsuite/plugs/plugs/test.in new file mode 100644 --- /dev/null +++ b/testsuite/plugs/plugs/test.in @@ -0,0 +1,2 @@ +let fibs = 1 : 1 : zipWith (+) fibs (tail fibs) in fibs !! 200 +:quit diff --git a/testsuite/plugs/runplugs/Main.hs b/testsuite/plugs/runplugs/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/plugs/runplugs/Main.hs @@ -0,0 +1,57 @@ +-- +-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons +-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html) +-- + +-- +-- | Runplugs: use hs-plugins to run a Haskell expression under +-- controlled conditions. +-- +import System.Eval.Haskell (unsafeEval) + +import Data.Char (chr) +import Data.Maybe (isJust, fromJust) +import Control.Monad + +import System.Random +import System.Exit (exitWith, ExitCode(ExitSuccess)) +import System.IO (getContents, putStrLn) +import System.Posix.Resource (setResourceLimit, + Resource(ResourceCPUTime), + ResourceLimits(ResourceLimits), + ResourceLimit(ResourceLimit)) + +import qualified Control.Exception (catch) + +rlimit = ResourceLimit 3 + +context = prehier ++ datas ++ qualifieds ++ controls + +prehier = ["Char", "List", "Maybe", "Numeric", "Random" ] + +qualifieds = ["qualified Data.Map as M" + ,"qualified Data.Set as S" + ,"qualified Data.IntSet as I"] + +datas = map ("Data." ++) [ + "Bits", "Bool", "Char", "Dynamic", "Either", + "Graph", "Int", "Ix", "List", + "Maybe", "Ratio", "Tree", "Tuple", "Typeable", "Word" + ] + +controls = map ("Control." ++) ["Monad", "Monad.Reader", "Monad.Fix", "Arrow"] + +main = do + setResourceLimit ResourceCPUTime (ResourceLimits rlimit rlimit) + s <- getLine + when (not . null $ s) $ do + x <- sequence (take 3 (repeat $ getStdRandom (randomR (97,122)) >>= return . chr)) + s <- unsafeEval ("let { "++x++ + " = \n# 1 \"\"\n"++s++ + "\n} in take 2048 (show "++x++ + ")") context + when (isJust s) $ Control.Exception.catch + (putStrLn $ fromJust s) + (\e -> putStrLn $ "Exception: " ++ show e ) + exitWith ExitSuccess + diff --git a/testsuite/plugs/runplugs/Makefile b/testsuite/plugs/runplugs/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/plugs/runplugs/Makefile @@ -0,0 +1,30 @@ +GHCFLAGS= -Onot $(GHC_EXTRA_OPTS) +PKGFLAGS= -package posix +PKGFLAGS+= -package plugins + +all: build + +build: + @$(GHC) $(GHCFLAGS) $(PKGFLAGS) $(EXTRAFLAGS) Main.hs -o runplugs +include ../../../config.mk +check: build + @(if [ -f "expected" ] ;\ + then \ + actual_out="/tmp/hs-plugins-actual.out.$$$$" ;\ + diff_out="/tmp/hs-plugins.diff.$$$$" ;\ + cat test.in | ./runplugs > $$actual_out 2>&1 || true ;\ + diff -u expected $$actual_out > $$diff_out || true ;\ + if [ -s "$$diff_out" ] ; then \ + echo "failed with:" ;\ + cat "$$diff_out" | sed '1,3d' ;\ + else \ + echo "ok." ;\ + fi ;\ + rm $$actual_out ;\ + else \ + cat test.in | ./runplugs 2>&1 || true ;\ + fi) +clean: + rm -rf *.hi *.o *~ *.dep ./runplugs + +include ../../../config.mk diff --git a/testsuite/plugs/runplugs/expected b/testsuite/plugs/runplugs/expected new file mode 100644 --- /dev/null +++ b/testsuite/plugs/runplugs/expected @@ -0,0 +1,1 @@ +453973694165307953197296969697410619233826 diff --git a/testsuite/plugs/runplugs/test.in b/testsuite/plugs/runplugs/test.in new file mode 100644 --- /dev/null +++ b/testsuite/plugs/runplugs/test.in @@ -0,0 +1,1 @@ +let fibs = 1 : 1 : zipWith (+) fibs (tail fibs) in fibs !! 200 diff --git a/testsuite/reload/null/Makefile b/testsuite/reload/null/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/reload/null/Makefile @@ -0,0 +1,4 @@ +TEST= reload/null +EXTRA_OBJS=Null.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/reload/null/Null.hs b/testsuite/reload/null/Null.hs new file mode 100644 --- /dev/null +++ b/testsuite/reload/null/Null.hs @@ -0,0 +1,11 @@ +module Null ( resource, resource_dyn ) where + +import API +import Data.Dynamic +import Prelude hiding (null) + +resource = null + +-- ! this has to be special: it can't be overridden by the user. +resource_dyn :: Dynamic +resource_dyn = toDyn resource diff --git a/testsuite/reload/null/api/API.hs b/testsuite/reload/null/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/reload/null/api/API.hs @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import Data.Dynamic + +data Null = Null { a, b :: Int } + deriving (Typeable, Show) + +null :: Null +null = Null { a = 42 , b = 1 } + diff --git a/testsuite/reload/null/prog/Main.hs b/testsuite/reload/null/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/reload/null/prog/Main.hs @@ -0,0 +1,19 @@ + +import System.Plugins +import API + +-- an example where we just want to load an object and run it + +main = do + m_v <- load "../Null.o" ["../api"] [] "resource" + (m,v) <- case m_v of + LoadSuccess m v -> return (m,v) + _ -> error "load failed" + putStrLn ( show (a v) ) + + m_v <- reload m "resource" -- get a new version + v' <- case m_v of + LoadSuccess _ v -> return v + _ -> error "load failed" + putStrLn ( show (a v') ) + diff --git a/testsuite/reload/null/prog/expected b/testsuite/reload/null/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/reload/null/prog/expected @@ -0,0 +1,2 @@ +42 +42 diff --git a/testsuite/shell/shell/API.hs b/testsuite/shell/shell/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/shell/shell/API.hs @@ -0,0 +1,8 @@ +module API where + +-- the interface between the app and the plugin +data Interface = Interface { function :: String -> String } + +-- default values for the interface +plugin :: Interface +plugin = Interface { function = id } diff --git a/testsuite/shell/shell/Main.hs b/testsuite/shell/shell/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/shell/shell/Main.hs @@ -0,0 +1,85 @@ +-- +-- a simple shell for loading plugins and evaluating their functions +-- + +import System.Plugins +import API + +import Data.Either +import Data.Char +import Control.Monad ( when ) +import System.Console.Readline ( readline ) +import System.Exit ( ExitCode(..), exitWith ) + + +source = "Plugin.hs" +stub = "Plugin.stub" + +sym = "resource" + +main = do + status <- makeWith source stub [] + p <- case status of + MakeFailure e -> mapM_ putStrLn e >> error "failed to compile" + MakeSuccess _ obj -> do + m_v <- load obj ["."] [] sym + case m_v of + LoadSuccess m v -> return (m,v) + LoadFailure e -> do mapM_ putStrLn e + error "failed to load" + shell p + + where + shell p@(m,v) = do + + s <- readline "> " + cmd <- case s of + Nothing -> exitWith ExitSuccess + Just ":q" -> exitWith ExitSuccess + Just s -> return (chomp s) + + status <- makeWith source stub [] + case status of + MakeFailure e -> do + mapM_ putStrLn e + shell p -- print error and back to prompt + + MakeSuccess NotReq o -> do + p' <- eval cmd p + shell p' -- eval str again + + MakeSuccess ReComp o -> do + m_v' <- reload m sym + case m_v' of + LoadFailure e -> mapM_ putStrLn e >> error "failed to load" + LoadSuccess _ v' -> do + let p' = (m,v') + p'' <- eval cmd p' + shell p'' + +-- +-- shell commands +-- +eval "" p = return p + +eval ":clear" p = do + let loop i = when (i < 40) (do putStr "\n" ; loop $! i+1) + loop 0 + return p + +eval ":?" p = do + putStrLn$"\":?\"\n" ++ + "\":quit\"\n" ++ + "\":clear\"\n" ++ + "\"foo\"" + return p + +eval s (m,v) = putStrLn ((function v) s) >> return (m,v) + +-- +-- strip trailing whitespace +-- +chomp :: String -> String +chomp [] = [] +chomp s | isSpace (last s) = chomp $! init s + | otherwise = s diff --git a/testsuite/shell/shell/Makefile b/testsuite/shell/shell/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/shell/shell/Makefile @@ -0,0 +1,2 @@ +TOP=../../.. +include ../../eval.mk diff --git a/testsuite/shell/shell/Plugin.hs b/testsuite/shell/shell/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/shell/shell/Plugin.hs @@ -0,0 +1,5 @@ + +resource = plugin { + function = map toUpper +} + diff --git a/testsuite/shell/shell/Plugin.stub b/testsuite/shell/shell/Plugin.stub new file mode 100644 --- /dev/null +++ b/testsuite/shell/shell/Plugin.stub @@ -0,0 +1,19 @@ +-- +-- this is a "stub" file, containing default syntax we don't +-- want the user to have to write +-- +-- for example, it constrains the module name and force the API to be +-- imported + +module Plugin ( resource ) where + +import API +import Data.Char +import Data.List + +-- this is a default definition of 'resource'. it will be overridden +-- by anything the user writes. useful for default values + +resource :: Interface +resource = plugin + diff --git a/testsuite/shell/shell/README b/testsuite/shell/shell/README new file mode 100644 --- /dev/null +++ b/testsuite/shell/shell/README @@ -0,0 +1,23 @@ +$ make +$ ./a.out +Compiling plugin ... done +Loading package base ... linking ... done +Loading objects API Plugin ... done +> ? +"?" +"quit" +"clear" +"filter foo" +> filter adf adsf +fsda fda +> filter asd faSDFADSF +FSDAFDSaf dsa + +-- at this point I edit the plugin and save the source + +> filter asfdaSDFASD +Compiling plugin ... done +Reloading Plugin ... done +DSAFDSADFSA + +-- it compiled and reloaded it for me. nice. diff --git a/testsuite/shell/shell/dont_test b/testsuite/shell/shell/dont_test new file mode 100644 --- /dev/null +++ b/testsuite/shell/shell/dont_test diff --git a/testsuite/shell/simple/Main.hs b/testsuite/shell/simple/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/shell/simple/Main.hs @@ -0,0 +1,41 @@ +import System.Plugins +import StringProcessorAPI +import System.Console.Readline +import System.Exit + +source = "Plugin.hs" +stub = "Plugin.stub" +symbol = "resource" + +main = do s <- makeWith source stub [] + o <- case s of + MakeSuccess _ obj -> do + ls <- load obj ["."] [] symbol + case ls of LoadSuccess m v -> return (m,v) + LoadFailure err -> error "load failed" + MakeFailure e -> mapM_ putStrLn e >> error "compile failed" + shell o + +shell o@(m,plugin) = do + s <- readline "> " + cmd <- case s of + Nothing -> exitWith ExitSuccess + Just (':':'q':_) -> exitWith ExitSuccess + Just s -> addHistory s >> return s + + s <- makeWith source stub [] -- maybe recompile the source + o' <- case s of + MakeSuccess ReComp o -> do + ls <- reload m symbol + case ls of LoadSuccess m' v' -> return (m',v') + LoadFailure err -> error "reload failed" + MakeSuccess NotReq _ -> return o + MakeFailure e -> mapM_ putStrLn e >> shell o + eval cmd o' + shell o' + +eval ":?" _ = putStrLn ":?\n:q\n" + +eval s (_,plugin) = let fn = (stringProcessor plugin) in putStrLn (fn s) + + diff --git a/testsuite/shell/simple/Makefile b/testsuite/shell/simple/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/shell/simple/Makefile @@ -0,0 +1,6 @@ +OBJS=StringProcessorAPI.o +TOP=../../.. +include ../../eval.mk + +#all: +# @echo test disabled diff --git a/testsuite/shell/simple/Plugin.hs b/testsuite/shell/simple/Plugin.hs new file mode 100644 --- /dev/null +++ b/testsuite/shell/simple/Plugin.hs @@ -0,0 +1,5 @@ +import Char + +resource = plugin { + stringProcessor = map toUpper +} diff --git a/testsuite/shell/simple/Plugin.stub b/testsuite/shell/simple/Plugin.stub new file mode 100644 --- /dev/null +++ b/testsuite/shell/simple/Plugin.stub @@ -0,0 +1,19 @@ +-- +-- this is a "stub" file, containing default syntax we don't +-- want the user to have to write +-- +-- for example, it constrains the module name and force the API to be +-- imported + +module Plugin ( resource ) where + +import StringProcessorAPI +import Data.Char +import Data.List + +-- this is a default definition of 'resource'. it will be overridden +-- by anything the user writes. useful for default values + +resource :: Interface +resource = plugin + diff --git a/testsuite/shell/simple/README b/testsuite/shell/simple/README new file mode 100644 --- /dev/null +++ b/testsuite/shell/simple/README @@ -0,0 +1,23 @@ +$ make +$ ./a.out +Compiling plugin ... done +Loading package base ... linking ... done +Loading objects API Plugin ... done +> ? +"?" +"quit" +"clear" +"filter foo" +> filter adf adsf +fsda fda +> filter asd faSDFADSF +FSDAFDSaf dsa + +-- at this point I edit the plugin and save the source + +> filter asfdaSDFASD +Compiling plugin ... done +Reloading Plugin ... done +DSAFDSADFSA + +-- it compiled and reloaded it for me. nice. diff --git a/testsuite/shell/simple/StringProcessorAPI.hs b/testsuite/shell/simple/StringProcessorAPI.hs new file mode 100644 --- /dev/null +++ b/testsuite/shell/simple/StringProcessorAPI.hs @@ -0,0 +1,8 @@ +module StringProcessorAPI where + +data Interface = Interface { + stringProcessor :: String -> String +} + +plugin :: Interface +plugin = Interface { stringProcessor = id } diff --git a/testsuite/shell/simple/dont_test b/testsuite/shell/simple/dont_test new file mode 100644 --- /dev/null +++ b/testsuite/shell/simple/dont_test diff --git a/testsuite/unload/null/Makefile b/testsuite/unload/null/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/unload/null/Makefile @@ -0,0 +1,4 @@ +TEST= unload/null +EXTRA_OBJS=Null.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/unload/null/Null.hs b/testsuite/unload/null/Null.hs new file mode 100644 --- /dev/null +++ b/testsuite/unload/null/Null.hs @@ -0,0 +1,11 @@ +module Null ( resource, resource_dyn ) where + +import API +import Data.Dynamic +import Prelude hiding (null) + +resource = null + +-- ! this has to be special: it can't be overridden by the user. +resource_dyn :: Dynamic +resource_dyn = toDyn resource diff --git a/testsuite/unload/null/api/API.hs b/testsuite/unload/null/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/unload/null/api/API.hs @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import Data.Dynamic + +data Null = Null { a, b :: Int } + deriving (Typeable, Show) + +null :: Null +null = Null { a = 42 , b = 1 } + diff --git a/testsuite/unload/null/prog/Main.hs b/testsuite/unload/null/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/unload/null/prog/Main.hs @@ -0,0 +1,11 @@ + +import System.Plugins +import API + +-- an example where we just want to load an object and run it + +main = do + m_v <- load "../Null.o" ["../api"] [] "resource" + case m_v of + LoadFailure _ -> error "load failed" + LoadSuccess m v -> do putStrLn ( show (a v) ) ; unload m diff --git a/testsuite/unload/null/prog/expected b/testsuite/unload/null/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/unload/null/prog/expected @@ -0,0 +1,1 @@ +42 diff --git a/testsuite/unload/sjwtrap/Makefile b/testsuite/unload/sjwtrap/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/unload/sjwtrap/Makefile @@ -0,0 +1,4 @@ +TEST= unload/sjwtrap +EXTRA_OBJS=Null.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/unload/sjwtrap/Null.hs b/testsuite/unload/sjwtrap/Null.hs new file mode 100644 --- /dev/null +++ b/testsuite/unload/sjwtrap/Null.hs @@ -0,0 +1,6 @@ +module Null where + +import qualified Prelude +import API + +resource = null diff --git a/testsuite/unload/sjwtrap/api/API.hs b/testsuite/unload/sjwtrap/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/unload/sjwtrap/api/API.hs @@ -0,0 +1,9 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +data Null = Null { a, b :: Int } + +null :: Null +null = Null { a = 42 , b = 1 } + diff --git a/testsuite/unload/sjwtrap/prog/Main.hs b/testsuite/unload/sjwtrap/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/unload/sjwtrap/prog/Main.hs @@ -0,0 +1,15 @@ + +import System.Plugins +import API + +-- +-- what happens if we try to use code that has been unloaded? +-- + +main = do + m_v <- load "../Null.o" ["../api"] [] "resource" + (m,v) <- case m_v of + LoadSuccess m v -> return (m,v) + _ -> error "load failed" + putStrLn ( show (a v) ) + unload m diff --git a/testsuite/unload/sjwtrap/prog/expected b/testsuite/unload/sjwtrap/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/unload/sjwtrap/prog/expected @@ -0,0 +1,1 @@ +42 diff --git a/testsuite/unloadAll/null/Dep.hs b/testsuite/unloadAll/null/Dep.hs new file mode 100644 --- /dev/null +++ b/testsuite/unloadAll/null/Dep.hs @@ -0,0 +1,7 @@ +module Dep ( resource ) where + +import API +import Data.Dynamic +import Prelude hiding (null) + +resource = null diff --git a/testsuite/unloadAll/null/Makefile b/testsuite/unloadAll/null/Makefile new file mode 100644 --- /dev/null +++ b/testsuite/unloadAll/null/Makefile @@ -0,0 +1,4 @@ +TEST= unloadAll/null +EXTRA_OBJS=Dep.o Null.o +TOP=../../.. +include ../../build.mk diff --git a/testsuite/unloadAll/null/Null.hs b/testsuite/unloadAll/null/Null.hs new file mode 100644 --- /dev/null +++ b/testsuite/unloadAll/null/Null.hs @@ -0,0 +1,12 @@ +module Null ( resource ) where + +import API +import Data.Dynamic +import Prelude hiding (null) +import qualified Dep + +resource = Dep.resource + +-- ! this has to be special: it can't be overridden by the user. +resource_dyn :: Dynamic +resource_dyn = toDyn resource diff --git a/testsuite/unloadAll/null/api/API.hs b/testsuite/unloadAll/null/api/API.hs new file mode 100644 --- /dev/null +++ b/testsuite/unloadAll/null/api/API.hs @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} + +module API where + +import Data.Dynamic + +data Null = Null { a, b :: Int } + deriving (Typeable, Show) + +null :: Null +null = Null { a = 42 , b = 1 } + diff --git a/testsuite/unloadAll/null/prog/Main.hs b/testsuite/unloadAll/null/prog/Main.hs new file mode 100644 --- /dev/null +++ b/testsuite/unloadAll/null/prog/Main.hs @@ -0,0 +1,15 @@ + +import System.Plugins +import API + +-- an example where we just want to load an object and run it + +main = do + m_v <- load_ "../Null.o" ["../api",".."] "resource" + t <- load_ "../Dep.o" ["../api"] "resource" + case m_v of + LoadFailure err -> error (unlines err) + LoadSuccess m v -> do putStrLn ( show (a v) ) ; unloadAll m -- unloads Null.o but not Dep.o since we're still using it. + case t of + LoadFailure err -> error (unlines err) + LoadSuccess m v -> do putStrLn ( show (a v) ) ; unloadAll m diff --git a/testsuite/unloadAll/null/prog/expected b/testsuite/unloadAll/null/prog/expected new file mode 100644 --- /dev/null +++ b/testsuite/unloadAll/null/prog/expected @@ -0,0 +1,2 @@ +42 +42