From 10c28ff25501484284305ddd4c868ecea1e3934f Mon Sep 17 00:00:00 2001
From: "Michael D. Adams" <t-madams@microsoft.com>
Date: Wed, 6 Jun 2007 09:05:10 +0000
Subject: [PATCH] Add formal parameters to the Cmm parser This patch is
 incomplete and will probably not compile by itself but it
 is being recorded to help keep track of later changes.

---
 compiler/cmm/CmmParse.y |   48 ++++++++++++++++++++++++++++++++++-------------
 1 file changed, 35 insertions(+), 13 deletions(-)

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 4690f69..6048c44 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -199,20 +199,23 @@ lits	:: { [ExtFCode CmmExpr] }
 	| ',' expr lits		{ $2 : $3 }
 
 cmmproc :: { ExtCode }
-	: info '{' body '}'
-		{ do  (info_lbl, info1, info2) <- $1;
-		      stmts <- getCgStmtsEC (loopDecls $3)
-		      blks <- code (cgStmtsToBlocks stmts)
-		      code (emitInfoTableAndCode info_lbl info1 info2 [] blks) }
+	: info maybe_formals '{' body '}'
+		{ do (info_lbl, info1, info2) <- $1;
+		     formals <- sequence $2;
+		     stmts <- getCgStmtsEC (loopDecls $4)
+		     blks <- code (cgStmtsToBlocks stmts)
+		     code (emitInfoTableAndCode info_lbl info1 info2 formals blks) }
 
-	| info ';'
+	| info maybe_formals ';'
 		{ do (info_lbl, info1, info2) <- $1;
-		     code (emitInfoTableAndCode info_lbl info1 info2 [] []) }
+		     formals <- sequence $2;
+		     code (emitInfoTableAndCode info_lbl info1 info2 formals []) }
 
-	| NAME '{' body '}'
-		{ do stmts <- getCgStmtsEC (loopDecls $3);
-		     blks <- code (cgStmtsToBlocks stmts)
-		     code (emitProc [] (mkRtsCodeLabelFS $1) [] blks) }
+	| NAME maybe_formals '{' body '}'
+		{ do formals <- sequence $2;
+		     stmts <- getCgStmtsEC (loopDecls $4);
+		     blks <- code (cgStmtsToBlocks stmts);
+		     code (emitProc [] (mkRtsCodeLabelFS $1) formals blks) }
 
 info	:: { ExtFCode (CLabel, [CmmLit],[CmmLit]) }
 	: 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
@@ -232,6 +235,7 @@ info	:: { ExtFCode (CLabel, [CmmLit],[CmmLit]) }
 		{ basicInfo $3 (mkIntCLit (fromIntegral $5)) 0 $7 $9 $11 }
 
 	| 'INFO_TABLE_RET' '(' NAME ',' INT ',' INT ',' INT ')'
+		-- size, live bits, closure type
 		{ retInfo $3 $5 $7 $9 }
 
 body	:: { ExtCode }
@@ -256,8 +260,8 @@ stmt	:: { ExtCode }
 
 -- HACK: this should just be lregs but that causes a shift/reduce conflict
 -- with foreign calls
-	| hint_lregs '=' expr ';'
-		{ do reg <- head $1; e <- $3; stmtEC (CmmAssign (fst reg) e) }
+--	| hint_lregs '=' expr ';'
+--		{ do reg <- head $1; e <- $3; stmtEC (CmmAssign (fst reg) e) }
 	| type '[' expr ']' '=' expr ';'
 		{ doStore $1 $3 $6 }
 	| maybe_results 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
@@ -420,6 +424,24 @@ lreg	:: { ExtFCode CmmReg }
 					other -> pprPanic "CmmParse:" (ftext $1 <> text " not a register") }
 	| GLOBALREG		{ return (CmmGlobal $1) }
 
+maybe_formals :: { [ExtFCode LocalReg] }
+	: {- empty -}		{ [] }
+	| '(' formals0 ')'	{ $2 }
+
+formals0 :: { [ExtFCode LocalReg] }
+	: {- empty -}		{ [] }
+	| formals		{ $1 }
+
+formals :: { [ExtFCode LocalReg] }
+	: formal ','		{ [$1] }
+	| formal		{ [$1] }
+	| formal ',' formals	{ $1 : $3 }
+
+formal :: { ExtFCode LocalReg }
+	: type NAME		{ newLocal defaultKind $1 $2 }
+	| STRING type NAME	{% do k <- parseKind $1;
+				     return $ newLocal k $2 $3 }
+
 type	:: { MachRep }
 	: 'bits8'		{ I8 }
 	| typenot8		{ $1 }
-- 
1.7.10.4