Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

bug in ocamlopt in version 3.06 #8189

Closed
vicuna opened this issue Jun 26, 2003 · 3 comments
Closed

bug in ocamlopt in version 3.06 #8189

vicuna opened this issue Jun 26, 2003 · 3 comments
Labels
bug

Comments

@vicuna
Copy link

vicuna commented Jun 26, 2003

Original bug ID: 1732
Reporter: administrator
Status: closed
Resolution: fixed
Priority: normal
Severity: minor
Category: ~DO NOT USE (was: OCaml general)

Bug description

Dear Camllists,

We just moved from version 3.04 to 3.06, and unfortunately we have
found a bug in ocamlopt. I'm not sure what the problem is, but I have
prepared a bundle that I hope will enable you to duplicate it.

The bundle at the bottom of this mail contains some Caml source code
and a shell script called buildme'. As you will see from the transcript below, if I run buildme' with the 3.06 compiler, it fails
in the linking step. If I run it with the 3.04 compiler, it links
without error.

I will be hopeful that you can provide a patch or suggest a
workaround.

Norman

: nr@labrador 1666 ; sh /tmp/bb
lc.mli
rc_ast.mli
rc_parse.mli
pc.mli
pp.mli
rx.mli
srcmap.mli
verbose.mli
lc.ml
rc_ast.ml
rc.mli
pc.ml
pp.ml
rx.ml
srcmap.ml
verbose.ml
rc_parse.ml
rc_scan.ml
rc.ml
buildme
: nr@labrador 1667 ; sh buildme
Files rc_parse.cmx and rc.cmx both define a module named Rc_parse
: nr@labrador 1668 ; rm *.cm?
: nr@labrador 1669 ; PATH=/usr/local/ocaml-3.04/bin:$PATH sh buildme
: nr@labrador 1670 ;
: nr@labrador 1675 ; uname -a
Linux labrador 2.4.18 #22 SMP Tue Jul 9 10:45:21 EDT 2002 i686 Pentium III (Katmai) GenuineIntel GNU/Linux

To unbundle, "sed '1,/^# To unbundle/d' < thisfile | sh"

To unbundle, make sure both lines appear in the file

Thu Jun 26 12:31:58 EDT 2003

echo lc.mli 1>&2
sed 's/^-//' >'lc.mli' <<'End of lc.mli'
-# 25 "lc.nw"
-exception Error of string
-# 32 "lc.nw"
-type 'a lexer
-# 42 "lc.nw"
-val succeed : 'a lexer
-# 47 "lc.nw"
-val fail : string -> 'a
-# 52 "lc.nw"
-val any : 'a lexer
-# 58 "lc.nw"
-val eof : 'a lexer
-# 64 "lc.nw"
-val satisfy : (char -> bool) -> 'a lexer
-# 70 "lc.nw"
-val chr : char -> 'a lexer
-# 76 "lc.nw"
-val str : string -> 'a lexer
-# 82 "lc.nw"
-val ( *** ) : 'a lexer -> 'a lexer -> 'a lexer
-val seq : 'a lexer -> 'a lexer -> 'a lexer
-# 91 "lc.nw"
-val ( ||| ) : 'a lexer -> 'a lexer -> 'a lexer
-val alt : 'a lexer -> 'a lexer -> 'a lexer
-# 98 "lc.nw"
-val many : 'a lexer -> 'a lexer
-# 106 "lc.nw"
-val some : 'a lexer -> 'a lexer
-# 112 "lc.nw"
-val opt : 'a lexer -> 'a lexer
-# 118 "lc.nw"
-val save : (string -> int -> int -> 'a) -> 'a lexer -> 'a lexer
-# 153 "lc.nw"
-val saveStr : string lexer -> string lexer
-# 160 "lc.nw"
-val scan: string -> 'a lexer -> (int * 'a list)
-# 167 "lc.nw"
-val scanFrom : int -> string -> 'a lexer -> (int * 'a list)
End of lc.mli
echo rc_ast.mli 1>&2
sed 's/^-//' >'rc_ast.mli' <<'End of rc_ast.mli'
-# 126 "rc.nw"
-type id = string

-type rc =

  •            | RCstr         of string

  •            | RCbool        of bool

  •            | RCint         of int

  •            | RCfloat       of float

  •            | RClist        of rc list

-# 140 "rc.nw"
-type rcdict
-# 147 "rc.nw"
-val find : id -> rcdict -> rc
-# 156 "rc.nw"
-val empty : rcdict
-# 162 "rc.nw"
-val add : id -> rc -> rcdict -> rcdict
-# 168 "rc.nw"
-val asList : rcdict -> (id * rc) list
End of rc_ast.mli
echo rc_parse.mli 1>&2
sed 's/^-//' >'rc_parse.mli' <<'End of rc_parse.mli'
-type token =

  • STR of (string)
  • | ID of (string)
  • | BOOL of (bool)
  • | FLOAT of (float)
  • | INT of (int)
  • | COMMA
  • | EQUAL
  • | TRUE
  • | FALSE
  • | EOF

-val rcfile :

  • (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Rc_ast.rcdict
    End of rc_parse.mli
    echo pc.mli 1>&2
    sed 's/^-//' >'pc.mli' <<'End of pc.mli'
    -# 60 "pc.nw"
    -type ('t, 'v) par = 't list -> 'v * 't list

-exception Error of string

-# 74 "pc.nw"
-val fail: string -> 'a
-val succeed: 'v -> ('t,'v) par

-# 81 "pc.nw"
-val any: ('t,'t) par

-# 87 "pc.nw"
-val eof: ('t,bool) par

-# 95 "pc.nw"
-val satisfy: ('t -> bool) -> ('t,'t) par

-# 103 "pc.nw"
-val literal: 't -> ('t,'t) par

-# 144 "pc.nw"
-val ( *** ): ('t,'v1) par -> ('t,'v2) par -> ('t,('v1*'v2)) par

-# 154 "pc.nw"
-val ( **< ): ('t,'v1) par -> ('t,'v2) par -> ('t,'v1) par
-val ( **> ): ('t,'v1) par -> ('t,'v2) par -> ('t,'v2) par

-# 163 "pc.nw"
-val ( ||| ): ('t,'v) par -> ('t,'v) par -> ('t,'v) par

-# 173 "pc.nw"
-val ( --> ): ('t,'v1) par -> ('v1 -> 'v2) -> ('t,'v2) par

-# 181 "pc.nw"
-val return: 'v1 -> 'v2 -> 'v1

-# 195 "pc.nw"
-val opt: ('t,'v) par -> ('t,'v option) par

-# 214 "pc.nw"
-val some: ('t,'v) par -> ('t,'v list) par

End of pc.mli
echo pp.mli 1>&2
sed 's/^-//' >'pp.mli' <<'End of pp.mli'
-# 50 "pp.nw"
-type doc

-# 56 "pp.nw"
-val empty : doc

-# 63 "pp.nw"
-val (^^) : doc -> doc -> doc

-# 70 "pp.nw"
-val text : string -> doc

-# 81 "pp.nw"
-val break : doc

-# 88 "pp.nw"
-val breakWith : string -> doc

-# 103 "pp.nw"
-val nest : int -> doc -> doc

-# 117 "pp.nw"
-val hgrp : doc -> doc

-# 128 "pp.nw"
-val vgrp : doc -> doc

-# 149 "pp.nw"
-val agrp : doc -> doc

-# 158 "pp.nw"
-val fgrp : doc -> doc

-# 181 "pp.nw"
-val ppToString : int -> doc -> string
-val ppToFile : out_channel -> int -> doc -> unit
-# 201 "pp.nw"
-val list : doc -> ('a -> doc) -> 'a list -> doc
-val commalist : ('a -> doc) -> 'a list -> doc

-# 209 "pp.nw"
-val (^/) : doc -> doc -> doc

-# 216 "pp.nw"
-val block : ('a -> doc) -> 'a list -> doc
End of pp.mli
echo rx.mli 1>&2
sed 's/^-//' >'rx.mli' <<'End of rx.mli'
-# 29 "rx.nw"
-type 'a rx
-# 35 "rx.nw"
-val zero : 'a rx (* never matches )
-val unit : 'a rx ( matches empty input )
-val sym : 'a -> 'a rx ( 'x' )
-val many : 'a rx -> 'a rx ( e* )
-val some : 'a rx -> 'a rx ( e+ )
-val opt : 'a rx -> 'a rx ( e? )
-val seq : 'a rx -> 'a rx -> 'a rx ( e1 e2 )
-val alt : 'a rx -> 'a rx -> 'a rx ( e1 | e2 )
-val ( ||| ) : 'a rx -> 'a rx -> 'a rx ( e1 | e2 )
-val ( *** ) : 'a rx -> 'a rx -> 'a rx ( e1 e2 )
-# 51 "rx.nw"
-val matches : 'a rx -> 'a list -> bool
-# 58 "rx.nw"
-val matchstr : char rx -> string -> bool
End of rx.mli
echo srcmap.mli 1>&2
sed 's/^-//' >'srcmap.mli' <<'End of srcmap.mli'
-# 90 "srcmap.nw"
-type pos = int
-type rgn = pos * pos
-# 97 "srcmap.nw"
-val null : rgn
-# 108 "srcmap.nw"
-type location = string ( file *)

  •                * int       (* line   *)

  •                * int       (* column *)

-# 118 "srcmap.nw"
-type map
-val mk: unit -> map (* empty map *)
-# 131 "srcmap.nw"
-val sync : map -> pos -> location -> unit
-val nl : map -> pos -> unit
-# 138 "srcmap.nw"
-val last : map -> location
-# 145 "srcmap.nw"
-val location : map -> pos -> location
-val dump: map -> unit
-# 152 "srcmap.nw"
-type point = map * pos
-type region = map * rgn
-# 158 "srcmap.nw"
-module Str:
-sig

  • val point : point -> string
  • val region : region -> string
    -end
    End of srcmap.mli
    echo verbose.mli 1>&2
    sed 's/^-//' >'verbose.mli' <<'End of verbose.mli'
    -# 13 "verbose.nw"
    -val say : int -> string list -> unit
  • (* if VERBOSITY >= k, then say k l writes every string in l to stderr )
    -val verbosity : int (     current verbosity *)
    End of verbose.mli
    echo lc.ml 1>&2
    sed 's/^-//' >'lc.ml' <<'End of lc.ml'
    -# 178 "lc.nw"
    -exception Error of string
    -let error msg = raise (Error msg)

-let strlen = String.length (* string -> int )
-let get = String.get ( string -> int -> char *)

-type region = int * int
-# 194 "lc.nw"
-type 'a lexer = string -> int -> 'a list -> (int * 'a list)

-(* naming convention: str=actual input, x=current position in str,

  • r=region list (all regions saved by the [save] lexer) *)

-let succeed str x r = (0,r)

-# 202 "lc.nw"
-let fail msg = error msg

-# 205 "lc.nw"
-let any = fun str x r ->

  •                      if x < strlen str 

  •                      then (1,r)

  •                      else fail "unexpected eof"

-# 211 "lc.nw"
-let eof = fun str x r ->

  •                      if x = strlen str

  •                      then (0,r)

  •                      else fail "eof expected"

-# 217 "lc.nw"
-let satisfy f = fun str x r ->

  •                      if x < strlen str && f (get str x)

  •                      then (1,r)

  •                      else fail "predicate failed"

-# 223 "lc.nw"
-let chr c = satisfy ((=) c)

-# 226 "lc.nw"
-let str s = fun st x r ->

  •                      let l = strlen s in

  •                      let rec loop i =

  •                          if   i = l 

  •                          then (l,r)

  •                          else if s.[i] = st.[x+i]

  •                              then loop (i+1)

  •                              else fail "str failed"

  •                          in 

  •                              loop 0

-# 238 "lc.nw"
-let seq l1 l2 = fun str x r ->

  •                      let (i1,r1) = l1 str  x     r    in

  •                      let (i2,r2) = l2 str (x+i1) r1   in

  •                          (i1+i2,r2)

-let ( *** ) = seq

-# 246 "lc.nw"
-let alt l1 l2 = fun str x r ->

  •                      try l1 str x r with

  •                          Error _ -> try l2 str x r with

  •                              Error _ -> fail "(x ||| y) failed"

  •                      (* the fun below seems superficial but it is

  •                         not: it prevents endless recursion in 

  •                         definitions like "let word = many any"

  •                         which are caused by strict evaluation

  •                         *)

-let (|||) = alt

-# 259 "lc.nw"
-let rec many l = fun str x r ->

  •                      (l *** many l ||| succeed) str x r

-# 263 "lc.nw"
-let some l = l *** many l

-# 266 "lc.nw"
-let opt l = l ||| succeed

-# 269 "lc.nw"
-let save f l = fun str x r ->

  •                      let (i,r') = l str x r   in

  •                          (i,f str x i :: r')

-# 274 "lc.nw"
-let saveStr l = save String.sub l

-(* auxilary functions *)

-let scanFrom x str lexer = lexer str x []
-let scan str lexer = lexer str 0 []
End of lc.ml
echo rc_ast.ml 1>&2
sed 's/^-//' >'rc_ast.ml' <<'End of rc_ast.ml'
-# 172 "rc.nw"
-type id = string

-type rc =

  •            | RCstr of string

  •            | RCbool of bool

  •            | RCint of int

  •            | RCfloat of float

  •            | RClist of rc list

-module IdMap =

  • Map.Make(struct type t=id let compare=Pervasives.compare end)

-(* rc files are maps (or dictinoaries) which map identifiers

  • to values (of type rc from above) *)

-type rcdict = rc IdMap.t

-let empty = IdMap.empty
-let find = IdMap.find
-let add = IdMap.add

-(* [asList dictfile] returns the contents of [dictfile] as a lsit of

  • id/rc pairs. This is for debugging only *)

-let asList dict =

  • let insert id rc list = (id,rc)::list in
  •    IdMap.fold insert dict []

End of rc_ast.ml
echo rc.mli 1>&2
sed 's/^-//' >'rc.mli' <<'End of rc.mli'
-# 57 "rc.nw"
-type id = Rc_ast.id
-type rc = Rc_ast.rc
-type rcdict = Rc_ast.rcdict

-exception Error of string (* reports parse/scan errors *)
-# 68 "rc.nw"
-val find : id -> rcdict -> rc
-# 74 "rc.nw"
-val read : string -> rcdict
End of rc.mli
echo pc.ml 1>&2
sed 's/^-//' >'pc.ml' <<'End of pc.ml'
-# 230 "pc.nw"
-exception Error of string
-let error s = raise (Error s)

-type ('t,'v) par = 't list -> 'v * ('t list)
-# 241 "pc.nw"
-let succeed v ts = (v,ts)
-let fail msg = error msg

-let any = function

  • | [] -> fail "token expected but none found"
  • | t::ts -> succeed t ts

-let eof = function

  • | [] -> succeed true []
  • | _ -> fail "end of input expected but token found"

-let satisfy f = function

  • | [] -> fail "satisfy parser: no input"
  • | t::ts -> if f t
  •               then succeed t ts

  •               else fail "token does not satisfy predicate"

-let literal x = satisfy ((=) x)

-# 299 "pc.nw"
-let ( ||| ) p1 p2 = fun ts ->

  • try p1 ts with
  • Error _ -> try p2 ts with
  •            Error _ -> fail "all alternatives failed"

-let ( --> ) p f = fun ts ->

  • let (v,ts') = p ts
  • in (f v, ts')

-let return x = fun _ -> x

-let ( *** ) p1 p2 = fun ts ->

  • let (v1,ts1) = p1 ts in
  • let (v2,ts2) = p2 ts1 in
  •    ((v1,v2),ts2)

-let ( **> ) p1 p2 =

  • p1 *** p2 --> snd

-let ( **< ) p1 p2 =

  • p1 *** p2 --> fst

-let rec many p = fun ts ->

  • ( p *** (many p) --> (fun (x,y)->x::y)
  •    ||| succeed []
  • ) ts

-let opt p =

  •    p --> (fun x -> Some x)
  • ||| succeed None

-let some p =

  • p *** many p --> (fun (x,y) -> x::y)

End of pc.ml
echo pp.ml 1>&2
sed 's/^-//' >'pp.ml' <<'End of pp.ml'
-# 462 "pp.nw"
-let debug = false
-let strlen = String.length

-# 470 "pp.nw"
-let nl = "\n"

-# 244 "pp.nw"
-type gmode =

  • | GFlat (* hgrp *)
  • | GBreak (* vgrp *)
  • | GFill (* fgrp *)
  • | GAuto (* agrp *)

-# 230 "pp.nw"
-type doc =

  • | DocNil
  • | DocCons of doc * doc
  • | DocText of string
  • | DocNest of int * doc
  • | DocBreak of string
  • | DocGroup of gmode * doc

-# 256 "pp.nw"
-let (^^) x y = DocCons(x,y)
-let empty = DocNil
-let text s = DocText(s)
-let nest i x = DocNest(i,x)
-let break = DocBreak(" ")
-let breakWith s = DocBreak(s)

-let hgrp d = DocGroup(GFlat, d)
-let vgrp d = DocGroup(GBreak,d)
-let agrp d = if debug

  •                      then DocGroup(GAuto, text "[" ^^ d ^^ text "]")

  •                      else DocGroup(GAuto, d)

-let fgrp d = if debug

  •                      then DocGroup(GFill, text "{" ^^ d ^^ text "}")

  •                      else DocGroup(GFill, d)

-# 286 "pp.nw"
-type sdoc =

  • | SNil
  • | SText of string * sdoc
  • | SLine of int * sdoc (* newline + spaces *)

-# 303 "pp.nw"
-let sdocToString sdoc =

  • let buf = Buffer.create 256 in
  • let rec loop = function
  •    | SNil              -> ()

  •    | SText(s,d)        -> ( Buffer.add_string buf s

  •                           ; loop d

  •                           )

  •    | SLine(i,d)        -> let prefix = String.make i ' ' in

  •                           ( Buffer.add_char   buf '\n'

  •                           ; Buffer.add_string buf prefix

  •                           ; loop d

  •                           )
  • in
  •    ( loop sdoc

  •    ; Buffer.contents buf

  •    )

-let sdocToFile oc doc =

  • let pstr = output_string oc in
  • let rec loop = function
  •    | SNil          -> () 

  •    | SText(s,d)    -> pstr s; loop d

  •    | SLine(i,d)    -> let prefix = String.make i ' ' 

  •                       in  pstr nl;

  •                           pstr prefix;

  •                           loop d
  • in
  •    loop doc

-# 344 "pp.nw"
-type mode =

  • | Flat
  • | Break
  • | Fill

-# 405 "pp.nw"
-let rec fits w = function

  • | _ when w < 0 -> false
  • | [] -> true
  • | (i,m,DocNil) :: z -> fits w z
  • | (i,m,DocCons(x,y)) :: z -> fits w ((i,m,x)::(i,m,y)::z)
  • | (i,m,DocNest(j,x)) :: z -> fits w ((i+j,m,x)::z)
  • | (i,m,DocText(s)) :: z -> fits (w - strlen s) z
  • | (i,Flat, DocBreak(s)) :: z -> fits (w - strlen s) z
  • | (i,Fill, DocBreak(_)) :: z -> true
  • | (i,Break,DocBreak(_)) :: z -> true
  • | (i,m,DocGroup(_,x)) :: z -> fits w ((i,Flat,x)::z)

-# 374 "pp.nw"
-let rec format w k = function

  • | [] -> SNil
  • | (i,m,DocNil) :: z -> format w k z
  • | (i,m,DocCons(x,y)) :: z -> format w k ((i,m,x)::(i,m,y)::z)
  • | (i,m,DocNest(j,x)) :: z -> format w k ((i+j,m,x)::z)
  • | (i,m,DocText(s)) :: z -> SText(s ,format w (k + strlen s) z)
  • | (i,Flat, DocBreak(s)) :: z -> SText(s ,format w (k + strlen s) z)
  • | (i,Fill, DocBreak(s)) :: z -> let l = strlen s in
  •                                        if   fits (w - k - l) z 

  •                                        then SText(s, format w (k+l) z)

  •                                        else SLine(i, format w  i    z)
  • | (i,Break,DocBreak(s)) :: z -> SLine(i,format w i z)
  • | (i,m,DocGroup(GFlat ,x)) :: z -> format w k ((i,Flat ,x)::z)
  • | (i,m,DocGroup(GFill ,x)) :: z -> format w k ((i,Fill ,x)::z)
  • | (i,m,DocGroup(GBreak,x)) :: z -> format w k ((i,Break,x)::z)
  • | (i,m,DocGroup(GAuto, x)) :: z -> if fits (w-k) ((i,Flat,x)::z)
  •                                    then format w k ((i,Flat ,x)::z)

  •                                    else format w k ((i,Break,x)::z)

-# 422 "pp.nw"
-let ppToString w doc =

  • sdocToString (format w 0 [0,Flat,agrp(doc)])

-let ppToFile oc w doc =

  • sdocToFile oc (format w 0 [0,Flat,agrp(doc)])

-# 433 "pp.nw"
-let rec list sep f xs =

  • let rec loop acc = function
  •    | []    -> acc

  •    | [x]   -> acc ^^ f x 

  •    | x::xs -> loop (acc ^^ f x ^^ sep) xs
  • in
  •    loop empty xs

-let commalist f = list (text "," ^^ break) f

-let (^/) x y = x ^^ break ^^ y
-let (~~) x = x

-let block f xs =

  • text "{"
  • ^^ nest 4 begin
  •   ~~ break

  •   ^^ list break f xs

  •   end
  • ^/ text "}"

End of pp.ml
echo rx.ml 1>&2
sed 's/^-//' >'rx.ml' <<'End of rx.ml'
-# 66 "rx.nw"
-type 'a rx =

  •            | RXzero                                (* {}           *)

  •            | RXunit                                (* ""           *)

  •            | RXsym         of 'a                   (* 'x'          *)

  •            | RXmany        of ('a rx)              (* e*           *)

  •            | RXsome        of ('a rx)              (* e+           *)

  •            | RXopt         of ('a rx)              (* e?           *)

  •            | RXseq         of ('a rx) * ('a rx)    (* e1 e2        *)

  •            | RXalt         of ('a rx) * ('a rx)    (* e1 | e2      *)

-# 76 "rx.nw"
-let zero = RXzero
-let unit = RXunit
-let sym x = RXsym x
-let many = function

  •            | RXunit        -> RXunit

  •            | RXzero        -> RXunit

  •            | x             -> RXmany x

-let some = function

  •            | RXunit        -> RXunit

  •            | RXzero        -> RXzero

  •            | x             -> RXsome x

-let opt = function

  •            | RXunit        -> RXunit

  •            | RXzero        -> RXunit

  •            | x             -> RXopt x

-let seq x y = match (x,y) with

  •            | RXzero, x     -> RXzero

  •            | RXunit, x     -> x

  •            | x     , RXzero-> RXzero

  •            | x     , RXunit-> x

  •            | x     , y     -> RXseq(x,y)

-let alt x y = match (x,y) with

  •            | RXzero, x     -> x

  •            | x     , RXzero-> x

  •            | x     , y     -> RXalt(x,y)

-# 102 "rx.nw"
-let ( ||| ) = alt
-let ( *** ) = seq
-# 110 "rx.nw"
-let rec nullable = function

  • | RXzero -> false
  • | RXunit -> true
  • | RXsym x -> false
  • | RXmany e -> true
  • | RXsome e -> nullable e
  • | RXopt e -> true
  • | RXseq(e1,e2) -> nullable e1 && nullable e2
  • | RXalt(e1,e2) -> nullable e1 || nullable e2
    -# 125 "rx.nw"
    -let rec residual e' x = match e' with
  • | RXzero -> RXzero
  • | RXunit -> RXzero
  • | RXsym x' -> if x' = x
  •                       then RXunit

  •                       else RXzero
  • | RXmany e -> seq (residual e x) (many e)
  • | RXsome e -> seq (residual e x) (many e)
  • | RXopt e -> residual e x
  • | RXseq(e1,e2) -> if nullable e1
  •                       then alt (seq (residual e1 x) e2) (residual e2 x)

  •                       else seq (residual e1 x) e2
  • | RXalt(e1,e2) -> alt (residual e1 x) (residual e2 x)
    -# 144 "rx.nw"
    -let matches e syms = nullable (List.fold_left residual e syms)
    -# 151 "rx.nw"
    -let matchstr e str =
  • let len = String.length str in
  • let rec loop e i =
  •    if   i = len 

  •    then nullable e

  •    else loop (residual e (String.get str i)) (i+1)
  • in
  •    loop e 0

End of rx.ml
echo srcmap.ml 1>&2
sed 's/^-//' >'srcmap.ml' <<'End of srcmap.ml'
-# 175 "srcmap.nw"
-type pos = int
-type rgn = pos * pos
-type location = string (* file *)

  •                * int       (* line   *)

  •                * int       (* column *)

-# 181 "srcmap.nw"
-let null = (0,0)
-# 189 "srcmap.nw"
-type syncpoint = pos * location
-# 213 "srcmap.nw"
-type map = { mutable points: syncpoint array

  •                ; mutable top:          int

  •                ; files :               (string, string) Hashtbl.t

  •                }

-type point = map * pos
-type region = map * rgn
-# 227 "srcmap.nw"
-let size = 2 (* small to test alloc *)
-let undefined = (0, ("undefined", -1, -1))

-# 231 "srcmap.nw"
-let mk () =

  • { points = Array.create size undefined
  • ; top = 0
  • ; files = Hashtbl.create 17
  • }

-# 245 "srcmap.nw"
-let alloc srcmap =

  • let length = Array.length srcmap.points in
  •    if   srcmap.top < length then 

  •        ()

  •    else 

  •        let points' = Array.create length undefined in

  •            srcmap.points <- Array.append srcmap.points points'

-# 261 "srcmap.nw"
-let sync srcmap pos (file,line,col) =

  • let _ = alloc srcmap in
  • let file' = try Hashtbl.find srcmap.files file
  •            with Not_found -> ( Hashtbl.add srcmap.files file file

  •                              ; file

  •                              )
  • in
  • let location' = (file', line, col) in
  • let top = srcmap.top in
  •    ( assert ((pos = 0) || (fst srcmap.points.(top-1) < pos))

  •    ; srcmap.points.(top) <- (pos,location')

  •    ; srcmap.top <- srcmap.top + 1

  •    )

-# 280 "srcmap.nw"
-let last map =

  • ( assert (map.top > 0 && map.top <= Array.length map.points)
  • ; snd map.points.(map.top-1)
  • )
    -# 305 "srcmap.nw"
    -let nl srcmap pos =
  • let _ = alloc srcmap in
  • let (file, line, _) = last srcmap in
  • let location' = (file, line+1,1) in
  • let top = srcmap.top in
  •    ( assert ((pos = 0) || (fst srcmap.points.(top-1) < pos))

  •    ; srcmap.points.(top) <- (pos,location')

  •    ; srcmap.top <- srcmap.top + 1

  •    )

-# 320 "srcmap.nw"
-let cmp x (y,_) = compare x y
-# 330 "srcmap.nw"
-let search x array length cmp =

  • let rec loop left right =
  •    if left > right then

  •        ( assert (0 <= right && right < Array.length array)

  •        ; array.(right)

  •        )

  •    else

  •        let pivot = (left + right)/2 in

  •        let res   = cmp x array.(pivot) in

  •        let _     = assert (0 <= pivot && pivot < Array.length array) in

  •            if res = 0 then 

  •                array.(pivot)

  •            else if res < 0 then

  •                loop left (pivot-1)

  •            else

  •                loop (pivot+1) right
  • in
  •    ( assert (length > 0)

  •    ; loop 0 (length-1)

  •    )

-# 360 "srcmap.nw"
-let location map pos =

  • let pos',(file,line,col) = search pos map.points map.top cmp in
  • (file,line,pos - pos' + col)
    -# 369 "srcmap.nw"
    -let dump map =
  • let point (pos,(file,line,col)) =
  •    Printf.printf "%5d: %-32s %4d %3d\n" pos file line col
  • in
  •    for i=0 to map.top-1 do

  •        point map.points.(i)

  •    done

-# 382 "srcmap.nw"
-module Str = struct

  • let point (map,pos) =
  •  let (file,line,column) = location map pos in

  •  Printf.sprintf "File \"%s\", line %d, character %d" file line column
  • let region (map,rgn) =
  •    match rgn with 

  •    | (0,0)        -> Printf.sprintf "<unknown location>"

  •    | (left,right) -> 

  •    let (file1,l1,col1) = location map left   in

  •    let (file2,l2,col2) = location map right  in

  •        if file1 = file2 && l1 = l2 then

  •            Printf.sprintf 

  •            "File \"%s\", line %d, characters %d-%d" file1 l1 col1 col2

  •        else if file1 = file2 then

  •            Printf.sprintf 

  •            "File \"%s\", line %d, character %d - line %d, character %d"

  •            file1 l1 col1 l2 col2

  •        else

  •            Printf.sprintf 

  •            "File \"%s\", line %d, character %d - file %s, line %d, character %d"

  •            file1 l1 col2 file2 l2 col2

-end
End of srcmap.ml
echo verbose.ml 1>&2
sed 's/^-//' >'verbose.ml' <<'End of verbose.ml'
-# 18 "verbose.nw"
-let verbosity = try int_of_string (Sys.getenv "VERBOSITY") with _ -> 0
-let err l = List.iter prerr_string l; flush stderr
-let say k = if verbosity >= k then err else ignore
End of verbose.ml
echo rc_parse.ml 1>&2
sed 's/^-//' >'rc_parse.ml' <<'End of rc_parse.ml'
-type token =

  • STR of (string)
  • | ID of (string)
  • | BOOL of (bool)
  • | FLOAT of (float)
  • | INT of (int)
  • | COMMA
  • | EQUAL
  • | TRUE
  • | FALSE
  • | EOF

-open Parsing
-# 2 "rc_parse.mly"
-open Rc_ast
-(* Line 5, file rc_parse.ml *)
-let yytransl_const = [|

  • 262 (* COMMA *);
  • 263 (* EQUAL *);
  • 264 (* TRUE *);
  • 265 (* FALSE *);
  • 0 (* EOF *);
  • 0|]

-let yytransl_block = [|

  • 257 (* STR *);
  • 258 (* ID *);
  • 259 (* BOOL *);
  • 260 (* FLOAT *);
  • 261 (* INT *);
  • 0|]

-let yylhs = "\255\255
-\001\000\002\000\002\000\003\000\003\000\004\000\004\000\004\000
-\004\000\004\000\004\000\005\000\005\000\000\000"

-let yylen = "\002\000
-\002\000\000\000\002\000\003\000\003\000\001\000\001\000\001\000
-\001\000\001\000\001\000\003\000\003\000\002\000"

-let yydefred = "\000\000
-\002\000\000\000\014\000\000\000\000\000\001\000\003\000\000\000
-\007\000\006\000\011\000\010\000\008\000\009\000\000\000\000\000
-\000\000\000\000\012\000\013\000"

-let yydgoto = "\002\000
-\003\000\004\000\007\000\015\000\016\000"

-let yysindex = "\255\255
-\000\000\000\000\000\000\001\000\255\254\000\000\000\000\003\255
-\000\000\000\000\000\000\000\000\000\000\000\000\007\255\008\255
-\003\255\003\255\000\000\000\000"

-let yyrindex = "\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\002\000\003\000
-\000\000\000\000\000\000\000\000"

-let yygindex = "\000\000
-\000\000\000\000\000\000\248\255\000\000"

-let yytablesize = 261
-let yytable = "\001\000
-\006\000\004\000\005\000\009\000\010\000\008\000\011\000\012\000
-\019\000\020\000\013\000\014\000\017\000\018\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000
-\000\000\000\000\005\000\004\000\005\000"

-let yycheck = "\001\000
-\000\000\000\000\000\000\001\001\002\001\007\001\004\001\005\001
-\017\000\018\000\008\001\009\001\006\001\006\001\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255
-\255\255\255\255\002\001\002\001\002\001"

-let yynames_const = "\

  • COMMA\000\
  • EQUAL\000\
  • TRUE\000\
  • FALSE\000\
  • EOF\000\
  • "

-let yynames_block = "\

  • STR\000\
  • ID\000\
  • BOOL\000\
  • FLOAT\000\
  • INT\000\
  • "

-let yyact = [|

  • (fun _ -> failwith "parser")
    -; (fun parser_env ->
  • let _1 = (peek_val parser_env 1 : 'rclines) in
  • Obj.repr((
    -# 19 "rc_parse.mly"
  •                                              _1            ) : Rc_ast.rcdict))

-; (fun parser_env ->

  • Obj.repr((
    -# 21 "rc_parse.mly"
  •                                              empty         ) : 'rclines))

-; (fun parser_env ->

  • let _1 = (peek_val parser_env 1 : 'rclines) in
  • let _2 = (peek_val parser_env 0 : 'rcline) in
  • Obj.repr((
    -# 22 "rc_parse.mly"
  •                                              let (id,rc) = _2 in

  •                                              add id rc _1

  •                                            ) : 'rclines))

-; (fun parser_env ->

  • let _1 = (peek_val parser_env 2 : string) in
  • let _3 = (peek_val parser_env 0 : 'value) in
  • Obj.repr((
    -# 26 "rc_parse.mly"
  •                                              (_1,_3)       ) : 'rcline))

-; (fun parser_env ->

  • let _1 = (peek_val parser_env 2 : string) in
  • let _3 = (peek_val parser_env 0 : 'values) in
  • Obj.repr((
    -# 27 "rc_parse.mly"
  •                                              (_1,RClist(List.rev _3))  ) : 'rcline))

-; (fun parser_env ->

  • let _1 = (peek_val parser_env 0 : string) in
  • Obj.repr((
    -# 29 "rc_parse.mly"
  •                                              RCstr(_1)     ) : 'value))

-; (fun parser_env ->

  • let _1 = (peek_val parser_env 0 : string) in
  • Obj.repr((
    -# 30 "rc_parse.mly"
  •                                              RCstr(_1)     ) : 'value))

-; (fun parser_env ->

  • Obj.repr((
    -# 31 "rc_parse.mly"
  •                                              RCbool(true)  ) : 'value))

-; (fun parser_env ->

  • Obj.repr((
    -# 32 "rc_parse.mly"
  •                                              RCbool(false) ) : 'value))

-; (fun parser_env ->

  • let _1 = (peek_val parser_env 0 : int) in
  • Obj.repr((
    -# 33 "rc_parse.mly"
  •                                              RCint(_1)     ) : 'value))

-; (fun parser_env ->

  • let _1 = (peek_val parser_env 0 : float) in
  • Obj.repr((
    -# 34 "rc_parse.mly"
  •                                              RCfloat(_1)   ) : 'value))

-; (fun parser_env ->

  • let _1 = (peek_val parser_env 2 : 'value) in
  • let _3 = (peek_val parser_env 0 : 'value) in
  • Obj.repr((
    -# 36 "rc_parse.mly"
  •                                              [_3  ; _1]    ) : 'values))

-; (fun parser_env ->

  • let _1 = (peek_val parser_env 2 : 'values) in
  • let _3 = (peek_val parser_env 0 : 'value) in
  • Obj.repr((
    -# 37 "rc_parse.mly"
  •                                               _3 :: _1     ) : 'values))

-(* Entry rcfile *)
-; (fun parser_env -> raise (YYexit (peek_val parser_env 0)))
-|]
-let yytables =

  • { actions=yyact;
  • transl_const=yytransl_const;
  • transl_block=yytransl_block;
  • lhs=yylhs;
  • len=yylen;
  • defred=yydefred;
  • dgoto=yydgoto;
  • sindex=yysindex;
  • rindex=yyrindex;
  • gindex=yygindex;
  • tablesize=yytablesize;
  • table=yytable;
  • check=yycheck;
  • error_function=parse_error;
  • names_const=yynames_const;
  • names_block=yynames_block }
    -let rcfile (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) =
  • (yyparse yytables 1 lexfun lexbuf : Rc_ast.rcdict)
    End of rc_parse.ml
    echo rc_scan.ml 1>&2
    sed 's/^-//' >'rc_scan.ml' <<'End of rc_scan.ml'
    -# 1 "rc_scan.mll"
  • open Rc_parse (* tokens are defined here *)
  • exception ScanError of string
  • let error msg = raise (ScanError msg)
  • let keywords = Hashtbl.create 127
  • let keyword s = Hashtbl.find keywords s
  • let _ = Array.iter (fun (x,y) -> Hashtbl.add keywords x y)
  •    [|

  •         ("true"        ,TRUE);

  •         ("false"       ,FALSE);

  •    |]
  • let get = Lexing.lexeme
  • (* buffer for string literals *)
  • let strBuffer = Buffer.create 80
  • let debug msg = print_endline msg
  • let init () =
  •    Buffer.clear strBuffer

-let lex_tables = {

  • Lexing.lex_base =
  • "\000\000\002\000\252\255\254\255\001\000\255\255\253\255\244\255\
  • \252\255\253\255\254\255\247\255\004\000\245\255\077\000\246\255\
  • \087\000\164\000\239\000\251\000\005\001\027\001\037\001\047\001\
  • \114\000\251\255";
  • Lexing.lex_backtrk =
  • "\255\255\255\255\255\255\255\255\003\000\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\011\000\255\255\006\000\255\255\
  • \005\000\005\000\255\255\006\000\007\000\255\255\255\255\007\000\
  • \255\255\255\255";
  • Lexing.lex_default =
  • "\007\000\002\000\000\000\000\000\006\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\024\000\000\000\255\255\000\000\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \024\000\000\000";
  • Lexing.lex_trans =
  • "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\008\000\009\000\010\000\010\000\010\000\025\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \010\000\000\000\011\000\012\000\003\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\013\000\000\000\000\000\000\000\
  • \014\000\014\000\014\000\014\000\014\000\014\000\014\000\014\000\
  • \014\000\014\000\000\000\000\000\000\000\015\000\000\000\000\000\
  • \000\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\016\000\000\000\000\000\000\000\004\000\016\000\
  • \000\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\016\000\018\000\025\000\019\000\019\000\019\000\
  • \019\000\019\000\019\000\019\000\019\000\019\000\019\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\000\000\000\000\000\000\000\000\017\000\000\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\000\000\000\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\000\000\
  • \005\000\255\255\005\000\017\000\255\255\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\020\000\
  • \020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\
  • \020\000\018\000\000\000\019\000\019\000\019\000\019\000\019\000\
  • \019\000\019\000\019\000\019\000\019\000\020\000\020\000\020\000\
  • \020\000\020\000\020\000\020\000\020\000\020\000\020\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\022\000\000\000\
  • \022\000\000\000\021\000\023\000\023\000\023\000\023\000\023\000\
  • \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\
  • \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\
  • \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\
  • \023\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\255\255\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • ";
  • Lexing.lex_check =
  • "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\000\000\000\000\000\000\000\000\000\000\012\000\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \000\000\255\255\000\000\000\000\001\000\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\000\000\255\255\255\255\255\255\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\255\255\255\255\255\255\000\000\255\255\255\255\
  • \255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\255\255\255\255\255\255\001\000\000\000\
  • \255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  • \000\000\000\000\000\000\014\000\024\000\014\000\014\000\014\000\
  • \014\000\014\000\014\000\014\000\014\000\014\000\014\000\016\000\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\255\255\255\255\255\255\255\255\016\000\255\255\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\
  • \016\000\016\000\255\255\255\255\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\255\255\
  • \000\000\004\000\001\000\017\000\012\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\
  • \017\000\017\000\017\000\017\000\017\000\017\000\017\000\018\000\
  • \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\
  • \018\000\019\000\255\255\019\000\019\000\019\000\019\000\019\000\
  • \019\000\019\000\019\000\019\000\019\000\020\000\020\000\020\000\
  • \020\000\020\000\020\000\020\000\020\000\020\000\020\000\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\021\000\255\255\
  • \021\000\255\255\020\000\021\000\021\000\021\000\021\000\021\000\
  • \021\000\021\000\021\000\021\000\021\000\022\000\022\000\022\000\
  • \022\000\022\000\022\000\022\000\022\000\022\000\022\000\023\000\
  • \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\
  • \023\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\024\000\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
  • "
    -}

-let rec scan lexbuf = __ocaml_lex_scan_rec lexbuf 0
-and __ocaml_lex_scan_rec lexbuf state =

  • match Lexing.engine lex_tables state lexbuf with
  • 0 -> (
    -# 39 "rc_scan.mll"
  •                      EOF )
  • | 1 -> (
    -# 40 "rc_scan.mll"
  •                      scan lexbuf )
  • | 2 -> (
    -# 41 "rc_scan.mll"
  •                      scan lexbuf )
  • | 3 -> (
    -# 42 "rc_scan.mll"
  •                      scan lexbuf )
  • | 4 -> (
    -# 43 "rc_scan.mll"
  •                      scan lexbuf )
  • | 5 -> (
    -# 45 "rc_scan.mll"
  •                      let s = get lexbuf in

  •                      try  keyword s 

  •                      with Not_found -> debug "id"; ID(s) 

  •                    )
  • | 6 -> (
    -# 49 "rc_scan.mll"
  •                      try 

  •                        INT   (int_of_string (get lexbuf)) 

  •                      with Failure _ -> 

  •                        let msg = "illegal integer `" ^ (get lexbuf) ^ "'"

  •                        in  error msg 

  •                    )
  • | 7 -> (
    -# 55 "rc_scan.mll"
  •                      try

  •                        FLOAT (float_of_string (get lexbuf)) 

  •                      with Failure _ -> 

  •                        let msg = "illegal float `" ^ (get lexbuf) ^ "'"

  •                        in  error msg 

  •                    )
  • | 8 -> (
    -# 61 "rc_scan.mll"
  •                      Buffer.clear strBuffer

  •                    ; string lexbuf 

  •                    ; STR(Buffer.contents strBuffer)

  •                    )
  • | 9 -> (
    -# 66 "rc_scan.mll"
  •                      EQUAL )
  • | 10 -> (
    -# 67 "rc_scan.mll"
  •                      COMMA )
  • | 11 -> (
    -# 69 "rc_scan.mll"
  •                      let c = get lexbuf in

  •                        error ("illegal character `" ^ c ^ "'")

  •                    )
  • | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_scan_rec lexbuf n

-and string lexbuf = __ocaml_lex_string_rec lexbuf 1
-and __ocaml_lex_string_rec lexbuf state =

  • match Lexing.engine lex_tables state lexbuf with
  • 0 -> (
    -# 73 "rc_scan.mll"
  •                      error "unterminated string" )
  • | 1 -> (
    -# 74 "rc_scan.mll"
  •                      (* return *) )
  • | 2 -> (
    -# 76 "rc_scan.mll"
  •                      let c = String.get (get lexbuf) 1 in

  •                        Buffer.add_char strBuffer c;

  •                        string lexbuf

  •                    )
  • | 3 -> (
    -# 80 "rc_scan.mll"
  •                      Buffer.add_string strBuffer (get lexbuf)

  •                    ; string lexbuf

  •                    )
  • | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_string_rec lexbuf n

-;;

End of rc_scan.ml
echo rc.ml 1>&2
sed 's/^-//' >'rc.ml' <<'End of rc.ml'
-# 82 "rc.nw"
-type id = Rc_ast.id
-type rc = Rc_ast.rc
-type rcdict = Rc_ast.rcdict

-exception Error of string
-let error msg = raise (Error msg)
-# 94 "rc.nw"
-let find = Rc_ast.find
-let asList = Rc_ast.asList
-# 102 "rc.nw"
-let read file =

  • let file_ic = try open_in file with
  •                      Sys_error msg -> error msg            in
  • let lexbuf = Lexing.from_channel file_ic in
  • let finally () = close_in file_ic in
  • let rc = try
  •                            Rc_parse.rcfile Rc_scan.scan lexbuf

  •                      with

  •                      | Parsing.Parse_error ->

  •                            finally ();

  •                            error ("parse error in `" ^ file ^ "'")

  •                      | Rc_scan.ScanError msg -> error msg

  •                      | e                   ->

  •                            finally ();

  •                            raise e                         in

  •    finally ();

  •    rc

End of rc.ml
echo buildme 1>&2
sed 's/^-//' >'buildme' <<'End of buildme'
-ocamlc -c lc.mli
-ocamlc -c rc_ast.mli
-ocamlc -c rc_parse.mli
-ocamlc -c pc.mli
-ocamlc -c pp.mli
-ocamlc -c rx.mli
-ocamlc -c srcmap.mli
-ocamlc -c verbose.mli
-ocamlopt -c lc.ml
-ocamlopt -c rc_ast.ml
-ocamlc -c rc.mli
-ocamlopt -c pc.ml
-ocamlopt -c pp.ml
-ocamlopt -c rx.ml
-ocamlopt -c srcmap.ml
-ocamlopt -c verbose.ml
-ocamlopt -c rc_parse.ml
-ocamlopt -c rc_scan.ml
-ocamlopt -c rc.ml
-ocamlopt -a -o cllib.cmxa lc.cmx rc.cmx rc_parse.cmx rc_scan.cmx pc.cmx pp.cmx rc_ast.cmx rx.cmx srcmap.cmx verbose.cmx
End of buildme
exit 0
@vicuna
Copy link
Author

vicuna commented Jun 27, 2003

Comment author: administrator

We just moved from version 3.04 to 3.06, and unfortunately we have
found a bug in ocamlopt. I'm not sure what the problem is, but I have
prepared a bundle that I hope will enable you to duplicate it.

Files rc_parse.cmx and rc.cmx both define a module named Rc_parse

The error message is atrociously wrong (and will be fixed), but 3.06
is right in complaining, while 3.04 incorrectly let your code go
through :-) This is an ordering problem between compilation units:

ocamlopt -a -o cllib.cmxa lc.cmx rc.cmx rc_parse.cmx rc_scan.cmx ...

Module Rc depends on Rc_parse and Rc_scan, hence rc.cmx should come after
rc_parse.cmx and rc_scan.cmx on the command line. There's a similar
issue with rc_ast.cmx. Your example goes through with

ocamlopt -a -o cllib.cmxa lc.cmx rc_ast.cmx rc_parse.cmx rc_scan.cmx rc.cmx pc.cmx pp.cmx rx.cmx srcmap.cmx verbose.cmx

Hope this helps,

  • Xavier

@vicuna
Copy link
Author

vicuna commented Jun 27, 2003

Comment author: administrator

Fixed by XL 2003-06-27

@vicuna vicuna closed this as completed Jun 27, 2003
@vicuna
Copy link
Author

vicuna commented Jun 27, 2003

Comment author: administrator

The error message is atrociously wrong (and will be fixed), but 3.06
is right in complaining, while 3.04 incorrectly let your code go
through :-) This is an ordering problem between compilation units...

How very embarrassing for me! I just naturally assumed that since
3.04 let it go, my code must be right. Thanks for finding my bug :-)

Norman

@vicuna vicuna added the bug label Mar 19, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Assignees
No one assigned
Labels
bug
Projects
None yet
Milestone
No milestone
Development

No branches or pull requests
1 participant
@vicuna