type Program1=[Instruction+] type Instruction= Alternative | Sequence | BlocUnaire | Expression type Alternative= [ [Expression] [Instruction+] Alternant?] type Alternant=[Instruction+] type Sequence=[Instruction+] type BlocUnaire=[ Variable [Expression] [Instruction+]] type Expression=Constante | Variable | Operation | InvocationPrimitive type Variable=[] type InvocationPrimitive = [Expression*] type Operation=OperationUnaire | OperationBinaire type OperationUnaire= [ [Expression]] type OperationBinaire= =' | '>' | '<>' | '!=']>[ [Expression] [Expression]] type Constante= [] | [] | [PCDATA] | [] type IlpEntier=[('-')?('0'--'9'+)] type IlpFlottant=[('-')?('0'--'9'+)'.'('0'--'9'+)] type Env=[Mem*] type Mem=(String,Constante) let filename : Latin1= match argv [] with [x ; _] -> x | _ -> raise "Use : ilp program_name" ;; let p : Program1= match load_xml filename with (x & Program1) -> x | _ -> raise "program not compatible with ILP1" ;; let bool_of (['true' | 'false'] -> Bool) "true" -> `true | "false" -> `false ;; let ilp_bool_of (Bool -> ['true' | 'false']) `true -> "true" | `false -> "false" ;; let ilp_nbr_of (Int -> IlpEntier ; Float -> IlpFlottant) (x & Int) -> (match string_of x with [x :: (('-')?('0'--'9'+))] -> x | _ -> raise "conversion") | (x & Float) -> (match string_of x with [x :: (('-')?('0'--'9'+)'.'('0'--'9'+))] -> x | _ -> raise "conversion") ;; let eval_inst ((Env,Instruction) -> Constante) (env,(x & Alternative)) -> eval_if (env,x) | (env,(x & Sequence)) -> eval_seq (env,x) | (env,(x & BlocUnaire)) -> eval_bloc (env,x) | (env,(x & Expression)) -> eval_expression (env,x) ;; let eval_seqinst ((Env,[Instruction+]) -> Constante) (env,[(x & Instruction)]) -> eval_inst (env,x) | (env,[(x & Instruction) ; q]) -> let _=eval_inst (env,x) in eval_seqinst (env,q) ;; let eval_expression ((Env,Expression) -> Constante) (_,(x & Constante)) -> x | (e,(x & Variable)) -> eval_var (e,x) | (e,(x & Operation)) -> eval_op (e,x) | (e,(x & InvocationPrimitive)) -> eval_prim (e,x) ;; let eval_if ((Env,Alternative) -> Constante) (env,<_>[<_>[e] <_>[c :: Instruction+] <_>[a :: Instruction+]]) -> let e_v=eval_expression (env,e) in (match e_v with [] -> eval_seqinst (env,c) | [] -> eval_seqinst (env,a) | _ -> raise "condition non-booleenne") | (env,<_>[<_>[e & Expression] [c :: Instruction+]]) -> let e_v=eval_expression (env,e) in (match e_v with [] -> eval_seqinst (env,c) | [] -> [] | _ -> raise "condition non-booleenne") ;; let eval_seq ((Env,Sequence) -> Constante) (env,[(x & Instruction)]) -> eval_inst (env,x) | (env,[(x & Instruction) ; q]) -> let _=eval_inst (env,x) in eval_seqinst (env,q) ;; let eval_prim ((Env,InvocationPrimitive) -> Constante) (_,[x & Expression]) -> (let _=print_xml x in []) | _ -> raise "Unknown primitive" ;; let eval_op ((Env,Operation) -> Constante) (e,(x & OperationBinaire)) -> eval_opbin (e,x) | (e,(x & OperationUnaire)) -> eval_opun (e,x) ;; let eval_opbin ((Env,OperationBinaire) -> Constante) (env,[ [opg] [opd]]) -> let opg_ev : Constante =eval_expression (env,opg) in let opd_ev : Constante =eval_expression (env,opd) in (match (op,opg_ev,opd_ev) with ("+",[],[]) -> [] | ("-",[],[]) -> [] | ("*",[],[]) -> [] | ("/",[],[]) -> let dr=int_of y in if not(dr = 0) then [] else raise "Division par zero" | ("%",[],[]) -> let dr=int_of y in if not(dr = 0) then [] else raise "Modulo zero" | ("|",[],[]) -> [] | ("&",[],[]) -> [] | ("<",[],[]) -> [] | (">",[],[]) -> > (int_of y))) >[] | ("==",[],[]) -> [] | (">=",[],[]) -> = (int_of y))) >[] | ("<=",[],[]) -> [] | ("<>",[],[]) -> [] | ("!=",[],[]) -> [] | _ -> raise "Error sur operation binaire") ;; let eval_opun ((Env,OperationUnaire) -> Constante) (env,[<_>[exp]]) -> let c : Constante=eval_expression (env,exp) in (match c with [] -> [] | [] -> [] | _ -> raise "Operation ! sur un non-booleen") | (env,[<_>[exp]]) -> let c=eval_expression (env,exp) in (match c with [] -> [] | _ -> raise "Operation - sur un non-booleen") ;; let eval_bloc ((Env,BlocUnaire) -> Constante) (env,[[] <_>[e & Expression] <_>[i :: Instruction+]]) -> let e_v=eval_expression (env,e) in let new_env=[(n,e_v) ; env] in eval_seqinst (new_env,i) ;; let find ((Env,String) -> Constante) ([],_) -> raise "Not found" | ([((n,value) & Mem) ; q],var) -> if n=var then value else find (q,var) ;; let eval_var ((Env,Variable) -> Constante) (env,[]) -> find (env,n) ;; let eval_program (Program1 -> Constante) <_>[x :: Instruction+] -> eval_seqinst ([],x) ;; print (print_xml (eval_program p));;