0000144: ocamlopt -p sur Alpha Linux

View Issue Details [ Jump to Notes ]

[ Issue History ] [ Print ]

Project

Category

View Status

Date Submitted

Last Update

0000144

OCaml

OCaml general

public

2000-06-19 18:01

2000-06-20 17:26

Reporter

administrator

Assigned To

Priority

normal

Severity

minor

Reproducibility

always

Status

closed

Resolution

no change required

Platform

OS Version

Product Version

Target Version

Fixed in Version

Summary

0000144: ocamlopt -p sur Alpha Linux

Description

Bug dans OCaml 3.0 sur Alpha Linux: le petit fichier source joint
- compile OK avec ocamlopt
- fait ceci avec ocamlopt -p:

[monniaux@jaunet absint]$ ocamlopt -p -c v_code.ml
File "v_code.ml", line 103, characters 7-113:
Warning: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
(BOR|BAND|BXOR|LSHIFT|RSHIFT)
Uncaught exception: End_of_file

Système: Alpha Linux, glibc 2.0.7

Merci,

David Monniaux http://www.di.ens.fr/~monniaux [^]
Laboratoire d'informatique de l'École Normale Supérieure,
Paris, France

----------------
(**********************************************************
ABSINTHE
Prototype abstract interpreter

David Monniaux, 1999, 2000
Laboratoire d'Informatique de l'École Normale Supérieure
**********************************************************)

(*
Module V_code:
Defines the code for the virtual machine

$Id: v_code.ml,v 1.10 2000/06/18 20:45:28 monniaux Exp $
*)

type integer=int
type floatval=float

type arith =
    MUL
  | ADD
  | SUB
  | DIV
  | BOR
  | BAND
  | BXOR
  | MOD
  | LSHIFT
  | RSHIFT

type comparison =
    GREATER
  | LOWER
  | EQUAL

type comparison2 =
    LOWER2
  | EQUAL2
  | GREATEREQ2
  | UNEQUAL2

type logical2 =
    OR
  | AND

type var_type =
    DOUBLE
  | INT
  | VOID

type unary =
    CAST of var_type * var_type

type ('var_code, 'non_exec) code =
    ARITH of arith * 'var_code * 'var_code * 'var_code
  | UNARY of unary * 'var_code * 'var_code
  | MOVE of 'var_code * 'var_code
  | LOAD_INT of 'var_code * integer
  | LOAD_DOUBLE of 'var_code * float
  | KNOW of (('var_code, 'non_exec) bexpr)
  | IFTHENELSE of (('var_code, 'non_exec) bexpr)
    * (('var_code, 'non_exec) block)
    * (('var_code, 'non_exec) block)
  | WHILE of (('var_code, 'non_exec) bexpr)*(('var_code, 'non_exec) block)
  | DESTROY of 'var_code
  | NOP of 'non_exec
  | FUNCALL of string*('var_code list)*'var_code

and ('var_code,'non_exec) block = (('var_code, 'non_exec) code) list

and ('var_code, 'non_exec) bexpr =
    COMPARISON of comparison
    *'var_code
    *'var_code
  | LOGICAL2 of logical2
    *(('var_code,'non_exec) bexpr)
    *(('var_code, 'non_exec) bexpr)
  | LOGIC_NOT of (('var_code,'non_exec) bexpr)
  | BE_BEFORE of ('var_code, 'non_exec) block * ('var_code, 'non_exec) bexpr
  | BE_AFTER of ('var_code, 'non_exec) bexpr * ('var_code, 'non_exec) block

type 'non_exec program =
  { nb_vars : int;
    var_types : var_type array;
    code_block : (int,'non_exec) block }

module IdentifierMap = Map.Make
  (struct type t=string let compare=Pervasives.compare end)

(* fonctions d'impression *)
let print_var_type channel ctype=
  output_string channel (match ctype with
    INT -> "int"
  | DOUBLE -> "double"
  | VOID -> "void");;

let next_tab s = " " ^ s

let rec print_code channel prepend = function
  ARITH(op, dst, src1, src2) ->
    Printf.fprintf channel "%sV%d := V%d %s V%d\n"
      prepend dst src1
      (match op with
     ADD -> "+"
       | SUB -> "-"
       | MUL -> "*"
       | DIV -> "/"
       | MOD -> "%") src2
| UNARY(op, dst, src) ->
    Printf.fprintf channel "%sV%d := %a V%d\n"
      prepend dst
      begin
    fun channel -> function
        CAST(from_type, to_type) ->
          Printf.fprintf channel "[%a -> %a]"
        print_var_type from_type
        print_var_type to_type
      end op src
| MOVE(dst, src) ->
    Printf.fprintf channel "%sV%d := V%d\n" prepend dst src
| LOAD_INT(dst, cst) ->
    Printf.fprintf channel "%sV%d := INT %d\n" prepend dst cst
| LOAD_DOUBLE(dst, cst) ->
    Printf.fprintf channel "%sV%d := DOUBLE %e\n" prepend dst cst
| IFTHENELSE(cond, clause1, clause2) ->
    Printf.fprintf channel "%sIF\n" prepend;
    print_bexpr channel (next_tab prepend) cond;
    Printf.fprintf channel "%sTHEN\n" prepend;
    List.iter (print_code channel (next_tab prepend)) clause1;
    Printf.fprintf channel "%sELSE\n" prepend;
    List.iter (print_code channel (next_tab prepend)) clause2;
    Printf.fprintf channel "%sENDIF\n" prepend
| KNOW(cond) ->
    Printf.fprintf channel "%sKNOW\n" prepend;
    print_bexpr channel (next_tab prepend) cond;
    Printf.fprintf channel "%sENDKNOW\n" prepend
| WHILE(cond, clause1) ->
    Printf.fprintf channel "%sWHILE\n" prepend;
    print_bexpr channel (next_tab prepend) cond;
    Printf.fprintf channel "%sDO\n" prepend;
    List.iter (print_code channel (next_tab prepend)) clause1;
    Printf.fprintf channel "%sDONE\n" prepend
| DESTROY(v) ->
    Printf.fprintf channel "%sDESTROY %d\n" prepend v
| NOP(_) ->
    Printf.fprintf channel "%sNOP\n" prepend
| FUNCALL(f, vars, dest) ->
    Printf.fprintf channel "%sV%d := CALL %s(%s)\n" prepend dest f
      (String.concat ", " (List.map string_of_int vars))

and print_bexpr channel prepend = function
    BE_BEFORE(code, e) ->
      begin
        Printf.fprintf channel "%sbefore {\n" prepend;
        List.iter (print_code channel (next_tab prepend)) code;
        Printf.fprintf channel "%s}\n" prepend;
    print_bexpr channel prepend e
      end
  | BE_AFTER(e, code) ->
      begin
    print_bexpr channel prepend e;
        Printf.fprintf channel "%safter {\n" prepend;
        List.iter (print_code channel (next_tab prepend)) code;
        Printf.fprintf channel "%s}\n" prepend
      end
  | COMPARISON(op, var1, var2) ->
      Printf.fprintf channel "%sV%d %s V%d\n" prepend var1
    (match op with
          GREATER -> ">"
    | LOWER -> "<"
    | EQUAL -> "=") var2
  | LOGICAL2(op, e1, e2) ->
      print_bexpr channel (next_tab prepend) e1;
      Printf.fprintf channel "%s%s\n" prepend
    (match op with
      OR -> "OR"
    | AND -> "AND");
      print_bexpr channel (next_tab prepend) e2
  | LOGIC_NOT(expr) ->
      Printf.fprintf channel "%sNOT\n" prepend;
      print_bexpr channel (next_tab prepend) expr

let print_program channel program =
  (* IndexMap.iter
    begin
      fun index var_type ->
    Printf.fprintf channel "V%d : %a\n" index print_var_type var_type
    end
    global_data.var_types; *)
  List.iter
    (print_code channel "")
    program.code_block

----------------
----------------

Issue History
Date Modified	Username	Field	Change
2005-11-18 10:13	administrator	New Issue

Notes
(0002129) administrator (administrator) 2000-06-20 17:26	NFS problem (see PR#145)

Relationships