Mercurial > repos > icfp2014
changeset 3:a9a2ad99adfb
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 |
files | code/lmc.tp code/test.lm |
diffstat | 2 files changed, 116 insertions(+), 7 deletions(-) [+] |
line wrap: on
line diff
--- a/code/lmc.tp Fri Jul 25 09:32:12 2014 -0700 +++ b/code/lmc.tp Fri Jul 25 10:52:17 2014 -0700 @@ -1,4 +1,62 @@ { + inst <- :_name _args { + #{ + name <- _name + args <- _args + translateLabels <- :labelDict { + missing <- #[] + foreach: args :idx arg { + if: (object does: arg understand?: "isString?") && (arg isString?) { + labelDict ifget: arg :translated { + args set: idx translated + } else: { + missing append: arg + } + } + } + missing + } + label <- "" + string <- { + (if: label != "" { ";" . label . "\n " } else: { " " } + ) . name . " " . (args join: " ") + } + } + } + _nextLabel <- 0 + _setLabel <- :inst { + inst + } + prog <- #{ + instructions <- #[] + add <- :inst { + instructions append: (_setLabel: inst) + } + makeLabel <- :suffix { + num <- _nextLabel + _nextLabel <- _nextLabel + 1 + "" . num . "_" . suffix + } + labels <- dict hash + setLabel <- :name { + labels set: name pc + _setLabel <- :inst { + _setLabel <- :i { i } + inst label!: name + } + } + pc <- { instructions length } + print <- { + foreach: instructions :idx i { + missing <- i translateLabels: labels + if: (missing length) > 0 { + error: "Undefined labels " . (missing join: ", ") . " at address " . idx + } + print: (string: i) . "\n" + } + + } + } error <- :msg { (file stderr) write: "Error - " . msg . "\n" } @@ -14,7 +72,7 @@ } _exprHandlers set: (ast intlit) :expr { - print: " LDC " . (expr val) . "\n" + prog add: (inst: "LDC" #[(expr val)]) } _exprHandlers set: (ast sequence) :expr { @@ -26,10 +84,10 @@ if: (expr array?) { count <- count - 1 } else: { - print: " LDC 0\n" + prog add: (inst: "LDC" #[0]) } while: { count > 0} do: { - print: " CONS\n" + prog add: (inst: "CONS" #[]) count <- count - 1 } } @@ -52,12 +110,58 @@ compileExpr: (expr right) compileExpr: (expr left) } - _opNames ifget: (expr op) :inst { - print: " " . inst . "\n" + _opNames ifget: (expr op) :i { + prog add: (inst: i #[]) } else: { error: "operator " . (expr op) . " is not supported" } } + + _funHandlers <- dict hash + _funHandlers set: "if:else" :args { + compileExpr: (args value) + args <- args tail + tlabel <- prog makeLabel: "true" + flabel <- prog makeLabel: "false" + prog add: (inst: "SEL" #[ + tlabel + flabel + ]) + prog setLabel: tlabel + foreach: ((args value) expressions) :idx expr { + compileExpr: expr + } + args <- args tail + prog setLabel: flabel + foreach: ((args value) expressions) :idx expr { + compileExpr: expr + } + } + _funHandlers set: "isInteger?" :args { + compileExpr: (args value) + prog add: (inst: "ATOM" #[]) + } + _funHandlers set: "value" :args { + compileExpr: (args value) + prog add: (inst: "CAR" #[]) + } + _funHandlers set: "tail" :args { + compileExpr: (args value) + prog add: (inst: "CDR" #[]) + } + + _exprHandlers set: (ast call) :expr { + tc <- (expr tocall) + if: (tc nodeType) = (ast sym) { + _funHandlers ifget: (tc name) :handler { + handler: (expr args) + } else: { + error: "function calls not implemented yet" + } + } else: { + error: "call expression to value not implemented yet - " . tc + } + } #{ compile <- :code { res <- parser top: code @@ -76,11 +180,12 @@ compileExpr: expr } foreach: others :name fun { - print: ";" . name . "\n" + prog setLabel: name foreach: (fun expressions) :idx expr { compileExpr: expr } } + print: prog } else: { error: "Parse failed!" }