Mercurial > repos > icfp2014
view code/gqc.tp @ 55:194a1414e240
Partial implementation of Ghost-Quiche
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Sun, 27 Jul 2014 16:26:56 -0700 |
parents | |
children | fde898a3cbbe |
line wrap: on
line source
{ mem <- :_addr { #{ addr <- { _addr } string <- { "[" . _addr . "]" } isReg? <- { false } } } reg? <- :val { (object does: val understand?: "isReg?") && (val isReg?) } reg <- :_num { #{ num <- { _num } string <- { (#["a" "b" "c" "d" "e" "f" "g" "h" "pc"]) get: _num } isReg? <- { true } != <- :other { (reg?: other) && _num != (other num) } = <- :other { (reg?: other) && _num = (other num) } } } 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 <- "" comment <- "" string <- { (if: label != "" { ";" . label . "\n " } else: { " " } ) . name . " " . (args join: ", ") . ( if: comment = "" { "" } else: { " ;" . comment}) } } } _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" } _nextVar <- 0 //a and b are reserved for int/return values //h is reserved as a stack pointer _tempRegs <- [ reg: 2 reg: 3 reg: 4 reg: 5 reg: 6 ] _exprHandlers <- dict hash compileExpr:syms <- :expr :syms { _exprHandlers ifget: (expr nodeType) :handler { handler: expr syms } else: { error: "Unhandled node type " . (expr nodeType) } } _exprHandlers set: (ast intlit) :expr syms { expr val } _opNames <- dict hash _opNames set: "+" "ADD" _opNames set: "-" "SUB" _opNames set: "*" "MUL" _opNames set: "/" "DIV" _opNames set: "and" "AND" _opNames set: "or" "OR" _opNames set: "xor" "XOR" _exprHandlers set: (ast binary) :expr syms { startTempRegs <- _tempRegs l <- compileExpr: (expr left) syms: syms r <- compileExpr: (expr right) syms: syms dest <- l if: (reg?: l) { _tempRegs <- startTempRegs filter: :r { r != l } } else: { dest <- startTempRegs value prog add: (inst: "MOV" #[ dest l ]) _tempRegs <- startTempRegs tail } _opNames ifget: (expr op) :i { prog add: (inst: i #[ dest r ]) dest } else: { error: "operator " . (expr op) . " is not supported" } } _exprHandlers set: (ast sym) :expr syms { syms ifDefined: (expr name) :info { info def } else: { error: "symbol " . (expr name) . " is not defined" } } _exprHandlers set: (ast assignment) :expr syms { sym <- expr to syms ifDefined: (sym name) :info { } else: { syms define: (sym name) (mem: _nextVar) _nextVar <- _nextVar + 1 } info <- syms find: (sym name) else: { error: "this should never happen!" } startTempRegs <- _tempRegs v <- compileExpr: (expr assign) syms: syms _tempRegs <- startTempRegs dest <- info def prog add: (inst: "MOV" #[ dest v ]) dest } _compileFun <- :name fun globsyms { syms <- symbols tableWithParent: globsyms saveTempRegs <- _tempRegs foreach: (fun args) :idx arg { argname <- (if: (arg startsWith?: ":") { arg from: 1 } else: { arg }) reg <- _tempRegs value _tempRegs <- _tempRegs tail syms define: argname reg } lastexpr <- ((fun expressions) length) - 1 foreach: (fun expressions) :idx expr { saveTempRegsExpr <- _tempRegs v <- compileExpr: expr syms: syms _tempRegs <- saveTempRegsExpr if: idx = lastexpr && (name != "main") { //move result to a register prog add: (inst: "MOV" #[ reg: 0 v ]) //return instruction prog add: (inst: "MOV" #[ reg: 8 mem: (reg: 7) ]) } } saveTempRegs <- _tempRegs } #{ compile <- :code { res <- parser top: code if: res { outer <- res yield functions <- dict hash syms <- symbols table foreach: (outer messages) :idx msg { if: (msg nodeType) = (ast assignment) { def <- msg assign sym <- (msg to) name if: (def nodeType) = (ast lambda) { functions set: sym def syms define: sym sym } else: { compileExpr: msg syms: syms } } else: { error: "Only assignments are allowed at the top level" } } functions ifget: "main" :def { prog setLabel: "main" _compileFun: "main" def syms } else: { error: "Program must have a main function!" } prog add: (inst: "HLT" #[]) foreach: functions :name def { if: name != "main" { prog setLabel: name _comipleFun: name def syms } } print: prog } } compileFile <- :filename { f <- file open: filename compile: (f readAll) } main <- :args { if: (args length) > 1 { compileFile: (args get: 1) } else: { print: "Usage lmc FILE\n" } } } }