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/trunk/src/compiler/Semant/elaborate/precedence.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/Semant/elaborate/precedence.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 587 - (view) (download)

1 : monnier 249 (* Copyright 1996 by AT&T Bell Laboratories *)
2 :     (* precedence.sml *)
3 :    
4 :     signature PRECEDENCE =
5 :     sig
6 :     val parse: {apply: 'a * 'a -> 'a, pair: 'a * 'a -> 'a} ->
7 :     'a Ast.fixitem list * StaticEnv.staticEnv *
8 :     (Ast.region->ErrorMsg.complainer) -> 'a
9 :    
10 :     end (* signature PRECEDENCE *)
11 :    
12 :    
13 :     structure Precedence : PRECEDENCE =
14 :     struct
15 :    
16 :     local structure EM = ErrorMsg
17 :     structure F = Fixity
18 :    
19 :     in
20 :    
21 :     datatype 'a precStack
22 :     = INf of Symbol.symbol * int * 'a * 'a precStack
23 :     | NONf of 'a * 'a precStack
24 :     | NILf
25 :    
26 :     fun parse {apply,pair} =
27 :     let fun ensureNONf((e,F.NONfix,_,err),p) = NONf(e,p)
28 :     | ensureNONf((e,F.INfix _,SOME sym,err),p) =
29 :     (err EM.COMPLAIN
30 :     ("expression or pattern begins with infix identifier \""
31 :     ^ Symbol.name sym ^ "\"") EM.nullErrorBody;
32 :     NONf(e,p))
33 : blume 587 | ensureNONf _ = EM.impossible "precedence:ensureNONf"
34 : monnier 249
35 :     fun start token = ensureNONf(token,NILf)
36 :    
37 :     (* parse an expression *)
38 :     fun parse(NONf(e,r), (e',F.NONfix,_,err)) = NONf(apply(e,e'),r)
39 :     | parse(p as INf _, token) = ensureNONf(token,p)
40 :     | parse(p as NONf(e1,INf(_,bp,e2,NONf(e3,r))),
41 :     (e4, f as F.INfix(lbp,rbp),SOME sym,err))=
42 :     if lbp > bp then INf(sym,rbp,e4,p)
43 :     else (if lbp = bp
44 :     then err EM.WARN "mixed left- and right-associative \
45 :     \operators of same precedence"
46 :     EM.nullErrorBody
47 :     else ();
48 :     parse(NONf(apply(e2,pair (e3,e1)),r),(e4,f,SOME sym,err)))
49 :    
50 :     | parse(p as NONf _, (e',F.INfix(lbp,rbp),SOME sym,_)) =
51 :     INf(sym,rbp,e',p)
52 :     | parse _ = EM.impossible "Precedence.parse"
53 :    
54 :     (* clean up the stack *)
55 :     fun finish (NONf(e1,INf(_,_,e2,NONf(e3,r))),err) =
56 :     finish(NONf(apply(e2,pair (e3,e1)),r),err)
57 :     | finish (NONf(e1,NILf),_) = e1
58 :     | finish (INf(sym,_,e1,NONf(e2,p)),err) =
59 :     (err EM.COMPLAIN
60 :     ("expression or pattern ends with infix identifier \""
61 :     ^ Symbol.name sym ^ "\"") EM.nullErrorBody;
62 :     finish(NONf(apply(e2,e1),p),err))
63 :     | finish (NILf,err) = EM.impossible "Corelang.finish NILf"
64 :     | finish _ = EM.impossible "Corelang.finish"
65 :    
66 :     in fn (items as item1 :: items',env,error) =>
67 :     let fun getfix{item,region,fixity} =
68 :     (item, case fixity of NONE => F.NONfix
69 :     | SOME sym => Lookup.lookFix(env,sym),
70 :     fixity, error region)
71 :    
72 :     fun endloc[{region=(_,x),item,fixity}] = error(x,x)
73 :     | endloc(_::a) = endloc a
74 : blume 587 | endloc _ = EM.impossible "precedence:endloc"
75 : monnier 249
76 :     fun loop(state, a::rest) = loop(parse(state,getfix a),rest)
77 :     | loop(state,nil) = finish(state, endloc items)
78 :    
79 :     in loop(start(getfix item1), items')
80 :     end
81 : blume 587 | _ => EM.impossible "precedence:parse"
82 : monnier 249 end
83 :    
84 :     end (* local *)
85 :     end (* structure Precedence *)
86 :    
87 :    
88 :    

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