summaryrefslogtreecommitdiff
path: root/src/prog.lm
blob: 3a11e34265f79d2eeb8e6638521739b2fd2eb6c5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
include 'colm.lm'

export ColmTree: start
export ColmError: str

A: str = argv->pop()
F: stream = open( A, 'r' )
parse P: start [ F ]

alias prod_map map<prod_list, id>
alias unique_prod map_el<prod_list, id>

global PM: prod_map = new prod_map()
global NextId: int = 1
global Modified: bool = false

prod_list cons_prod( SLA: prod_sublist )
{
	if match SLA [Left: prod_sublist BAR prod_el_list]
		return cons prod_list[ cons_prod(Left) ' | [ ' SLA.prod_el_list ' ] ' ]
	else
		return cons prod_list[ '[ ' SLA.prod_el_list ' ]' ]
}

cfl_def rewrite_cfl_def( CflDef: ref<cfl_def> )
{
	NewDef: cfl_def
	for PE: prod_el in CflDef {
		if match PE [
			OptName: opt_prod_el_name POPEN PS: prod_sublist PCLOSE OptRep: opt_repeat]
		{
			PL: prod_list = cons_prod(PS)

			Name: id = PM->find( PL )
			if ( !Name ) {
				Name = parse id
					"_sublist_[sprintf("%d", NextId)]"
				NextId = NextId + 1

				PM->insert( PL, Name )

				NewDef = cons cfl_def
					"def [Name] [PL]"
			}

			PE = cons prod_el
				[OptName Name OptRep " "]

			Modified = true

			# Currently can return only one item.
			if ( NewDef )
				break
		}
	}
	return NewDef
}

void rewrite( P: ref<start> )
{
	Modified = false
	
	for RIL: root_item<* in P {
		require RIL [Head: root_item<* CflDef: cfl_def]

		NewDef: cfl_def

		NewDef = rewrite_cfl_def( CflDef )

		if NewDef {
			RIL = cons root_item<* [Head NewDef "\n\n" CflDef]
			Modified = true
		}
		else {
			RIL = cons root_item<* [Head CflDef]
		}

	}

	return Modified
}

if P {
	while ( rewrite( P ) ) {}
}

ColmTree = P
ColmError = error