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

SCM Repository

[smlnj] Annotation of /sml/branches/SMLNJ/src/compiler/Parse/ast/astutil.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/compiler/Parse/ast/astutil.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 227 - (view) (download)

1 : monnier 16 (* Copyright 1992 by AT&T Bell Laboratories
2 :     *)
3 :    
4 :     structure AstUtil:ASTUTIL = struct
5 :    
6 :     open Symbol Fixity Ast PrintUtil ErrorMsg
7 :    
8 :     val unitPat = RecordPat{def=nil,flexibility=false}
9 :     val unitExp = RecordExp nil
10 :     val trueDcon = [varSymbol "true"]
11 :     val falseDcon = [varSymbol "false"]
12 :     val quoteDcon = [strSymbol "SMLofNJ", varSymbol "QUOTE"]
13 :     val antiquoteDcon = [strSymbol "SMLofNJ", varSymbol "ANTIQUOTE"]
14 :     val arrowTycon = tycSymbol "->"
15 :     val exnID = Symbol.tycSymbol "exn"
16 :     val bogusID = varSymbol "BOGUS"
17 :     val symArg = strSymbol "<Parameter>"
18 :     val itsym = [varSymbol "it"]
19 :    
20 :     fun checkFix (i, err) =
21 :     if (i < 0) orelse (9 < i)
22 :     then (
23 :     err COMPLAIN "fixity precedence must be between 0 and 9" nullErrorBody;
24 :     9)
25 :     else i
26 :    
27 :     (* layered patterns *)
28 :    
29 :     fun lay3 ((x as VarPat _), y, _) = LayeredPat{varPat=x,expPat=y}
30 :     | lay3 (ConstraintPat{pattern,constraint}, y, err) =
31 :     (err COMPLAIN "illegal (multiple?) type constraints in AS pattern"
32 :     nullErrorBody;
33 :     case lay3 (pattern,y,err)
34 :     of LayeredPat{varPat,expPat} =>
35 :     LayeredPat{varPat=varPat,
36 :     expPat=ConstraintPat{pattern=expPat,
37 :     constraint=constraint}}
38 :     | pat => pat)
39 :     | lay3 (MarkPat(x,_),y, err) = lay3 (x,y,err)
40 :     | lay3 (FlatAppPat[x],y,err) = (err COMPLAIN "parentheses illegal around variable in AS pattern" nullErrorBody; y)
41 :     | lay3 (x,y,err) = (err COMPLAIN "pattern to left of AS must be variable"
42 :     nullErrorBody; y)
43 :    
44 :     fun lay2 (ConstraintPat{pattern,constraint}, y, err) =
45 :     (err COMPLAIN "illegal (multiple?) type constraints in AS pattern"
46 :     nullErrorBody;
47 :     case lay2 (pattern,y,err)
48 :     of LayeredPat{varPat,expPat} =>
49 :     LayeredPat{varPat=varPat,
50 :     expPat=ConstraintPat{pattern=expPat,
51 :     constraint=constraint}}
52 :     | pat => pat)
53 :     | lay2 (MarkPat(x,_),y, err) = lay2 (x,y,err)
54 :     | lay2 (FlatAppPat[{item,...}],y,err) = lay3(item,y,err)
55 :     | lay2 p = lay3 p
56 :    
57 :     fun lay (ConstraintPat{pattern,constraint}, y, err) =
58 :     (case lay2 (pattern,y,err)
59 :     of LayeredPat{varPat,expPat} =>
60 :     LayeredPat{varPat=varPat,
61 :     expPat=ConstraintPat{pattern=expPat,
62 :     constraint=constraint}}
63 :     | pat => pat)
64 :     | lay (MarkPat(x,_),y, err) = lay (x,y,err)
65 :     | lay p = lay2 p
66 :    
67 :     val layered = lay
68 :    
69 :     (* sequence of declarations *)
70 :     fun makeSEQdec (SeqDec a, SeqDec b) = SeqDec(a@b)
71 :     | makeSEQdec (SeqDec a, b) = SeqDec(a@[b])
72 :     | makeSEQdec (a, SeqDec b) = SeqDec(a::b)
73 :     | makeSEQdec (a,b) = SeqDec[a,b]
74 :    
75 :    
76 :     fun QuoteExp s = AppExp{function=VarExp quoteDcon,argument=StringExp s}
77 :     fun AntiquoteExp e = AppExp{function=VarExp antiquoteDcon,argument= e}
78 :    
79 :     end (* structure *)
80 :    
81 :    
82 :     (*
83 : monnier 227 * $Log$
84 : monnier 16 *)

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