Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/compiler/Parse/ast/astutil.sml
ViewVC logotype

View of /sml/trunk/src/compiler/Parse/ast/astutil.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 114 - (download) (annotate)
Fri Jun 5 19:41:21 1998 UTC (22 years, 1 month ago) by monnier
File size: 2670 byte(s)
This commit was generated by cvs2svn to compensate for changes in r113,
which included commits to RCS files with non-trunk default branches.
(* Copyright 1992 by AT&T Bell Laboratories 
 *)

structure AstUtil:ASTUTIL = struct    

open Symbol Fixity Ast PrintUtil ErrorMsg

val unitPat = RecordPat{def=nil,flexibility=false}
val unitExp = RecordExp nil
val trueDcon = [varSymbol "true"]
val falseDcon = [varSymbol "false"]
val quoteDcon = [strSymbol "SMLofNJ", varSymbol "QUOTE"]
val antiquoteDcon = [strSymbol "SMLofNJ", varSymbol "ANTIQUOTE"]
val arrowTycon = tycSymbol "->"
val exnID = Symbol.tycSymbol "exn"
val bogusID = varSymbol "BOGUS"
val symArg = strSymbol "<Parameter>"
val itsym = [varSymbol "it"]

fun checkFix (i, err) =
      if (i < 0) orelse (9 < i)
	then (
	  err COMPLAIN "fixity precedence must be between 0 and 9" nullErrorBody;
	  9)
	else i

(* layered patterns *)

fun lay3 ((x as VarPat _), y, _) = LayeredPat{varPat=x,expPat=y}
  | lay3 (ConstraintPat{pattern,constraint}, y, err) = 
	 (err COMPLAIN "illegal (multiple?) type constraints in AS pattern" 
		       nullErrorBody;
          case lay3 (pattern,y,err)
           of LayeredPat{varPat,expPat} =>
	     LayeredPat{varPat=varPat,
			expPat=ConstraintPat{pattern=expPat,
					     constraint=constraint}}
            | pat => pat)
  | lay3 (MarkPat(x,_),y, err) = lay3 (x,y,err)
  | lay3 (FlatAppPat[x],y,err) = (err COMPLAIN "parentheses illegal around variable in AS pattern" nullErrorBody; y)
  | lay3 (x,y,err) = (err COMPLAIN "pattern to left of AS must be variable"
			    nullErrorBody; y)

fun lay2 (ConstraintPat{pattern,constraint}, y, err) = 
	 (err COMPLAIN "illegal (multiple?) type constraints in AS pattern" 
		       nullErrorBody;
          case lay2 (pattern,y,err)
           of LayeredPat{varPat,expPat} =>
	     LayeredPat{varPat=varPat,
			expPat=ConstraintPat{pattern=expPat,
					     constraint=constraint}}
            | pat => pat)
  | lay2 (MarkPat(x,_),y, err) = lay2 (x,y,err)
  | lay2 (FlatAppPat[{item,...}],y,err) = lay3(item,y,err)
  | lay2 p = lay3 p

fun lay (ConstraintPat{pattern,constraint}, y, err) = 
         (case lay2 (pattern,y,err)
           of LayeredPat{varPat,expPat} =>
	     LayeredPat{varPat=varPat,
			expPat=ConstraintPat{pattern=expPat,
					     constraint=constraint}}
            | pat => pat)
  | lay (MarkPat(x,_),y, err) = lay (x,y,err)
  | lay p = lay2 p

val layered = lay

(* sequence of declarations *)
fun makeSEQdec (SeqDec a, SeqDec b) = SeqDec(a@b)
  | makeSEQdec (SeqDec a, b) = SeqDec(a@[b])
  | makeSEQdec (a, SeqDec b) = SeqDec(a::b)
  | makeSEQdec (a,b) = SeqDec[a,b]


fun QuoteExp s = AppExp{function=VarExp quoteDcon,argument=StringExp s}
fun AntiquoteExp e = AppExp{function=VarExp antiquoteDcon,argument= e}

end (* structure *)


(*
 * $Log$
 *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0