source: applications/trunk/LFC/ToASR/ToASR.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.6 KB
Line 
1$module ToASR;
2
3$use Access Arithm Convert Box List StdIO;
4$use Parser GrammarParser;
5
6$func Comp e.ast = e.asr;
7Comp {
8  (FUNC t.name (e.func_type) (e.var_decls) e.sentences) e.rest =
9    e.func_type : e.types t,
10    <Store &Idx 0>,
11    <Map &GenerArg (e.types)> :: e.args,
12    (LOCAL FUNC <RefName t.name> (e.args) ((EVAR)) (BRANCH (LEFT e.args) (CUTALL)
13      <Map &CallEarley (e.args)>
14      (ALT <Map &CompSentence (e.args) (e.var_decls) (e.sentences)>)
15    ))
16    <Comp e.rest>;
17  t1 e.rest = t1 <Comp e.rest>;
18  /*empty*/ = /*empty*/;
19};
20
21$box Idx;
22
23$func GenerArg t.type = t.var;
24GenerArg (TYPE (e.name)) =
25  <Get &Idx> : s.n,
26  <Store &Idx <Add s.n 1>>,
27  (EVAR (s.n e.name));
28
29$func CallEarley t.var = e.call;
30CallEarley (EVAR (s.n e.name)) =
31  (RESULT (CALL (Earley Earley) (PAREN TYPE (PAREN e.name)) (EVAR (s.n e.name))))
32  (FORMAT (EVAR (s.n)));
33
34$func CompSentence (e.args) (e.var_decls) t.sentence = e.branch;
35CompSentence (e.args) (e.var_decls) (SENTENCE t.name (e.patterns) e.exp) =
36  <Store &Idx 0>,
37  (BRANCH <Map &CompPattern (e.args) (e.var_decls) (e.patterns)> (CUTALL) (RESULT <Map &CompTerm (e.exp)>));
38
39$func CompPattern (e.args) (e.var_decls) t.pattern = e.pattern;
40CompPattern (e.args) (e.var_decls) (e.pattern) =
41  <Get &Idx> : s.n,
42  <Store &Idx <Add s.n 1>>,
43  <L s.n e.args> : (EVAR (s.n e.type_name)),
44  (RESULT (EVAR (s.n)))
45  (LEFT <FreshEVAR> (PAREN (PAREN TYPE (PAREN e.type_name) (EVAR (0 s.n))) <Map &VarType (e.var_decls) (e.pattern)> DOT 0) <FreshEVAR>)
46  (RESULT (CALL (Earley RemoveParens) (EVAR (0 s.n))))
47  (LEFT <Map &GetVar (e.pattern)>);
48
49$func VarType (e.var_decls) t.pat = t.pat;
50VarType (e.var_decls) t.pat, {
51  t.pat : (VAR t.name) =
52    e.var_decls : e (e t.pat e (TYPE (e.type_name))) e = (PAREN TYPE (PAREN e.type_name));
53  t.pat;
54};
55
56$func GetVar t.pat = e.var;
57GetVar {
58  (VAR t.name) = (PAREN (EVAR t.name));
59  t = ;
60};
61
62$func CompTerm t.term = e.asr;
63CompTerm {
64  (UNDEFINED) = (ERROR (BRANCH (RESULT UNDEFINED)));
65  s.char = s.char;
66  (VAR t.name) = (EVAR t.name);
67  (CALL t.name e.args) = (CALL <RefName t.name> <Map &CompArg (e.args)>);
68  (IF (e.cond) (e.exp_true) (e.exp_false)) = (ALT
69    (BRANCH (RESULT <Map &CompTerm (e.cond)>) (LEFT 'True') (CUTALL) <Map &CompTerm (e.exp_true)>)
70    (BRANCH <Map &CompTerm (e.exp_false)>)
71  );
72  t1 = t1;
73};
74
75$func CompArg t.arg = e.asr;
76CompArg (e.exp) = (PAREN <Map &CompTerm (e.exp)>);
77
78$box FreeIdx;
79$func FreshEVAR = t.var;
80FreshEVAR = {
81  <Get &FreeIdx> : s.n =
82    <Store &FreeIdx <Add s.n 1>>,
83    (EVAR (s.n));
84  <Store &FreeIdx 101>,
85    (EVAR (100));
86};
87
88$func GenerMain t.fname e.grammar = t.func;
89GenerMain t.fname e.grammar =
90  (LOCAL FUNC <RefName ('Main')> () ((EVAR)) (BRANCH (LEFT) (CUTALL)
91    (RESULT (CALL (Earley Init) e.grammar))
92    (RESULT (CALL <RefName t.fname>))
93  ));
94
95$func AddPAREN e = e;
96AddPAREN {
97  (e1) e2 = (PAREN <AddPAREN e1>) <AddPAREN e2>;
98  s1 e2 = s1 <AddPAREN e2>;
99  /*empty*/ = /*empty*/;
100};
101
102$box ModuleName;
103
104$func RefName t.name = t.ref_name;
105RefName (e.chars) = (<Get &ModuleName> <ToWord e.chars>);
106
107$func Main = e;
108Main =
109  <ParseFile "samples.lfc"> :: e.ast,
110  <AddPAREN <ParseGrammarFile "samples.g">> :: e.grammar,
111  <Store &ModuleName "samples">,
112  (IMPORT FUNC ("refal" "plus" StdIO WriteLn) ((EVAR)) ())
113  (IMPORT FUNC (Earley Init) ((EVAR)) ())
114  (IMPORT FUNC (Earley RemoveParens) ((EVAR)) ((EVAR)))
115  (IMPORT FUNC (Earley Earley) ((TVAR) (EVAR)) ((EVAR))) :: e.imports,
116  <Channel> :: s.ch,
117  <OpenFile s.ch "samples.asr" W>,
118  <WriteLnCh s.ch (MODULE (<Get &ModuleName>) e.imports <Comp e.ast> <GenerMain ('isBit') e.grammar>)>,
119  <CloseChannel s.ch>;
Note: See TracBrowser for help on using the repository browser.