~ubuntu-branches/ubuntu/precise/ocaml-batteries/precise

« back to all changes in this revision

Viewing changes to src/syntax/pa_where/pa_where.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stefano Zacchiroli
  • Date: 2010-03-06 16:03:38 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20100306160338-spvwiv3uc4jr28hw
Tags: 1.1.0-1
* New upstream release
  - major changes, "diet" version of the library
  - fix old FTBFS error, due to major code changes (Closes: #569455)
* Revamp packaging
  - adapt to new stuff shipped by upstream
  - switch from CDBS to dh
  - adapt dependencies (generally: reduce them)
* debian/patches/
  - remove old debian/patches/{debian-specific-installation-paths,
    debian-specific-info-on-doc-availability} as obsolete
  - new patch 0001-install-fix-for-bytecode-only-build: avoid
    installing *.a files with bytecode only compilation
* debian/libbatteries-ocaml-dev.links: remove file, shortend
  /usr/bin/ocaml-batteries to the top-level no longer exists
* remove debian/README.Debian (previous content is now obsolete)
* bump Standards-Version to 3.8.4 (no changes needed)
* debian/watch: update to match new upstream version convention
* debian/libbatteries-ocaml-{dev,doc}.{docs,examples}: ship only doc
  file from the root dir, other stuff is currently out of date
  (Closes: #514265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
(* File: pa_where.ml
2
 
 
3
 
   Copyright (C) 2007-
4
 
     mfp <mfp@acm.org>
5
 
     bluestorm <bluestorm.dylc@gmail.com>
6
 
 
7
 
    This program is free software: you can redistribute it and/or
8
 
    modify it under the terms of the GNU Library General Public
9
 
    License as published by the Free Software Foundation, either
10
 
    version 2 of the License, or (at your option) any later version,
11
 
    with the special exception on linking described in the file
12
 
    LICENSE.
13
 
 
14
 
    This program is distributed in the hope that it will be useful,
15
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
16
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17
 
    GNU Library General Public License (file LICENSE) for more details.
18
 
 
19
 
   Use :
20
 
     Introduce a "where" keyword for backward declarations.
21
 
 
22
 
     Generic form :
23
 
       <something> where <declaration>  ==>  <declaration> (sep) <something>
24
 
     Supported forms : where let, where val
25
 
     Examples :
26
 
       expr where let a = b     ==>  let a = b in expr
27
 
       expr where let rec a = b ==>  let rec a = b in expr
28
 
       str_item where val a = b ==>  let a = b ;; str_item 
29
 
   
30
 
     Default case : as "where let" is the more common form,
31
 
     the "let" is optional and you can use "where" alone :
32
 
       expr where a = b  ==> let a = b in expr
33
 
 
34
 
   Associativity : a where b where c ==> (a where b) where c
35
 
   Precedence : let a = b where c and d ==> let a = (b where c and d)
36
 
 
37
 
   Example Input :
38
 
     let a =
39
 
       b c
40
 
       where b = d
41
 
       where d = e
42
 
 
43
 
     where val c = f
44
 
 
45
 
   Output :
46
 
     let c = f
47
 
 
48
 
     let a =
49
 
       let d = e in
50
 
       let b = d in
51
 
     b c
52
 
 
53
 
   Compilation :
54
 
     ocamlfind ocamlc -syntax camlp4o -package camlp4.extend,camlp4.quotations -c pa_where.ml
55
 
   Ocamlfind installation :
56
 
     ocamlfind install pa_where META pa_where.cmo pa_where.ml test.ml
57
 
   Ocamlfind use :
58
 
     ocamlfind ocamlc -syntax camlp4o -package pa_where.syntax ....
59
 
*)
60
 
 
61
 
open Camlp4
62
 
open Sig
63
 
 
64
 
module Id = struct
65
 
  let name = "pa_where"
66
 
  let version = "0.4"
67
 
  let description = "'where' backward declarations"
68
 
end
69
 
 
70
 
module Make (Syntax : Sig.Camlp4Syntax) = struct
71
 
  include Syntax
72
 
 
73
 
  let test_where_let = Gram.Entry.of_parser "test_where_let"
74
 
    (* we don't ask for the 2-deep npeek directly because, in the
75
 
       toplevel, it would hang and wait for two more tokens (wich is
76
 
       problematic if the first token was ";;" and the user is waiting
77
 
       for feedback). We only ask for the second token if the first is
78
 
       a "where" *)
79
 
    (fun strm ->
80
 
       match Stream.peek strm with
81
 
       | Some (KEYWORD "where", _) ->
82
 
           (match Stream.npeek 2 strm with
83
 
            | [ (KEYWORD "where", _); (KEYWORD ("let" | "rec"), _) ] -> ()
84
 
            | [ (KEYWORD "where", _); (KEYWORD _, _) ] -> raise Stream.Failure
85
 
            | [ (KEYWORD "where", _); _ ] -> ()
86
 
            | _ -> raise Stream.Failure)
87
 
       | _ -> raise Stream.Failure)
88
 
       
89
 
 
90
 
  EXTEND Gram
91
 
    GLOBAL: expr str_item;
92
 
 
93
 
    str_item: BEFORE "top"
94
 
      [ NONA
95
 
          [ e = str_item; "where"; "val";
96
 
            rf = opt_rec; lb = top_where_binding ->
97
 
              <:str_item< value $rec:rf$ $lb$ ; $e$ >>
98
 
          ] ];
99
 
 
100
 
    (* the test_where_let is necessary because of the dangling
101
 
       str_item/expr case :
102
 
 
103
 
       let a = b where val b = 2 *)
104
 
    expr: BEFORE "top"
105
 
      [ NONA
106
 
          [ e = expr; test_where_let; "where"; OPT "let";
107
 
            rf = opt_rec; lb = where_binding ->
108
 
              <:expr< let $rec:rf$ $lb$ in $e$ >>
109
 
          ] ];
110
 
 
111
 
    top_where_binding:
112
 
      [ LEFTA
113
 
          [ b1 = SELF; "and"; b2 = SELF -> <:binding< $b1$ and $b2$ >>
114
 
            | p = ipatt; e = fun_binding -> <:binding< $p$ = $e$ >> ] ];
115
 
 
116
 
    where_binding:
117
 
      [ LEFTA
118
 
          [ b1 = SELF; "and"; b2 = SELF -> <:binding< $b1$ and $b2$ >>
119
 
            | p = ipatt; e = fun_binding' -> <:binding< $p$ = $e$ >> ] ];
120
 
 
121
 
    (* fun_binding' is needed for associativity issues :
122
 
       (a where b where c) parses as ((a where b) where c)
123
 
       with fun_binding' and (a where (b where c)) with fun_binding.
124
 
       
125
 
       The first form was choosen as standard.
126
 
       Rationale : it more natural to have an aligned indentation,
127
 
       wich suggest the first choice :
128
 
 
129
 
       a where b
130
 
       where c
131
 
    *)     
132
 
    fun_binding':
133
 
      [ RIGHTA
134
 
          [ p = labeled_ipatt; e = SELF ->
135
 
              <:expr< fun $p$ -> $e$ >>
136
 
              | "="; e = expr LEVEL "top" -> <:expr< $e$ >>
137
 
              | ":"; t = ctyp; "="; e = expr LEVEL "top" -> <:expr< ($e$ : $t$) >>
138
 
              | ":>"; t = ctyp; "="; e = expr LEVEL "top" -> <:expr< ($e$ :> $t$) >> ] ];
139
 
 
140
 
    END
141
 
end
142
 
 
143
 
let module M = Register.OCamlSyntaxExtension(Id)(Make) in ()