CVS: sml-dist/src/ml-yacc/src absyn.sig,1.4,1.5 absyn.sml,1.5,1.6 yacc.sml,1.5,1.6
Matthias Blume <[email protected]>
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/ml-yacc/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12355/src/ml-yacc/src
Modified Files:
absyn.sig absyn.sml yacc.sml
Log Message:
fixed bug in ml-yacc (as patterns)
Index: absyn.sig
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/ml-yacc/src/absyn.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** absyn.sig 9 Jun 2000 03:39:03 -0000 1.4
--- absyn.sig 24 Jan 2005 23:39:11 -0000 1.5
***************
*** 15,22 ****
| PAPP of string * pat
| PTUPLE of pat list
! | PLIST of pat list
| PINT of int
| WILD
! | AS of pat * pat
and decl = VB of pat * exp
and rule = RULE of pat * exp
--- 15,22 ----
| PAPP of string * pat
| PTUPLE of pat list
! | PLIST of pat list * pat option
| PINT of int
| WILD
! | AS of string * pat
and decl = VB of pat * exp
and rule = RULE of pat * exp
Index: absyn.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/ml-yacc/src/absyn.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** absyn.sml 9 Jun 2000 03:39:03 -0000 1.5
--- absyn.sml 24 Jan 2005 23:39:13 -0000 1.6
***************
*** 17,24 ****
| PAPP of string * pat
| PINT of int
! | PLIST of pat list
| PTUPLE of pat list
| WILD
! | AS of pat * pat
and decl = VB of pat * exp
and rule = RULE of pat * exp
--- 17,24 ----
| PAPP of string * pat
| PINT of int
! | PLIST of pat list * pat option
| PTUPLE of pat list
| WILD
! | AS of string * pat
and decl = VB of pat * exp
and rule = RULE of pat * exp
***************
*** 59,68 ****
of WILD => WILD
| pat' => PAPP(s,pat'))
! | (PLIST l) =>
! let val l' = map f l
! in if List.exists(fn WILD=>false | _ => true) l'
! then PLIST l'
! else WILD
! end
| (PTUPLE l) =>
let val l' = map f l
--- 59,73 ----
of WILD => WILD
| pat' => PAPP(s,pat'))
! | (PLIST (l, topt)) =>
! let val l' = map f l
! val topt' = Option.map f topt
! fun notWild WILD = false
! | notWild _ = true
! in case topt' of
! SOME WILD => if List.exists notWild l' then
! PLIST (l', topt')
! else WILD
! | _ => PLIST (l', topt')
! end
| (PTUPLE l) =>
let val l' = map f l
***************
*** 72,82 ****
end
| (AS(a,b)) =>
! let val a'=f a
! val b'=f b
! in case(a',b')
! of (WILD,_) => b'
! | (_,WILD) => a'
! | _ => AS(a',b')
! end
| _ => a
in f
--- 77,85 ----
end
| (AS(a,b)) =>
! if used a then
! case f b of
! WILD => PVAR a
! | b' => AS(a,b')
! else f b
| _ => a
in f
***************
*** 97,168 ****
end
! fun printRule (say : string -> unit, sayln:string -> unit) = let
! val lp = ["("]
! val rp = [")"]
! val sp = [" "]
! val sm = [";"]
! val cm = [","]
! val cr = ["\n"]
! val unit = ["()"]
! fun printExp c =
! let fun f (CODE c) = ["(",c,")"]
! | f (EAPP(EVAR a,UNIT)) = [a," ","()"]
! | f (EAPP(EVAR a,EINT i)) = [a," ",Int.toString i]
! | f (EAPP(EVAR a,EVAR b)) = [a," ",b]
! | f (EAPP(EVAR a,b)) = List.concat[[a],lp,f b,rp]
! | f (EAPP(a,b)) = List.concat [lp,f a,rp,lp,f b,rp]
! | f (EINT i) = [Int.toString i]
! | f (ETUPLE (a::r)) =
! let fun scan nil = [rp]
! | scan (h :: t) = cm :: f h :: scan t
! in List.concat (lp :: f a :: scan r)
! end
! | f (ETUPLE _) = ["<bogus-tuple>"]
! | f (EVAR s) = [s]
! | f (FN (p,b)) = List.concat[["fn "],printPat p,[" => "],f b]
! | f (LET (nil,body)) = f body
! | f (LET (dl,body)) =
! let fun scan nil = [[" in "],f body,[" end"],cr]
! | scan (h :: t) = printDecl h :: scan t
! in List.concat(["let "] :: scan dl)
! end
! | f (SEQ (a,b)) = List.concat [lp,f a,sm,f b,rp]
! | f (UNIT) = unit
! in f c
! end
! and printDecl (VB (pat,exp)) =
! List.concat[["val "],printPat pat,["="],printExp exp,cr]
! and printPat c =
! let fun f (AS(PVAR a,PVAR b)) = [a," as ",b]
! | f (AS(a,b)) = List.concat [lp,f a,[") as ("],f b,rp]
! | f (PAPP(a,WILD)) = [a," ","_"]
! | f (PAPP(a,PINT i)) = [a," ",Int.toString i]
! | f (PAPP(a,PVAR b)) = [a," ",b]
! | f (PAPP(a,b)) = List.concat [lp,[a],sp,f b,rp]
! | f (PINT i) = [Int.toString i]
! | f (PLIST l) =
! let fun scan [h] = [f h]
! | scan (h :: t) = f h :: ["::"] :: scan t
! | scan [] = [["<bogus-list>"]]
! in List.concat (scan l)
! end
! | f (PTUPLE (a::r)) =
! let fun scan nil = [rp]
! | scan (h :: t) = cm :: f h :: scan t
! in List.concat (lp :: f a :: scan r)
! end
! | f (PTUPLE nil) = ["<bogus-pattern-tuple>"]
! | f (PVAR a) = [a]
! | f WILD = ["_"]
! in f c
! end
! fun oursay "\n" = sayln ""
! | oursay a = say a
! in fn a =>
! let val RULE(p,e) = simplifyRule a
! in app oursay (printPat p);
! say " => ";
! app oursay (printExp e)
! end
! end
end;
--- 100,162 ----
end
! fun printRule (say : string -> unit, sayln:string -> unit) r = let
! fun flat (a, []) = rev a
! | flat (a, SEQ (e1, e2) :: el) = flat (a, e1 :: e2 :: el)
! | flat (a, e :: el) = flat (e :: a, el)
! fun pl (lb, rb, c, f, [], a) = " " :: lb :: rb :: a
! | pl (lb, rb, c, f, h :: t, a) =
! " " :: lb :: f (h, foldr (fn (x, a) => c :: f (x, a))
! (rb :: a)
! t)
! fun pe (CODE c, a) = " (" :: c :: ")" :: a
! | pe (EAPP (x, y as (EAPP _)), a) =
! pe (x, " (" :: pe (y, ")" :: a))
! | pe (EAPP (x, y), a) =
! pe (x, pe (y, a))
! | pe (EINT i, a) =
! " " :: Int.toString i :: a
! | pe (ETUPLE l, a) = pl ("(", ")", ",", pe, l, a)
! | pe (EVAR v, a) =
! " " :: v :: a
! | pe (FN (p, b), a) =
! " (fn" :: pp (p, " =>" :: pe (b, ")" :: a))
! | pe (LET ([], b), a) =
! pe (b, a)
! | pe (LET (dl, b), a) =
! let fun pr (VB (p, e), a) =
! " val " :: pp (p, " =" :: pe (e, "\n" :: a))
! in " let" :: foldr pr (" in" :: pe (b, "\nend" :: a)) dl
! end
! | pe (SEQ (e1, e2), a) =
! pl ("(", ")", ";", pe, flat ([], [e1, e2]), a)
! | pe (UNIT, a) =
! " ()" :: a
! and pp (PVAR v, a) =
! " " :: v :: a
! | pp (PAPP (x, y as PAPP _), a) =
! " " :: x :: " (" :: pp (y, ")" :: a)
! | pp (PAPP (x, y), a) =
! " " :: x :: pp (y, a)
! | pp (PINT i, a) =
! " " :: Int.toString i :: a
! | pp (PLIST (l, NONE), a) =
! pl ("[", "]", ",", pp, l, a)
! | pp (PLIST (l, SOME t), a) =
! " (" :: foldr (fn (x, a) => pp (x, " ::" :: a))
! (pp (t, ")" :: a))
! l
! | pp (PTUPLE l, a) =
! pl ("(", ")", ",", pp, l, a)
! | pp (WILD, a) =
! " _" :: a
! | pp (AS (v, PVAR v'), a) =
! " (" :: v :: " as " :: v' :: ")" :: a
! | pp (AS (v, p), a) =
! " (" :: v :: " as (" :: pp (p, "))" :: a)
! fun out "\n" = sayln ""
! | out s = say s
! in
! case simplifyRule r of
! RULE (p, e) => app out (pp (p, " =>" :: pe (e, ["\n"])))
! end
end;
Index: yacc.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/ml-yacc/src/yacc.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** yacc.sml 9 Jun 2000 03:39:04 -0000 1.5
--- yacc.sml 24 Jan 2005 23:39:13 -0000 1.6
***************
*** 311,320 ****
PAPP(valueStruct^"."^symString,
if num=1 andalso pureActions
! then AS(PVAR symNum,PVAR symString)
else PVAR symNum),
! if num=1 then AS(PVAR (symString^"left"),
PVAR(symNum^"left"))
else PVAR(symNum^"left"),
! if num=1 then AS(PVAR(symString^"right"),
PVAR(symNum^"right"))
else PVAR(symNum^"right")]]
--- 311,320 ----
PAPP(valueStruct^"."^symString,
if num=1 andalso pureActions
! then AS(symNum,PVAR symString)
else PVAR symNum),
! if num=1 then AS(symString^"left",
PVAR(symNum^"left"))
else PVAR(symNum^"left"),
! if num=1 then AS(symString^"right",
PVAR(symNum^"right"))
else PVAR(symNum^"right")]]
***************
*** 325,330 ****
(* construct case pattern *)
! val pat = PTUPLE[PINT i,PLIST(map mkToken numberedRhs @
! [PVAR "rest671"])]
(* remove terminals in argument list w/o types *)
--- 325,330 ----
(* construct case pattern *)
! val pat = PTUPLE[PINT i,PLIST(map mkToken numberedRhs,
! SOME (PVAR "rest671"))]
(* remove terminals in argument list w/o types *)
***************
*** 357,361 ****
val symNum = symString ^ Int.toString num
in VB(if num=1 then
! AS(PVAR symString,PVAR symNum)
else PVAR symNum,
EAPP(EVAR symNum,UNIT))
--- 357,361 ----
val symNum = symString ^ Int.toString num
in VB(if num=1 then
! AS(symString,PVAR symNum)
else PVAR symNum,
EAPP(EVAR symNum,UNIT))
-------------------------------------------------------
This SF.Net email is sponsored by: IntelliVIEW -- Interactive Reporting
Tool for open source databases. Create drag-&-drop reports. Save time
by over 75%! Publish reports on the web. Export to DOC, XLS, RTF, etc.
Download a FREE copy at http://www.intelliview.com/go/osdn_nl