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

Last change on this file since 3895 was 3895, checked in by orlov, 12 years ago
  • Some progress in the LFC implementation through ASR.
File size: 3.2 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 e.prod (e.string) = ;
11Check e.prod (e.string) =
12  <Parse (e.string) (((TYPE 0) DOT e.prod 0))> :: e.sets,
13  <Map &WriteLn (e.sets)> : e,
14  e.sets : e (e ((TYPE 0 e.info) e.prod DOT 0) e);
15
16$public $func Earley t.type e.string = e.set;
17Earley t.type e.string =
18  <Parse (e.string) (((TYPE 0) DOT t.type 0))> : e (e.set),
19  e.set;
20
21$func Parse (e.string) e.sets = e.sets;
22Parse (e.string) e.sets =
23  <Completer <Predictor e.sets>> :: e.new_sets,
24  {
25    e.new_sets : e.sets = e.string : {
26      /*empty*/ = e.sets;
27      s.ch e.rest = <Parse (e.rest) <Scanner s.ch e.sets ()>>;
28    };
29    <Parse (e.string) e.new_sets>;
30  };
31
32$func Scanner s.ch e.sets = e.sets;
33Scanner s.ch e.sets (e.current) (e.new) =
34  (e.current) (e.new) $iter {
35    e.items : e ((TYPE t.name e.info) e1 DOT s.ch e2 s.n) e.rest =
36      (e.rest) (e.new ((TYPE t.name e.info s.ch) e1 s.ch DOT e2 s.n));
37    () (e.new);
38  } :: (e.items) (e.new),
39  e.items : /*empty*/ =
40  e.sets (e.current) (e.new);
41
42$func Predictor e.sets = e.sets;
43Predictor e.sets (e.current) =
44  (e.current) (/*e.new*/) $iter e.current : {
45    (t.type e1 DOT (TYPE t.name) e2 s.n) e.rest =
46      (e.rest)
47      (<Or (e.new) (t.type e1 DOT (TYPE t.name) e2 s.n)
48        <GetRules (<Get &Grammar>) t.name <Length e.sets>>>);
49    t.item e.rest =
50      (e.rest) (<Or (e.new) t.item>);
51  } :: (e.current) (e.new),
52  e.current : /*empty*/ =
53  e.sets (e.new);
54
55$func GetRules (e.grammar) t.name s.n = e.rules;
56GetRules {
57  (e (PROD (TYPE t.name) e.prods) e.rest) t.name s.n =
58    (e.prods) (/*e.rules*/) $iter {
59      e.prods : (e.prod) e.rest_prods =
60        (e.rest_prods) (e.rules ((TYPE t.name) DOT e.prod s.n));
61    } :: (e.prods) (e.rules),
62    e.prods : /*empty*/ =
63    e.rules <GetRules (e.rest) t.name s.n>;
64  (e) t.name s.n = /*empty*/;
65};
66
67$func Completer e.sets = e.sets;
68Completer e.sets =
69  e.sets : e.head (e.current),
70  (e.current) (/*e.new*/) $iter {
71    e.items : e ((TYPE t.name1 e.info1) e1 DOT s.n) e.rest =
72      <L s.n e.sets> : (e.prev_items),
73      (e.prev_items) (e.new) $iter {
74        e.prev_items : e ((TYPE t.name2 e.info2) e2 DOT (TYPE t.name1) e3 s.m) e.rest2 =
75          (e.rest2) (e.new ((TYPE t.name2 e.info2 (e.info1)) e2 (TYPE t.name1) DOT e3 s.m));
76        () (e.new);
77      } :: (e.prev_items) (e.new),
78      e.prev_items : /*empty*/ =
79      (e.rest) (e.new);
80    () (e.new);
81  } :: (e.items) (e.new),
82  e.items : /*empty*/ =
83  e.head (<Or (e.current) e.new>);
84
85$func Main = e;
86
87Main =
88  <Init (PROD (TYPE ('E')) ((TYPE ('E')) '+' (TYPE ('E'))) ('n'))>,
89  <Check (TYPE ('E')) ('n+n')>,
90  <PrintLn>,
91  <Check (TYPE ('E')) ('n+n+n')>,
92  <PrintLn>,
93  <Init (PROD (TYPE ('S')) ((TYPE ('A')) (TYPE ('A')) (TYPE ('A')) (TYPE ('A'))))
94        (PROD (TYPE ('A')) ('a') ((TYPE ('E'))))
95        (PROD (TYPE ('E')) ())>,
96  <Check (TYPE ('S')) ('a')>,
97  <PrintLn>,
98  <Init (PROD (TYPE ('T')) ((TYPE ('A'))) ((TYPE ('B'))))
99        (PROD (TYPE ('A')) ('x'))
100        (PROD (TYPE ('B')) ('x'))>,
101  <Check (TYPE ('T')) ('x')>;
Note: See TracBrowser for help on using the repository browser.