/[svn]/compile/compile.ml
ViewVC logotype

Diff of /compile/compile.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 697 by abate, Tue Jul 10 17:56:03 2007 UTC revision 698 by abate, Tue Jul 10 17:56:40 2007 UTC
# Line 83  Line 83 
83           { vars = Env.add x (Stack env.stack_size) env.vars;           { vars = Env.add x (Stack env.stack_size) env.vars;
84             stack_size = env.stack_size + 1 }             stack_size = env.stack_size + 1 }
85    
86        ) env (IdSet.get (Patterns.fv br.Typed.br_pat)) in        ) env (Patterns.fv_list br.Typed.br_pat) in
87    (br.Typed.br_pat, compile env tail br.Typed.br_body)    (br.Typed.br_pat, compile env tail br.Typed.br_body)
88    
89    
# Line 93  Line 93 
93    
94  let enter_globals = List.fold_left enter_global  let enter_globals = List.fold_left enter_global
95    
96    let compile_eval env e = Eval (compile env false e)
97    
98  let compile_let_decl env decl =  let compile_let_decl env decl =
99    let pat = decl.Typed.let_pat in    let pat = decl.Typed.let_pat in
100    let decl = { let_pat = pat; let_expr = compile env false (decl.Typed.let_body) } in    let code = Let_decl (pat, compile env false (decl.Typed.let_body)) in
101    let names = IdSet.get (Patterns.fv pat) in    let env = enter_globals env (Patterns.fv_list pat) in
102    let env = enter_globals env names in    (env, code)
   (env, decl)  
103    
104    
105  let compile_rec_funs env funs =  let compile_rec_funs env funs =
# Line 111  Line 112 
112    let names = List.map fun_name funs in    let names = List.map fun_name funs in
113    let env = enter_globals env names in    let env = enter_globals env names in
114    let exprs = List.map (compile_abstr env) (List.map fun_a funs) in    let exprs = List.map (compile_abstr env) (List.map fun_a funs) in
115    (env, exprs)    (env, Let_funs exprs)
116    
117    
118    (****************************************)
119    
120    open Location
121    
122    let eval (tenv,cenv,codes) e =
123      let (e,_) = Typer.type_expr tenv e in
124      let code = compile_eval cenv e in
125      (tenv,cenv,code :: codes)
126    
127    let let_decl (tenv,cenv,codes) p e =
128      let (tenv,decl,_) = Typer.type_let_decl tenv p e in
129      let (cenv,code) = compile_let_decl cenv decl in
130      (tenv,cenv,code :: codes)
131    
132    let let_funs (tenv,cenv,codes) funs =
133      let (tenv,funs,_) = Typer.type_let_funs tenv funs in
134      let (cenv,code) = compile_rec_funs cenv funs in
135      (tenv,cenv,code :: codes)
136    
137    let type_defs (tenv,cenv,codes) typs =
138      let tenv = Typer.enter_types (Typer.type_defs tenv typs) tenv in
139      (tenv,cenv,codes)
140    
141    let namespace (tenv,cenv,codes) pr ns =
142      let tenv = Typer.enter_ns pr ns tenv in
143      (tenv,cenv,codes)
144    
145    let rec collect_funs accu = function
146      | { descr = Ast.FunDecl e } :: rest -> collect_funs (e::accu) rest
147      | rest -> (accu,rest)
148    
149    let rec collect_types accu = function
150      | { descr = Ast.TypeDecl (x,t) } :: rest ->
151          collect_types ((x,t) :: accu) rest
152      | rest -> (accu,rest)
153    
154    let rec phrases accu phs = match phs with
155      | { descr = Ast.FunDecl _ } :: _ ->
156          let (funs,rest) = collect_funs [] phs in
157          phrases (let_funs accu funs) rest
158      | { descr = Ast.TypeDecl (_,_) } :: _ ->
159          let (typs,rest) = collect_types [] phs in
160          phrases (type_defs accu typs) rest
161      | { descr = Ast.SchemaDecl (name, schema) } :: rest ->
162          Typer.register_schema name schema;
163          phrases accu rest
164      | { descr = Ast.Namespace (pr,ns) } :: rest ->
165          phrases (namespace accu pr ns) rest
166      | { descr = Ast.EvalStatement e } :: rest ->
167          phrases (eval accu e) rest
168      | { descr = Ast.LetDecl (p,e) } :: rest ->
169          phrases (let_decl accu p e) rest
170      | { descr = Ast.Debug l } :: rest ->
171          phrases accu rest
172      | { descr = Ast.Directive _ } :: rest ->
173          phrases accu rest
174      | [] -> accu
175    
176    let comp_unit tenv cenv phs =
177      let (tenv,cenv,codes) = phrases (tenv,cenv,[]) phs in
178      (tenv,cenv,List.rev codes)
Legend:
Removed from v.697  
changed lines
  Added in v.698
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5