1 /**************************************************************************
4 * Author: Maria M. Gutierrez *
5 * Modified by: Kevin Hammond *
6 * Last date revised: December 13 1991. KH. *
7 * Modification: Haskell 1.1 Syntax. *
10 * Description: This file contains the LALR(1) grammar for Haskell. *
12 * Entry Point: module *
14 * Problems: None known. *
17 * LALR(1) Syntax for Haskell 1.2 *
19 **************************************************************************/
31 #include "constants.h"
34 /**********************************************************************
37 * Imported Variables and Functions *
40 **********************************************************************/
42 static BOOLEAN expect_ccurly = FALSE; /* Used to signal that a CCURLY could be inserted here */
45 extern char *input_filename;
46 static char *the_module_name;
47 static maybe module_exports;
50 extern list reverse_list();
53 /* For FN, SAMEFN macros */
55 extern BOOLEAN samefn[];
56 extern short icontexts;
59 extern int hsplineno, hspcolno;
60 extern int modulelineno;
61 extern int startlineno;
64 /**********************************************************************
67 * Fixity and Precedence Declarations *
70 **********************************************************************/
72 static int Fixity = 0, Precedence = 0;
74 char *ineg PROTO((char *));
76 long source_version = 0;
77 BOOLEAN pat_check=TRUE;
103 /**********************************************************************
106 * These are lexemes. *
109 **********************************************************************/
112 %token VARID CONID QVARID QCONID
113 VARSYM CONSYM QVARSYM QCONSYM
115 %token INTEGER FLOAT CHAR STRING
116 CHARPRIM STRINGPRIM INTPRIM FLOATPRIM
121 /**********************************************************************
127 **********************************************************************/
129 %token OCURLY CCURLY VCCURLY
130 %token COMMA SEMI OBRACK CBRACK
131 %token BQUOTE OPAREN CPAREN
132 %token OUNBOXPAREN CUNBOXPAREN
135 /**********************************************************************
138 * Reserved Operators *
141 **********************************************************************/
143 %token DOTDOT DCOLON EQUAL LAMBDA
144 %token VBAR RARROW LARROW
145 %token AT LAZY DARROW
148 /**********************************************************************
151 * Reserved Identifiers *
154 **********************************************************************/
156 %token CASE CLASS DATA
157 %token DEFAULT DERIVING DO
158 %token ELSE IF IMPORT
159 %token IN INFIX INFIXL
160 %token INFIXR INSTANCE LET
161 %token MODULE NEWTYPE OF
162 %token THEN TYPE WHERE
165 %token CCALL CCALL_GC CASM CASM_GC
168 %token EXPORT UNSAFE STDCALL C_CALL LABEL
169 %token PASCAL FASTCALL FOREIGN DYNAMIC
171 /**********************************************************************
174 * Special symbols/identifiers which need to be recognised *
177 **********************************************************************/
179 %token MINUS BANG PLUS
180 %token AS HIDING QUALIFIED
183 /**********************************************************************
186 * Special Symbols for the Lexer *
189 **********************************************************************/
191 %token INTERFACE_UPRAGMA SPECIALISE_UPRAGMA
192 %token INLINE_UPRAGMA NOINLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
194 %token SOURCE_UPRAGMA
196 /**********************************************************************
199 * Precedences of the various tokens *
202 **********************************************************************/
207 SCC CASM CCALL CASM_GC CCALL_GC
209 %left VARSYM CONSYM QVARSYM QCONSYM
210 MINUS BQUOTE BANG DARROW PLUS
216 %left OCURLY OBRACK OPAREN
222 /**********************************************************************
225 * Type Declarations *
228 **********************************************************************/
231 %type <ulist> caserest alts quals
233 rbinds rbinds1 rpats rpats1 list_exps list_rest
235 constrs fields conargatypes
238 pats simple_context simple_context_list
241 impdecls maybeimpdecls impdecl
244 lampats cexps gd texps
245 tyvars1 constr_context forall
249 %type <ugrhsb> valrhs altrhs
251 %type <umaybe> maybeexports impspec deriving
252 ext_name opt_sig opt_asig
254 %type <uliteral> lit_constant
256 %type <utree> exp oexp dexp kexp fexp aexp rbind
257 expL oexpL kexpL expLno oexpLno dexpLno kexpLno
258 funlhs funlhs1 funlhs2 funlhs3 qual leftexp
259 pat dpat cpat bpat apat apatc conpat rpat
260 patk bpatk apatck conpatk
263 %type <uid> MINUS PLUS DARROW AS LAZY
264 VARID CONID VARSYM CONSYM
265 var con varop conop op
266 vark varid varsym varsym_nominus
267 tycon modid ccallid tyvar
270 %type <uqid> QVARID QCONID QVARSYM QCONSYM
271 qvarid qconid qvarsym qconsym
272 qvar qcon qvarop qconop qop
273 qvark qconk qtycon qtycls
274 gcon gconk gtycon itycon qop1 qvarop1
277 %type <ubinding> topdecl topdecls letdecls
278 typed datad newtd classd instd defaultd foreignd
279 decl decls fixdecl fix_op fix_ops valdef
280 maybe_where with_where where_body type_and_maybe_id
282 %type <uttype> polytype
283 conargatype conapptype
287 simple_con_app simple_con_app1 inst_type
289 %type <uconstr> constr constr_after_context field constr1
291 %type <ustring> FLOAT INTEGER INTPRIM
292 FLOATPRIM DOUBLEPRIM CLITLIT
294 %type <uhstring> STRING STRINGPRIM CHAR CHARPRIM
296 %type <uentid> export import
298 %type <ulong> commas importkey get_line_no
301 /**********************************************************************
304 * Start Symbol for the Parser *
307 **********************************************************************/
312 module : modulekey modid maybeexports
314 modulelineno = startlineno;
315 the_module_name = $2;
321 the_module_name = install_literal("Main");
322 module_exports = mknothing();
327 body : ocurly { setstartlineno(); } main_body ccurly
328 | vocurly main_body vccurly
331 main_body : interface_pragma maybeimpdecls topdecls
333 root = mkhmodule(the_module_name, $2, module_exports,
334 $3, source_version,modulelineno);
336 | interface_pragma impdecls
338 root = mkhmodule(the_module_name, $2, module_exports,
339 mknullbind(), source_version, modulelineno);
342 interface_pragma : /* empty */
343 | INTERFACE_UPRAGMA INTEGER END_UPRAGMA SEMI
345 source_version = atoi($2);
349 maybeexports : /* empty */ { $$ = mknothing(); }
350 | OPAREN export_list CPAREN { $$ = mkjust($2); }
351 | OPAREN export_list COMMA CPAREN { $$ = mkjust($2); }
355 export { $$ = lsing($1); }
356 | export_list COMMA export { $$ = lapp($1, $3); }
359 export : qvar { $$ = mkentid($1); }
360 | gtycon { $$ = mkenttype($1); }
361 | gtycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); }
362 | gtycon OPAREN CPAREN { $$ = mkenttypenamed($1,Lnil); }
363 | gtycon OPAREN enames CPAREN { $$ = mkenttypenamed($1,$3); }
364 | MODULE modid { $$ = mkentmod($2); }
367 enames : ename { $$ = lsing($1); }
368 | enames COMMA ename { $$ = lapp($1,$3); }
375 maybeimpdecls : /* empty */ { $$ = Lnil; }
376 | impdecls SEMI { $$ = $1; }
379 impdecls: impdecl { $$ = $1; }
380 | impdecls SEMI impdecl { $$ = lconc($1,$3); }
384 impdecl : importkey modid impspec
385 { $$ = lsing(mkimport($2,0,mknothing(),$3,$1,startlineno)); }
386 | importkey QUALIFIED modid impspec
387 { $$ = lsing(mkimport($3,1,mknothing(),$4,$1,startlineno)); }
388 | importkey QUALIFIED modid AS modid impspec
389 { $$ = lsing(mkimport($3,1,mkjust($5),$6,$1,startlineno)); }
390 | importkey modid AS modid impspec
391 { $$ = lsing(mkimport($3,1,mkjust($4),$5,$1,startlineno)); }
394 impspec : /* empty */ { $$ = mknothing(); }
395 | OPAREN CPAREN { $$ = mkjust(mkleft(Lnil)); }
396 | OPAREN import_list CPAREN { $$ = mkjust(mkleft($2)); }
397 | OPAREN import_list COMMA CPAREN { $$ = mkjust(mkleft($2)); }
398 | HIDING OPAREN CPAREN { $$ = mkjust(mkright(Lnil)); }
399 | HIDING OPAREN import_list CPAREN { $$ = mkjust(mkright($3)); }
400 | HIDING OPAREN import_list COMMA CPAREN { $$ = mkjust(mkright($3)); }
404 import { $$ = lsing($1); }
405 | import_list COMMA import { $$ = lapp($1, $3); }
408 import : var { $$ = mkentid(mknoqual($1)); }
409 | itycon { $$ = mkenttype($1); }
410 | itycon OPAREN DOTDOT CPAREN { $$ = mkenttypeall($1); }
411 | itycon OPAREN CPAREN { $$ = mkenttypenamed($1,Lnil);}
412 | itycon OPAREN inames CPAREN { $$ = mkenttypenamed($1,$3); }
415 itycon : tycon { $$ = mknoqual($1); }
416 | OBRACK CBRACK { $$ = creategid(NILGID); }
417 | OPAREN CPAREN { $$ = creategid(UNITGID); }
418 | OPAREN commas CPAREN { $$ = creategid($2); }
421 inames : iname { $$ = lsing($1); }
422 | inames COMMA iname { $$ = lapp($1,$3); }
424 iname : var { $$ = mknoqual($1); }
425 | con { $$ = mknoqual($1); }
428 /**********************************************************************
431 * Fixes and Decls etc *
434 **********************************************************************/
437 | topdecls SEMI { $$ = $1; }
438 | topdecls SEMI topdecl
457 topdecl : typed { $$ = $1; FN = NULL; SAMEFN = 0; }
458 | datad { $$ = $1; FN = NULL; SAMEFN = 0; }
459 | newtd { $$ = $1; FN = NULL; SAMEFN = 0; }
460 | classd { $$ = $1; FN = NULL; SAMEFN = 0; }
461 | instd { $$ = $1; FN = NULL; SAMEFN = 0; }
462 | defaultd { $$ = $1; FN = NULL; SAMEFN = 0; }
463 | foreignd { $$ = $1; FN = NULL; SAMEFN = 0; }
467 typed : typekey simple_con_app EQUAL tautype { $$ = mknbind($2,$4,startlineno); }
471 datad : datakey simple_con_app EQUAL constrs deriving
472 { $$ = mktbind(Lnil,$2,$4,$5,startlineno); }
473 | datakey simple_context DARROW simple_con_app EQUAL constrs deriving
474 { $$ = mktbind($2,$4,$6,$7,startlineno); }
477 newtd : newtypekey simple_con_app EQUAL constr1 deriving
478 { $$ = mkntbind(Lnil,$2,lsing($4),$5,startlineno); }
479 | newtypekey simple_context DARROW simple_con_app EQUAL constr1 deriving
480 { $$ = mkntbind($2,$4,lsing($6),$7,startlineno); }
483 deriving: /* empty */ { $$ = mknothing(); }
484 | DERIVING dtyclses { $$ = mkjust($2); }
487 classd : classkey apptype DARROW simple_con_app1 maybe_where
488 /* Context can now be more than simple_context */
489 { $$ = mkcbind(type2context($2),$4,$5,startlineno); }
490 | classkey apptype maybe_where
491 /* We have to say apptype rather than simple_con_app1, else
492 we get reduce/reduce errs */
493 { check_class_decl_head($2);
494 $$ = mkcbind(Lnil,$2,$3,startlineno); }
497 instd : instkey inst_type maybe_where { $$ = mkibind($2,$3,startlineno); }
500 /* Compare polytype */
501 /* [July 98: first production was tautype DARROW tautype, but I can't see why.] */
502 inst_type : apptype DARROW apptype { is_context_format( $3, 0 ); /* Check the instance head */
503 $$ = mkforall(Lnil,type2context($1),$3); }
504 | apptype { is_context_format( $1, 0 ); /* Check the instance head */
509 defaultd: defaultkey OPAREN tautypes CPAREN { $$ = mkdbind($3,startlineno); }
510 | defaultkey OPAREN CPAREN { $$ = mkdbind(Lnil,startlineno); }
513 /* FFI primitive declarations - GHC/Hugs specific */
514 foreignd: foreignkey IMPORT callconv ext_name unsafe_flag qvarid DCOLON tautype
515 { $$ = mkfobind($6,$8,$4,$5,$3,FOREIGN_IMPORT,startlineno); }
516 | foreignkey EXPORT callconv ext_name qvarid DCOLON tautype
517 { $$ = mkfobind($5,$7,$4,0,$3,FOREIGN_EXPORT,startlineno); }
518 | foreignkey LABEL ext_name qvarid DCOLON tautype
519 { $$ = mkfobind($4,$6,$3,0,-1,FOREIGN_LABEL,startlineno); }
522 callconv: STDCALL { $$ = CALLCONV_STDCALL; }
523 | C_CALL { $$ = CALLCONV_CCALL; }
524 | PASCAL { $$ = CALLCONV_PASCAL; }
525 | FASTCALL { $$ = CALLCONV_FASTCALL; }
526 /* If you leave out the specification of a calling convention, you'll (probably) get C's. */
527 | /*empty*/ { $$ = CALLCONV_NONE; }
530 ext_name: STRING { $$ = mkjust(lsing($1)); }
531 | STRING STRING { $$ = mkjust(mklcons ($1,lsing($2))); }
532 | DYNAMIC { $$ = mknothing(); }
534 unsafe_flag: UNSAFE { $$ = 1; }
535 | /*empty*/ { $$ = 0; }
539 | decls SEMI { $$ = $1; }
553 Note: if there is an iclasop_pragma here, then we must be
554 doing a class-op in an interface -- unless the user is up
555 to real mischief (ugly, but likely to work).
560 | qvarsk DCOLON polytype
561 { $$ = mksbind($1,$3,startlineno);
562 FN = NULL; SAMEFN = 0;
565 | qvark DCOLON polytype
566 { $$ = mksbind(lsing($1),$3,startlineno);
567 FN = NULL; SAMEFN = 0;
570 /* User-specified pragmas come in as "signatures"...
571 They are similar in that they can appear anywhere in the module,
572 and have to be "joined up" with their related entity.
574 Have left out the case specialising to an overloaded type.
575 Let's get real, OK? (WDP)
577 | SPECIALISE_UPRAGMA qvark DCOLON types_and_maybe_ids END_UPRAGMA
579 $$ = mkvspec_uprag($2, $4, startlineno);
580 FN = NULL; SAMEFN = 0;
583 | SPECIALISE_UPRAGMA INSTANCE gtycon atype END_UPRAGMA
585 $$ = mkispec_uprag($3, $4, startlineno);
586 FN = NULL; SAMEFN = 0;
589 | SPECIALISE_UPRAGMA DATA gtycon atypes END_UPRAGMA
591 $$ = mkdspec_uprag($3, $4, startlineno);
592 FN = NULL; SAMEFN = 0;
595 | INLINE_UPRAGMA qvark END_UPRAGMA
597 $$ = mkinline_uprag($2, startlineno);
598 FN = NULL; SAMEFN = 0;
601 | NOINLINE_UPRAGMA qvark END_UPRAGMA
603 $$ = mknoinline_uprag($2, startlineno);
604 FN = NULL; SAMEFN = 0;
607 | MAGIC_UNFOLDING_UPRAGMA qvark vark END_UPRAGMA
609 $$ = mkmagicuf_uprag($2, $3, startlineno);
610 FN = NULL; SAMEFN = 0;
613 /* end of user-specified pragmas */
618 fixdecl : INFIXL INTEGER { Precedence = checkfixity($2); Fixity = INFIXL; }
620 | INFIXR INTEGER { Precedence = checkfixity($2); Fixity = INFIXR; }
622 | INFIX INTEGER { Precedence = checkfixity($2); Fixity = INFIX; }
624 | INFIXL { Fixity = INFIXL; Precedence = 9; }
626 | INFIXR { Fixity = INFIXR; Precedence = 9; }
628 | INFIX { Fixity = INFIX; Precedence = 9; }
632 /* Grotesque global-variable hack to
633 make a separate fixity decl for each op */
635 | fix_ops COMMA fix_op { $$ = mkabind($1,$3); }
638 fix_op : op { $$ = mkfixd(mknoqual($1),infixint(Fixity),Precedence,startlineno); }
641 qvarsk : qvark COMMA qvars_list { $$ = mklcons($1,$3); }
644 qvars_list: qvar { $$ = lsing($1); }
645 | qvars_list COMMA qvar { $$ = lapp($1,$3); }
648 types_and_maybe_ids :
649 type_and_maybe_id { $$ = lsing($1); }
650 | types_and_maybe_ids COMMA type_and_maybe_id { $$ = lapp($1,$3); }
654 tautype { $$ = mkvspec_ty_and_id($1,mknothing()); }
655 | tautype EQUAL qvark { $$ = mkvspec_ty_and_id($1,mkjust($3)); }
658 /**********************************************************************
664 **********************************************************************/
666 /* "DCOLON context => tautype" vs "DCOLON tautype" is a problem,
667 because you can't distinguish between
669 foo :: (Baz a, Baz a)
670 bar :: (Baz a, Baz a) => [a] -> [a] -> [a]
672 with one token of lookahead. The HACK is to have "DCOLON apptype"
673 in the first case, then check that it has the right
674 form C a, or (C1 a, C2 b, ... Cn z) and convert it into a
678 /* --------------------------- */
683 polytype : FORALL tyvars1 DOT
684 apptype DARROW tautype { $$ = mkforall($2, type2context($4), $6); }
685 | FORALL tyvars1 DOT tautype { $$ = mkforall($2, Lnil, $4); }
686 | apptype DARROW tautype { $$ = mkforall(Lnil, type2context($1), $3); }
690 /* --------------------------- */
691 /* tautype is just a monomorphic type.
692 But it may have nested for-alls if we're in a rank-2 type */
694 tautype : apptype RARROW tautype { $$ = mktfun($1,$3); }
695 | apptype { $$ = $1; }
698 tautypes : tautype { $$ = lsing($1); }
699 | tautypes COMMA tautype { $$ = lapp($1,$3); }
702 /* --------------------------- */
703 /* apptype: type application */
705 apptype : apptype atype { $$ = mktapp($1,$2); }
709 /* --------------------------- */
710 /* atype: an atomic or bracketed type: T, x, [ty], tuple ty */
712 atypes : atype { $$ = lsing($1); }
713 | atype atypes { $$ = mklcons($1,$2); }
716 atype : gtycon { $$ = mktname($1); }
717 | tyvar { $$ = mknamedtvar($1); }
719 | OPAREN tautype COMMA
720 tautypes CPAREN { $$ = mkttuple(mklcons($2,$4)); }
722 | OUNBOXPAREN tautype COMMA
723 tautypes CUNBOXPAREN { $$ = mktutuple(mklcons($2,$4)); }
725 | OBRACK tautype CBRACK { $$ = mktllist($2); }
726 | OPAREN polytype CPAREN { $$ = $2; }
729 /* --------------------------- */
731 | OPAREN RARROW CPAREN { $$ = creategid(ARROWGID); }
732 | OBRACK CBRACK { $$ = creategid(NILGID); }
733 | OPAREN CPAREN { $$ = creategid(UNITGID); }
734 | OPAREN commas CPAREN { $$ = creategid($2); }
737 commas : COMMA { $$ = 1; }
738 | commas COMMA { $$ = $1 + 1; }
741 /**********************************************************************
744 * Declaration stuff *
747 **********************************************************************/
749 /* C a b c, where a,b,c are type variables */
750 /* C can be a class or tycon */
752 /* simple_con_app can have no args; simple_con_app1 must have at least one */
753 simple_con_app: gtycon { $$ = mktname($1); }
754 | simple_con_app1 { $$ = $1; }
757 simple_con_app1: gtycon tyvar { $$ = mktapp(mktname($1),mknamedtvar($2)); }
758 | simple_con_app1 tyvar { $$ = mktapp($1, mknamedtvar($2)); }
761 simple_context : OPAREN simple_context_list CPAREN { $$ = $2; }
762 | OPAREN CPAREN { $$ = Lnil; }
763 | simple_con_app1 { $$ = lsing($1); }
766 simple_context_list : simple_con_app1 { $$ = lsing($1); }
767 | simple_context_list COMMA simple_con_app1 { $$ = lapp($1,$3); }
770 constrs : constr { $$ = lsing($1); }
771 | constrs VBAR constr { $$ = lapp($1,$3); }
774 constr : forall constr_context DARROW constr_after_context { $$ = mkconstrex ( $1, $2, $4 ); }
775 | forall constr_after_context { $$ = mkconstrex ( $1, Lnil, $2 ); }
778 forall : { $$ = Lnil }
779 | FORALL tyvars1 DOT { $$ = $2; }
783 : conapptype conargatype { $$ = type2context( mktapp($1,$2) ); }
784 | conargatype { $$ = type2context( $1 ); }
787 constr_after_context :
789 /* We have to parse the constructor application as a *type*, else we get
790 into terrible ambiguity problems. Consider the difference between
792 data T = S Int Int Int `R` Int
794 data T = S Int Int Int
796 It isn't till we get to the operator that we discover that the "S" is
797 part of a type in the first, but part of a constructor application in the
801 /* Con !Int (Tree a) */
802 conapptype { qid tyc; list tys;
803 splittyconapp($1, &tyc, &tys);
804 $$ = mkconstrpre(tyc,tys,hsplineno); }
806 /* (::) (Tree a) Int */
807 | OPAREN qconsym CPAREN conargatypes { $$ = mkconstrpre($2,$4,hsplineno); }
809 /* !Int `Con` Tree a */
810 | conargatype qconop conargatype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
812 /* Con { op1 :: Int } */
813 | qtycon OCURLY CCURLY { $$ = mkconstrrec($1,Lnil,hsplineno); }
814 | qtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); }
815 | OPAREN qconsym CPAREN OCURLY fields CCURLY { $$ = mkconstrrec($2,$5,hsplineno); }
817 /* 1 S/R conflict on OCURLY -> shift */
820 conapptype : gtycon { $$ = mktname($1); }
821 | conapptype conargatype { $$ = mktapp($1, $2); }
824 conargatype : polyatype { $$ = $1; }
825 | BANG polyatype { $$ = mktbang( $2 ); }
828 conargatypes : { $$ = Lnil; }
829 | conargatype conargatypes { $$ = mklcons($1,$2); }
832 fields : field { $$ = lsing($1); }
833 | fields COMMA field { $$ = lapp($1,$3); }
836 field : qvars_list DCOLON polytype { $$ = mkfield($1,$3); }
837 | qvars_list DCOLON BANG polyatype { $$ = mkfield($1,mktbang($4)); }
840 constr1 : gtycon conargatype { $$ = mkconstrnew($1,$2,mknothing(),hsplineno); }
841 | gtycon OCURLY qvar DCOLON polytype CCURLY { $$ = mkconstrnew($1,$5,mkjust($3),hsplineno); }
845 dtyclses: OPAREN dtycls_list CPAREN { $$ = $2; }
846 | OPAREN CPAREN { $$ = Lnil; }
847 | qtycls { $$ = lsing($1); }
850 dtycls_list: qtycls { $$ = lsing($1); }
851 | dtycls_list COMMA qtycls { $$ = lapp($1,$3); }
854 valdef : funlhs opt_sig { checksamefn($1); }
855 get_line_no valrhs { $$ = mkfbind( lsing(mkpmatch( lsing($1), $2, $5 )), $4); }
857 /* Special case for f :: type = e
858 We treat it as a special kind of pattern binding */
859 | qvark DCOLON tautype
860 get_line_no valrhs { $$ = mkpbind( mkrestr( mkident($1), $3 ), $5, $4 );
861 FN = NULL; SAMEFN = 0; }
864 get_line_no valrhs { $$ = mkpbind($1, $3, $2);
865 FN = NULL; SAMEFN = 0; }
867 get_line_no : { $$ = hsplineno; /* startlineno; */ }
869 /* This grammar still isn't quite right
872 you should get a function binding, but actually the (x+3) will
873 parse as a pattern, and you'll get a parse error. */
875 funlhs : patk qvarop cpat { $$ = mkinfixap($2,$1,$3); }
876 | funlhs1 apat { $$ = mkap( $1, $2 ); }
878 funlhs1 : oparenkey funlhs2 CPAREN { $$ = mkpar($2); }
879 | funlhs1 apat { $$ = mkap( $1, $2 ); }
880 | qvark { $$ = mkident($1); }
883 funlhs2 : cpat qvarop cpat { $$ = mkinfixap($2,$1,$3); }
884 | funlhs3 apat { $$ = mkap( $1, $2 ); }
886 funlhs3 : OPAREN funlhs2 CPAREN { $$ = mkpar($2); }
887 | funlhs3 apat { $$ = mkap( $1, $2 ); }
888 | qvar { $$ = mkident($1); }
891 opt_sig : { $$ = mknothing(); }
892 | DCOLON tautype { $$ = mkjust($2); }
895 /* opt_asig is the same, but with a parenthesised type */
896 opt_asig : { $$ = mknothing(); }
897 | DCOLON atype { $$ = mkjust($2); }
900 valrhs : EQUAL get_line_no exp maybe_where { $$ = mkpnoguards($2, $3, $4); }
901 | gdrhs maybe_where { $$ = mkpguards($1, $2); }
904 gdrhs : gd EQUAL get_line_no exp { $$ = lsing(mkpgdexp($1,$3,$4)); }
905 | gd EQUAL get_line_no exp gdrhs { $$ = mklcons(mkpgdexp($1,$3,$4),$5); }
908 maybe_where: /* empty */ { $$ = mknullbind(); }
909 | WHERE with_where { $$ = $2; }
912 with_where : /* empty */ { $$ = mknullbind(); }
913 | where_body { $$ = $1; }
916 where_body : ocurly decls ccurly { $$ = $2; }
917 | vocurly decls vccurly { $$ = $2; }
918 | ocurly ccurly { $$ = mknullbind(); }
921 gd : VBAR quals { $$ = $2; }
925 /**********************************************************************
931 **********************************************************************/
933 exp : oexp DCOLON polytype { $$ = mkrestr($1,$3); }
938 Operators must be left-associative at the same precedence for
939 precedence parsing to work.
941 /* 10 S/R conflicts on qop -> shift */
942 oexp : oexp qop dexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
947 This comes here because of the funny precedence rules concerning
950 dexp : MINUS kexp { $$ = mknegate($2); }
955 We need to factor out a leading let expression so we can set
956 pat_check=FALSE when parsing (non let) expressions inside stmts and quals
958 expLno : oexpLno DCOLON polytype { $$ = mkrestr($1,$3); }
961 oexpLno : oexpLno qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
964 dexpLno : MINUS kexp { $$ = mknegate($2); }
968 expL : oexpL DCOLON polytype { $$ = mkrestr($1,$3); }
971 oexpL : oexpL qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
976 let/if/lambda/case have higher precedence than infix operators.
983 /* kexpL = a let expression */
984 kexpL : letdecls IN exp { $$ = mklet($1,$3); }
987 /* kexpLno = any other expression more tightly binding than operator application */
989 { hsincindent(); /* push new context for FN = NULL; */
990 FN = NULL; /* not actually concerned about indenting */
995 RARROW get_line_no exp /* lambda abstraction */
996 { $$ = mklambda( mkpmatch( $3, $4, mkpnoguards( $7, $8, mknullbind() ) ) ); }
999 | IF {$<ulong>$ = hsplineno;}
1000 exp THEN exp ELSE exp { $$ = mkife($3,$5,$7,$<ulong>2); }
1002 /* Case Expression */
1003 | CASE {$<ulong>$ = hsplineno;}
1004 exp OF caserest { $$ = mkcasee($3,$5,$<ulong>2); }
1007 | DO {$<ulong>$ = hsplineno;}
1008 dorest { $$ = mkdoe($3,$<ulong>2); }
1010 /* CCALL/CASM Expression */
1011 | CCALL ccallid cexps { $$ = mkccall($2,install_literal("n"),$3); }
1012 | CCALL ccallid { $$ = mkccall($2,install_literal("n"),Lnil); }
1013 | CCALL_GC ccallid cexps { $$ = mkccall($2,install_literal("p"),$3); }
1014 | CCALL_GC ccallid { $$ = mkccall($2,install_literal("p"),Lnil); }
1015 | CASM CLITLIT cexps { $$ = mkccall($2,install_literal("N"),$3); }
1016 | CASM CLITLIT { $$ = mkccall($2,install_literal("N"),Lnil); }
1017 | CASM_GC CLITLIT cexps { $$ = mkccall($2,install_literal("P"),$3); }
1018 | CASM_GC CLITLIT { $$ = mkccall($2,install_literal("P"),Lnil); }
1020 /* SCC Expression */
1025 "\"%s\":%d: _scc_ (`set [profiling] cost centre') ignored\n",
1026 input_filename, hsplineno);
1028 $$ = mkpar($3); /* Note the mkpar(). If we don't have it, then
1029 (x >> _scc_ y >> z) parses as (x >> (y >> z)),
1030 right associated. But the precedence reorganiser expects
1031 the parser to *left* associate all operators unless there
1032 are explicit parens. The _scc_ acts like an explicit paren,
1033 so if we omit it we'd better add explicit parens instead. */
1041 fexp : fexp aexp { $$ = mkap($1,$2); }
1045 /* simple expressions */
1046 aexp : qvar { $$ = mkident($1); }
1047 | gcon { $$ = mkident($1); }
1048 | lit_constant { $$ = mklit($1); }
1049 | OPAREN exp CPAREN { $$ = mkpar($2); } /* mkpar: stop infix parsing at ()'s */
1050 | qcon OCURLY rbinds CCURLY { $$ = mkrecord($1,$3); } /* 1 S/R conflict on OCURLY -> shift */
1051 | OBRACK list_exps CBRACK { $$ = mkllist($2); }
1052 | OPAREN exp COMMA texps CPAREN { $$ = mktuple(mklcons($2,$4)); }
1053 /* unboxed tuples */
1054 | OUNBOXPAREN exp COMMA texps CUNBOXPAREN
1055 { $$ = mkutuple(mklcons($2,$4)); }
1057 /* only in expressions ... */
1058 | aexp OCURLY rbinds1 CCURLY { $$ = mkrupdate($1,$3); }
1059 | OBRACK exp VBAR quals CBRACK { $$ = mkcomprh($2,$4); }
1060 | OBRACK exp COMMA exp DOTDOT exp CBRACK {$$= mkeenum($2,mkjust($4),mkjust($6)); }
1061 | OBRACK exp COMMA exp DOTDOT CBRACK { $$ = mkeenum($2,mkjust($4),mknothing()); }
1062 | OBRACK exp DOTDOT exp CBRACK { $$ = mkeenum($2,mknothing(),mkjust($4)); }
1063 | OBRACK exp DOTDOT CBRACK { $$ = mkeenum($2,mknothing(),mknothing()); }
1064 | OPAREN oexp qop CPAREN { $$ = mklsection($2,$3); }
1065 | OPAREN qop1 oexp CPAREN { $$ = mkrsection($2,$3); }
1067 /* only in patterns ... */
1068 /* these add 2 S/R conflict with with aexp . OCURLY rbinds CCURLY */
1069 | qvar AT aexp { checkinpat(); $$ = mkas($1,$3); }
1070 | LAZY aexp { checkinpat(); $$ = mklazyp($2); }
1073 /* ccall arguments */
1074 cexps : cexps aexp { $$ = lapp($1,$2); }
1075 | aexp { $$ = lsing($1); }
1078 caserest: ocurly alts ccurly { $$ = $2; }
1079 | vocurly alts vccurly { $$ = $2; }
1081 dorest : ocurly stmts ccurly { checkdostmts($2); $$ = $2; }
1082 | vocurly stmts vccurly { checkdostmts($2); $$ = $2; }
1085 rbinds : /* empty */ { $$ = Lnil; }
1089 rbinds1 : rbind { $$ = lsing($1); }
1090 | rbinds1 COMMA rbind { $$ = lapp($1,$3); }
1093 rbind : qvar EQUAL exp { $$ = mkrbind($1,mkjust($3)); }
1096 texps : exp { $$ = lsing($1); }
1097 | exp COMMA texps { $$ = mklcons($1, $3) }
1098 /* right recursion? WDP */
1102 exp { $$ = lsing($1); }
1103 | exp COMMA exp { $$ = mklcons( $1, lsing($3) ); }
1104 | exp COMMA exp COMMA list_rest { $$ = mklcons( $1, mklcons( $3, reverse_list( $5 ))); }
1107 /* Use left recusion for list_rest, because we sometimes get programs with
1108 very long explicit lists. */
1109 list_rest : exp { $$ = lsing($1); }
1110 | list_rest COMMA exp { $$ = mklcons( $3, $1 ); }
1114 exp { $$ = lsing($1); }
1115 | exp COMMA list_exps { $$ = mklcons($1, $3); }
1117 /* right recursion? (WDP)
1119 It has to be this way, though, otherwise you
1120 may do the wrong thing to distinguish between...
1122 [ e1 , e2 .. ] -- an enumeration ...
1123 [ e1 , e2 , e3 ] -- a list
1125 (In fact, if you change the grammar and throw yacc/bison
1126 at it, it *will* do the wrong thing [WDP 94/06])
1129 letdecls: LET { pat_check = TRUE; } ocurly decls ccurly { $$ = $4; }
1130 | LET { pat_check = TRUE; } vocurly decls vccurly { $$ = $4; }
1134 When parsing patterns inside do stmt blocks or quals, we have
1135 to tentatively parse them as expressions, since we don't know at
1136 the time of parsing `p' whether it will be part of "p <- e" (pat)
1137 or "p" (expr). When we eventually can tell the difference, the parse
1138 of `p' is examined to see if it consitutes a syntactically legal pattern
1141 The expr rule used to parse the pattern/expression do contain
1142 pattern-special productions (e.g., _ , a@pat, etc.), which are
1143 illegal in expressions. Since we don't know whether what
1144 we're parsing is an expression rather than a pattern, we turn off
1145 the check and instead do it later.
1147 The rather clumsy way that this check is turned on/off is there
1148 to work around a Bison feature/shortcoming. Turning the flag
1149 on/off just around the relevant nonterminal by decorating it
1150 with simple semantic actions, e.g.,
1152 {pat_check = FALSE; } expLNo { pat_check = TRUE; }
1154 causes Bison to generate a parser where in one state it either
1155 has to reduce/perform a semantic action ( { pat_check = FALSE; })
1156 or reduce an error (the error production used to implement
1157 vccurly.) Bison picks the semantic action, which it ideally shouldn't.
1158 The work around is to lift out the setting of { pat_check = FALSE; }
1159 and then later reset pat_check. Not pretty.
1164 quals : { pat_check = FALSE;} qual { pat_check = TRUE; $$ = lsing($2); }
1165 | quals COMMA { pat_check = FALSE; } qual { pat_check = TRUE; $$ = lapp($1,$4); }
1168 qual : letdecls { $$ = mkseqlet($1); }
1169 | expL { expORpat(LEGIT_EXPR,$1); $$ = $1; }
1170 | expLno { pat_check = TRUE; } leftexp
1172 expORpat(LEGIT_EXPR,$1);
1175 expORpat(LEGIT_PATT,$1);
1181 alts : /* empty */ { $$ = Lnil; }
1182 | alt { $$ = lsing($1); }
1183 | alt SEMI alts { $$ = mklcons($1,$3); }
1184 | SEMI alts { $$ = $2; }
1187 alt : dpat opt_sig altrhs { $$ = mkpmatch( lsing($1), $2, $3 ); }
1190 altrhs : RARROW get_line_no exp maybe_where { $$ = mkpnoguards($2, $3, $4); }
1191 | gdpat maybe_where { $$ = mkpguards($1, $2); }
1194 gdpat : gd RARROW get_line_no exp { $$ = lsing(mkpgdexp($1,$3,$4)); }
1195 | gd RARROW get_line_no exp gdpat { $$ = mklcons(mkpgdexp($1,$3,$4),$5); }
1198 stmts : {pat_check = FALSE;} stmt {pat_check=TRUE; $$ = $2; }
1199 | stmts SEMI {pat_check=FALSE;} stmt {pat_check=TRUE; $$ = lconc($1,$4); }
1202 stmt : /* empty */ { $$ = Lnil; }
1203 | letdecls { $$ = lsing(mkseqlet($1)); }
1204 | expL { expORpat(LEGIT_EXPR,$1); $$ = lsing(mkdoexp($1,hsplineno)); }
1205 | expLno {pat_check=TRUE;} leftexp
1207 expORpat(LEGIT_EXPR,$1);
1208 $$ = lsing(mkdoexp($1,endlineno));
1210 expORpat(LEGIT_PATT,$1);
1211 $$ = lsing(mkdobind($1,$3,endlineno));
1217 leftexp : LARROW exp { $$ = $2; }
1218 | /* empty */ { $$ = NULL; }
1221 /**********************************************************************
1227 **********************************************************************/
1229 pat : dpat DCOLON tautype { $$ = mkrestr($1,$3); }
1233 dpat : qvar PLUS INTEGER { $$ = mkplusp($1, mkinteger($3)); }
1237 cpat : cpat qconop bpat { $$ = mkinfixap($2,$1,$3); }
1243 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1244 | MINUS INTEGER { $$ = mknegate(mklit(mkinteger($2))); }
1245 | MINUS FLOAT { $$ = mknegate(mklit(mkfloatr($2))); }
1248 conpat : gcon { $$ = mkident($1); }
1249 | conpat apat { $$ = mkap($1,$2); }
1252 apat : gcon { $$ = mkident($1); }
1253 | qcon OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1257 apatc : qvar { $$ = mkident($1); }
1258 | qvar AT apat { $$ = mkas($1,$3); }
1259 | lit_constant { $$ = mklit($1); }
1260 | OPAREN pat CPAREN { $$ = mkpar($2); }
1261 | OPAREN pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1262 | OUNBOXPAREN pat COMMA pats CUNBOXPAREN { $$ = mkutuple(mklcons($2,$4)); }
1263 | OBRACK pats CBRACK { $$ = mkllist($2); }
1264 | LAZY apat { $$ = mklazyp($2); }
1268 INTEGER { $$ = mkinteger($1); }
1269 | FLOAT { $$ = mkfloatr($1); }
1270 | CHAR { $$ = mkcharr($1); }
1271 | STRING { $$ = mkstring($1); }
1272 | CHARPRIM { $$ = mkcharprim($1); }
1273 | STRINGPRIM { $$ = mkstringprim($1); }
1274 | INTPRIM { $$ = mkintprim($1); }
1275 | FLOATPRIM { $$ = mkfloatprim($1); }
1276 | DOUBLEPRIM { $$ = mkdoubleprim($1); }
1277 | CLITLIT /* yurble yurble */ { $$ = mkclitlit($1); }
1280 /* Sequence of apats for a lambda abstraction */
1281 lampats : apat lampats { $$ = mklcons($1,$2); }
1282 | apat { $$ = lsing($1); }
1283 /* right recursion? (WDP) */
1286 /* Comma-separated sequence of pats */
1287 pats : pat COMMA pats { $$ = mklcons($1, $3); }
1288 | pat { $$ = lsing($1); }
1289 /* right recursion? (WDP) */
1292 /* Comma separated sequence of record patterns, each of form 'field=pat' */
1293 rpats : /* empty */ { $$ = Lnil; }
1297 rpats1 : rpat { $$ = lsing($1); }
1298 | rpats1 COMMA rpat { $$ = lapp($1,$3); }
1301 rpat : qvar EQUAL pat { $$ = mkrbind($1,mkjust($3)); }
1305 /* I can't figure out just what these ...k patterns are for.
1306 It seems to have something to do with recording the line number */
1308 /* Corresponds to a cpat */
1309 patk : patk qconop bpat { $$ = mkinfixap($2,$1,$3); }
1315 | qconk OCURLY rpats CCURLY { $$ = mkrecord($1,$3); }
1316 | minuskey INTEGER { $$ = mknegate(mklit(mkinteger($2))); }
1317 | minuskey FLOAT { $$ = mknegate(mklit(mkfloatr($2))); }
1320 conpatk : gconk { $$ = mkident($1); }
1321 | conpatk apat { $$ = mkap($1,$2); }
1324 apatck : qvark { $$ = mkident($1); }
1325 | qvark AT apat { $$ = mkas($1,$3); }
1326 | lit_constant { $$ = mklit($1); setstartlineno(); }
1327 | oparenkey pat CPAREN { $$ = mkpar($2); }
1328 | oparenkey pat COMMA pats CPAREN { $$ = mktuple(mklcons($2,$4)); }
1329 | ounboxparenkey pat COMMA pats CUNBOXPAREN
1330 { $$ = mkutuple(mklcons($2,$4)); }
1331 | obrackkey pats CBRACK { $$ = mkllist($2); }
1332 | lazykey apat { $$ = mklazyp($2); }
1337 | OBRACK CBRACK { $$ = creategid(NILGID); }
1338 | OPAREN CPAREN { $$ = creategid(UNITGID); }
1339 | OPAREN commas CPAREN { $$ = creategid($2); }
1343 | obrackkey CBRACK { $$ = creategid(NILGID); }
1344 | oparenkey CPAREN { $$ = creategid(UNITGID); }
1345 | oparenkey commas CPAREN { $$ = creategid($2); }
1348 /**********************************************************************
1351 * Keywords which record the line start *
1354 **********************************************************************/
1356 importkey: IMPORT { setstartlineno(); $$ = 0; }
1357 | IMPORT SOURCE_UPRAGMA { setstartlineno(); $$ = 1; }
1360 datakey : DATA { setstartlineno();
1363 printf("%u\n",startlineno);
1365 fprintf(stderr,"%u\tdata\n",startlineno);
1370 typekey : TYPE { setstartlineno();
1373 printf("%u\n",startlineno);
1375 fprintf(stderr,"%u\ttype\n",startlineno);
1380 newtypekey : NEWTYPE { setstartlineno();
1383 printf("%u\n",startlineno);
1385 fprintf(stderr,"%u\tnewtype\n",startlineno);
1390 instkey : INSTANCE { setstartlineno();
1393 printf("%u\n",startlineno);
1396 fprintf(stderr,"%u\tinstance\n",startlineno);
1401 defaultkey: DEFAULT { setstartlineno(); }
1404 foreignkey: FOREIGN { setstartlineno(); }
1407 classkey: CLASS { setstartlineno();
1410 printf("%u\n",startlineno);
1412 fprintf(stderr,"%u\tclass\n",startlineno);
1417 modulekey: MODULE { setstartlineno();
1420 printf("%u\n",startlineno);
1422 fprintf(stderr,"%u\tmodule\n",startlineno);
1427 oparenkey: OPAREN { setstartlineno(); }
1430 ounboxparenkey: OUNBOXPAREN { setstartlineno(); }
1433 obrackkey: OBRACK { setstartlineno(); }
1436 lazykey : LAZY { setstartlineno(); }
1439 minuskey: MINUS { setstartlineno(); }
1443 /**********************************************************************
1446 * Basic qualified/unqualified ids/ops *
1449 **********************************************************************/
1452 | OPAREN qvarsym CPAREN { $$ = $2; }
1455 | OPAREN qconsym CPAREN { $$ = $2; }
1458 | BQUOTE qvarid BQUOTE { $$ = $2; }
1461 | BQUOTE qconid BQUOTE { $$ = $2; }
1467 /* Non "-" op, used in right sections */
1472 /* Non "-" varop, used in right sections */
1474 | varsym_nominus { $$ = mknoqual($1); }
1475 | BQUOTE qvarid BQUOTE { $$ = $2; }
1480 | OPAREN varsym CPAREN { $$ = $2; }
1482 con : tycon /* using tycon removes conflicts */
1483 | OPAREN CONSYM CPAREN { $$ = $2; }
1486 | BQUOTE varid BQUOTE { $$ = $2; }
1489 | BQUOTE CONID BQUOTE { $$ = $2; }
1495 qvark : qvarid { setstartlineno(); $$ = $1; }
1496 | oparenkey qvarsym CPAREN { $$ = $2; }
1498 qconk : qconid { setstartlineno(); $$ = $1; }
1499 | oparenkey qconsym CPAREN { $$ = $2; }
1501 vark : varid { setstartlineno(); $$ = $1; }
1502 | oparenkey varsym CPAREN { $$ = $2; }
1506 | varid { $$ = mknoqual($1); }
1509 | varsym { $$ = mknoqual($1); }
1512 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1515 | CONSYM { $$ = mknoqual($1); }
1518 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1521 | tycon { $$ = mknoqual($1); } /* using tycon removes conflicts */
1524 varsym : varsym_nominus
1525 | MINUS { $$ = install_literal("-"); }
1528 /* PLUS, BANG are valid varsyms */
1529 varsym_nominus : VARSYM
1530 | PLUS { $$ = install_literal("+"); }
1531 | BANG { $$ = install_literal("!"); }
1532 | DOT { $$ = install_literal("."); }
1535 /* AS HIDING QUALIFIED are valid varids */
1536 varid : varid_noforall
1537 | FORALL { $$ = install_literal("forall"); }
1542 | AS { $$ = install_literal("as"); }
1543 | HIDING { $$ = install_literal("hiding"); }
1544 | QUALIFIED { $$ = install_literal("qualified"); }
1545 /* The rest of these guys are used by the FFI decls, a ghc (and hugs) extension. */
1546 | EXPORT { $$ = install_literal("export"); }
1547 | UNSAFE { $$ = install_literal("unsafe"); }
1548 | DYNAMIC { $$ = install_literal("dynamic"); }
1549 | LABEL { $$ = install_literal("label"); }
1550 | C_CALL { $$ = install_literal("ccall"); }
1551 | STDCALL { $$ = install_literal("stdcall"); }
1552 | PASCAL { $$ = install_literal("pascal"); }
1564 /* ---------------------------------------------- */
1565 tyvar : varid_noforall { $$ = $1; }
1568 /* tyvars1: At least one tyvar */
1569 tyvars1 : tyvar { $$ = lsing($1); }
1570 | tyvar tyvars1 { $$ = mklcons($1,$2); }
1573 /**********************************************************************
1576 * Stuff to do with layout *
1579 **********************************************************************/
1581 ocurly : layout OCURLY { hsincindent(); }
1583 vocurly : layout { hssetindent(); }
1586 layout : { hsindentoff(); }
1592 FN = NULL; SAMEFN = 0;
1597 vccurly : { expect_ccurly = 1; } vccurly1 { expect_ccurly = 0; }
1603 FN = NULL; SAMEFN = 0;
1609 FN = NULL; SAMEFN = 0;
1616 /**********************************************************************
1618 * Error Processing and Reporting *
1620 * (This stuff is here in case we want to use Yacc macros and such.) *
1622 **********************************************************************/
1629 hsperror("pattern syntax used in expression");
1632 /* The parser calls "hsperror" when it sees a
1633 `report this and die' error. It sets the stage
1634 and calls "yyerror".
1636 There should be no direct calls in the parser to
1637 "yyerror", except for the one from "hsperror". Thus,
1638 the only other calls will be from the error productions
1639 introduced by yacc/bison/whatever.
1641 We need to be able to recognise the from-error-production
1642 case, because we sometimes want to say, "Oh, never mind",
1643 because the layout rule kicks into action and may save
1647 static BOOLEAN error_and_I_mean_it = FALSE;
1653 error_and_I_mean_it = TRUE;
1657 extern char *yytext;
1664 /* We want to be able to distinguish 'error'-raised yyerrors
1665 from yyerrors explicitly coded by the parser hacker.
1667 if ( expect_ccurly && ! error_and_I_mean_it ) {
1671 fprintf(stderr, "%s:%d:%d: %s on input: ",
1672 input_filename, hsplineno, hspcolno + 1, s);
1674 if (yyleng == 1 && *yytext == '\0')
1675 fprintf(stderr, "<EOF>");
1679 format_string(stderr, (unsigned char *) yytext, yyleng);
1682 fputc('\n', stderr);
1684 /* a common problem */
1685 if (strcmp(yytext, "#") == 0)
1686 fprintf(stderr, "\t(Perhaps you forgot a `-cpp' or `-fglasgow-exts' flag?)\n");
1693 format_string(fp, s, len)
1700 case '\0': fputs("\\NUL", fp); break;
1701 case '\007': fputs("\\a", fp); break;
1702 case '\010': fputs("\\b", fp); break;
1703 case '\011': fputs("\\t", fp); break;
1704 case '\012': fputs("\\n", fp); break;
1705 case '\013': fputs("\\v", fp); break;
1706 case '\014': fputs("\\f", fp); break;
1707 case '\015': fputs("\\r", fp); break;
1708 case '\033': fputs("\\ESC", fp); break;
1709 case '\034': fputs("\\FS", fp); break;
1710 case '\035': fputs("\\GS", fp); break;
1711 case '\036': fputs("\\RS", fp); break;
1712 case '\037': fputs("\\US", fp); break;
1713 case '\177': fputs("\\DEL", fp); break;
1718 fprintf(fp, "\\^%c", *s + '@');