source: applications/trunk/LFC/Earley/Earley.rf @ 3892

Last change on this file since 3892 was 3892, checked in by orlov, 12 years ago
  • Earley parser.
File size: 2.9 KB
Line 
1$module Earley;
2
3$use Access Box List StdIO;
4
5$box Grammar;
6
7$func Init e.grammar = ;
8Init e.grammar = <Store &Grammar e.grammar>;
9
10$func? Check t.type (STRING e.string) = ;
11Check t.type (STRING e.string) =
12  <Parse (e.string) (((TYPE 0) DOT t.type 0))> :: e.sets,
13  <Map &WriteLn (e.sets)> : e,
14  e.sets : e (e ((TYPE 0)t.type DOT 0) e);
15
16$func Parse (e.string) e.sets = e.sets;
17Parse (e.string) e.sets =
18  <Completer <Predictor e.sets>> :: e.new_sets,
19  {
20    e.new_sets : e.sets = e.string : {
21      /*empty*/ = e.sets;
22      s.ch e.rest = <Parse (e.rest) <Scanner s.ch e.sets ()>>;
23    };
24    <Parse (e.string) e.new_sets>;
25  };
26
27$func Scanner s.ch e.sets = e.sets;
28Scanner s.ch e.sets (e.current) (e.new) =
29  (e.current) (e.new) $iter {
30    e.items : e (t.type e1 DOT (STRING s.ch e.str) e2 s.n) e.rest =
31      (e.rest) (e.new (t.type e1 (STRING s.ch) DOT (STRING e.str) e2 s.n));
32    () (e.new);
33  } :: (e.items) (e.new),
34  e.items : /*empty*/ =
35  e.sets (e.current) (e.new);
36
37$func Predictor e.sets = e.sets;
38Predictor e.sets (e.current) =
39  (e.current) (/*e.new*/) $iter e.current : {
40    (t.type e1 DOT (TYPE t.name) e2 s.n) e.rest =
41      (e.rest)
42      (<Or (e.new) (t.type e1 DOT (TYPE t.name) e2 s.n)
43        <GetRules (<Get &Grammar>) t.name <Length e.sets>>>);
44    (t.type e1 DOT (STRING) e2 s.n) e.rest =
45      ((t.type e1 DOT e2 s.n) e.rest) (e.new);
46    t.item e.rest =
47      (e.rest) (<Or (e.new) t.item>);
48  } :: (e.current) (e.new),
49  e.current : /*empty*/ =
50  e.sets (e.new);
51
52$func GetRules (e.grammar) t.name s.n = e.rules;
53GetRules {
54  (e (PROD (TYPE t.name) e.prods) e.rest) t.name s.n =
55    (e.prods) (/*e.rules*/) $iter {
56      e.prods : (e.prod) e.rest_prods =
57        (e.rest_prods) (e.rules ((TYPE t.name) DOT e.prod s.n));
58    } :: (e.prods) (e.rules),
59    e.prods : /*empty*/ =
60    e.rules <GetRules (e.rest) t.name s.n>;
61  (e) t.name s.n = /*empty*/;
62};
63
64$func Completer e.sets = e.sets;
65Completer e.sets =
66  e.sets : e.head (e.current),
67  (e.current) (/*e.new*/) $iter {
68    e.items : e (t.type1 e1 DOT s.n) e.rest =
69      <L s.n e.sets> : (e.prev_items),
70      (e.prev_items) (e.new) $iter {
71        e.prev_items : e (t.type2 e2 DOT t.type1 e3 s.m) e.rest2 =
72          (e.rest2) (e.new (t.type2 e2 t.type1 DOT e3 s.m));
73        () (e.new);
74      } :: (e.prev_items) (e.new),
75      e.prev_items : /*empty*/ =
76      (e.rest) (e.new);
77    () (e.new);
78  } :: (e.items) (e.new),
79  e.items : /*empty*/ =
80  e.head (<Or (e.current) e.new>);
81
82$func Main = e;
83
84Main =
85  <Init (PROD (TYPE ('E')) ((TYPE ('E')) (STRING '+') (TYPE ('E'))) ((STRING 'n')))>,
86  <Check (TYPE ('E')) (STRING 'n+n')>,
87  <PrintLn>,
88  <Init (PROD (TYPE ('S')) ((TYPE ('A')) (TYPE ('A')) (TYPE ('A')) (TYPE ('A'))))
89        (PROD (TYPE ('A')) ((STRING 'a')) ((TYPE ('E'))))
90        (PROD (TYPE ('E')) ((STRING)))>,
91  <Check (TYPE ('S')) (STRING 'a')>;
Note: See TracBrowser for help on using the repository browser.