Mercurial > repos > icfp2014

comparison code/lmc.tp @ 3:a9a2ad99adfb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rework lmc a bit to support labels in generated code. Add support for certain special funcall expressions, namely: if:else, isInteger? value and tail which translate to SEL ATOM CAR and CDR respectively
author Michael Pavone <pavone@retrodev.com>
date Fri, 25 Jul 2014 10:52:17 -0700
parents 71e8d638da5c
children eaf0a014d18b
comparison
equal deleted inserted replaced
2:71e8d638da5c 3:a9a2ad99adfb
1 { 1 {
2 inst <- :_name _args {
3 #{
4 name <- _name
5 args <- _args
6 translateLabels <- :labelDict {
7 missing <- #[]
8 foreach: args :idx arg {
9 if: (object does: arg understand?: "isString?") && (arg isString?) {
10 labelDict ifget: arg :translated {
11 args set: idx translated
12 } else: {
13 missing append: arg
14 }
15 }
16 }
17 missing
18 }
19 label <- ""
20 string <- {
21 (if: label != "" { ";" . label . "\n " } else: { " " }
22 ) . name . " " . (args join: " ")
23 }
24 }
25 }
26 _nextLabel <- 0
27 _setLabel <- :inst {
28 inst
29 }
30 prog <- #{
31 instructions <- #[]
32 add <- :inst {
33 instructions append: (_setLabel: inst)
34 }
35 makeLabel <- :suffix {
36 num <- _nextLabel
37 _nextLabel <- _nextLabel + 1
38 "" . num . "_" . suffix
39 }
40 labels <- dict hash
41 setLabel <- :name {
42 labels set: name pc
43 _setLabel <- :inst {
44 _setLabel <- :i { i }
45 inst label!: name
46 }
47 }
48 pc <- { instructions length }
49 print <- {
50 foreach: instructions :idx i {
51 missing <- i translateLabels: labels
52 if: (missing length) > 0 {
53 error: "Undefined labels " . (missing join: ", ") . " at address " . idx
54 }
55 print: (string: i) . "\n"
56 }
57
58 }
59 }
2 error <- :msg { 60 error <- :msg {
3 (file stderr) write: "Error - " . msg . "\n" 61 (file stderr) write: "Error - " . msg . "\n"
4 } 62 }
5 63
6 _exprHandlers <- dict hash 64 _exprHandlers <- dict hash
12 error: "Unhandled node type " . (expr nodeType) 70 error: "Unhandled node type " . (expr nodeType)
13 } 71 }
14 } 72 }
15 73
16 _exprHandlers set: (ast intlit) :expr { 74 _exprHandlers set: (ast intlit) :expr {
17 print: " LDC " . (expr val) . "\n" 75 prog add: (inst: "LDC" #[(expr val)])
18 } 76 }
19 77
20 _exprHandlers set: (ast sequence) :expr { 78 _exprHandlers set: (ast sequence) :expr {
21 count <- 0 79 count <- 0
22 foreach: (expr els) :idx el { 80 foreach: (expr els) :idx el {
24 count <- count + 1 82 count <- count + 1
25 } 83 }
26 if: (expr array?) { 84 if: (expr array?) {
27 count <- count - 1 85 count <- count - 1
28 } else: { 86 } else: {
29 print: " LDC 0\n" 87 prog add: (inst: "LDC" #[0])
30 } 88 }
31 while: { count > 0} do: { 89 while: { count > 0} do: {
32 print: " CONS\n" 90 prog add: (inst: "CONS" #[])
33 count <- count - 1 91 count <- count - 1
34 } 92 }
35 } 93 }
36 94
37 _opNames <- dict hash 95 _opNames <- dict hash
50 compileExpr: (expr right) 108 compileExpr: (expr right)
51 } else: { 109 } else: {
52 compileExpr: (expr right) 110 compileExpr: (expr right)
53 compileExpr: (expr left) 111 compileExpr: (expr left)
54 } 112 }
55 _opNames ifget: (expr op) :inst { 113 _opNames ifget: (expr op) :i {
56 print: " " . inst . "\n" 114 prog add: (inst: i #[])
57 } else: { 115 } else: {
58 error: "operator " . (expr op) . " is not supported" 116 error: "operator " . (expr op) . " is not supported"
117 }
118 }
119
120 _funHandlers <- dict hash
121 _funHandlers set: "if:else" :args {
122 compileExpr: (args value)
123 args <- args tail
124 tlabel <- prog makeLabel: "true"
125 flabel <- prog makeLabel: "false"
126 prog add: (inst: "SEL" #[
127 tlabel
128 flabel
129 ])
130 prog setLabel: tlabel
131 foreach: ((args value) expressions) :idx expr {
132 compileExpr: expr
133 }
134 args <- args tail
135 prog setLabel: flabel
136 foreach: ((args value) expressions) :idx expr {
137 compileExpr: expr
138 }
139 }
140 _funHandlers set: "isInteger?" :args {
141 compileExpr: (args value)
142 prog add: (inst: "ATOM" #[])
143 }
144 _funHandlers set: "value" :args {
145 compileExpr: (args value)
146 prog add: (inst: "CAR" #[])
147 }
148 _funHandlers set: "tail" :args {
149 compileExpr: (args value)
150 prog add: (inst: "CDR" #[])
151 }
152
153 _exprHandlers set: (ast call) :expr {
154 tc <- (expr tocall)
155 if: (tc nodeType) = (ast sym) {
156 _funHandlers ifget: (tc name) :handler {
157 handler: (expr args)
158 } else: {
159 error: "function calls not implemented yet"
160 }
161 } else: {
162 error: "call expression to value not implemented yet - " . tc
59 } 163 }
60 } 164 }
61 #{ 165 #{
62 compile <- :code { 166 compile <- :code {
63 res <- parser top: code 167 res <- parser top: code
74 } 178 }
75 foreach: (main_fun expressions) :idx expr { 179 foreach: (main_fun expressions) :idx expr {
76 compileExpr: expr 180 compileExpr: expr
77 } 181 }
78 foreach: others :name fun { 182 foreach: others :name fun {
79 print: ";" . name . "\n" 183 prog setLabel: name
80 foreach: (fun expressions) :idx expr { 184 foreach: (fun expressions) :idx expr {
81 compileExpr: expr 185 compileExpr: expr
82 } 186 }
83 } 187 }
188 print: prog
84 } else: { 189 } else: {
85 error: "Parse failed!" 190 error: "Parse failed!"
86 } 191 }
87 } 192 }
88 193