Skip to content

GitLab

Commit 4847ea83 authored by andy's avatar andy
Browse files

[project @ 1999-10-20 02:15:56 by andy] 

Adding final diffs between Hugs98 (Jan99) and Hugs98 (Sep99)
manually to STG Hugs.
parent 511ec6dd
Hide whitespace changes
Inline Side-by-side
ghc/includes/options.h
View file @ 4847ea83
......@@ -13,8 +13,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: options.h,v $
* $Revision: 1.8 $
* $Date: 1999/05/11 16:46:20 $
* $Revision: 1.9 $
* $Date: 1999/10/20 02:15:56 $
* ------------------------------------------------------------------------*/
......@@ -267,6 +267,10 @@
/* Doesn't work in current system - I don't know what the primops do */
#define TREX 0
/* Define if :xplain should be enabled */
#define EXPLAIN_INSTANCE_RESOLUTION 0
/* Define if you want to run Haskell code through a preprocessor
*
* Note that the :reload command doesn't know about any dependencies
......@@ -332,10 +336,12 @@
/* Define if debugging generated bytecodes or the bytecode interpreter */
#define DEBUG_CODE 1
/* Define if debugging generated supercombinator definitions or compiler */
#define DEBUG_SHOWSC 0
/* Define if you want to use a low-level printer from within a debugger */
#define DEBUG_PRINTER 1
/* --------------------------------------------------------------------------
* Experimental features
* These are likely to disappear/change in future versions and should not
......
ghc/interpreter/compiler.c
View file @ 4847ea83
......@@ -11,8 +11,8 @@
* included in the distribution.
*
* $RCSfile: compiler.c,v $
* $Revision: 1.9 $
* $Date: 1999/10/15 21:41:03 $
* $Revision: 1.10 $
* $Date: 1999/10/20 02:15:58 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -136,7 +136,9 @@ Cell e; {
case STRCELL :
case BIGCELL :
case CHARCELL : return e;
#if IPARAM
case IPVAR : return nameId;
#endif
case FINLIST : mapOver(translate,snd(e));
return mkConsList(snd(e));
......@@ -215,7 +217,15 @@ static List local transBinds(bs) /* Translate list of bindings: */
List bs; { /* eliminating pattern matching on */
List newBinds = NIL; /* lhs of bindings. */
for (; nonNull(bs); bs=tl(bs)) {
#if IPARAM
Cell v = fst(hd(bs));
while (isAp(v) && fst(v) == nameInd)
v = arg(v);
fst(hd(bs)) = v;
if (isVar(v)) {
#else
if (isVar(fst(hd(bs)))) {
#endif
mapProc(transAlt,snd(hd(bs)));
newBinds = cons(hd(bs),newBinds);
}
......
ghc/interpreter/connect.h
View file @ 4847ea83
......@@ -8,8 +8,8 @@
* included in the distribution.
*
* $RCSfile: connect.h,v $
* $Revision: 1.11 $
* $Date: 1999/10/16 02:17:30 $
* $Revision: 1.12 $
* $Date: 1999/10/20 02:15:59 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -156,6 +156,7 @@ extern Bool preludeLoaded; /* TRUE => prelude has been loaded */
extern Bool gcMessages; /* TRUE => print GC messages */
extern Bool literateScripts; /* TRUE => default lit scripts */
extern Bool literateErrors; /* TRUE => report errs in lit scrs */
extern Bool showInstRes; /* TRUE => show instance resolution */
extern Bool optimise; /* TRUE => simplify STG */
extern Int cutoff; /* Constraint Cutoff depth */
......@@ -326,8 +327,26 @@ extern Bool broken; /* indicates interrupt received */
# define ctrlbrk(bh)
# define allowBreak() kbhit()
#else /* !HUGS_FOR_WINDOWS */
# define ctrlbrk(bh) signal(SIGINT,bh); signal(SIGBREAK,bh)
# define allowBreak() if (broken) { broken=FALSE; sigRaise(breakHandler); }
# if HAVE_SIGPROCMASK
# include <signal.h>
# define ctrlbrk(bh) { sigset_t mask; \
signal(SIGINT,bh); \
sigemptyset(&mask); \
sigaddset(&mask, SIGINT); \
sigprocmask(SIG_UNBLOCK, &mask, NULL); \
}
# else
# define ctrlbrk(bh) signal(SIGINT,bh)
# endif
#if SYMANTEC_C
extern int time_release;
extern int allow_break_count;
# define allowBreak() if (time_release !=0 && \
(++allow_break_count % time_release) == 0) \
ProcessEvent();
#else
# define allowBreak() if (broken) { broken=FALSE; sigRaise(breakHandler); }
#endif
#endif /* !HUGS_FOR_WINDOWS */
/*---------------------------------------------------------------------------
......
ghc/interpreter/dynamic.c
View file @ 4847ea83
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: dynamic.c,v $
* $Revision: 1.7 $
* $Date: 1999/10/15 21:41:05 $
* $Revision: 1.8 $
* $Date: 1999/10/20 02:15:59 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -78,11 +78,17 @@ String symbol; {
#else /* eg FreeBSD doesn't have RTLD_LAZY */
ObjectFile instance = dlopen(dll,1);
#endif
void *sym;
if (NULL == instance) {
ERRMSG(0) "Error %s while importing DLL \"%s\"", dlerror(), dll
ERRMSG(0) "Error while importing DLL \"%s\":\n%s\n", dll, dlerror()
EEND;
}
return dlsym(instance,symbol);
if (sym = dlsym(instance,symbol))
return sym;
ERRMSG(0) "Error loading sym:\n%s\n", dlerror()
EEND;
}
#elif HAVE_DL_H /* eg HPUX */
......
ghc/interpreter/hugs.c
View file @ 4847ea83
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: hugs.c,v $
* $Revision: 1.14 $
* $Date: 1999/10/19 23:51:57 $
* $Revision: 1.15 $
* $Date: 1999/10/20 02:15:59 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
......@@ -1422,8 +1422,6 @@ static Void local showtype() { /* print type of expression (if any)*/
static Void local browseit(mod,t)
Module mod;
String t; {
#if 0
/* AJG: DISABLED FOR NOW */
if (nonNull(mod)) {
Cell cs;
Printf("module %s where\n",textToStr(module(mod).text));
......@@ -1444,9 +1442,6 @@ String t; {
} else if (isSfun(nm)) {
Printf(" -- selector function");
}
if (name(nm).primDef) {
Printf(" -- primitive");
}
Printf("\n");
}
}
......@@ -1456,7 +1451,6 @@ String t; {
Printf("Unknown module %s\n",t);
}
}
#endif
}
static Void local browse() { /* browse modules */
......@@ -1715,8 +1709,7 @@ Text t; {
Printf(" => ");
}
printPred(stdout,cclass(cl).head);
#if 0
/* AJG: commented out for now */
if (nonNull(cclass(cl).fds)) {
List fds = cclass(cl).fds;
String pre = " | ";
......@@ -1726,7 +1719,7 @@ Text t; {
pre = ", ";
}
}
#endif
if (nonNull(cclass(cl).members)) {
List ms = cclass(cl).members;
Printf(" where");
......
ghc/interpreter/machdep.c
View file @ 4847ea83
......@@ -13,8 +13,8 @@
* included in the distribution.
*
* $RCSfile: machdep.c,v $
* $Revision: 1.8 $
* $Date: 1999/10/15 21:40:52 $
* $Revision: 1.9 $
* $Date: 1999/10/20 02:16:01 $
* ------------------------------------------------------------------------*/
#ifdef HAVE_SIGNAL_H
......@@ -100,6 +100,9 @@ extern unsigned _stklen = 8000; /* Allocate an 8k stack segment */
#ifdef HAVE_UNIX_H
#include <unix.h>
#endif
#if SYMANTEC_C
int allow_break_count = 0;
#endif
/* --------------------------------------------------------------------------
* Prototypes for registry reading
......@@ -113,7 +116,7 @@ extern unsigned _stklen = 8000; /* Allocate an 8k stack segment */
#endif
#define HugsRoot ("SOFTWARE\\Haskell\\Hugs\\" HUGS_VERSION "\\")
#define ProjectRoot ("SOFTWARE\\Haskell\\Hugs\\Projects\\")
#define ProjectRoot ("SOFTWARE\\Haskell\\Projects\\")
static Bool local createKey Args((HKEY, String, PHKEY, REGSAM));
static Bool local queryValue Args((HKEY, String, String, LPDWORD, LPBYTE, DWORD));
......@@ -306,7 +309,7 @@ static String local hugsdir() { /* directory containing lib/Prelude.hs */
}
#if HSCRIPT
static String local hscriptDir() { /* directory containing ?? what Daan? */
static String local hscriptDir() { /* Directory containing hscript.dll */
static char dir[FILENAME_MAX+1] = "";
if (dir[0] == '\0') { /* not initialised yet */
String s = readRegString(HKEY_LOCAL_MACHINE,HScriptRoot,"InstallDir","");
......@@ -1064,7 +1067,54 @@ Int readTerminalChar() { /* read character from terminal */
if (terminalEchoReqd) {
return getchar();
} else {
Int c = getch();
#if IS_WIN32 && !HUGS_FOR_WINDOWS && !__BORLANDC__
/* When reading a character from the console/terminal, we want
* to operate in 'raw' mode (to use old UNIX tty parlance) and have
* it return when a character is available and _not_ wait until
* the next time the user hits carriage return. On Windows platforms,
* this _can_ be done by reading directly from the console, using
* getch(). However, this doesn't sit well with programming
* environments such as Emacs which allow you to create sub-processes
* running Hugs, and then communicate with the running interpreter
* through its standard input and output handles. If you use getch()
* in that setting, you end up trying to read the (unused) console
* of the editor itself, through which not a lot of characters is
* bound to come out, since the editor communicates input to Hugs
* via the standard input handle.
*
* To avoid this rather unfortunate situation, we use the Win32
* console API and re-jig the input properties of the standard
* input handle before trying to read a character using stdio's
* getchar().
*
* The 'cost' of this solution is that it is Win32 specific and
* won't work with Windows 3.1 + it is kind of ugly and verbose
* to have to futz around with the console properties on a
* per-char basis. Both of these disadvantages aren't in my
* opinion fatal.
*
* -- sof 5/99
*/
Int c;
DWORD mo;
HANDLE hIn;
/* I don't quite understand why, but if the FILE*'s underlying file
descriptor is in text mode, we seem to lose the first carriage
return.
*/
setmode(fileno(stdin), _O_BINARY);
hIn = GetStdHandle(STD_INPUT_HANDLE);
GetConsoleMode(hIn, &mo);
SetConsoleMode(hIn, mo & ~(ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT));
c = getc(stdin);
/* Same as it ever was - revert back state of stdin. */
SetConsoleMode(hIn, mo);
setmode(fileno(stdin), _O_TEXT);
#else
Int c = getch();
#endif
return c=='\r' ? '\n' : c; /* slight paranoia about CR-LF */
}
}
......@@ -1121,8 +1171,21 @@ static sigHandler(panic) { /* exit in a panic, on receipt of */
}
#endif /* !DONT_PANIC */
#if IS_WIN32
BOOL WINAPI consoleHandler(DWORD dwCtrlType) {
switch (dwCtrlType) { /* Allows Hugs to be terminated */
case CTRL_CLOSE_EVENT : /* from the window's close menu. */
ExitProcess(0);
}
return FALSE;
}
#endif
static Void local installHandlers() { /* Install handlers for all fatal */
/* signals except SIGINT and SIGBREAK*/
#if IS_WIN32
SetConsoleCtrlHandler(consoleHandler,TRUE);
#endif
#if !DONT_PANIC && !DOS
# ifdef SIGABRT
signal(SIGABRT,panic);
......@@ -1173,7 +1236,7 @@ String nm; { /* or just line may be zero */
String ec = editorCmd;
String rd = NULL; /* Set to nonnull to redo ... */
for (; n>0 && *he && *he!=' '; n--)
for (; n>0 && *he && *he!=' ' && *he!='%'; n--)
*ec++ = *he++; /* Copy editor name to buffer */
/* assuming filename ends at space */
......
ghc/interpreter/output.c
View file @ 4847ea83
......@@ -10,8 +10,8 @@
* included in the distribution.
*
* $RCSfile: output.c,v $
* $Revision: 1.7 $
* $Date: 1999/10/16 02:17:28 $
* $Revision: 1.8 $
* $Date: 1999/10/20 02:16:02 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -148,6 +148,18 @@ Cell e; {
case CONOPCELL : unlexVar(textOf(e));
break;
#if IPARAM
case IPVAR : putChr('?');
unlexVar(textOf(e));
break;
case WITHEXP : OPEN(d>WHERE_PREC);
putStr("dlet {...} in ");
put(WHERE_PREC+1,fst(snd(e)));
CLOSE(d>WHERE_PREC);
break;
#endif
#if TREX
case RECSEL : putChr('#');
unlexVar(extText(snd(e)));
......@@ -622,9 +634,12 @@ List qs;
Int fr; {
Int len = length(ps) + length(qs);
Int c = len;
if (len!=1) {
putChr('(');
}
#if IPARAM
Bool useParens = len!=1 || isIP(fun(hd(ps)));
#else
Bool useParens = len!=1;
#endif
if (useParens)
for (; nonNull(ps); ps=tl(ps)) {
putPred(hd(ps),fr);
if (--c > 0) {
......@@ -637,9 +652,8 @@ Int fr; {
putStr(", ");
}
}
if (len!=1) {
if (useParens)
putChr(')');
}
}
static Void local putPred(pi,fr) /* Output predicate */
......@@ -653,6 +667,15 @@ Int fr; {
putStr(textToStr(extText(fun(pi))));
return;
}
#endif
#if IPARAM
if (whatIs(fun(pi)) == IPCELL) {
putChr('?');
putPred(fun(pi),fr);
putStr(" :: ");
putType(arg(pi),NEVER,fr);
return;
}
#endif
putPred(fun(pi),fr);
putChr(' ');
......@@ -662,6 +685,10 @@ Int fr; {
putStr(textToStr(cclass(pi).text));
else if (isCon(pi))
putStr(textToStr(textOf(pi)));
#if IPARAM
else if (whatIs(pi) == IPCELL)
unlexVar(textOf(pi));
#endif
else
putStr("<unknownPredicate>");
}
......@@ -688,7 +715,7 @@ Int fr; {
for (; isAp(ks); ks=tl(ks)) {
putTyVar(fr++);
if (isAp(tl(ks)))
putChr(',');
putChr(' ');
}
putStr(". ");
putType(monotypeOf(t),NEVER,fr);
......@@ -747,12 +774,14 @@ Int fr; {
CLOSE(prec>=ARROW_PREC);
return;
}
#if 0
else if (argCount==1) {
putChr('(');
putType(arg(t),ARROW_PREC,fr);
putStr("->)");
return;
}
#endif
}
else if (isTuple(typeHead)) {
if (argCount==tupleOf(typeHead)) {
......@@ -770,7 +799,7 @@ Int fr; {
putStr(punc);
punc = ", ";
putStr(textToStr(extText(typeHead)));
putStr("::");
putStr(" :: ");
putType(extField(t),NEVER,fr);
t = extRow(t);
typeHead = getHead(t);
......
ghc/interpreter/parser.y
View file @ 4847ea83
......@@ -5,14 +5,15 @@
* Expect 6 shift/reduce conflicts when passing this grammar through yacc,
* but don't worry; they should all be resolved in an appropriate manner.
*
* Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
* Haskell Group 1994-99, and is distributed as Open Source software
* under the Artistic License; see the file "Artistic" that is included
* in the distribution for details.
* The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
* Yale Haskell Group, and the Oregon Graduate Institute of Science and
* Technology, 1994-1999, All rights reserved. It is distributed as
* free software under the license in the file "License", which is
* included in the distribution.
*
* $RCSfile: parser.y,v $
* $Revision: 1.10 $
* $Date: 1999/10/16 02:17:29 $
* $Revision: 1.11 $
* $Date: 1999/10/20 02:16:02 $
* ------------------------------------------------------------------------*/
%{
......@@ -46,6 +47,9 @@ static Cell local checkTyLhs Args((Cell));
#if !TREX
static Void local noTREX Args((String));
#endif
#if !IPARAM
static Void local noIP Args((String));
#endif
/* For the purposes of reasonably portable garbage collection, it is
* necessary to simulate the YACC stack on the Hugs stack to keep
......@@ -78,11 +82,14 @@ static Void local noTREX Args((String));
%token THEN ELSE WHERE LET IN
%token INFIXN INFIXL INFIXR FOREIGN TNEWTYPE
%token DEFAULT DERIVING DO TCLASS TINSTANCE
/*#if IPARAM*/
%token WITH DLET
/*#endif*/
%token REPEAT ALL NUMLIT CHARLIT STRINGLIT
%token VAROP VARID CONOP CONID
%token QVAROP QVARID QCONOP QCONID
/*#if TREX*/
%token RECSELID
%token RECSELID IPVARID
/*#endif*/
%token COCO '=' UPTO '@' '\\'
%token '|' '-' FROM ARROW '~'
......@@ -96,6 +103,7 @@ static Void local noTREX Args((String));
/*- Top level script/module structure -------------------------------------*/
start : EXPR exp wherePart {inputExpr = letrec($3,$2); sp-=2;}
| CONTEXT context {inputContext = $2; sp-=1;}
| SCRIPT topModule {valDefns = $2; sp-=1;}
| INTERFACE iface {sp-=1;}
| error {syntaxError("input");}
......@@ -641,7 +649,7 @@ unsafe_flag: /* empty */ {$$ = gc0(NIL);}
/*- Class declarations: ---------------------------------------------------*/
topDecl : TCLASS crule wherePart {classDefn(intOf($1),$2,$3,NIL); sp-=3;}
topDecl : TCLASS crule fds wherePart {classDefn(intOf($1),$2,$4,$3); sp-=4;}
| TINSTANCE irule wherePart {instDefn(intOf($1),$2,$3); sp-=3;}
| DEFAULT '(' dtypes ')' {defaultDefn(intOf($1),$3); sp-=4;}
| TCLASS error {syntaxError("class declaration");}
......@@ -661,9 +669,27 @@ dtypes1 : dtypes1 ',' type {$$ = gc3(cons($3,$1));}
| type {$$ = gc1(cons($1,NIL));}
;
/*- Type expressions: -----------------------------------------------------*/
topType : context IMPLIES topType1 {$$ = gc3(qualify($1,$3));}
fds : /* empty */ {$$ = gc0(NIL);}
| '|' fds1 {h98DoesntSupport(row,"dependent parameters");
$$ = gc2(rev($2));}
;
fds1 : fds1 ',' fd {$$ = gc3(cons($3,$1));}
| fd {$$ = gc1(cons($1,NIL));}
|
;
fd : varids0 ARROW varids0 {$$ = gc3(pair(rev($1),rev($3)));}
;
varids0 : /* empty */ {$$ = gc0(NIL);}
| varids0 varid {$$ = gc2(cons($2,$1));}
;
/*- Type expressions: -----------------------------------------------------*/
topType : ALL varids '.' topType0 {$$ = gc4(ap(POLYTYPE,
pair(rev($2),$4)));}
| topType0 {$$ = $1;}
;
topType0 : context IMPLIES topType1 {$$ = gc3(qualify($1,$3));}
| topType1 {$$ = $1;}
;
topType1 : bpolyType ARROW topType1 {$$ = gc3(fn($1,$3));}
......@@ -673,11 +699,12 @@ topType1 : bpolyType ARROW topType1 {$$ = gc3(fn($1,$3));}
;
polyType : ALL varids '.' sigType {$$ = gc4(ap(POLYTYPE,
pair(rev($2),$4)));}
| context IMPLIES type {$$ = gc3(qualify($1,$3));}
| bpolyType {$$ = $1;}
;
bpolyType : '(' polyType ')' {$$ = gc3($2);}
;
varids : varids ',' varid {$$ = gc3(cons($3,$1));}
varids : varids varid {$$ = gc2(cons($2,$1));}
| varid {$$ = gc1(singleton($1));}
;
sigType : context IMPLIES type {$$ = gc3(qualify($1,$3));}
......@@ -698,6 +725,13 @@ lacks : varid '\\' varid {
noTREX("a type context");
#endif
}
| IPVARID COCO type {
#if IPARAM
$$ = gc3(pair(mkIParam($1),$3));
#else
noIP("a type context");
#endif
}
;
lacks1 : btypes2 ',' lacks {$$ = gc3(cons($3,$1));}
| lacks1 ',' btype2 {$$ = gc3(cons($3,$1));}
......@@ -735,7 +769,6 @@ atype1 : varid {$$ = $1;}
| '(' tupCommas ')' {$$ = gc3($2);}
| '(' btypes2 ')' {$$ = gc3(buildTuple($2));}
| '(' typeTuple ')' {$$ = gc3(buildTuple($2));}
/*#if TREX*/
| '(' tfields ')' {
#if TREX
$$ = gc3(revOnto($2,typeNoRow));
......@@ -743,11 +776,17 @@ atype1 : varid {$$ = $1;}
noTREX("a type");
#endif
}
| '(' tfields '|' type ')' {$$ = gc5(revOnto($2,$4));}
/*#endif*/
| '(' tfields '|' type ')' {
#if TREX
$$ = gc5(revOnto($2,$4));
#else
noTREX("a type");
#endif
}
| '[' type ']' {$$ = gc3(ap(typeList,$2));}
| '[' ']' {$$ = gc2(typeList);}
| '_' {$$ = gc1(inventVar());}
| '_' {h98DoesntSupport(row,"anonymous type variables");
$$ = gc1(inventVar());}
;
btypes2 : btypes2 ',' btype2 {$$ = gc3(cons($3,$1));}
| btype2 ',' btype2 {$$ = gc3(cons($3,cons($1,NIL)));}
......@@ -761,7 +800,8 @@ typeTuple : type1 ',' type {$$ = gc3(cons($3,cons($1,NIL)));}
tfields : tfields ',' tfield {$$ = gc3(cons($3,$1));}
| tfield {$$ = gc1(singleton($1));}
;
tfield : varid COCO type {$$ = gc3(ap(mkExt(textOf($1)),$3));}
tfield : varid COCO type {h98DoesntSupport(row,"extensible records");
$$ = gc3(ap(mkExt(textOf($1)),$3));}
;
/*#endif*/
......@@ -853,6 +893,7 @@ pat0_vI : pat10_vI {$$ = $1;}
| infixPat {$$ = gc1(ap(INFIX,$1));}
;
infixPat : '-' pat10 {$$ = gc2(ap(NEG,only($2)));}
| '-' error {syntaxError("pattern");}
| var qconop pat10 {$$ = gc3(ap(ap($2,only($1)),$3));}
| var qconop '-' pat10 {$$ = gc4(ap(NEG,ap2($2,only($1),$4)));}
| NUMLIT qconop pat10 {$$ = gc3(ap(ap($2,only($1)),$3));}
......@@ -932,6 +973,13 @@ exp : exp_err {$$ = $1;}
| error {syntaxError("expression");}
;
exp_err : exp0a COCO sigType {$$ = gc3(ap(ESIGN,pair($1,$3)));}
| exp0a WITH dbinds {
#if IPARAM
$$ = gc3(ap(WITHEXP,pair($1,$3)));
#else
noIP("an expression");
#endif
}
| exp0 {$$ = $1;}
;
exp0 : exp0a {$$ = $1;}
......@@ -966,6 +1014,13 @@ exp10b : '\\' pats ARROW exp {$$ = gc4(ap(LAMBDA,
pair($3,$4))));}
| LET decls IN exp {$$ = gc4(letrec($2,$4));}
| IF exp THEN exp ELSE exp {$$ = gc6(ap(COND,triple($2,$4,$6)));}
| DLET dbinds IN exp {
#if IPARAM
$$ = gc4(ap(WITHEXP,pair($4,$2)));
#else
noIP("an expression");
#endif
}
;
pats : pats apat {$$ = gc2(cons($2,$1));}
| apat {$$ = gc1(cons($1,NIL));}
......@@ -976,6 +1031,7 @@ appExp : appExp aexp {$$ = gc2(ap($1,$2));}
aexp : qvar {$$ = $1;}
| qvar '@' aexp {$$ = gc3(ap(ASPAT,pair($1,$3)));}
| '~' aexp {$$ = gc2(ap(LAZYPAT,$2));}
| IPVARID {$$ = $1;}
| '_' {$$ = gc1(WILDCARD);}